mars_nwe/mars-nweadmin
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import nweadmin 0.1b from upstream zip

Browse Source
This commit is contained in:
Mario Fetka
2026-05-12 20:38:28 +02:00
parent b5395dadee
commit 94a5ab5902
142 changed files with 41657 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

339
COPYING Normal file
View File

@@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

BIN
NWADMIN.EXE Normal file
View File

Binary file not shown.

339
NWTP/COPYING Normal file
View File

@@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

9
NWTP/FILE_ID.DIZ Normal file
View File

@@ -0,0 +1,9 @@
Netware Interface Units for Pascal.
(Novell Netware 3.x and TP/BP 6.x/7.x)
Freeware. Full sources, over 300 kb. of
documentation and lots of examples. The
most complete API available for PASCAL.
KEYWORDS: LAN, Network, Novell, API,
Library, Bindery, IPX, SPX, Queue,
Tool, Reference, Workstation, Client,
Real Mode, Protected Mode, Windows.

561
NWTP/NWACCT.PAS Normal file
View File

@@ -0,0 +1,561 @@
{$X+,B-,V-,S-} {essential compiler directives}
Unit nwAcct;
{ nwAcct unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
INTERFACE
Uses nwIntr,nwMisc,nwBindry,nwConn;
{ Primary functions: Interrupt: Comments:
* GetAccountStatus (F217/96) (1)
* SubmitAccountCharge (F217/97) (2)(3)
* SubmitAccountHold (F217/98) (2)
* SubmitAccountNote (F217/99) (2)
Secondary functions:
* AccountingInstalled (4)
* SetAccountStatus (5)
* AddAccountingServer (5)
* DeleteAccountingServer (5)
* DeleteAccountHolds (2)
Notes: (1) To be called by:
-accounting servers;
-supervisor equivalent users;
-objects querying their own account status.
(2) To be called by accounting servers only.
(3) Can be imitated by supervisor-equivalent users by
calling GetAccountStatus and SetAccountStatus. Atomicity
of such a bindery transaction can not be guaranteed.
(4) Can be called by all logged on users.
(5) Supervisor equivalent users only.
}
Var result:word;
{ Type definitions based on NET$ACCT.FMT by Wolfgang Schreiber }
{ See Acct.pas in the XACCT archive for an example of their use. }
CONST { Accounting file record types }
RT_SUBMIT_CHARGE=1;
RT_ACCOUNT_NOTE =2;
{ comment types within accounting file }
CT_CONN_CHARGE = 1;
CT_STORAGE_CHARGE = 2;
CT_LOGIN_NOTE = 3;
CT_LOGOUT_NOTE = 4;
CT_INTRUDER_NOTE = 5;
CT_TIMEMOD_NOTE = 6;
CT_BOOT_NOTE = 8;
CT_DOWN_NOTE = 9;
CT_COMMENT = 99;
Type TAccDateTime6 = Array [1..6] of Byte; { date and time stamp of entry YMDHMS}
Type TComment = RECORD { interprete comments according to CmtType }
CASE Integer of
CT_CONN_CHARGE : (ConnectTime : LongInt;
RequestCount : LongInt;
BytesRead : Array[1..6] of BYTE; {hi-lo}
BytesWritten : Array[1..6] of BYTE); {hi-lo}
CT_STORAGE_CHARGE : (BlocksOwned : LongInt;
HalfHours : LongInt);
CT_LOGIN_NOTE,
CT_LOGOUT_NOTE,
CT_INTRUDER_NOTE : (Net :TnetworkAddress;
Node:TnodeAddress);
CT_TIMEMOD_NOTE : (ServerTime : TAccDateTime6);
CT_BOOT_NOTE,
CT_DOWN_NOTE : ();{ NO comment fields }
CT_COMMENT : (Comment : String)
END;
{ Use either the Type SubmitCharge or SubmitNote to interprete
an entry - decide on typecasting with the aid of the RecType field. }
Type TChargeRecord = RECORD
Length : Word;
ServerObjId : LongInt; {hi-lo}
TimeStamp : TAccDateTime6;
RecType : BYTE; {Record type Note/Charge}
ccode : BYTE; {completion code}
ServiceType : WORD; {hi-lo}
ClientObjID : LongInt; {hi-lo}
Charge : LongInt; {hi-lo}
CommentType : WORD; {hi-lo}
Comment : Tcomment; {Variable length field}
END;
Type TNoteRecord = RECORD
Length : Word;
ServerObjId : LongInt; {hi-lo}
TimeStamp : TAccDateTime6;
RecType : BYTE;
ccode : BYTE;
ServiceType : WORD; {hi-lo}
ClientObjID : LongInt; {hi-lo}
CommentType : WORD; {hi-lo}
Comment : TComment;
END;
{F217/96 [2.15c+]}
Function GetAccountStatus(objName:string; objType:word;
Var balance,limit,holds:LongInt):boolean;
{F217/97 [2.15c+]}
Function SubmitAccountCharge(objName:string; objType:word;
charge,cancelHoldAmount:Longint;
serviceType, commentType:word; comment:string):boolean;
{F217/98 [2.15c+]}
Function SubmitAccountHold(objName:string; objType:word;
reserveAmount:Longint ):boolean;
{F217/99 [2.15c+]}
Function SubmitAccountNote(objName:string; objType:word;
serviceType,commentType:word; comment:string):boolean;
{--------Secondary Functions-----------------------------------------------}
Function AccountingInstalled:boolean;
Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
{ need to be supervisor equivalent to use this call }
Function AddAccountingServer(objName:string;objType:word):boolean;
{ need to be supervisor equivalent to use this call }
Function DeleteAccountingServer(objName:string;objType:word):boolean;
{ need to be supervisor equivalent to use this call }
Function DeleteAccountHolds(objName:string; objType:word):boolean;
{ delete all holds the caller (an accounting server) has on the
object with name objName of type objType. }
Type Tcharge=record
DaysOfCharge:Byte; { bit 0=sunday,.. bit 6=saturday }
TimeOfCharge:Byte; { 0:00=0 ..23:30 =47, half-hour
during which the specified 'new' rate takes effect. }
ChargeRateMultiplier,
ChargeRateDivisor:Word;
end;
TchargeRec=record
NextChargeTime:Longint; { minutes since 1-1-1985 }
charges:array[1..20] of Tcharge;
end;
Type TchargeTableEntry=array[0..47] of Real;
Var ChargeTable:Array [0..6] of TchargeTableEntry;
IMPLEMENTATION {===========================================================}
Procedure GetBindryAccountStatus(objName:string; objType:word;
Var balance,limit,holds:LongInt);
{ called by GetAccountStatus when the calling object isn't an
accounting server. The F217/96 fails, but a bindery read will
work for supervisor-equivalent users. }
Var accPropVal:Tproperty;
accVal: record
_balance:LongInt; {hi-lo}
_limit:LongInt; {hi-lo}
_Reserved:array[1..120] of byte; { NW internal info }
end ABSOLUTE accPropVal;
holdPropVal:Tproperty;
holdVal: array[1..16]
of record
AccountServerID:Longint; {hi-lo}
HoldAmount :LongInt; {hi-lo}
end ABSOLUTE holdPropVal;
moreSegments:boolean;
t,propFlags:byte;
begin
IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
accPropVal,moreSegments,propFlags)
then begin
balance:=Lswap(accVal._balance);
limit:=Lswap(accVal._limit);
IF ReadPropertyValue(objName,objType,'ACCOUNT_HOLDS',1,
holdPropVal,moreSegments,propFlags)
then begin { holds exist. }
holds:=0;
for t:=1 to 16
do if holdVal[t].AccountServerID<>0
then holds:=holds+Lswap(holdVal[t].HoldAmount);
end;
if nwBindry.result=$FB
then begin
result:=0;
holds:=0;
end
else result:=nwBindry.result;
end
else if nwBindry.result=$FB { no such property }
then result:=$C1
else if nwBindry.result=$F1 { invalid bindery security }
then result:=$C0
else result:=nwBindry.result;
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
FF Bindery Failure}
end;
{F217/96 [2.15c+]}
Function GetAccountStatus(objName:string; objType:word;
Var balance,limit,holds:LongInt):boolean;
{ equivalent to reading the ACCOUNT_BALANCE and ACCOUNT_HOLDS properties
of the object. The properties may not exist. }
{ This function will be successful if:
a) the caller is an accounting server on the current fileserver
OR b) the caller is supervisor-equivalent
OR c) the caller is querying his own account status }
Type Treq=record
len:word;
subF:byte;
_objType:word; {hi-lo}
_objName:string[48];
end;
Trep=record
_balance: LongInt; {hi-lo}
_limit : Longint; {hi-lo}
reserved: array [1..120] of byte;
_holds : array [1..16]
of record
serverObjId:LongInt; {hi-lo}
HoldAmount :LongInt {hi-lo}
end;
end;
TPreq=^Treq;
TPrep=^Trep;
Var t:byte;
begin
With TPreq(GlobalReqBuf)^
do begin
len:=sizeOf(Treq)-2;
subf:=$96;
_objType:=swap(objType); { force hi-lo}
PstrCopy(_objName,objName,48); UpString(_objName);
end;
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
With TPrep(GlobalReplyBuf)^
do begin
balance:=Lswap(_balance); { force lo-hi again }
limit:=Lswap(_limit); { force lo-hi again }
holds:=0;
for t:=1 to 16
do if _holds[t].serverObjId<>0
then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
end;
IF result=$C0 { no account privileges }
then GetBindryAccountStatus(objName,objType,balance,limit,holds);
{ try to read status not as an accounting server, but as a supervisor }
GetAccountStatus:=(result=0);
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
end;
{F217/97 [2.15c+]}
Function SubmitAccountCharge(objName:string; objType:word;
charge,cancelHoldAmount:Longint;
serviceType, commentType:word; comment:string):boolean;
{ -The cancelHold amount should be exactly the same as the amount that
was put on huld with the SubmitAccountHold call. If no
SubmitAccountHold call was made, the cancelHoldAmount should be set to zero.
-'negative charges' are allowed. They will increase the balance of
the object objName of objType.
-Use the objectType of caller for the serviceType parameter.
(audit log purposes)
-Set commentType to 0 and comment to '' if you aren't interested in the
audit log.
-To be called by accounting servers only.
-Can be imitated by supervisor-equivalent users by
calling GetAccountStatus and SetAccountStatus. Atomicity
of such a bindery transcation can not be guaranteed.
}
Type Treq=record
len :word;
subf:byte;
_serviceType:word; {hi-lo}
_charge :Longint; {hi-lo}
_cancelHold :Longint; {hi-lo}
_objType :word; {hi-lo}
_commentType:word; {hi-lo}
_objNameAndComment:Array[1..305] of char;
end;
TPreq=^Treq;
Var p:byte;
begin
With TPreq(GlobalReqBuf)^
do begin
subf:=$97;
_serviceType:= swap(serviceType); {force hi-lo}
_charge :=Lswap(charge); {force hi-lo}
_cancelHold :=Lswap(cancelHoldAmount); {force hi-lo}
_objType := swap(objType); {force hi-lo}
_commentType:= swap(commentType); {force hi-lo}
p:=ord(objName[0]);if p>48 then p:=48;
UpString(objName);
Move(objname[0],_objNameandComment[1],p+1);
Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
len:=15+p+1+ord(comment[0])+1;
F2SystemCall($17,len+2,0,result);
end;
SubmitAccountCharge:=(result=$00);
{ resultcodes: 00 successful; C0 No Account Privileges;
C1 No Account Balance; C2 Credit Limit Exceeded. }
end;
{F217/98 [2.15c+]}
Function SubmitAccountHold(objName:string; objType:word;
reserveAmount:Longint ):boolean;
{ To be called by accounting servers only. }
Type Treq=record
len :word;
subf:byte;
_reserveAmount:Longint; {hi-lo}
_objType:word; {hi-lo}
_objName:string[48];
end;
TPreq=^Treq;
Var p:byte;
begin
With TPreq(GlobalReqBuf)^
do begin
subf:=$98;
_reserveAmount:=Lswap(ReserveAmount); { force hi-lo}
_objType:=swap(objType); { force hi-lo }
p:=ord(objName[0]); if p>48 then p:=48;
_objName:=objname;UpString(_objName);_objName[0]:=chr(p);
len:=7+p+1;
F2SystemCall($17,len+2,0,result);
end;
SubmitAccountHold:=(result=$00);
{ resultcodes: 00 successful; C0 No Account Privileges;
C1 No Account Balance; C2 Credit Limit Exceeded.
C3 Account Too Many Holds }
end;
{F217/99 [2.15c+]}
Function SubmitAccountNote(objName:string; objType:word;
serviceType,commentType:word; comment:string):boolean;
{ To be called by accounting servers only.}
Type Treq=record
len:word;
subf:byte;
_serviceType:word; {hi-lo}
_objType:word; {hi-lo}
_commentType:word; {hi-lo}
_objNameAndComment:array[1..305] of char;
end;
TPreq=^Treq;
Var p:byte;
begin
with TPreq(GlobalReqBuf)^
do begin
subf:=$99;
_serviceType:= swap(serviceType); {force hi-lo}
_objType := swap(objType); {force hi-lo}
_commentType:= swap(commentType); {force hi-lo}
p:=ord(objName[0]);if p>48 then p:=48;
UpString(objName);
Move(objname[0],_objNameandComment[1],p+1);
Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
len:=7+p+1+ord(comment[0])+1;
F2SystemCall($17,len+2,0,result);
end;
SubmitAccountNote:=(result=0);
{resultcodes: 00 Successful; C0 No Account Privileges }
end;
{---------------- Secondary Functions--------------------------------------}
Function AccountingInstalled:boolean;
Var propVal:Tproperty;
connId:byte;
moreSegments:boolean;
propFlags:byte;
currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
then result:=nwConn.result
else if NOT GetFileServerName(ConnId,currServerName)
then result:=nwConn.result
else begin
ReadPropertyValue(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',1,
propVal,moreSegments,propFlags);
result:=nwBindry.result;
end;
AccountingInstalled:=(result=0);
end;
Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
{ will change the account status to reflect the given parameters.
any holds will not be changed.
You need to be supervisor-eq. to do this...}
Var accPropVal:Tproperty;
accVal: record
_balance:LongInt; {hi-lo}
_limit:LongInt; {hi-lo}
_Reserved:array[1..120] of byte; { NW internal info }
end ABSOLUTE accPropVal;
OldBalance,OldLimit,OldHolds:LongInt;
moreSegments:boolean;
propFlags:byte;
begin
IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
accPropVal,moreSegments,propFlags)
then begin
accVal._balance:=Lswap(balance); { force hi-lo}
accVal._limit:=Lswap(limit); { force hi-lo}
WritePropertyValue(objName,objType,'ACCOUNT_BALANCE',
1,accPropVal,FALSE);
if (nwBindry.result=$F1) or (nwBindry.result=$F8)
then result:=$C0
else result:=nwBindry.result;
end
else if nwBindry.result=$FB { no such property }
then result:=$C1
else if nwBindry.result=$F1 { invalid bindery security }
then result:=$C0
else result:=nwBindry.result;
SetAccountStatus:=(result=$00);
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
FF Bindery Failure}
end;
Function AddAccountingServer(objName:string;objType:word):boolean;
Var ConnId:byte;
currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
then result:=nwConn.result
else if NOT GetFileServerName(ConnId,currServerName)
then result:=nwConn.result
else begin
AddBinderyObjectToSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
objName,objType);
result:=nwBindry.result;
end;
AddAccountingServer:=(result=0);
end;
Function DeleteAccountingServer(objName:string;objType:word):boolean;
Var ConnId:byte;
currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
then result:=nwConn.result
else if NOT GetFileServerName(ConnId,currServerName)
then result:=nwConn.result
else begin
DeleteBinderyObjectFromSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
objName,objType);
result:=nwBindry.result;
end;
DeleteAccountingServer:=(result=0);
end;
{F217/96 }
Function DeleteAccountHolds(objName:string; objType:word):boolean;
{ delete all holds the caller (an accounting server) has on the
object with name objName of type objType. }
Type Treq=record
len:word;
subF:byte;
_objType:word; {hi-lo}
_objName:string[48];
end;
Trep=record
_balance: LongInt; {hi-lo}
_limit : Longint; {hi-lo}
reserved: array [1..120] of byte;
_holds : array [1..16]
of record
serverObjId:LongInt; {hi-lo}
HoldAmount :LongInt {hi-lo}
end;
end;
TPreq=^Treq;
TPrep=^Trep;
Var t:byte;
holds:LongInt;
level:byte;
accServerId:LongInt;
accServerType:word;
accServerName:string;
begin
GetBinderyAccessLevel(Level,accServerID);
GetBinderyObjectName(accServerID,accServerName,accServerType);
With TPreq(GlobalReqBuf)^
do begin
len:=sizeOf(Treq)-2;
subf:=$96;
_objType:=swap(objType); { force hi-lo}
PstrCopy(_objName,objName,48); UpString(_objName);
end;
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
if result=0
then With TPrep(GlobalReplyBuf)^
do begin
holds:=0;
for t:=1 to 16
do if accServerID=Lswap(_holds[t].serverObjId)
then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
if holds<>0
then SubmitAccountCharge(objName,objType,0,holds,
accServerType,0,'clearing holds');
end;
DeleteAccountHolds:=(result=0);
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
end;
Function GetConnectTimeCharge(Var currentCharge:Real;Var chargeRec:TchargeRec):boolean;
Var propVal:Tproperty;
_chargeRec:TchargeRec ABSOLUTE propVal;
_currcharge:record
fill:LongInt;
currMult,currDiv:word; {hi-lo}
end ABSOLUTE propVal;
connId:byte;
moreSegments:boolean;
propFlags:byte;
currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
then result:=nwConn.result
else if NOT GetFileServerName(ConnId,currServerName)
then result:=nwConn.result
else if ReadPropertyValue(currServerName,OT_FILE_SERVER,
'CONNECT_TIME',1,
propVal,moreSegments,propFlags)
then begin
IF _currCharge.currDiv=0
then currentCharge:=0
else currentCharge:=Swap(_currCharge.currMult)/Swap(_currCharge.currDiv);
move(propVal[9],propVal[5],124);
chargeRec:=_chargeRec;
result:=0;
end
else result:=nwBindry.result;
GetConnectTimeCharge:=(result=0);
end;
end.

1442
NWTP/NWBINDRY.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

1455
NWTP/NWCONN.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

2999
NWTP/NWFILE.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

761
NWTP/NWINTR.PAS Normal file
View File

@@ -0,0 +1,761 @@
UNIT NWintr;
{ DPMI Protected mode calls: Hubert Plattfaut of 2:2447/203.4
Windows Protected Mode calls:
-Based on EZDPMI by Julian M. Bucknall [1993: 100116.1572@Compuserve.Com]
-Based on the NetCalls and WinDPMI units by Siebrand Dijkstra [1995: 2:512/250.595]
-Corrections by Berend de Boer [1995: berend@beard.nest.nl or 2:281/527.23]
NwTP Version 0.6, 950301, Copyright 1993,1995 R. Spronk
}
INTERFACE
{$B-,F+,O-,R-,S-,X+}
{$DEFINE ProtMode}
{$IFDEF MSDOS}
{$DEFINE RealMode}
{$UNDEF ProtMode}
{$ENDIF}
uses
{$IFDEF RealMode} Dos
{$ENDIF}
{$IFDEF DPMI} Dos,WinApi { we need the GlobalDosAlloc-Function}
{$ENDIF}
{$IFDEF WINDOWS} WinTypes,WinDOS,WinProcs
{$ENDIF};
CONST VLM_ID_UNKNOWN = $0000; { non-VLM application }
VLM_ID_VLM = $0001;
VLM_ID_CONN = $0010;
VLM_ID_TRAN = $0020;
VLM_ID_IPX = $0021;
VLM_ID_TCP = $0022;
VLM_ID_NWP = $0030;
VLM_ID_BIND = $0031;
VLM_ID_NDS = $0032;
VLM_ID_PNW = $0033;
VLM_ID_RSA = $0034;
VLM_ID_REDIR = $0040;
VLM_ID_FIO = $0041;
VLM_ID_PRINT = $0042;
VLM_ID_GENR = $0043;
VLM_ID_NETX = $0050;
VLM_ID_AUTO = $0060;
VLM_ID_SECURITY = $0061;
VLM_ID_NMR = $0100;
VLM_ID_DRVPRN = $09F2;
VLM_ID_SAA = $09F5; { SAA Client API for NetWare }
VLM_ID_IPXMIB = $09F6;
VLM_ID_PNWMIB = $09F7;
VLM_ID_PNTRAP = $09F8;
VLM_ID_MIB2PROT = $09F9;
VLM_ID_MIB2IF = $09FA;
VLM_ID_NVT = $09FB;
VLM_ID_TRAP = $09FC;
VLM_ID_REG = $09FD;
VLM_ID_ASN1 = $09FE;
VLM_ID_SNMP = $09FF;
Type
{$ifdef ProtMode}
TTregisters= Record {This is the data-structure for the}
Case Byte Of {real-mode-interrupts in DPMI-mode}
0: {32 bit registers}
(EDI,ESI,EBP,Reserved,EBX,EDX,
ECX,EAX:LongInt);
1: {16 bit registers}
(DI,DIHigh,SI,SIHigh,
BP,BPHigh,ReservedLow,ReservedHigh,
BX,BXHigh,DX,DXHigh,
CX,CXHigh,AX,AXHigh,
Flags,ES,DS,FS,GS,IP,
CS,SP,SS:Word);
2: {8 bit registers}
(DILowLow,DILowHigh,DIHighLow,DIHighHigh,
SILowLow,SILowHigh,SIHighLow,SIHighHigh,
BPLowLow,BPLowHigh,BPHighLow,BPHighHigh,
ReservedLowLow,ReservedLowHigh,ReservedHighLow,ReservedHighHigh,
BL,BH,BXHighLow,BXHighHigh,
DL,DH,DXHighLow,DXHighHigh,
CL,CH,CXHighLow,CXHighHigh,
AL,AH,AXHighLow,AXHighHigh:Byte)
End;
{$else} {RealMode}
TTregisters= Record
case Integer of
0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
end;
{$endif}
TPtrRec=record Ofs,Seg:word end;
TintrBuffer=array[1..576] of byte;
TPintrBuffer=^TintrBuffer;
TVLMheader=record
unknown1 :array[1..4] of byte;
ptr1ofs,ptr1seg, { pointers to 'procedures' }
ptr2ofs,ptr2seg,
ptr3ofs,ptr3seg,
ptr4ofs,ptr4seg :word;
unknown2 :array[1..4] of byte; { 00 00 00 00 }
HeaderLen :byte; { 1.11-> 4E; 1.20-> 4E}
MultiplexIDstring :array[1..3] of char; { 56 4C 4D 'VLM' }
unknown3 :array[1..4] of byte; { 01 00 80 00 }
TransientSwitchCount :word;
CallCount :word;
ControlBlockOfs :word; { in same segment as this header }
CurrentVLMID :word;
MemoryType :byte; { 04 = XMS }
ModulesLoaded :byte;
BlockId :word;
TransientBlock :word;
GlobalSegment :word;
AsyncQueue :array[1..3] of record { head, tail, s }
pqofs,pqseg:word;
end;
BusyQueue :array[1..3] of record { head, tail, s }
pqofs,pqseg:word;
end;
ReEntranceLevel :word;
FullMapCount :word;
unknown5 :word; { 00 00 }
end;
TVLMcontrolBlockEntry=record
Flag :word;
ID :word;
Func :word;
Maps :word;
TimesCalled :word;
unknown1 :word; { SSeg ? }
TransientSeg,GlobalSeg :word;
AddressLow,AddressHi :word;
TsegSize,GSegSize,SSegSize:word; { in 16 byte paragraphs }
VLMname :array[1..9] of char;
{ null terminated string }
end;
Var GlobalReqBuf,GlobalReplyBuf:TPintrBuffer;
{ real-mode only, DPMI: all flags are set to false }
VLM_EXE_loaded :Boolean;
NETX_VLM_loaded:Boolean; { if true, then VLM_EXE_loaded must also be true. }
NETX_EXE_loaded:Boolean;
Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
Procedure nwMsDos(VAR R:ttregisters);
Function InRealMode:Boolean;
Function MapRealmodeSegment(RSeg:Word):Word;
Function nwPtr(s,o:word):Pointer;
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
{$IFDEF RealMode}
Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
Function GetVLMControlBlock(Entry:Byte;
Var ControlBlock:TVLMControlBlockEntry):Boolean;
{ entry: 0 .. VLMheader.ModulesLoaded }
{$ENDIF}
IMPLEMENTATION {===========================================================}
Var GlobalRegisters:TTregisters; { all Modes ! }
VLMCall:Procedure;
{$IFDEF RealMode}
Var VLMtransientSeg:word;
{ ---------- Real mode procedures ------------------------------------}
{$F+}
Var RequesterProc:Procedure(Var regs:Registers);
{ VLMCall:Procedure; }
Procedure VlmSystemCall(Var regs:registers); assembler;
asm
push ds
{ check if VLMCall known. If not, return error $FF in fake AL }
xor ah,ah
mov al,$FF
les di,VLMCall
mov bx,es
cmp bx,$0000
je @1
{ move fake regs registers to 'real' registers }
{ AX, CX, DX, DS, SI, DI, ES only. }
les di,regs
mov ax,es:[di+16]
push ax { push new es }
mov ax,es:[di+12]
push ax { push new di }
mov ds,es:[di+14]
mov ax,es:[di]
mov cx,es:[di+4]
mov dx,es:[di+6]
mov si,es:[di+10]
pop di
pop es
{ farr call to VLM handler }
push bp
CALL VLMCall
pop bp
@1: { move 'real' registers to fake regs registers }
{push es
push di}
les di,regs
mov es:[di],ax
{mov es:[di+4],cx
mov es:[di+6],dx
mov es:[di+10],si
pop ax ax:= 'di'
mov es:[di+12],ax
pop ax ax:= 'es'
mov es:[di+16],ax }
pop ds
end;
Procedure VLMcheck;
CONST DOS_MULTIPLEX =$2F;
Var regs:registers;
ccode:byte;
Function getBinderyAccessLevel:boolean; { to be replaced by a non-bindery call }
Type Treq=record
len :word;
subF :byte;
end;
Trep=record
accLeveL:byte;
_objId:longInt;
fill:array[1..20] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
Var result:word;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
subF:=$46;
len:=sizeOf(Treq)-2;
end;
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
GetBinderyAccessLevel:=(result=0);
end;
Var phdr:^TVLMHeader;
pVLMcbl:^TVLMcontrolBlockEntry;
t:word;
begin
VLM_EXE_Loaded:=false;
Regs.AX:=$7A20;
Regs.BX:=$0000;
Regs.CX:=$0000;
Intr($2F,Regs);
if regs.AX=$0000
then begin
{ OK. AX=0000. All seems well. But is it really the 2F VLM handler? }
phdr:=ptr(regs.es,$0000);
VLM_EXE_Loaded:=(phdr^.MultiplexIdString[1]='V')
and (phdr^.MultiplexIdString[2]='L')
and (phdr^.MultiplexIdString[3]='M');
IF VLM_EXE_Loaded
then begin
NETX_EXE_loaded:=False;
{ Determine whether netx.vlm is loaded }
NETX_VLM_Loaded:=False;
t:=0;
While t<phdr^.ModulesLoaded
do begin
pVLMcbl:=ptr(regs.es,phdr^.ControlBlockOfs+(t*SizeOf(TVLMControlBlockEntry)));
IF pVLMcbl^.ID=VLM_ID_NETX
then begin
t:=$0100; { end of iteration }
NETX_VLM_Loaded:=True;
end;
inc(t);
end;
{ Set requester proc to VLM entry point }
@VLMcall:=Ptr(Regs.es,Regs.bx);
VLMtransientSeg:=regs.es;
{ @requesterProc:=@VLMsystemCall; ---------- ERR ------}
@RequesterProc:=@dos.msdos;
end
end;
if NOT VLM_EXE_Loaded
then begin
NETX_VLM_loaded:=false;
@RequesterProc:=@dos.msdos;
NETX_EXE_loaded:=GetBinderyAccessLevel;
end;
end;
Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
begin
Intr(intNo,registers(regs));
RealModeIntr:=true;
end;
Procedure nwMsDos(VAR R:ttregisters);
begin
msDos(registers(R));
end;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
begin
With GlobalRegisters
do begin
CX := Req_size;
DX := rep_size;
AH := $f2;
AL := subf;
DS := Seg(GlobalReqBuf^); SI := Ofs(GlobalReqBuf^);
ES := Seg(GlobalReplyBuf^);DI := Ofs(GlobalReplyBuf^);
MSDOS(registers(GlobalRegisters));
Result:=al;
end;
end;
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
begin
Sreq := Seg(GlobalReqBuf^);
Oreq := Ofs(GlobalReqBuf^);
Srep := Seg(GlobalReplyBuf^);
Orep := Ofs(GlobalReplyBuf^);
end;
Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
Var p:^TVLMHeader;
begin
if VLMtransientSeg<>$0000
then begin
p:=ptr(VLMtransientSeg,$0000);
move(p^,VLMheader,SizeOf(TVLMHeader));
end;
GetVLMHeader:=(VLMtransientSeg<>$0000);
end;
Function GetVLMControlBlock(Entry:Byte;
Var ControlBlock:TVLMControlBlockEntry):Boolean;
{ entry: 0 .. VLMheader.ModulesLoaded }
Var ph:^TVLMHeader;
pcb:^TVLMControlBlockEntry;
begin
if VLMtransientSeg<>$0000
then begin
ph:=ptr(VLMtransientSeg,$0000);
pcb:=ptr(VLMtransientSeg,ph^.ControlBlockOfs+entry*SizeOf(TVLMControlBlockEntry));
move(pcb^,ControlBlock,SizeOf(TVLMControlBlockEntry));
end;
GetVLMControlBlock:=(VLMtransientSeg<>$0000);
end;
Function nwPtr(s,o:word):Pointer;
begin
nwPtr:=Ptr(s,o);
end;
Function MapRealmodeSegment(RSeg:Word):Word;
begin
MapRealmodeSegment:=RSeg;
end;
{$ENDIF} {------------- end of real-mode procedures -------------------}
{$IFDEF ProtMode}
Type pRealSegItem=^tRealSegItem;
tRealSegItem=record {structure to store information}
Seg:word; {about allocated selectors}
Sel:Word;
prev,next:pRealSegItem;
end;
{we need to allocate selectors which map real-mode segments.}
{all these selectors are stored in an dynamic list}
{and are cleand up them at then end of the program}
Var GlobalRealReqSeg,
GlobalRealReplySeg:Word;
SelectorList:pRealSegItem;
Function RealModeIntr (IntNo:Byte;VAR Regs:ttregisters):Boolean;Assembler;
{Simulate a call to the spectified real mode interrupt. The registers passed
to the real mode code are held in RealModeRegisters. This structure contains
the register content upon termination of the real mode ISR.
Returns False if there was an error.}
ASM
push di
push es
mov bh,00 {For DOSX to reset the int controller and A20 line. Windows ingores it.}
mov bl,IntNo {Tell DPMI which interrupt to simulate}
xor cx,cx {0 bytes to copy to real mode stack}
les di,Regs {Get the real mode structure}
mov word ptr es:[di+$c],0 {reserved to 0}
mov word ptr es:[di+$c+2],0
mov word ptr es:[di+$26],0 {fs to 0}
mov word ptr es:[di+$28],0 {gs to 0}
mov word ptr es:[di+$2e],0 {sp to 0}
mov word ptr es:[di+$30],0 {ss to 0}
mov ax,$0300 {Function 0300h is simulate real mode interrupt}
int 31h
jc @Error {The carry flag was set, so there was an error}
mov ax,True {Return no error}
jmp @AllDone
@Error:
mov ax,False {Return false indicating an error}
@AllDone:
pop es
pop di
End;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
begin
With GlobalRegisters
do begin
CX := Req_size;
DX := rep_size;
AH := $f2;
AL := subf;
DS := GlobalRealReqSeg; {Use then REAL-MODE segments}
ES := GlobalRealReplySeg; {of the global buffers}
DI := 0; {OFFSET always 0 for}
SI := 0; {'GlobalDosAlloc'ated memory}
if not RealModeIntr($21,GlobalRegisters)
then RUNERROR(217);
{DPMI-ERRORS, maybe we should stop the system with the new Errorcode 217}
Result:=al;
end;
end;
Procedure nwMsDos(VAR R:ttregisters);
begin
if not RealModeIntr($21,R)
then RUNERROR(217);
{DPMI-ERRORS, maybe we should stop then system with the new Errorcode 217}
end;
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
begin
Sreq := GlobalRealReqSeg; {Use the REAL-MODE segments}
Srep := GlobalRealReplySeg; {of the global buffers}
Oreq := 0; {OFFSET always 0 for}
Orep := 0; {'GlobalDosAlloc'ated memory}
end;
{----- Some low-level functions for DPMI -----------}
TYPE os = record
o, s : Word;
end; {for typecasts}
LDTStr = record {Structure of LDT-Elements}
limit : Word;
base : Word;
data : Array[0..1] of Word;
end;
Procedure Halt218; {runError 218: low-level DPMI-Errors}
begin
RunError(218);
end;
{DMPI-Function 0: Allocate LDT Descriptor}
function AllocLDTD(var NEWD : Word) : Word; Assembler;
asm
xor ax,ax
mov cx,1 {only 1 descriptor needed}
int 31h {Call DPMI}
jnc @@ok
Call Halt218 {Error on carry}
@@ok:
les di,NEWD {save descriptor to VAR NEWD}
mov es:[di],ax
xor ax,ax
end;
{DMPI-Function 1: Free LDT Descriptor}
function FreeLDTD(D : Word) : Word; Assembler;
asm
mov ax,0001h
mov bx,D
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 7: Set Segment Base Address}
function SetSBA(S: Word; BA: LongInt) : Word; Assembler;
asm
mov ax,0007h
mov bx,S
mov cx,word ptr BA+2
mov dx,word ptr BA
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 8: Set Segment Limit}
function SetSL(S: Word; L: LongInt) : Word; Assembler;
asm
mov ax,0008h
mov bx,S
mov dx,word ptr L
mov cx,word ptr L+2
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 9: Set Descriptor Access Rights}
function SetDAS(S: Word; R: Word) : Word; Assembler;
asm
mov ax,0009h
mov bx,S
mov cx,R
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 11: Get Descriptor}
function GetD(S: Word; var D : LDTStr) : Word; Assembler;
asm
mov ax,000Bh
mov bx,S
les di,D
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{Set then Length of the Descriptor-Segment}
function SetLimit(Sele: Word; L: LongInt) : Word;
var St,R: Word;
Des : LDTStr;
begin
St:= GetD(Sele, Des); {get the Descriptor-Entry from LDT}
if St <> 0
then begin
SetLimit:= St; {not in LDT, return Error}
Exit;
end;
with Des
do R := (Data[0] shr 8) or ((Data[1] and $00F0) shl 8);
{form then rights for the DPMI-9-Call, register cl}
if L > $FFFFF
then begin {> 1MB: Page aligned}
if L and $FFF <> $FFF
then begin {Limit=Length-1!}
SetLimit := $8021; {return Error: not page aligned}
Exit;
end;
R:= R or $8000; {set Page granularity}
end
else R:= R and $7FFF; {set Byte granularity}
St := SetSL(Sele, 0); {fist set limit to 0}
if St = 0 then St := SetDAS(Sele, R); {ok, set the new rights}
if St = 0 then St:= SetSL(Sele, L); {ok, set then limit}
SetLimit := St; {return errorcode}
end;
{get a Selector for a part of then real-mode memory}
function RealMemSel(RealP : Pointer; Limit : LongInt; var Sele : Word) : Word;
function NP(P : Pointer) : LongInt;
VAR TC:OS absolute P;
begin
NP := (LongInt(TC.S) shl 4)+LongInt(TC.O);
end;
var St : Word;
begin
St := AllocLDTD(Sele); {get a new Selector}
if St = 0
then begin
St := SetSBA(Sele, NP(RealP)); {set base addresse to the linear}
if St = 0
then begin {address of the Real-Segment}
St := SetLimit(Sele, Limit); {set the selector-limit}
if St <> 0
then if FreeLDTD(Sele)<>0 then; {on error: free selector}
end
else if FreeLDTD(Sele)<>0 then; {on error: free selector}
end;
RealMemSel := St; {return errorcode}
end;
{check if the required selector is already allocated}
Function InSelectorList(S:Word):pRealSegItem;
VAR li:pRealSegItem;
begin
li:=SelectorList;
while li<>NIL
do begin
if li^.Seg=S
then begin
InSelectorList:=Li;
exit;
end;
li:=li^.Next;
end;
InSelectorList:=NIL;
end;
{insert a new SelectorItem at start of the list}
Procedure AddToSelectorlist(Segment,Selector:Word);
VAR li:pRealSegItem;
begin
new(li);
with li^
do begin
Seg:=segment;
Sel:=Selector;
next:=Selectorlist;
prev:=NIL;
end;
Selectorlist^.prev:=li;
Selectorlist:=li;
end;
{clean up}
Procedure FreeSelectorList;
VAR li:pRealSegItem;
begin
while Selectorlist<>NIL
do begin
li:=selectorlist;
selectorlist:=li^.next;
if li^.sel<>0
then FreeLDTD(li^.Sel);
dispose(li);
end;
end;
Function MapRealmodeSegment(RSeg:Word):Word;
VAR sel:Word;
li:pRealSegItem;
begin
li:=InSelectorList(RSeg);
if li=NIL
then begin
if RealMemSel(Ptr(RSeg,0),$ffff,Sel)<>0
then RUNERROR(217); {something's wrong: Errorcode 217}
MapRealModeSegment:=Sel;
AddToSelectorList(Rseg,Sel);
end
else MapRealModeSegment:=li^.Sel;
end;
Function nwPtr(s,o:word):Pointer;
begin
nwPtr:=Ptr(MapRealModeSegment(s),o);
end;
{$ENDIF} {----------------- end of protected mode procedures -------------}
Var OldExitProc:pointer;
Function InRealMode:Boolean;
begin
{$IFDEF Windows}
InRealMode:=(GetWinFlags and wf_PMode)=0;
{$ELSE}
{$IFDEF ProtMode}
InRealMode:=False;
{$ELSE}
InRealMode:=True;
{$ENDIF}
{$ENDIF}
end;
{$F+}
Procedure IntrExit;
begin
ExitProc:=OldExitProc;
{$IFDEF ProtMode}
if GlobalDosFree(Seg(GlobalReqBuf^))<>0 then; {ignore Errors}
if GlobalDosFree(Seg(GlobalReplyBuf^))<>0 then;
FreeSelectorList;
{$ELSE} {RealMode}
FreeMem(GlobalReqBuf,SizeOf(TintrBuffer));
Freemem(GlobalReplyBuf,Sizeof(TintrBuffer));
{$ENDIF}
end;
{$F-}
{$IFDEF ProtMode}
VAR w1:Longint absolute GlobalRegisters;
{ we only need w1 during the initialisation, so we use the static
var GlobalRegisters to save 4 bytes of memory :-) }
{$ENDIF}
begin
VLM_EXE_Loaded:=false;
NETX_EXE_loaded:=false;
NETX_VLM_loaded:=false;
{$IFDEF ProtMode}
new(SelectorList);
fillchar(Selectorlist^,Sizeof(Selectorlist^),0);
w1:=GlobalDosAlloc(Sizeof(tIntrBuffer)); {alloc REQ-Buffer}
if w1=0
then runerror(217); {DPMI-ERROR, no free Memory}
GlobalReqBuf:=Ptr(loWord(w1),0); {buffer-address for protected Mode}
GlobalRealReqSeg:=hiWord(w1); {REAL-Mode-Segment of the buffer-address}
w1:=GlobalDosAlloc(Sizeof(tIntrBuffer)); {alloc REPLY-Buffer}
if w1=0
then runerror(217);
GlobalReplyBuf:=Ptr(loWord(w1),0);
GlobalRealReplySeg:=hiWord(w1);
{$else} {RealMode}
new(GlobalReqBuf);
if GlobalReqBuf=NIL
then RunError(203); {where has all the memory gone?? /Heap-Overflow}
new(GlobalReplyBuf);
if GlobalReplyBuf=NIL
then RunError(203);
VLMtransientSeg:=$0000;
VLMcheck;
{$endif}
OldExitProc:=ExitProc;
ExitProc:=@IntrExit;
end.

606
NWTP/NWIPX.PAS Normal file
View File

@@ -0,0 +1,606 @@
{$B-,V-,X+}
UNIT nwIPX;
{$DEFINE ProtMode}
{$IFDEF MSDOS} {$UNDEF ProtMode} {$DEFINE RealMode} {$ENDIF}
{$IFDEF ProtMode} sorry, protected mode not supported (yet) {$ENDIF}
{ nwIPX unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
INTERFACE
Uses Dos,nwMisc;
{ Primary IPX calls: Subf: Comments:
IPXCancelEvent 6 AES
* IPXCloseSocket 1 (1)
IPXDisconnectFromTarget B (1)
* IPXGetInterNetworkaddress 9
* IPXGetIntervalMarker 8
* IPXGetLocalTarget 2
- IPXGetPacketSize D (IPX internal use only)
* IPXInitialize INT 2F
- IPXInitializeNetworkAddress C (IPX internal use only)
* IPXListenForPacket 4
* IPXOpenSocket 0
* IPXRelinquishControl A
* IPXScheduleIPXEvent 5 AES
IPXScheduleSpecialEvent 7
* IPXSendPacket 3
- IPXTerminateSockets E (IPX internal use only)
Secondary calls:
* IPXpresent
* IPXsetupSendECB
* IPXsetupListenECB
Notes: (1) These functions use INT 21 and are not to be called from
within an ESR.
}
CONST
LONG_LIVED_SOCKET = TRUE; { IPXopenSocket }
SHORT_LIVED_SOCKET = FALSE;
{*** PACKET TYPES ***}
UNKNOWN_PACKET_TYPE =0; { (basic) Unknown IPX packet }
IPX_PACKET_TYPE =0;
RIP_PACKET_TYPE =1; { Routing Information Packet }
ECHO_PACKET_TYPE =2;
ERROR_PACKET_TYPE =3;
PEP_PACKET_TYPE =4; { Packet Exchange Protocol }
SPX_PACKET_TYPE =5; { Sequenced Packet Protocol Packet }
PUP_PACKET_TYPE =12;
DOD_IP_PACKET_TYPE =13; { Internet Protocol packet Type }
NCP_PACKET_TYPE =17; { NetWare Core Protocol }
{ Experimental packet types: 20 - 37 }
{*** SOCKET NUMBERS ***}
{0001-0BB8 Registered with Xerox }
SKT_XEROX_ROUTING_INFORMATION= $0001;
SKT_ECHO_PROTOCOL = $0002;
SKT_ERROR_HANDLER = $0003;
{0020-003F Xerox : Experimental }
SKT_NW4_TIME_SYNC_SERVER = $0040; { used by OT_NW4_TIME_SYNC_SERVER }
SKT_FILE_SERVICE = $0451; { see also $8140, used by OT_RSPCX_SERVER }
SKT_SERVICE_ADVERTISING = $0452; { SAP }
SKT_ROUTING_INFORMATION = $0453; { Novell's RIP Socket }
SKT_NETBIOS = $0455;
SKT_DIAGNOSTIC = $0456;
{ 0457h ??? (appears to be related to server serial numbers) }
{0BB9-FFFF Xerox : Dynamically assignable Sockets }
{0BB9-3FFF Novell: }
SKT_NMA_AGENT =$2F90; { used by OT_NMA_AGENT (NMS) }
{4000-7FFF Novell: Dynamically assignable Sockets }
{ Use a socket in this range for your own applications. }
{ To avoid conflicts with other programs, you are advised NOT }
{ to use sockets numbers where the hi-byte equals the low-byte, }
{ C programmers mostly use those to avoid byte-order swapping. }
{ ! See the SKT_XXX file in the XIPX archive for the latest info
on socket numbers... }
{8000-FFFF Novell: Well known sockets, registered with Novell. }
SKT_EMAIL_CHAT =$8055; { Niche Corp. }
SKT_EMAIL_CHAT_2 =$8056; { Niche Corp. }
SKT_BTRIEVE =$8058;
SKT_BTRIEVE_2 =$8059;
SKT_NW_SQL =$805A;
SKT_NW_SQL_2 =$805B;
SKT_GAMESERVER =$805C;
SKT_GAMESERVER_2 =$805D;
SKT_PRINT_SERVER =$8060;
SKT_DIGITAL_CHAT =$806C; { Digital Inc. }
SKT_NW_ACCESS_SERVER =$806F;
SKT_OXXI_EMAIL_CHAT =$80C3; { Oxxi Inc. }
SKT_PRINT_SERVER_2 =$811E;
SKT_INTEL_EMAIL_CHAT =$845F; { Intel Corp. }
SKT_WINDOWS_EMAIL_CHAT =$9017;
SKT_JOB_SERVER =$9022;
Var Result:word; { unit errorcode variable }
Type TipxHeader=Record
checksum :word; { not used, set to $FFFF }
length :word; { total number of bytes }
TransportControl :byte; { used by bridges: low 4 bits= hop count }
packetType :byte; { ignored by IPX, used by higher level
protocols only. $00=unknown packet type}
destination,
source :TinternetWorkAddress;
{ if dest.network equals 0; dest
assumed on same network as sender }
{ if dest.node =$FFFFFFFFFFFF, packet
will be sent to all nodes. }
end;
{ Fields within IPX and SPX are high-low. Byte swapping will be done
by the IPX functions, except network and node addresses. }
Tfragment=record { address and size of buffer fragment. }
Address:Pointer;
Size:word;
end;
Tecb=record
Linkaddress :Pointer; { used by IPX itself }
ESRaddress :Pointer;
InUseFlag :Byte; { reset to $00 when request completed }
CompletionCode :Byte; { valid after InUseFlag becomes $00;
completionCode=$00: packet sent/received. }
SocketNumber :word;
IPXworkspace :array[1..4] of byte;
DriverWorkspace :array[1..12] of byte;
Immediateaddress:Tnodeaddress; { 6 bytes }
FragmentCount :word; { must be >0 }
Fragment :array[1..2] of Tfragment; { [1..FragmentCount] }
{ The number of fragments is unlimited.
However, most applications use 1 or 2. }
end;
Tpecb=^Tecb;
{ TAESecb=:
Offset Size Description
00h DWORD Link
04h DWORD ESR address
08h BYTE in use flag (see below)
09h 5 BYTEs AES workspace }
Function IpxPresent:boolean;
{ Determines if an IPX driver is loaded. Calls IPXInitialize. }
Function IPXinitialize:Boolean;
{ Determines if an IPX driver is loaded. }
{IPX/SPX: 09h}
Function IPXGetInternetworkAddress(Var Address:TinterNetworkAddress):boolean;
{ This call returns the network and node address of the requesting workstation. }
{ The two byte socketnumber must be appended to the end to form a full }
{ 12-Byte network address. The socketnumber will be set to 0000, indicating
that it has to be filled later with a meaningfule number. }
{IPX/SPX: 00h}
Function IPXOpenSocket(Var socket:word; PermanentSocket:boolean):boolean;
{ When an application wants to send or receive packets on a socket,
it should first open the socket. PermanentSocket should be set to TRUE
if the socket is used by a TSR. This way, the socket will only be
closed when the IPXcloseSocket function is called. Otherwise, set to FALSE. }
{IPX/SPX: 01h}
Function IPXCloseSocket(socket:word):boolean;
{ Closes the socket. TSRs should close permanent sockets before terminating. }
{IPX/SPX: 02h}
Function IPXGetLocalTarget(Address:TinternetworkAddress;
Var ImmAddr:TnodeAddress;
Var Ticks:word ):boolean;
{ Returns the nodeaddress (Immediate address) of a bridge/router that
connects the senders' network with the target-network. If the target
lies within the same network as the sender, the returned node address
is the same as the target node-address. }
{IPX/SPX: 03h}
Function IPXSendPacket(Var Ecb:Tecb):boolean;
{ After calling this function, control is immediately turned back to the
calling process, whilst in the background the IPX driver is trying to
send the packet. To check if the message has been sent, check the
ECB.InUseFlag or use a SendESR.
The ecb must be filled with appropriate values before calling this function,
the socket to send on must be open. }
{IPX/SPX: 0Fh}
Function IPXInternalSendPacket(Var Ecb:Tecb):boolean;
{IPX/SPX: 04h}
Function IPXListenForPacket(Var Ecb:Tecb):Boolean;
{ After calling this function, control is immediately turned back to the
calling process. The IPX driver will wait in the background for a packet
to be received. To check if a message has been received, check the
ECB.InUseFlag or use a ListenESR.
The ecb must be filled with appropriate values before calling this function,
the socket to receive on must be open. }
{IPX/SPX: 0Ah}
Function IPXrelinquishControl:boolean;
{ Temporarily gives away CPU time to bakcground processes. This call
improves efficeincy by informing the IPX driver that the CPU is
available. }
{IPX/SPX: 08h}
Function IPXgetIntervalMarker(Var ticks:word):boolean;
{ Gets a time marker from IPX. The difference between two known
time-markers can be used to determine if a timeout has occurred.
1 Tick = 1/18.2 second. }
{IPX/SPX: 06h}
Function IPXcancelEvent(ECB:Tecb):boolean;
{ AES call: Cancel an event.
When the event is canceled, the ECB.InUseFlag will be set to $00 and the
ECB.CompletionCode to $FC: Event Canceled. }
{IPX/SPX: 0Bh}
Function IPXdisconnectFromTarget(Address:TinternetworkAddress):boolean;
{ Informs the listening socket at the specified adress that no more
packets will be sent to the listening socket.
This function is not required in your application, it is merely used
to inform some drivers that the connection (if any) has ended. }
{IPX/SPX: 05h}
Function IPXscheduleIPXevent(ticks:word;Var ECB:Tecb):boolean;
{ AES call: schedule an event.
After calling this function, control is immediately turned back to the
calling process. After waiting the number of ticks specified
(1 tick= 1/18.2 sec.), the IPX driver activates the ECB.
This function should never be called with an ECB that is still in use
by the IPXdriver (i.e. ECB.InUseFlag should be 0 before calling)
}
{UPX: 0007}
Function IPXscheduleSpecialEvent(ticks:word;Var ECB:Tecb):boolean;
Procedure IpxSpxSystemCall(Var regs:registers);
{ Provides an entry into the INT A7 interrupt handler;
Valid only if IPXinitialize or IPXinstalled were called previously. }
{************** Secondary Procedures ***************************************}
Procedure IPXSetupListenECB(ESRptr:Pointer; ReceiveSocket:word;
BufPtr:Pointer; BufSize:word;
{out:} Var IpxHdr:TipxHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
Procedure IPXsetupSendECB(ESRptr:pointer; SourceSocket:Word;
DestAddr:TinterNetworkAddress;
BufPtr:pointer; BufSize:word;
{out:} Var IpxHdr:TipxHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
IMPLEMENTATION {==============================================================}
CONST
IPX_MAX_DATA_LENGTH =546;
Var IpxSpxCall:Procedure;
Procedure IpxSpxSystemCall(Var regs:registers); assembler;
{ This method of calling IPX/SPX is preferred by Novell. }
{ For what its' worth: this call is 48 bytes longer than the other one.. }
asm
{ check if IpxSpxCall known. If not, return error $FF in fake AL }
xor ah,ah
mov al,$FF
les di,IpxSpxCall
mov bx,es
cmp bx,$0000
je @1
{ move fake regs registers to 'real' registers }
{ AX, BX, CX, DX, SI, DI, ES only. }
les di,regs
mov ax,es:[di+16]
push ax { push new es }
mov ax,es:[di+12]
push ax { push new di }
mov ax,es:[di]
mov bx,es:[di+2]
mov cx,es:[di+4]
mov dx,es:[di+6]
mov si,es:[di+10]
pop di
pop es
{ farr call to A7 interrup handler }
push bp
CALL IpxSpxCall
pop bp
@1: { move 'real' registers to fake regs registers }
push es
push di
les di,regs
mov es:[di],ax
mov es:[di+2],bx
mov es:[di+4],cx
mov es:[di+6],dx
mov es:[di+10],si
pop ax { ax:= 'di' }
mov es:[di+12],ax
pop ax { ax:= 'es' }
mov es:[di+16],ax
end;
Function IPXinitialize:Boolean;
CONST DOS_MULTIPLEX =$2F;
Var regs:registers;
begin
Regs.AX:=$7A00;
INTR(DOS_MULTIPLEX,Regs);
if regs.AL<>$FF
then begin
Result:=IPX_NOT_INSTALLED;
IpxInitialize:=false
end
else begin
@IpxSpxCall:=Ptr(Regs.es,Regs.di);
Result:=0;
IpxInitialize:=true;
end;
end;
Function IpxPresent:boolean;
begin
IpxPresent:=IpxInitialize
end;
{IPX: 09h}
Function IPXGetInternetworkAddress(Var Address:TinterNetworkAddress):boolean;
{ This call returns the network and node address of the requesting workstation. }
{ The two byte socketnumber must be appended to the end to form a full }
{ 12-Byte network address. }
Var regs:registers;
begin
regs.bx:=$0009;
regs.es:=seg(Address);
regs.si:=ofs(Address);
IpxSpxSystemCall(Regs);
result:=regs.al;
address.socket:=$0000; { unknown, to be set later. }
if result<>$FF
then result:=$00;
IPXGetInternetworkAddress:=(result=$00);
{ possible resultcodes: $00 Successful; $FF IPX not initialized }
end;
{IPX: 00}
Function IPXOpenSocket(Var socket:word; permanentSocket:boolean):boolean;
Var regs:registers;
reqForSocket:boolean;
begin
regs.bx:=$0000;
if permanentSocket
then regs.al:=$FF
else regs.al:=$00;
regs.dx:=swap(socket); {hi-lo}
reqForSocket:=(socket=$0000);
IpxSpxSystemCall(Regs);
result:=regs.al;
if reqForSocket
then socket:=swap(regs.dx); {force lo-hi}
IPXopenSocket:=(result=0);
{ resultcodes: $00 successful; $FE Socket Table Is Full;
$FF socket already open OR IPX not initilazed. }
end;
{IPX: 01}
Function IPXCloseSocket(socket:word):boolean;
Var regs:registers;
begin
regs.bx:=$01;
regs.dx:=swap(socket);
IpxSpxSystemCall(regs);
result:=regs.al;
if result<>$FF then result:=$00;
IPXCloseSocket:=(result=$00);
{ possible resultcodes: $00 Successful; $FF IPX not initialized }
end;
{IPX: 02}
Function IPXGetLocalTarget(Address:TinternetworkAddress;
Var ImmAddr:TnodeAddress;
VAR ticks:Word ):boolean;
{ Ticks = estimated transmission time, in number of ticks (1/18 sec) }
Var reqAddr:TinternetworkAddress;
repNode:TnodeAddress;
Regs :registers;
begin
move(Address,reqAddr,10);
reqAddr.socket:=swap(Address.socket); {hi-lo}
With regs
do begin
bx:=$0002;
es:=seg(reqAddr); si:=ofs(reqAddr); di:=ofs(repNode);
IpxSpxSystemCall(regs);
ticks:=regs.cx;
result:=regs.al;
if result=0
then move(repNode,ImmAddr,6);
end;
IPXGetLocalTarget:=(result=$00);
{ resultcodes: $00 Successful; $FA No path to destination node found;
$FF IPX not initialized. }
end;
Function IPXSendPacket(Var Ecb:Tecb):boolean;
{ the ecb must be filled, before calling this function }
{ Right after this call, IPXrelinquishControl should be called Iteratively,
this allows the sending of the IPX packet. }
Var regs:Registers;
begin
regs.bx:=$0003;
regs.es:=seg(ecb);
regs.si:=ofs(ecb);
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF then result:=$00;
IpxSendPacket:=(result=$00);
{ possible resultcodes: $00 Successful; $FF IPX not initialized }
end;
Function IPXInternalSendPacket(Var Ecb:Tecb):boolean;
Var regs:Registers;
begin
regs.bx:=$000F;
regs.es:=seg(ecb);
regs.si:=ofs(ecb);
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF then result:=$00;
IpxInternalSendPacket:=(result=$00);
{ possible resultcodes: $00 Successful; $FF IPX not initialized }
end;
Function IPXListenForPacket(Var Ecb:Tecb):Boolean;
{ socket must be opened, ECB (partly) filled. }
Var regs:Registers;
begin
regs.bx:=$0004;
regs.es:=seg(ecb);
regs.si:=ofs(ecb);
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF
then result:=$00;
IpxListenForPacket:=(result=$00);
{resultcodes: $00 Successful;
$FF Listening Socket doesn't exist OR IPX not initialized }
end;
Function IPXrelinquishControl:boolean;
Var regs:Registers;
begin
regs.bx:=$000A;
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF then result:=$00;
IpxrelinquishControl:=(result=$00);
{resultcodes: $00 Successful; $FF IPX not initialized }
end;
Function IPXgetIntervalMarker(Var ticks:word):boolean;
Var regs:Registers;
begin
regs.bx:=$0008;
IpxSpxSystemCall(Regs);
ticks:=regs.ax;
result:=$00;
IPXgetIntervalMarker:=True;
end;
Function IPXcancelEvent(ECB:Tecb):boolean;
Var regs:registers;
begin
regs.bx:=$0006;
regs.es:=seg(ecb);
regs.si:=ofs(ecb);
IpxSpxSystemCall(Regs);
result:=regs.al;
IPXcancelEvent:=(result=0);
{ resultcodes: 00 Successful; F9 ECB cannot be canceled;
FF ECB not in use OR IPX not initialized. }
end;
Function IPXdisconnectFromTarget(Address:TinternetworkAddress):boolean;
VAR regs:registers;
LocAddr:TinternetworkAddress;
begin
move(Address,LocAddr,10);
LocAddr.socket:=swap(Address.socket);
regs.bx:=$000B;
regs.es:=seg(LocAddr);
regs.si:=ofs(LocAddr);
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF
then result:=$00;
IPXdisconnectFromTarget:=(result=0);
{resultcodes: $00 Successful; $FF IPX not initialized }
end;
Function IPXscheduleIPXevent(ticks:word;Var ECB:Tecb):boolean;
Var regs:registers;
begin
regs.bx:=$0005;
regs.ax:=ticks;
regs.es:=seg(ECB);
regs.si:=ofs(ECB);
IpxSpxSystemCall(Regs);
if result<>$FF
then result:=$00;
IPXscheduleIPXevent:=(result=0);
{resulcodes: 00 successful; FF IPX not initialized }
end;
Function IPXscheduleSpecialEvent(ticks:word;Var ECB:Tecb):boolean;
Var regs:registers;
begin
regs.bx:=$0007;
regs.ax:=ticks;
regs.es:=seg(ECB);
regs.si:=ofs(ECB);
IpxSpxSystemCall(Regs);
if result<>$FF
then result:=$00;
IPXscheduleSpecialEvent:=(result=0);
{resulcodes: 00 successful; FF IPX not initialized }
end;
{************** Secondary Procedures ***************************************}
Procedure IPXSetupListenECB(ESRptr:Pointer;ReceiveSocket:word;
BufPtr:Pointer;BufSize:word;
{out:} Var IpxHdr:TipxHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
{ ECB: ESR adress field, socket number, fragment count, frag.descriptor fields }
begin
FillChar(ecb,SizeOf(Tecb),#0);
FillChar(ipxHdr,SizeOF(TipxHeader),#0);
WITH ECB
do begin
if ESRptr<>NIL
then ESRaddress:=ESRptr;
Fragmentcount:=2;
socketNumber:=swap(ReceiveSocket); {hi-lo}
Fragment[1].Address:=@ipxHdr;
Fragment[2].Address:=BufPtr;
Fragment[1].size:=SizeOf(Tipxheader);
Fragment[2].size:=BufSize;
end;
end;
Procedure IPXsetupSendECB(ESRptr:pointer; SourceSocket:word;
DestAddr:TinterNetworkAddress;
BufPtr:pointer; BufSize:word;
{out:} Var IpxHdr:TipxHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
Var ImmAddr:TnodeAddress;
Ticks:word;
begin
fillchar(ipxHdr,SizeOf(TipxHeader),#0);
with ipxhdr
do begin
PacketType:=IPX_PACKET_TYPE;
Move(DestAddr,Destination,10);
destination.socket:=swap(DestAddr.socket); {hi-lo}
end;
IPXGetLocalTarget(DestAddr,ImmAddr,Ticks);
fillchar(ecb,sizeOf(ecb),#0);
With ecb
do begin
if ESRptr<>NIL
then ESRaddress:=ESRptr;
socketNumber:=swap(SourceSocket); {hi-lo}
Move(ImmAddr,ImmediateAddress,6);
FragmentCount:=2;
fragment[1].Address:=@ipxhdr;
fragment[1].size:=SizeOf(TipxHeader);
fragment[2].Address:=BufPtr;
fragment[2].size:=BufSize;
end;
end;
end.

663
NWTP/NWLOCK.PAS Normal file
View File

@@ -0,0 +1,663 @@
{$X+,B-,V-} {essential compiler directives}
UNIT nwLock;
{ nwLock unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk
This unit was based on units by
a. Scott A. Lewis, 36 Maythorpe Drive, Windsor, CT 06095, U.S.A.
Note: (1987) 76515,135@Compuserve.Com
b. Erik van Heyningen, Hague Consulting Group,
The Hague, the Netherlands.
Note: (1994) hcg@hacktick.nl }
{ Function: Interrupt: Notes:
Physical File locking/unlocking
-------------------------------
* LogPhysicalFile EB (6) -> F203
* LockPhysicalFileSet F204
* ReleasePhysicalFile EC -> F205
* ReleasePhysicalFileSet CD -> F206
* ClearPhysicalFile ED (6) -> F207
* ClearPhysicalFileSet CF -> F208
Logical File Locking
--------------------
+ LogLogicalFile (5)
+ LogLogicalFileSet (5)
+ ReleaseLogicalFile (5)
+ ReleaseLogicalFileSet (5)
+ ClearLogicalFile (5)
+ ClearLogicalFileSet (5)
Logical record locking/unlocking
--------------------------------
* LogLogicalRecord D0 -> F209
* LockLogicalRecordSet D1 -> F20A
* ReleaseLogicalRecord D2 -> F20C
* ReleaseLogicalRecordSet D3 -> F20D
* ClearLogicalRecord D4 -> F20B
* ClearLogicalRecordSet D5 -> F20E
GetLogicalRecordInformation F217/F0 (3)
GetLogicalRecordsByConnection F217/EF (3)
Physical record locking/unlocking
---------------------------------
. LogPhysicalRecord BC -> F21A
. LockPhysicalRecordSet C2 -> F21B
. ReleasePhysicalRecord BD -> F21C
. ReleasePhysicalRecordSet C3 -> F21D
. ClearPhysicalRecord BE -> F21E
. ClearPhysicalRecordSet C4 -> F21F
GetPhysRecLocksByConnectionAndFile F217/ED (3)
GetPhysRecLocksByFile F217/EE (3)
- ControlRecordAccess 5C (DOS) (4)
Not Implemented
---------------
- GetLockMode C600 (1)
- SetLockMode C601 (1)
- BeginLogicalFileLocking C8 / F201 (2)
- EndLogicalFileLocking C9 / F202 (2)
Notes: -Semaphores can be found in the nwSema Unit
(1) Obsolete
(2) Not supported by (all) 3.x versions
(3) Supported by NW 3.x and upwards
(4) Generic physical record locking call, DOS 3.1+
Equivalent to:
I . LockPhysicalRecord (without logging)
II. ReleasePhysicalrecord
(5) Use the equivalent LogicalRecordLocking calls
to emulate LogicalFileLocking. NOTE: remember
that there's only ONE Log.
(6) Includes VLM fix for filenames (GetTrueEntryName
in the nwFile unit is called)
-> F2xx To be rewritten to the F2 interface.
}
INTERFACE
Uses nwIntr,nwMisc;
CONST { Log Resource }
LD_LOG = 0;
LD_LOG_LOCK = 1; { Deny all access to file/record }
LD_LOG_LOCK_RO = 3; { Allow read / deny write (record locking only)}
{ Lock Resource }
LD_lOCK = 0; { Deny all access to file/record }
LD_LOCK_RO = 1; { Allow read / deny write (record locking only)}
Var Result:word;
{------------------- PHYSICAL FILE LOCKING OPERATIONS -----------------------}
{F204 [2.15c+]}
FUNCTION LockPhysicalFileSet(TimeoutLimit : Word) : Boolean;
{Lock a set of files that were logged by the LogFile function }
{CD.. [1.0+]}
FUNCTION ReleasePhysicalFileSet:boolean;
{ Release lock on set of files in logged table, files remain logged }
{CF [1.0+]}
FUNCTION ClearPhysicalFileSet : Boolean;
{ Unlock and UnLog the entire logged file set }
{EB.. [1.0+]}
FUNCTION LogPhysicalFile(FileName : String; LockDirective : Byte; TimeoutLimit : Word) : Boolean;
{Log files for later use }
{EC.. [1.0+]}
FUNCTION ReleasePhysicalFile(FileName : String) : boolean;
{Release file lock, but keep logged in the table }
{ED.. [1.0+]}
FUNCTION ClearPhysicalFile(FileName : String) : boolean;
{Release a file from the file log table, unlock the file if it is locked }
{ ------------------- LOGICAL RECORD LOCKING OPERATIONS --------------------}
{D0 [1.0+]}
FUNCTION LogLogicalRecord(Name:string; LockDirective:Byte; Timeout: Word) : Boolean;
{Add a record to the lockable logical record table }
{D1.. [1.0+]}
FUNCTION LockLogicalRecordSet(LockDirective:Byte; TimeoutLimit : Word) : Boolean;
{Lock all logged records }
{D2.. [1.0+]}
FUNCTION ReleaseLogicalRecord(Name : String) : Boolean;
{Unlock a record, keep record in logtable }
{D3.. [1.0+]}
FUNCTION ReleaseLogicalRecordSet : Boolean;
{Unlock all locked records, keep records logged }
{D4.. [1.0+]}
FUNCTION ClearLogicalRecord(Name : String) : Boolean;
{Unlock and UnLog a record }
{D5.. [1.0+]}
FUNCTION ClearLogicalRecordSet : Boolean;
{Unlocks and UnLogs all logged records }
{F217/EF [2.1x+]}
Function GetLogicalRecordLocksByConnection(ConnNbr:word;
{i/o} Var NextRecNbr:word;
Var TaskNbr:word;
Var LockStatus:Byte;
Var LockName:String):Boolean;
{ You need console operator rights to use this function }
{----------------------- PHYSICAL RECORD LOCKING OPERATION -----------------}
{BC.. [1.0+]}
function LogPhysicalRecord(Handle:Word;
LockDirective:Byte;
RecordOffset,RecordLength:Longint;
TimeOutLimit:Word): boolean;
{Add a record to the lockable physical record logtable }
{BD.. [1.0+]}
function ReleasePhysicalRecord( Handle:Word; RecordOffset,RecordLength:Longint) : boolean;
{Unlock record, keep record logged }
{BE.. [1.0+]}
function ClearPhysicalRecord(Handle:Word; RecordOffset,RecordLength:Longint): boolean;
{Unlock and Unlog a record }
{C2.. [1.0+]}
function LockPhysicalRecordSet(LockDirective: byte; TimeoutLimit : Word): boolean;
{Lock all logged records }
{C3.. [1.0+]}
function ReleasePhysicalRecordSet : boolean;
{Unlock all logged records, keep records logged }
{C4.. [1.0+]}
function ClearPhysicalRecordSet : boolean;
{Unlocks and unLogs all logged records }
IMPLEMENTATION{==============================================================}
uses nwFile;
Var regs:TTRegisters;
Procedure SetLockMode(mode:Byte);
begin
regs.AH:=$c6;
regs.al:=mode; { 0 or 1 }
RealModeIntr($21,regs);
end;
(* THE FOLLOWING PROCEDURES ARE FOR LOGGING AND LOCKING/RELEASING FILE SETS *)
(* File locking by set can be very effective in avoiding deadly embrace *)
{F204 [3.x+]}
FUNCTION LockPhysicalFileSet(TimeoutLimit : Word) : Boolean;
Type Treq=record
_TimeOutLimit:Word;
end;
TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
_TimeoutLimit:=swap(TimeoutLimit);
end;
F2SystemCall($04,SizeOf(Treq),0,result);
LockPhysicalFileSet:=(result=0);
{ 00 Successful FF Fail FE Timeout }
END;
{CD.. [1.0+]}
FUNCTION ReleasePhysicalFileSet:boolean;
{ Release lock on set of files in logged table, files remain logged }
{ These files remain open but cannot be accessed without an error }
{ To reuse them, send another lock file set }
Type Treq=record
end;
BEGIN
WITH Regs
DO BEGIN
AH := $CD;
RealModeIntr($21,Regs);
result:=0;
END;
ReleasePhysicalFileSet:=true;
END;
{CF [2.0+]}
FUNCTION ClearPhysicalFileSet : Boolean;
{ Unlock and UnLog the entire personal file set (all files are closed) }
BEGIN
WITH Regs
DO BEGIN
AH := $CF;
RealModeIntr($21,Regs);
result:=0;
END;
ClearPhysicalFileSet:=true;
END;
{EB.. [2.0+] }
FUNCTION LogPhysicalFile(FileName : String; LockDirective : Byte; TimeoutLimit : Word) : Boolean;
{ This function allows a station to log files for later personal use }
{ After the desired files are logged, function CBh can be used to lock }
{ the entire set of files }
{ !! There is a known problem with lock directive 3 (log and lock shareable)
use 1 instead. }
Type Treq=record
LockDirective:Byte;
TimeOutLimit:Word;
FileName:string[255]; { or Asciiz ? }
end;
Var temp1,temp2:word;
TEname:string;
BEGIN
GetTrueEntryName(FileName,TEname); { also UpCases string }
{ IF this function isn't included and VLMs are used, this call will
*appear* to be successful. No error code is returned, the call is
however unsuccessful. }
WITH Regs
DO BEGIN
AH := $EB;
AL := LockDirective; { 0 = Log Only, 1 Log and Lock }
BP := TimeoutLimit; { in 1/18 seconds, 0 = No wait }
TEname := TEName+#0; { Terminate with a nul for asciiz }
Move(TEname[1],GlobalReqBuf^,ord(TEname[0]));
GetGlobalBufferAddress(DS,DX,temp1,temp2);
{ DS:DX real mode pointer to buffer in realmode-range holding Filename }
RealModeIntr($21,Regs);
Result:=AL;
LogPhysicalFile := (Result = 0);
END;
{ FE Timeout FF hardware error }
END;
{EC.. [1.0+]}
FUNCTION ReleasePhysicalFile(FileName : String) : boolean;
{ Release file lock, but keep logged in the table }
Var temp1,temp2:word;
TEname:string;
BEGIN
GetTrueEntryName(FileName,TEname); { also UpCases string }
{ IF this function isn't included and VLMs are used, this call will
*appear* to be successful. No error code is returned, the call is
however unsuccessful. }
WITH Regs
DO BEGIN
AH := $EC;
UpString(FileName);
TEName := TEName+#0; { null terminate }
Move(TEname[1],GlobalReqBuf^,ord(TEname[0]));
GetGlobalBufferAddress(DS,DX,temp1,temp2);
{ DS:DX real mode pointer to buffer in realmode-range holding Filename }
RealModeIntr($21,Regs);
result:=AL;
ReleasePhysicalFile:=(result=0);
END;
{FF File not found }
END;
{ED.. [1.0+]}
FUNCTION ClearPhysicalFile(FileName : String) : boolean;
{ Release a file from the file log table, unlock the file if it is locked }
Var temp1,temp2:word;
BEGIN
WITH Regs
DO BEGIN
AH := $ED;
UpString(FileName);
FileName := FileName+#0; { null terminate }
Move(Filename[1],GlobalReqBuf^,ord(Filename[0]));
GetGlobalBufferAddress(DS,DX,temp1,temp2);
{ DS:DX real mode pointer to buffer in realmode-range holding Filename }
RealModeIntr($21,Regs);
Result:=AL;
ClearPhysicalFile := (Result = 0);
{ 0 means OK FF File not found}
END;
END;
(* THE FOLLOWING FUNCTIONS ARE FOR LOGICAL LOCKING OPERATIONS *)
(* Logical locks work only if all software accessing the files use the *)
(* same logical synchronization scheme. Logical locks are much easier *)
(* and faster to implement than physical locks. *)
{D0 [1.0+]}
FUNCTION LogLogicalRecord(Name:String; LockDirective:Byte; Timeout: Word) : Boolean;
{ This function will log the specified record string in the record log table }
{ of the requesting station. }
{ Max length of name: 99 chars }
{ LockDirective LD_LOG = 0;
LD_LOG_LOCK = 1; Deny all access to file/record
LD_LOG_LOCK_RO = 3; Allow read / deny write }
{ TimeOut=0 means NoWait }
Var temp1,temp2:word;
BEGIN
WITH Regs
DO BEGIN
AH := $D0;
AL := LockDirective;
UpString(Name);
Move(Name,GlobalReqBuf^,ord(Name[0])+1);
GetGlobalBufferAddress(DS,DX,temp1,temp2);
{ DS:DX real mode pointer to buffer in realmode-range holding Filename }
BP := Timeout; { In 1/18th seconds (use only with lock bit set }
RealModeIntr($21,Regs);
Result:=AL;
LogLogicalRecord := (Result=0);
{ FFh fail }
{ FEh timeout }
{ 96h No dynamic memory for file }
END;
END;
{D1 [1.0+]}
FUNCTION LockLogicalRecordSet(LockDirective:Byte; TimeoutLimit : Word) : Boolean;
{ Call this to lock all records logged with Log_Logical_Record }
{ LockDirective LD_LOCK = 0; Deny all access to file/record
LD_LOCK_RO = 1; Allow read / deny write }
BEGIN
WITH Regs
DO BEGIN
AH := $D1;
AL := LockDirective;
BP := TimeoutLimit; { In 1/18th seconds, 0 = No wait }
RealModeIntr($21,Regs);
Result:=AL;
LockLogicalRecordSet := (Result=0);
{00 - Success
FF - fail,
FE - timeout }
END;
END;
{D2.. [1.0+]}
FUNCTION ReleaseLogicalRecord(Name : String) : Boolean;
{ Call this to release a logical record lock without removing the rec }
{ from the table }
Var temp1,temp2:word;
BEGIN
WITH Regs
DO BEGIN
AH := $D2;
UpString(Name);
Move(Name,GlobalReqBuf^,ord(Name[0])+1);
GetGlobalBufferAddress(DS,DX,temp1,temp2);
{ DS:DX real mode pointer to buffer in realmode-range holding Filename }
RealModeIntr($21,Regs);
Result:=AL;
ReleaseLogicalRecord := (Result=0);
{ FF No record found }
END;
END;
{D3.. [1.0+]}
FUNCTION ReleaseLogicalRecordSet : Boolean;
{ release all locked logical records, doesn't remove them from the table }
BEGIN
WITH Regs
DO BEGIN
AH := $D3;
RealModeIntr($21,Regs);
Result:=0;
ReleaseLogicalRecordSet := True;
END;
END;
{D4.. [1.0+]}
FUNCTION ClearLogicalRecord(Name : String) : Boolean;
{ This call unlocks and removes the Logical Record lock from the table }
Var temp1,temp2:word;
BEGIN
WITH Regs
DO BEGIN
AH := $D4;
UpString(Name);
Move(Name,GlobalReqBuf^,ord(Name[0])+1);
GetGlobalBufferAddress(DS,DX,temp1,temp2);
{ DS:DX real mode pointer to buffer in realmode-range holding Filename }
RealModeIntr($21,Regs);
Result:=AL;
ClearLogicalRecord := (Result=0);
{ FF No record Found }
END;
END;
{D5.. [1.0+]}
FUNCTION ClearLogicalRecordSet : Boolean;
{ Unlocks and removes from the table all of the stations logical record locks }
BEGIN
WITH Regs
DO BEGIN
AH := $D5;
RealModeIntr($21,Regs);
Result:=0;
ClearLogicalRecordSet := True;
END;
END;
(************* THE FOLLOWING ARE PHYSICAL RECORD LOCK CALLS ****************)
{F:BC..:Lock (& Log) records in a file}
function LogPhysicalRecord(Handle:Word;
LockDirective:Byte;
RecordOffset,RecordLength:Longint;
TimeOutLimit:Word): boolean;
{ Max length of name: 99 chars }
{ LockDirective LD_LOG = 0;
LD_LOG_LOCK = 1; Deny all access to file/record
LD_LOG_LOCK_RO = 3; Allow read / deny write }
{ TimeOut=0 means NoWait; TimeOut not valid if logging only }
{ Handle is the file handle }
begin
with regs
do begin
AH := $BC;
AL := LockDirective;
BX := Handle;
CX := HiLong(RecordOffset);
DX := LowLong(RecordOffset);
BP := TimeOutLimit;
SI := HiLong(RecordLength);
DI := LowLong(RecordLength);
RealModeIntr($21,Regs);
Result:=AL;
LogPhysicalRecord := (Result=0);
{ $FF = fail, $FE Timeout, $96 = No dynamic memory }
end;
end;
{BD.. [1.0+]}
function ReleasePhysicalRecord( Handle:Word; RecordOffset,RecordLength:Longint) : boolean;
{ When a record is released, it is unlocked for use by someone else, but }
{ it remains in the log table }
{ Handle is the file handle, Start_Hi and Start_Lo are the boundaries of }
{ the locked region to be released }
begin
with regs
do begin
AH := $BD;
BX := Handle;
CX := HiLong(RecordOffset);
DX := LowLong(RecordOffset);
SI := HiLong(RecordLength);
DI := LowLong(RecordLength);
RealModeIntr($21,Regs);
Result:=AL;
ReleasePhysicalRecord := (Result=0);
{ $FF = No locked record found}
end;
end;
{BE.. [1.0+]}
function ClearPhysicalRecord(Handle: Word;
RecordOffset,RecordLength:Longint): boolean;
{ Handle is the file handle, Start_Hi and Start_Lo are the boundaries }
{ of the file region to be locked. Clearing a record will unlock it }
{ and remove it from the log table. }
begin
with regs
do begin
AH := $BE;
BX := Handle;
CX := HiLong(RecordOffset);
DX := LowLong(RecordOffset);
SI := HiLong(RecordLength);
DI := LowLong(RecordLength);
RealModeIntr($21,Regs);
Result:=AL;
ClearPhysicalRecord := (Result=0);
{ $FF No locked record found }
end;
end;
{C2.. [1.0+]}
function LockPhysicalRecordSet(LockDirective: byte; TimeoutLimit: Word): boolean;
{ flgs are the lock flags: bit 1 set means shared (non-exclusive) lock }
{ Timeout is in 1/18 seconds, 0 = no wait, -1 means indefinite wait }
{ This function attempts to lock all of the records logged in the station's }
{ log table. }
{ LockDirective LD_LOCK = 0; Deny all access to file/record
LD_LOCK_RO = 1; Allow read / deny write }
{ !! There is known problem when the locking directive equals 1. }
begin
with regs
do begin
AH := $C2;
AL := LockDirective;
BP := TimeOutLimit;
RealModeIntr($21,Regs);
Result:=AL;
LockPhysicalRecordSet := (Result=0);
{ $FF = fail, $FE = timeout fail }
end;
end;
{C3.. [1.0+]}
function ReleasePhysicalRecordSet : boolean;
{ unlocks the entire record log table of the station. records remain in }
{ the log table. }
begin
regs.AH := $C3;
RealModeIntr($21,Regs);
Result:=0;
ReleasePhysicalRecordSet := True;
end;
{C4.. [1.0+]}
function ClearPhysicalRecordSet : boolean;
{ unlocks and removes from the log table any records logged and locked }
begin
regs.AH := $C4;
RealModeIntr($21,Regs);
Result:=0;
ClearPhysicalRecordSet := True;
end;
{F217/EF [2.1x+]}
Function GetLogicalRecordLocksByConnection(ConnNbr:word;
{i/o} Var NextRecNbr:word;
Var TaskNbr:word;
Var LockStatus:Byte;
Var LockName:String):Boolean;
{ You need console operator rights to use this function }
Type Treq=record
len :Word;
subFunc :Byte;
_ConnNbr :word; {lo-hi} { !! Invalid numbers may cause an abend }
_LastRecSeen:word; {lo-hi}
end;
Trep=record
_LastRecSeen :word; {lo-hi}
_NbrOfRecords:word; {lo-hi}
_LockInfo :array[1..508] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
Begin
WITH TPreq(GlobalReqBuf)^
do begin
subFunc:=$EF;
_ConnNbr:=ConnNbr;
_LastRecSeen:=NextRecNbr;
len:=SizeOf(Treq)-2;
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
With TPrep(GlobalReplyBuf)^
do begin
Move(_LastRecSeen,NextRecNbr,2);
end;
GetLogicalRecordLocksByConnection:=(result=0)
{ Valid completion codes:
$00 Success
$FF Failure
}
end;
{$IFDEF xxxx}
{F217/ [2.1x+]}
Function ( ):Boolean;
Type Treq=record
len:Word;
subFunc:Byte;
end;
Trep=record
end;
TPreq=^Treq;
TPrep=^Trep;
Begin
WITH TPreq(GlobalReqBuf)^
do begin
subFunc:=$
len:=SizeOf(Treq)-2;
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
With TPrep(GlobalReplyBuf)^
do begin
end;
:=(result=0)
{ Valid completion codes:
$00 Success
$FF Failure.
}
end;
{$ENDIF}
Begin
SetLockMode(1);
END.

308
NWTP/NWMESS.PAS Normal file
View File

@@ -0,0 +1,308 @@
{$X+,B-,V-} {essential compiler directives}
UNIT nwMess;
{ nwMess unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
INTERFACE
Uses nwIntr,nwMisc;
{ Primary functions: Interrupt: comments:
* BroadcastToConsole (F215/09)
* GetBroadcastMessage (F215/01)
* GetBroadcastMode (DE..(..04))
* SendBroadcastMessage (F215/00)
* SendConsoleBroadcast (F217/D1)
* SetBroadcastMode (DE..(..0x)), x= 0,1,2,3
Secondary Functions:
* SendMessageToUser
Not implemented:
- CheckPipeStatus (F215/08) (1)
- CloseMessagePipe (F215/07) (1)
- DisableStationBroadcast (F215/02) (3)
- EnableStationBroadcast (F215/03) (3)
- GetPersonalMessage (F215/05) (1)
- LogNetworkMessage (F215/0D) (2)
- OpenMessagePipe (F215/06) (1)
- SendPersonalMessage (F215/04) (1)
Notes:
(1) These calls are NOT supported by Netware 386 versions shipped after
December 1990, because they use pipe mechanisms, which cause a
considerable deal of server overhead.
These functions are not implemented in this unit.
Use IPX/SPX peer-to-peer communication instead (nwIPX,nwSPX,nwPEP).
(2) Network msg file no longer supported by 3.x
(3) Not supported by Netware 3.x. Use SetBroadcastMode instead.
}
Var result:word;
{F215/09 [2.15c+]}
Function BroadcastToConsole(message:string):boolean;
{ broadcast a message to the file server console. }
{F215/01 [2.15c+]}
Function GetBroadcastMessage(var bmessage: string):boolean;
{ Reads a broadcast message strored at server }
{DE..(..04) [1.x/2.x/ 3.x]}
Function GetBroadcastMode(var bmode:byte):boolean;
{ Returns the message mode. }
{F215/00 [2.15c+]}
Function SendBroadcastMessage( message:string;
connCount:byte;
connList:TconnectionList;
VAR resultlist:TconnectionList ):boolean;
{ Sends a broadcast message to a number of logical connections. }
{DE..(..0n) n=0,1,2,3 [1.x/2.x/3.x]}
Function SetBroadcastMode(bmode:byte):boolean;
{F217/D1 [2.15c+]}
Function SendConsoleBroadcast(message:string; connCount:byte;
connList:TconnectionList ):boolean;
{ Sends a message to a number of connections, as if the message was send
by a console broadcast command. Console oprator privileges required. }
{--------------------Secondary Functions-------------------------------}
Procedure SendMessageToUser(UserName,Message:String);
{ sends a message to a (group of) users.
The username may contain wildcards (* and ?).
The message will not be received by stations whose status is CASTOFF.}
IMPLEMENTATION {============================================================}
USES nwConn;
{DE..(..04) [1.x/2.x/ 3.x]}
Function GetBroadcastMode(var bmode:byte):boolean;
{ Returns the message mode.
00 Server Stores : Netware Messages and User Messages,
Shell automaticly displays messages.
01 Server Stores : Server Messages. (User messages discarded)
Shell automaticly displays messages.
02 Server stores : Server messages only.
Applications have to use GetBroadCastMessage to see if there is a message.
03 Server stores : Server messages and User messages.
Applications have to use GetBroadCastMessage to see if there is a message. }
var regs : TTregisters;
begin
regs.ah := $de;
regs.dl := $04;
RealModeIntr($21,regs);
bmode := regs.al;
result:=$00; { the call has no return codes }
GetBroadCastMode:=True;
end;
{DE..(..0n) n=0,1,2,3 [1.x/2.x/3.x]}
Function SetBroadcastMode(bmode:byte):boolean;
{ Sets the new message mode.
possible resultcode: $FF ( illegal broadcastmode supplied or
the broadcastmode after the call is not equal
to the intended broadcast mode )
00 Server Stores : Netware Messages and User Messages,
Shell automaticly displays messages.
01 Server Stores : Server Messages. (User messages discarded)
Shell automaticly displays messages.
02 Server stores : Server messages only.
Applications have to use GetBroadCastMessage to see if there is a message.
03 Server stores : Server messages and User messages.
Applications have to use GetBroadCastMessage to see if there is a message. }
var regs : TTregisters;
begin
if (bmode <4)
then begin
regs.ah := $de;
regs.dl := bmode;
RealModeIntr($21,regs);
if regs.al<>bmode { if confirmation of new mode unequal desired mode }
then result:=$FF
else result:=$00;
end
else result:=$FF;
SetBroadcastMode:=(result=0);
end;
{F215/01 [2.15c+]}
Function GetBroadcastMessage(var bmessage: string):boolean;
{ An application should poll this to see if there is a broadcastmessage
stored (for this workstation) at the default server.
The message mode must be 2 or 3. (No Notification by Shell)
If no message was stored at the server, or the message was empty,
this function will return FALSE and an errorcode of $103. }
Type Treq=record
len :word;
subF :byte;
end;
Trep=record
_message:string[55];
end;
TPreq=^Treq;
TPrep=^Trep;
BEGIN
With TPreq(GlobalreqBuf)^
do begin
subF:=$01;
len:=1;
end;
F2SystemCall($15,sizeOf(Treq),sizeOf(Trep),result);
If result=0
then bmessage:=TPrep(GlobalReplyBuf)^._message;
if bmessage[0]=#0 then result:=$103; { whups! empty message }
GetBroadCastMessage:=(result=0);
{ returncodes:
00 Successful; FC Message Queue Full;
FE I/O failure: Lack of dynamic workspace.
103 No msgs stored at server. }
end;
{F215/00 [2.15c+]}
Function SendBroadcastMessage( message:string;
connCount:byte;
connList:TconnectionList;
VAR resultlist:TconnectionList ):boolean;
{ Sends a broadcast message to a number of logical connections.
The connectionlist is an array[1..connCount] of logical connection numbers,
the result of the broadcast can be found in the resultList parameter.
example:
connCount=5
connList= [ 4,9,1,5,2 ]
resultList= [$00, $00, $FC, $FD, $FF]
possible codes in resultList:
$00: broadcast to this logical connnection was successful.
$FC: message rejected, buffer for this station already contains a message,
$FD: invalid connection number
$FF: The target connection has blocked incoming messages,
or the target connection is not in use. }
Type Treq=record
len :word;
subF :byte;
_connCount :byte;
connLandMessage:array[1..306] of byte; { 250 conn, 56 msg }
end;
Trep=record
connCount:byte;
_ResultList:TconnectionList;
end;
TPreq=^Treq;
TPrep=^Trep;
Var t:byte;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
subF:=$00;
_connCount:=connCount;
move(connList[1],connLandMessage[1],connCount);
t:=ord(message[0]); if t>55 then t:=55;
move(message[0],connLandMessage[connCount+1],t+1);
len:=3+connCount+t; { 2 bytes + [connList] + len(str) + str[0] }
end;
F2SystemCall($15,sizeOf(Treq),sizeOf(Trep),result);
If result=0
then with TPrep(GlobalReplyBuf)^
do resultList:=_resultlist;
SendBroadcastMessage:=(result=0);
end;
{F215/09 [2.15c+]}
Function BroadcastToConsole(message:string):boolean;
{ broadcast a message to the file server console.
The message (max 60 chars, in ascii range [$20..$7E]) will be displayed
at the bottom of the console screen.
This function truncates the messagelength to 60 and repaces illegal
characters with a . }
Type Treq=record
len :word;
subF :byte;
_message :string;
end;
TPreq=^Treq;
Var t:byte;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
subF:=$09;
PstrCopy(_message,message,60);
for t:=1 to 60
do if (_message[t]<>#$0) and
((_message[t]<#$20) or (_message[t]>#$7E))
then _message[t]:='.';
len:=62;
end;
F2SystemCall($15,sizeOf(Treq),0,result);
BroadcastToConsole:=(result=0);
{ resultcodes: 00 success ; $FC message queue full ;
$FE I/O failure: lack of dynamic workspace }
end;
{F217/D1 [2.15c+]}
Function SendConsoleBroadcast(message:string; connCount:byte;
connList:TconnectionList ):boolean;
{Sends a message to a number of connections, as if the message was send
by a console oprator. Console operator privileges required.
If connCount equals 0, then the message is send to all connections. }
Type Treq=record
len :word;
subF :byte;
_ConnCount:byte;
_connAndMess:array[1..306] of byte;
end;
TPreq=^Treq;
Var t:byte;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
subF:=$D1;
_connCount:=connCount;
Move(connList[1],_connAndMess[1],connCount);
t:=ord(message[0]); if t>55 then t:=55;
{!! to do: strip hi-bit of message.. }
Move(message[0],_connAndMess[connCount+1],t+1);
len:=t+connCount+3;
end;
F2SystemCall($17,sizeOf(Treq),0,result);
SendConsoleBroadcast:=(result=0);
{Resultcodes: $00 success; $C6 No Console Rights}
end;
{=================== Secondary Functions ===================================}
Procedure SendMessageToUser(UserName,Message:String);
{ sends a message to a (group of) users.
The username may contain wildcards (* and ?).
The message will not be received by stations whose status is CASTOFF.}
{ calls nwConn.getObjectConnectionNumber and nwMess.SendBroadcastMessage }
Var NbrOfConn:byte;
connList,ResultList:TconnectionList;
begin
IF NwConn.GetObjectConnectionNumbers(UserName,1 {OT_USER},NbrOfConn,connList)
AND (NbrOfConn>0)
then SendBroadcastMessage(Message,NbrOfConn,connList,ResultList);
end;
end. {unit nwMess}

961
NWTP/NWMISC.PAS Normal file
View File

@@ -0,0 +1,961 @@
{$X+,B-,V-,R-,S-} { essential compiler directives }
UNIT NWMISC;
{ nwMisc unit as of 950301 / NwTP 0.6 API. (c) 1993,1995 R.Spronk }
{ Includes a bugfix of the EncryptPassword function by Horst Jelonneck }
INTERFACE
uses nwIntr;
{ Miscellaneous Functions: Comments:
Diagnostic Functions:
* IsV3Supported
* GetNWversion
Novell types comparison functions:
* IsLowerNetworkAddress
* IsEqualNetworkAddress
* IsLaterNovTime
* IsEqualNovTime
Password Encryption Functions:
* EncryptPassword (1)
* EncryptPasswordDifference (1)
Conversion Functions:
* UpString (2)
* HexStr
* HexDumpStr
* PStrCopy
* ZStrCopy
* LoNibble
* HiNibble
* Lswap
* HiLong
* LowLong
* MakeLong
* NovTime2String
* DosTime2NovTime
* NovTime2DosTime
* NovPath2DosPath
DosPath2NovPath
. MapV2RightsToV3
. MapV3RightsToV2
Notes: (1)-Encrypt3 and associated tables adapted from a c source
(NVPW.C) by Willem Jan Hengeveld, A.K.A. Itsme@Hacktic.nl
-Source of the encryption routine: LOGON.PAS by Barry Nance,
[1:141/209] BYTE March'93
(2) Fast upcasestring by Bob Swart.
}
Type TnovTime=record
year,month,day,hour,min,sec,DayOfWeek:byte; { 0=sunday }
end;
TconnectionList=array[1..250] of byte;
TencryptionKey=array[0..7] of byte;
TencrPWdifference=array[0..15] of byte;
TnetworkAddress=array[1..4] of byte; { hi-endian }
TnodeAddress =array[1..6] of byte; { Hi-endian }
TinterNetworkAddress=record
net :TnetworkAddress; {hi-lo}
node :Tnodeaddress; {hi-lo}
socket:word; {lo-hi}
end;
Function IsV3Supported:Boolean;
Procedure NovTime2String(tim:TnovTime;Var DateStr:string);
{ Puts the time/date information of a NovTime into a string.
output format: 'DOW, dd mmm yyyy hh:mm:ss' DOW= day of the week. }
Procedure DosTime2NovTime(dt:Longint;Var nt:TnovTime);
{ Converts a compact DOS time record (4 bytes) into a Tnovtime record }
Procedure NovTime2DosTime(nt:TnovTime;Var dt:Longint);
Procedure NovPath2DosPath(np:String;Var dp:string);
{ Converts Novell type path into a DOS path of type
Subdir1\Subdir2\.. \subDirN }
{============================level 0 support functions=======================}
Procedure UpString(s:string);
{ Converts s to upperstring. Assembler, so it's realy a Var parameter. }
Function HexStr(dw:LongInt;len:byte):string;
{ Converts dw into a hex-string of length len. }
Function HexDumpStr(Var dumpVar;len:Byte):String;
{ Converts dumpVar into a hex-string of length len.
Basically the same as HexStr, but accepts variables only.
(Mostly used to dump an array of byte) }
procedure PStrCopy(Var dest:String;source:String;len:byte);
{ if length(source)>len
then Copy len bytes from source to dest.
else Copy source to dest and fill out with NULLs.
Length(Dest) will allways be set to len. }
procedure ZStrCopy(dest:String;VAR source;len:byte);
{ 1. Copies len bytes form an array to a pascal type string. }
{ 2. Trailing NULLs are removed from the string. }
{ consequently, the length of dest (dest[0]) will allways be <= len. }
{ -SOURCE is an array of byte: array[ ] of byte; }
Function IsLowerNetworkAddress(Var a, b): Boolean;
{ Compare two net&node addresses.
a and b should be of type TinternetworkAddress }
Function IsEqualNetworkAddress(Var a, b): Boolean;
{ Compare two net&node addresses.
a and b should be of type TinternetworkAddress }
Function IsLaterNovTime(time1,time2:TnovTime):boolean;
Function IsEqualNovTime(time1,time2:TnovTime):boolean;
Function MapV2RightsToV3(V2Rights:byte):word;
Function MapV3RightsToV2(V3Rights:Word):Byte;
Procedure GetNWversion(Var version:word);
{ determine the version of software installed on the current file server. }
{ see GetFileServerInformation F217/11 for more information }
{ Version: MajorVersion * 100 + MinorVersion; e.g. 311 for 3.11 }
Procedure EncryptPassword(objId:longint;password:string;
{i/o} Var Ekey:TencryptionKey);
{ called by LoginToFileServer (unit nwConn),
and by VerifyBinderyObjectPassword, ChangeBinderyObjectPassword (nwBindry) }
{ Source of the encryption routine: LOGON.PAS by Barry Nance, [1:141/209]
BYTE March'93 }
Procedure EncryptPasswordDifference(objId:Longint;
OldPassword,NewPassword:string;
Var key:TencryptionKey;
Var PWdif:TencrPWdifference;
Var PWdifChecksum:byte
);
Function LoNibble(b:Byte):Byte;
{ Returns the low nibble of the argument (in low nibble position),
with high nibble set to 0000 }
Function HiNibble(b:Byte):Byte;
{ Returns the high nibble of the argument (in low nibble position),
with high nibble set to 0000 }
Function Lswap(l:Longint):Longint;
{ swaps bytes in a longInt; ( reverse byte order ) }
Inline(
$5A/ {pop DX ; low word of long }
$58/ {pop AX ; hi word of long }
$86/$F2/ {xchg dl,dh ; swap bytes }
$86/$E0); {xchg al,ah ; swap bytes }
function HiLong(Long : LongInt) : Word;
{ This inline directive is similar to Turbo's Hi() function, except }
{ it returns the high word of a LongInt }
Inline(
$5A/ {pop dx ; low word of long }
$58); {pop ax ; hi word of long }
function LowLong(Long : LongInt) : Word;
{ This inline directive is similar to Turbo's Lo() function, except }
{ it returns the Low word of a LongInt }
Inline(
$5A/ {pop dx ; low word of long }
$58/ {pop ax ; hi word of long }
$89/$D0); {mov ax,dx ; return lo word as func. result in Ax }
function MakeLong(HiWord,LoWord : Word) : LongInt;
{ Takes hi and lo words and makes a longint }
Inline(
$58/ { pop ax ; pop low word into AX }
$5A); { pop dx ; pop high word into DX }
CONST
{** ERRORS DEFINED BY NWxxx UNITS *******}
{** STANDARD ERRORS AS USED BY NETWARE **}
HARDWARE_FAILURE = 255;
INVALID_INITIAL_SEMAPHORE_VALUE = 255; {nwSema}
INVALID_SEMAPHORE_HANDLE = 255; {nwSema}
BAD_PRINTER_ERROR = 255;
QUEUE_FULL_ERROR = 255;
NO_FILES_FOUND_ERROR = 255;
BAD_RECORD_OFFSET = 255;
PATH_NOT_LOCATABLE = 255;
SOCKET_ALREADY_OPEN = 255;
INVALID_DRIVE_NUMBER = 255; {nwDir}
NO_RECORD_FOUND = 255;
NO_RESPONSE_FROM_SERVER = 255;
REQUEST_NOT_OUTSTANDING = 255;
NO_SUCH_OBJECT_OR_BAD_PASSWORD = 255;
CLOSE_FCB_ERROR = 255;
FILE_EXTENSION_ERROR = 255;
FILE_NAME_ERROR = 255;
IO_BOUND_ERROR = 255;
SPX_IS_INSTALLED = 255; {nwIpx}
SPX_SOCKET_NOT_OPENED = 255; {nwIpx}
EXPLICIT_TRANSACTION_ACTIVE = 255; {nwTTS}
NO_EXPLICIT_TRANSACTION_ACTIVE = 255; {nwTTS}
TRANSACTION_NOT_YET_WRITTEN = 255; {nwTTS}
NO_MORE_MATCHING_FILES = 255; {nwTTS}
BINDERY_FAILURE = 255;
OPEN_FILES = 255; {3.x}
PRINT_JOB_ALREADY_QUEUED = 255; {3.x}
PRINT_JOB_ALREADY_SET = 255; {3.x}
SUPERVISOR_HAS_DISABLED_LOGIN = 254; {nwConn}
TIMEOUT_FAILURE = 254;
BINDERY_LOCKED = 254; {nwBindry}
SERVER_BINDERY_LOCKED = 254;
INVALID_SEMAPHORE_NAME_LENGTH = 254; {nwSema}
PACKET_NOT_DELIVERABLE = 254;
SOCKET_TABLE_FULL = 254;
DIRECTORY_LOCKED = 254;
SPOOL_DIRECTORY_ERROR = 254;
IMPLICIT_TRANSACTION_ACTIVE = 254; {nwTTS}
TRANSACTION_ENDS_RECORD_LOCK = 254; {nwTTS}
IO_FAILURE = 254; {3.x}
UNKNOWN_REQUEST = 253;
INVALID_PACKET_LENGTH = 253;
FIELD_ALREADY_LOCKED = 253;
BAD_STATION_NUMBER = 253;
SPX_MALFORMED_PACKET = 253;
SPX_PACKET_OVERFLOW = 253;
TTS_DISABLED = 253;
NO_SUCH_OBJECT = 252;
UNKNOWN_FILE_SERVER = 252;
INTERNET_PACKET_REQT_CANCELED = 252;
MESSAGE_QUEUE_FULL = 252; {nwMess}
SPX_LISTEN_CANCELED = 252;
NO_SUCH_PROPERTY = 251;
INVALID_PARAMETERS = 251;
{UNKNOWN_REQUEST = 251; ?double see 253}
NO_MORE_SERVER_SLOTS = 250;
TEMP_REMAP_ERROR = 250;
NO_PROPERTY_READ_PRIVILEGE = 249;
NO_FREE_CONNECTION_SLOTS = 249;
NO_PROPERTY_WRITE_PRIVILEGE = 248;
ALREADY_ATTACHED_TO_SERVER = 248;
NOT_ATTACHED_TO_SERVER = 248;
NO_PROPERTY_CREATE_PRIVILEGE = 247;
TARGET_DRIVE_NOT_LOCAL = 247;
NO_PROPERTY_DELETE_PRIVILEGE = 246;
NOT_SAME_LOCAL_DRIVE = 246;
NO_OBJECT_CREATE_PRIVILEGE = 245;
NO_OBJECT_DELETE_PRIVILEGE = 244;
NO_OBJECT_RENAME_PRIVILEGE = 243;
NO_OBJECT_READ_PRIVILEGE = 242;
INVALID_BINDERY_SECURITY = 241;
WILD_CARD_NOT_ALLOWED = 240;
IPX_NOT_INSTALLED = 240; {nwIpx}
INVALID_NAME = 239;
SPX_CONNECTION_TABLE_FULL = 239;
OBJECT_ALREADY_EXISTS = 238;
SPX_INVALID_CONNECTION = 238;
PROPERTY_ALREADY_EXISTS = 237;
SPX_NO_ANSWER_FROM_TARGET = 237;
SPX_CONNECTION_FAILED = 237;
SPX_CONNECTION_TERMINATED = 237;
NO_SUCH_SEGMENT = 236;
SPX_TERMINATED_POORLY = 236;
NOT_GROUP_PROPERTY = 235;
NO_SUCH_MEMBER = 234;
MEMBER_ALREADY_EXISTS = 233;
NOT_ITEM_PROPERTY = 232;
WRITE_PROPERTY_TO_GROUP = 232;
PASSWORD_HAS_EXPIRED = 223;
PASSWORD_HAS_EXPIRED_NO_GRACE = 222;
ACCOUNT_DISABLED = 220;
UNAUTHORIZED_LOGIN_STATION = 219;
MAX_Q_SERVERS = 219;
UNAUTHORIZED_LOGIN_TIME = 218;
Q_HALTED = 218;
LOGIN_DENIED_NO_CONNECTION = 217;
STN_NOT_SERVER = 217;
PASSWORD_TOO_SHORT = 216;
Q_NOT_ACTIVE = 216;
PASSWORD_NOT_UNIQUE = 215;
Q_SERVICING = 215;
NO_JOB_RIGHTS = 214;
NO_Q_JOB = 213;
Q_FULL = 212;
NO_Q_RIGHTS = 211;
NO_Q_SERVER = 210;
NO_QUEUE = 209;
Q_ERROR = 208;
NOT_CONSOLE_OPERATOR = 198;
INTRUDER_DETECTION_LOCK = 197;
ACCOUNT_TOO_MANY_HOLDS = 195;
CREDIT_LIMIT_EXCEEDED = 194;
NO_ACCOUNT_BALANCE = 193;
NO_ACCOUNT_PRIVILEGES = 192;
READ_FILE_WITH_RECORD_LOCKED = 162;
DIRECTORY_IO_ERROR = 161;
DIRECTORY_NOT_EMPTY = 160;
DIRECTORY_ACTIVE = 159;
INVALID_FILENAME = 158;
NO_MORE_DIRECTORY_HANDLES = 157;
NO_MORE_TRUSTEES = 156;
INVALID_PATH = 156;
BAD_DIRECTORY_HANDLE = 155;
RENAMING_ACROSS_VOLUMES = 154;
DIRECTORY_FULL = 153;
VOLUME_DOES_NOT_EXIST = 152;
NO_DISK_SPACE_FOR_SPOOL_FILE = 151;
SERVER_OUT_OF_MEMORY = 150;
OUT_OF_DYNAMIC_WORKSPACE = 150;
FILE_DETACHED = 149;
NO_WRITE_PRIVILEGES = 148;
READ_ONLY = 148;
NO_READ_PRIVILEGES = 147;
NO_FILES_RENAMED_NAME_EXISTS = 146;
SOME_FILES_RENAMED_NAME_EXISTS = 145;
NO_FILES_AFFECTED_READ_ONLY = 144;
SOME_FILES_AFFECTED_READ_ONLY = 143;
NO_FILES_AFFECTED_IN_USE = 142;
SOME_FILES_AFFECTED_IN_USE = 141;
NO_MODIFY_PRIVILEGES = 140;
NO_RENAME_PRIVILEGES = 139;
NO_DELETE_PRIVILEGES = 138;
NO_SEARCH_PRIVILEGES = 137;
INVALID_FILE_HANDLE = 136;
WILD_CARDS_IN_CREATE_FILENAME = 135;
CREATE_FILE_EXISTS_READ_ONLY = 134;
NO_CREATE_DELETE_PRIVILEGES = 133;
NO_CREATE_PRIVILEGES = 132;
IO_ERROR_NETWORK_DISK = 131;
NO_OPEN_PRIVILEGES = 130;
NO_MORE_FILE_HANDLES = 129;
FILE_IN_USE_ERROR = 128;
DOS_LOCK_VIOLATION = 33;
DOS_SHARING_VIOLATION = 32;
DOS_NO_MORE_FILES = 31;
DOS_NOT_SAME_DEVICE = 30;
DOS_ATTEMPT_TO_DEL_CURRENT_DIR = 16;
DOS_INVALID_DRIVE = 15;
DOS_INVALID_DATA = 13;
DOS_INVALID_ACCESS_CODE = 12;
DOS_INVALID_FORMAT = 11;
DOS_INVALID_ENVIRONMENT = 10;
DOS_INVALID_MEMORY_BLOCK_ADDR = 9;
DOS_INSUFFICIENT_MEMORY = 8;
DOS_MEMORY_BLOCKS_DESTROYED = 7;
DOS_INVALID_FILE_HANDLE = 6;
DOS_ACCESS_DENIED = 5;
DOS_TOO_MANY_OPEN_FILES = 4;
DOS_PATH_NOT_FOUND = 3;
DOS_FILE_NOT_FOUND = 2;
TTS_AVAILABLE = 1;
SERVER_IN_USE = 1;
SEMAPHORE_OVERFLOW = 1;
DOS_INVALID_FUNCTION_NUMBER = 1;
TTS_NOT_AVAILABLE = 1;
SERVER_NOT_IN_USE = 1;
IMPLEMENTATION{=============================================================}
{----------------------- Encryption tables and procedures --------------}
TYPE
Buf32 = ARRAY [0..31] OF Byte;
Buf16 = ARRAY [0..15] OF Byte;
Buf8 = ARRAY [0..7] OF Byte;
Buf4 = ARRAY [0..3] OF Byte;
CONST
EncryptTable : ARRAY [0..255] OF Byte =
($7,$8,$0,$8,$6,$4,$E,$4,$5,$C,$1,$7,$B,$F,$A,$8,
$F,$8,$C,$C,$9,$4,$1,$E,$4,$6,$2,$4,$0,$A,$B,$9,
$2,$F,$B,$1,$D,$2,$1,$9,$5,$E,$7,$0,$0,$2,$6,$6,
$0,$7,$3,$8,$2,$9,$3,$F,$7,$F,$C,$F,$6,$4,$A,$0,
$2,$3,$A,$B,$D,$8,$3,$A,$1,$7,$C,$F,$1,$8,$9,$D,
$9,$1,$9,$4,$E,$4,$C,$5,$5,$C,$8,$B,$2,$3,$9,$E,
$7,$7,$6,$9,$E,$F,$C,$8,$D,$1,$A,$6,$E,$D,$0,$7,
$7,$A,$0,$1,$F,$5,$4,$B,$7,$B,$E,$C,$9,$5,$D,$1,
$B,$D,$1,$3,$5,$D,$E,$6,$3,$0,$B,$B,$F,$3,$6,$4,
$9,$D,$A,$3,$1,$4,$9,$4,$8,$3,$B,$E,$5,$0,$5,$2,
$C,$B,$D,$5,$D,$5,$D,$2,$D,$9,$A,$C,$A,$0,$B,$3,
$5,$3,$6,$9,$5,$1,$E,$E,$0,$E,$8,$2,$D,$2,$2,$0,
$4,$F,$8,$5,$9,$6,$8,$6,$B,$A,$B,$F,$0,$7,$2,$8,
$C,$7,$3,$A,$1,$4,$2,$5,$F,$7,$A,$C,$E,$5,$9,$3,
$E,$7,$1,$2,$E,$1,$F,$4,$A,$6,$C,$6,$F,$4,$3,$0,
$C,$0,$3,$6,$F,$8,$7,$B,$2,$D,$C,$6,$A,$A,$8,$D);
EncryptKeys : Array[0..31] of byte =
($48,$93,$46,$67,$98,$3D,$E6,$8D,$B7,$10,$7A,$26,$5A,$B9,$B1,$35,
$6B,$0F,$D5,$70,$AE,$FB,$AD,$11,$F4,$47,$DC,$A7,$EC,$CF,$50,$C0);
EncryptTable1:array [0..7,0..1,0..15] OF byte= { used by encrypt3 }
{ 0 1 2 3 4 5 6 7 8 9 a b c d e f }
((( $F,$8,$5,$7,$C,$2,$E,$9,$0,$1,$6,$D,$3,$4,$B,$A),
( $2,$C,$E,$6,$F,$0,$1,$8,$D,$3,$A,$4,$9,$B,$5,$7)),
(( $5,$2,$9,$F,$C,$4,$D,$0,$E,$A,$6,$8,$B,$1,$3,$7),
( $F,$D,$2,$6,$7,$8,$5,$9,$0,$4,$C,$3,$1,$A,$B,$E)),
(( $5,$E,$2,$B,$D,$A,$7,$0,$8,$6,$4,$1,$F,$C,$3,$9),
( $8,$2,$F,$A,$5,$9,$6,$C,$0,$B,$1,$D,$7,$3,$4,$E)),
(( $E,$8,$0,$9,$4,$B,$2,$7,$C,$3,$A,$5,$D,$1,$6,$F),
( $1,$4,$8,$A,$D,$B,$7,$E,$5,$F,$3,$9,$0,$2,$6,$C)),
(( $5,$3,$C,$8,$B,$2,$E,$A,$4,$1,$D,$0,$6,$7,$F,$9),
( $6,$0,$B,$E,$D,$4,$C,$F,$7,$2,$8,$A,$1,$5,$3,$9)),
(( $B,$5,$A,$E,$F,$1,$C,$0,$6,$4,$2,$9,$3,$D,$7,$8),
( $7,$2,$A,$0,$E,$8,$F,$4,$C,$B,$9,$1,$5,$D,$3,$6)),
(( $7,$4,$F,$9,$5,$1,$C,$B,$0,$3,$8,$E,$2,$A,$6,$D),
( $9,$4,$8,$0,$A,$3,$1,$C,$5,$F,$7,$2,$B,$E,$6,$D)),
(( $9,$5,$4,$7,$E,$8,$3,$1,$D,$B,$C,$2,$0,$F,$6,$A),
( $9,$A,$B,$D,$5,$3,$F,$0,$1,$C,$8,$7,$6,$4,$E,$2))
);
EncryptTable3:array[0..15] of byte= { used by encrypt3 }
( $3,$E,$F,$2,$D,$C,$4,$5,$9,$6,$0,$1,$B,$7,$A,$8 );
PROCEDURE Shuffle(VAR ShuffleKey, buf; buflen : Word; VAR target);
{ UNIT INTERNAL PROCEDURE }
{ id, password[1.. ],length(passw), OUT: buf }
PROCEDURE Shuffle1(VAR temp : Buf32; VAR target);
VAR _target : Buf16 ABSOLUTE target;
b4 : Word;
b3 : Byte;
d, k, i : Word;
Begin
{** Step 4: .. }
b4 := 0;
FOR k := 0 TO 1
DO Begin
FOR i := 0 TO 31
DO Begin
b3 := Lo( Lo(temp[i] + b4) XOR
Lo(temp[(i + b4) AND 31] - EncryptKeys[i]));
b4 := b4 + b3;
temp[i] := b3;
End;
End;
{*** Step 5:... }
FOR i := 0 TO 15
DO _Target[i] := EncryptTable[temp[i Shl 1]] OR
(EncryptTable[temp[i Shl 1 +1]] Shl 4);
End;
VAR locShuffleKey : Buf4 ABSOLUTE ShuffleKey;
localBuf : ARRAY [0..127] OF Byte ABSOLUTE buf;
BufBytesUsed : Word;
temp : Buf32;
t, IndexOfBufBytes : Word;
Begin
{ strip trailing NULLs of the to-be-encoded buf,
last element of buf must be a NULL ? }
While (buflen > 0) AND (localBuf[buflen-1] = 0)
DO buflen := buflen - 1;
{ clear output of 1st shuffle }
FillChar(temp, SizeOf(temp), #0);
{*** 1ST Step: XOR folding of first (32*(buflen DIV 32)) bytes. }
{ temp= buf[0..31] XOR buf[32..63] XOR buf[64..95] XOR etc.. }
{ IndexOfBufBytes is a multiple of 32, length password= IndexOfBufBytes + buflen }
{ Temp varuable filled with XOR folding of the first IndexOfBufBytes bytes of the PW. }
IndexOfBufBytes := 0;
WHILE buflen >= 32
DO Begin
FOR t := 0 TO 31
DO Begin
temp[t] := temp[t] XOR localBuf[IndexOfBufBytes];
IndexOfBufBytes := IndexOfBufBytes + 1;
End;
buflen := buflen - 32;
End;
{*** 2ND step: repetitive XOR folding with (remainder of) password
password='hello', (BufBytesUsed=0)
or password='12345678901234567890123456789012hello' (BufBytesUsed=32)
of which the first 32 bytes were used in the 1st encryption step.
temp=temp XOR [hellohellohellohellohellohellohe];
}
BufBytesUsed:=IndexOfBufBytes;
IF buflen > 0
Then Begin
FOR t := 0 TO 31
DO Begin
IF IndexOfBufBytes + buflen = BufBytesUsed
Then Begin
BufBytesUsed := IndexOfBufBytes;
temp[t] := temp[t] XOR EncryptKeys[t];
End
Else Begin
temp[t] := temp[t] XOR localBuf[BufBytesUsed];
BufBytesUsed := BufBytesUsed + 1;
End;
End;
End;
{*** 3RD step: XOR-ing with shuffleKey (bytes of a longint)}
FOR t := 0 TO 31 DO temp[t] := temp[t] XOR locShuffleKey[t AND 3];
{*** 4&5 TH Step: see Shuffle1 }
Shuffle1(temp, target);
End;
PROCEDURE Encrypt(VAR key, buf, EncrPassword);
{ The encryptionKey 'key' is encrypted with the aid of
the shuffled login name/id within 'buf'.
Result: the encrypted Password (of type TencryptionKey). }
VAR _Key : TencryptionKey ABSOLUTE Key;
_EncrKey : TencryptionKey ABSOLUTE EncrPassword;
_LocalBuf : Buf32;
i: Byte;
Begin
Shuffle(_Key[0], buf, 16, _LocalBuf[0]);
Shuffle(_Key[4], buf, 16, _LocalBuf[16]);
FOR i := 0 TO 15 DO _LocalBuf[i] := _LocalBuf[i] XOR _LocalBuf[31-i];
FOR i := 0 TO 7 DO _EncrKey[i] := _LocalBuf[i] XOR _LocalBuf[15-i];
End;
Procedure EncryptPassword(objId:longint;password:string;Var Ekey:TencryptionKey);
{ Source of the encryption routine: LOGON.PAS by Barry Nance, [1:141/209] BYTE March'93 }
{ Two bugs fixed by Horst Jelonneck (930323) }
Var buf:buf32;
TobjId:Longint;
Tpassword:string;
begin
TobjId:=Lswap(objId);
Tpassword:=password+#0;
Shuffle(TObjId,Tpassword[1],length(password),buf);
Encrypt(Ekey,buf,Ekey);
end;
Procedure EncryptPasswordDifference(objId:Longint;
OldPassword,NewPassword:string;
Var key:TencryptionKey;
Var PWdif:TencrPWdifference;
Var PWdifChecksum:byte
);
{ Used by nwBindry.ChangeEncrBinderyObjectPassword.
Encrypt3 and associated tables adapted from a c source (NVPW.C)
by Willem Jan Hengeveld, A.K.A. Itsme@Hacktic.nl }
Procedure Encrypt3(Var buf1,buf2,buf3);
{ buf1: (part of) encrypted oldPW
buf2: (part of) encrypted newPW
buf3: 'change pw' data (result) }
Var p1:buf8 absolute buf1;
p2:buf8 absolute buf2;
p3:buf8 absolute buf3;
j,c,i:byte;
buf:buf8;
begin
buf:=p2;
for i:=0 to 15
do begin
for j:=0 to 7
do begin
c:=buf[j] XOR p1[j];
buf[j]:=EncryptTable1[j][0][c AND $0F]
OR (EncryptTable1[j][1][c SHR 4] SHL 4);
end;
c:=p1[7];
for j:=7 downto 1
do p1[j]:=(p1[j] SHL 4) OR (p1[j-1] SHR 4);
p1[0]:=(c SHR 4) OR (p1[0] SHL 4);
FillChar(p3,8,#$0);
for j:=0 to 15
do begin
c:=EncryptTable3[j];
If odd(EncryptTable3[j])
then c:=buf[c DIV 2] SHR 4
else c:=buf[c DIV 2] AND $0F;
if Odd(j)
then p3[j DIV 2]:=p3[j DIV 2] XOR (c SHL 4)
else p3[j DIV 2]:=p3[j DIV 2] XOR c;
end;
buf:=p3;
end;
end;
Var l:byte;
OldShuffledPW,NewShuffledPW:array[0..15] of byte;
begin
objId:=Lswap(objId);
Shuffle(objId,OldPassword[1],Length(OldPassword),OldShuffledPW);
Shuffle(objId,NewPassword[1],Length(NewPassword),NewShuffledPW);
Encrypt(key,OldShuffledPW,key);
Encrypt3(OldShuffledPW,NewShuffledPW,PWdif);
Encrypt3(OldShuffledPW[8],NewShuffledPW[8],PWdif[8]);
if Length(NewPassword)<63
then l:=length(NewPassword)
else l:=63;
PWdifChecksum:=(((l XOR OldShuffledPW[1] XOR OldShuffledPW[2]) AND $7F) OR $40);
end;
{-------------- End of encryption procedures ----------------------------}
Procedure UpString(s : String); Assembler;
{ fast upcasestring by Bob Swart }
ASM
PUSH DS
LDS SI, s
LES DI, s
CLD
XOR AH, AH
LODSB
STOSB
XCHG AX, CX { empty string? }
JCXZ @2
@1: LODSB
SUB AL, 'a'
CMP AL, 'z'-'a'+1
SBB AH, AH
AND AH, 'a'-'A'
SUB AL, AH
ADD AL, 'a'
STOSB
LOOP @1
@2: POP DS
end;
procedure ZStrCopy(dest:String;Var source;len:byte); assembler;
{ 1. Copies len bytes from an array to a pascal type string. }
{ 2. Trailing NULLs are removed from the string. }
{ consequently, the length of det (dest[0]) will allways be <= len. }
asm
mov dx,ds
les di,dest
xor ch,ch
mov [es:di],ch { dest[0]:=#0 }
mov cl,len
jcxz @4 { if len=0 then goto @4 }
lds si,source
@3: lodsb
or al,al
jz @2 { determine non-0 length of source }
dec cx
jnz @3
@2: xor ax,ax
mov al,len
sub ax,cx { ax:= bytes to copy }
les di,dest
lds si,source
mov es:[di],al { dest[0]:=actual non-0 len }
inc di { es:di => dest[1] ; ds:si => source[0] }
mov cx,ax
cld
rep movsb { copy cx bytes from ds:si to es:di }
@4: mov ds,dx
end;
procedure PStrCopy(Var dest:String;source:String;len:byte);
Var w:byte;
begin
w:=1;
dest[0]:=chr(len);
While w<=ord(source[0])
do begin
dest[w]:=source[w];
inc(w)
end;
While w<=len
do begin
dest[w]:=#0;
inc(w)
end;
end;
Procedure NovTime2String(tim:TnovTime;Var DateStr:string);
CONST day:array[0..6] of string[3]
=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
Month:array[1..12] of string[3]
=('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
Type string4=string[4];
Var sday,syear,shour,smin,ssec:string4;
Procedure zstr(n:byte;Var s:string4);
begin
str(n,s);
if s[0]=#1 then s:='0'+s;
end;
begin
if (tim.month>12) or (tim.month<1)
or (tim.day<1) or (tim.day>31)
or (tim.hour>23) or (tim.min>59) or (tim.sec>59)
then DateStr:='<invalid date & time> '
else begin
zstr(tim.day,sday);
if sday[1]='0' then sday[1]:=' ';
if tim.year<80 then str(tim.year+2000,syear)
else str(tim.year+1900,syear);
zstr(tim.hour,shour);
zstr(tim.min,smin);
zstr(tim.sec,ssec);
DateStr:=day[tim.DayOfWeek]+', '+
sday+' '+Month[tim.month]+' '+syear+' '+
shour+':'+smin+':'+ssec;
end;
end;
Procedure DosTime2NovTime(dt:Longint;Var nt:TnovTime);
Var k:array[1..2] of word absolute dt;
begin
with nt
do begin
year:=(80+byte(k[2] SHR 9)) MOD 100;
month:=(byte(k[2] SHR 5) AND 15);
day:=byte(k[2] AND 31);
hour:=byte (k[1] SHR 11);
min:=(byte(k[1] SHR 5) AND 63);
sec:=2*byte(k[1] AND 31);
end;
end;
Procedure NovTime2DosTime(nt:TnovTime;Var dt:Longint);
Var k:array[1..2] of word absolute dt;
begin
with nt
do begin
k[2]:=(((100+year-80) mod 100) SHL 9)+(month SHL 5)+day;
k[1]:=(hour SHL 11)+(min SHL 5)+(sec DIV 2);
end;
end;
Procedure NovPath2DosPath(np:String;Var dp:string);
{ np is a pascal type string with the folowing format:
chr(length(subdir1)),subdir1,
...
chr(length(subdirN)),subDirN.
It will be transformed to a DOS path of type Subdir1\Subdir2\.. \subDirN }
Var t:Byte;
begin
dp:=np;
delete(dp,1,1);
for t:=1 to ord(dp[1])
do if dp[t]<=#20 then dp[t]:='\';
end;
Function LoNibble(b:Byte):Byte; assembler;
asm
mov al,b
and al,$0F
end;
Function HiNibble(b:Byte):Byte; assembler;
asm
mov ah,$00
mov al,b
shr ax,1
shr ax,1
shr ax,1
shr ax,1
end;
Function HexStr(dw:LongInt;len:byte):string;
CONST n:array[0..15] of char
=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
Var t:integer;
ldw:LongInt;
res:string;
begin
res:='';
for t:=1 to len
do begin
ldw:=dw AND $0000000F;
res:=n[ldw]+res;
dw:=dw SHR 4;
end;
HexStr:=res;
end;
Function HexDumpStr(Var dumpVar;len:Byte):String;
Var arr:Array[1..256] of Byte ABSOLUTE dumpVar;
t:Byte;
res:String;
begin
res:='';
for t:=1 to (1+(len DIV 2))
do res:=res+HexStr(arr[t],2);
res[0]:=chr(len);
HexDumpStr:=res;
end;
Function IsLowerNetworkAddress(Var a, b): Boolean;
Type TCharNetAddress = Array [1..10] of Char;
Var Aaddr : TCharNetAddress ABSOLUTE a;
Baddr : TCharNetAddress ABSOLUTE b;
Begin
IsLowerNetworkAddress := Aaddr < Baddr;
End;
Function IsEqualNetworkAddress(Var a, b): Boolean;
Type TCharNetAddress = Array [1..10] of Char;
Var Aaddr : TCharNetAddress ABSOLUTE a;
Baddr : TCharNetAddress ABSOLUTE b;
Begin
IsEqualNetworkAddress := (Aaddr = Baddr);
End;
Function IsLaterNovTime(time1,time2:TnovTime):boolean;
Var bAft:boolean;
y1,y2:word;
begin
if time1.year>=80
then y1:=1900+time1.year
else y1:=2000+time1.year;
if time2.year>=80
then y2:=1900+time2.year
else y2:=2000+time2.year;
bAft:=(y1>y2);
if y1=y2
then begin
bAft:=(time1.month>time2.month);
if time1.month=time2.month
then begin
bAft:=(time1.day>time2.day);
if time1.day=time2.day
then begin
bAft:=(time1.hour>time2.hour);
if time1.hour=time2.hour
then begin
bAft:=(time1.min>time2.min);
if time1.min=time2.min
then bAft:=(time1.sec>time2.sec);
end;
end;
end;
end;
IsLaterNovTime:=bAft
end;
Function IsEqualNovTime(time1,time2:TnovTime):boolean;
Var t1:array[1..Sizeof(TnovTime)-1] of char absolute time1;
t2:array[1..SizeOf(TnovTime)-1] of char absolute time2;
begin
IsEqualNovTime:=(t1=t2);
end;
Function MapV2RightsToV3(V2Rights:byte):word;
CONST RightsNotChanged:byte=$08+$10+$40+$80;
Var result:Word;
begin
if (V2Rights and $FF)>0
then result:=$1FF
else begin
result:=(V2Rights and RightsNotChanged);
if (V2Rights and ($01+$04))>0
then result:=result or $01;
if (V2Rights and ($02+$04))>0
then result:=result or $02;
if (V2Rights and $04)>0
then result:=result or $01;
if (V2Rights and $20)>0
then result:=result or $28;
end;
MapV2RightsToV3:=result;
end;
Function MapV3RightsToV2(V3Rights:Word):Byte;
CONST RightsNotChanged:word=$10+$20+$40+$80;
Var result:Byte;
begin
If (V3Rights and $0100)>0
then result:=$FF
else begin
result:=(lo(V3Rights) and RightsNotChanged);
If (V3Rights and $01)>0
then result:=result or $05;
If (V3Rights and $02)>0
then result:=result or $06;
{If (V3Rights and $04)>0
then result:=result or $00;}
If (V3Rights and $08)>0
then result:=result or $28;
end;
MapV3RightsToV2:=result;
end;
Procedure GetNWversion(Var version:word);
{ determine the version of the software installed on the current file server. }
{ see GetFileServerInformation F217/11 in the nwServ unit for more information }
{ version : word; contains the versionnumber of the fileserver we're
currently connected to. Used by primary functions to
determine what type of calls to use to perform a certain function.
format: (majorVersion*100)+minorVersion
e.g. 311 for 3.11
Range: 215 (advanced netware 2.15) and upwards }
{ If the version is lower than 2.15, 2.15 is returned. }
{ note: you don't have to be logged in to call this function. }
Type TReq= Record
PacketLength : Word;
FunctionVal : Byte;
End;
TRep=array[1..$80] of byte;
Tpreq=^Treq;
Tprep=^Trep;
Var Result:word;
Begin
With TPreq(GlobalReqBuf)^
Do Begin
PacketLength := 1; FunctionVal := $11;
End;
F2SystemCall($17,sizeof(Treq),Sizeof(Trep),result);
If result=0
then version:=(TPrep(GlobalReplyBuf)^[49]*100)+TPrep(GlobalReplyBuf)^[50]
else version:=215;
End;
Function IsV3Supported:boolean;
Var version:word;
begin
GetNWversion(version);
IsV3Supported:=(version>=300);
end;
END.

1149
NWTP/NWQMS.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

330
NWTP/NWSEMA.PAS Normal file
View File

@@ -0,0 +1,330 @@
{$X+,B-,V-} {essential compiler directives}
Unit nwSema;
{ nwSema unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
INTERFACE
{ Primary functions: Interrupt: comments:
* CloseSemaphore (F220/04)
* ExamineSemaphore (F220/01)
* GetConnectionsSemaphores (F217/F1)
* GetSemaphoreInformation (F217/F2)
* OpenSemaphore (F220/00)
* SignalSemaphore (F220/03)
* WaitOnSemaphore (F220/02)
Notes: Functions marked with a '*' have been tested and found correct.
}
Uses nwIntr,nwMisc;
Type TsemaInfo=record
ConnNbr:word;
TaskNbr:word;
end;
TsemaInfoList=array[1..100] of TsemaInfo;
{ used by GetSemaphoreInformation }
TconnSema=record
OpenCount: Byte;
Value : Integer;
TaskNbr : Word;
unknown : byte; { always 00 ?! }
Name : string[127];
end;
{ used by GetConnectionsSemaphores }
Var Result:word;
{F220/00 [2.15? 3.x]}
Function OpenSemaphore(SemName : String; InitVal : Integer;
VAR SemHandle : LongInt;
VAR OpenCount : Word ):Boolean;
{F220/01 [2.15? 3.x]}
FUNCTION ExamineSemaphore( SemHandle :LongInt;
VAR Value :Integer;
VAR OpenCount :Word ) :Boolean;
{ This functions returns the current value and open count of a semaphore.}
{F220/02 [3.x]}
FUNCTION WaitOnSemaphore( SemHandle :LongInt;
Wait_Time :Word ) :Boolean;
{ Decrement the semaphore value and, if it is negative, }
{ wait until it becomes non-negative or until a timeout occurs. }
{F220/03 [3.x]}
FUNCTION SignalSemaphore(SemHandle:LongInt) : Boolean;
{ Increment the semaphore value and release if waiting. }
{F220/04 [3.x]}
FUNCTION CloseSemaphore(SemHandle:LongInt) : Boolean;
{ Decrement the open count of a semaphore.}
{ When the open count goes to zero, the semaphore is destroyed. }
{F217/F1 [2.15+? 3.x+]}
Function GetConnectionsSemaphores(ConnNbr:Word;
{i/o} Var seqNbr:Word;
{out} Var NbrOfSemaLeft:Byte;
{out} Var SemaInfo:TconnSema):Boolean;
{Caller needs console privileges }
{F217/F2 [2.15? 3.x+]}
Function GetSemaphoreInformation(SemaName:String;
{i/o} Var seqNbr:word;
{out} Var OpenCount:word;
Var SemValue:Integer;
Var NbrOfSemaLeft:byte;
Var info:TsemaInfoList):Boolean;
{ Caller needs console privileges }
IMPLEMENTATION {=============================================================}
{F220/00 [3.x]}
Function OpenSemaphore(SemName : String; InitVal : Integer;
VAR SemHandle : LongInt;
VAR OpenCount : Word ):Boolean;
Type Treq=Record
subf:byte;
_InitVal:byte;
_SemNameLen:byte;
_SemName:array[0..127] of byte;
end;
Trep=record
_SemHandle:LongInt;
_OpenCount:Byte;
end;
TPreq=^Treq;
TPrep=^Trep;
begin
With TPreq(GlobalReqBuf)^
do begin
subf:=$00;
If InitVal<0
then _InitVal:=Lo(256+Initval)
else _InitVal:=Lo(InitVal);
UpString(SemName);SemName:=SemName+#0;
move(semName[1],_SemName[0],ord(SemName[0]));
_SemNameLen:=ord(semName[0])-1;
end;
F2SystemCall($20,SizeOf(treq),SizeOf(trep),result);
With TPrep(GlobalReplyBuf)^
do begin
SemHandle:=Lswap(_SemHandle);
OpenCount:=_OPenCount;
end;
OpenSemaphore:=(result=0);
end;
{F220/02 [3.x]}
Function WaitOnSemaphore( SemHandle : LongInt;
Wait_Time : Word ) : Boolean;
{ Decrement the semaphore value and wait if it is negative. If negative,}
{ the workstation will wait until it becomes non-negative or until a }
{ timeout occurs. }
Type Treq=Record
subf:byte;
_SemHandle:Longint;
_wait :word; { hi-lo }
end;
TPreq=^Treq;
begin
With TPreq(GlobalReqBuf)^
do begin
subf:=$02;
_semHandle:=Lswap(SemHandle);
_wait:=swap(wait_Time);
end;
F2SystemCall($20,SizeOf(treq),0,result);
WaitOnSemaphore:=(result=0);
end;
{F220/03 [3.x+]}
Function SignalSemaphore(SemHandle:LongInt) : Boolean;
{ Increment the semaphore value and release if waiting. If any stations}
{ are waiting, the station that has been waiting the longest will be }
{ signalled to proceed }
Type Treq=Record
subf:byte;
_semhandle:Longint;
end;
TPreq=^Treq;
begin
With TPreq(GlobalReqBuf)^
do begin
subf:=$03;
_semHandle:=Lswap(SemHandle);
end;
F2SystemCall($20,SizeOf(treq),0,result);
SignalSemaphore:=(result=0);
end;
{F220/04 [3.x+]}
Function CloseSemaphore(SemHandle:LongInt) : Boolean;
{ Decrement the open count of a semaphore. When the open count goes }
{ to zero, the semaphore is destroyed. }
Type Treq=Record
subf:byte;
_semhandle:Longint;
end;
TPreq=^Treq;
begin
With TPreq(GlobalReqBuf)^
do begin
subf:=$04;
_semHandle:=Lswap(SemHandle);
end;
F2SystemCall($20,SizeOf(treq),0,result);
CloseSemaphore:=(result=0);
end;
{F220/01 [2.x/3.x]}
FUNCTION ExamineSemaphore(SemHandle:LongInt;
VAR Value : Integer;
VAR OpenCount : Word ) : Boolean;
{ The semaphore value that comes back is the count from the open call }
{ - the open count is incremented }
{ anytime a station opens the semaphore this can be used for controlling }
{ the number of users using your software }
Type Treq=record
subf:byte;
_semHandle:Longint;
end;
Trep=record
_Value:Byte;
_OpenCount:Byte;
end;
TPreq=^Treq;
TPrep=^Trep;
BEGIN
With TPreq(GlobalReqBuf)^
DO begin
subf:=$01;
_semHandle:=Lswap(SemHandle);
end;
F2SystemCall($20,SizeOf(Treq),SizeOf(Trep),result);
With TPrep(GlobalReplyBuf)^
do begin
if (_Value and $80)>0
then Value:=254-_Value
else Value:=_Value;
OpenCount:=_OpenCount;
end;
ExamineSemaphore := (result = 0);
END;
{F217/F1 [2.15+? 3.x+]}
Function GetConnectionsSemaphores(ConnNbr:Word;
{i/o} Var seqNbr:Word;
{out} Var NbrOfSemaLeft:Byte;
{out} Var SemaInfo:TconnSema):Boolean;
{ To be called iteratively. Inital seqNbr=1. Iterate until seqNbr
becomes 0 (or until NbrOfSemaLeft becomes 0).
This function can return information about several semaphores at the
same time. However, the size of the reply buffer is limited, causing
several as of now unsolvable problems. For now this function will
return information on a per semaphore basis. }
Type Treq=Record
len:word;
subf:byte;
_ConnNbr:word; {lo-hi}
_SeqNbr:word; {lo-hi}
end;
Trep=record
_NextSeqNbr:word;
_nbrOfSema:byte; { word (lo-hi) ? }
_unknown:byte; { -^ }
_SemaInfoBuf:array[1..508] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
Var i,t:Byte;
begin
With TPreq(GlobalReqBuf)^
do begin
len:=SizeOf(Treq)-2;
subf:=$F1;
_ConnNbr:=ConnNbr;
_SeqNbr:=SeqNbr;
end;
F2SystemCall($17,SizeOf(treq),SizeOf(trep),result);
if result=0
then With TPrep(GlobalReplyBuf)^
do begin
NbrOfSemaLeft:=(_NbrOfSema-1);
if NbrOfSemaLeft=0
then seqNbr:=0
else seqNbr:=seqNbr+1; { unfortunately, _NextSeqNbr returns no valid info. }
Move(_SemaInfoBuf[1],SemaInfo,7+_SemaInfoBuf[7]);
With SemaInfo
do begin
Value:=swap(Value);
TaskNbr:=swap(TaskNbr);
end;
end;
GetConnectionsSemaphores:=(result=0);
{ 00 Successful C6 No console rights FD Bad connection number }
end;
{F217/F2 [2.15? 3.x+]}
Function GetSemaphoreInformation(SemaName:String;
{i/o} Var seqNbr:word;
{out} Var OpenCount:word;
Var SemValue:Integer;
Var NbrOfSemaLeft:byte;
Var info:TsemaInfoList):Boolean;
Type Treq=Record
len:word;
subf:byte;
_seqNbr: word;
_semaName:string[127];
end;
Trep=record
_NextSeqNbr:Word;
_OpenCount:word;
_SemValue:word;
_NbrOfRecords:word;
_SemaInfoBuf:array[1..514] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
begin
UpString(SemaName);
if SemaName[0]>#127
then SemaName[0]:=#127;
With TPreq(GlobalReqBuf)^
do begin
subf:=$F2;
_seqNbr:=seqNbr;
_SemaName:=SemaName;
len:=4+ord(_SemaName[0]);
end;
F2SystemCall($17,SizeOf(treq),SizeOf(trep),result);
With TPrep(GlobalReplyBuf)^
do begin
OpenCount:=_OpenCount;
SemValue:=Integer(_SemValue);
NbrOfSemaLeft:=_NbrOfRecords;
move(_SemaInfoBuf,Info,SizeOf(TsemaInfoList));
if NbrOfSemaLeft>100
then seqNbr:=seqNbr+100
else seqNbr:=0;
end;
GetSemaphoreInformation:=(result=0);
{ 00 Successful C6 No console rights }
end;
END.

748
NWTP/NWSERV.PAS Normal file
View File

@@ -0,0 +1,748 @@
{$X+,B-,V-} {essential compiler directives}
UNIT nwServ;
{ nwServ unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk }
INTERFACE
uses nwIntr,NwMisc,nwConn;
Var result:word;
{ Primary Functions: Interrupt: Comments:
* CheckConsolePrivileges (F217/C8)
* ClearConnectionNumber (F217/D2)
* DisableFileServerLogin (F217/CB)
. DisableTransactionTracking (F217/CF)
* DownFileServer (F217/D3)
* EnableFileServerLogin (F217/CC)
. EnableTransactionTracking (F217/D0)
* GetConnectionsOpenFiles (F217/EB)
GetConnectionsUsingAFile (F217/EC)
* GetDiskUtilization (F217/0E)
* GetFileServerDateAndTime (F214)
* GetFileServerDescriptionStrings (F217/C9)
* GetFileServerLoginStatus (F217/CD)
* GetNetworkSerialNumber (F217/12)
* GetFileServerInformation (F217/11)
* SetFileServerDateAndTime (F217/CA)
* VerifyNetworkSerialNumber (F217/0C)
Secondary functions:
* CheckNetwareVersion
Not supported by netware 3.x: (2.x only)
- GetBinderyObjectDiskSpaceLeft (F217/E6) (failed during testing)
- GetConnectionsTaskInformation (E3../DA)
- GetConnectionsUsageStats (E3../E5)
- GetConnectionsUsingAFile (E3../DC)
- GetDiskCacheStats (E3../D6)
- GetDiskChannelStats (E3../D9)
- GetDriveMappingTable (E3../D7)
- GetFileServerLANIOStats (E3../E7)
- GetFileServerMiscInformation (E3../E8)
- GetFileSystemStats (E3../D4)
- GetLANDriverConfigInfo (E3../E3)
- GetLogicalRecordInformation (E3../E0)
- GetLogicalRecordsByConnection (E3../DF)
- GetPhysicalDiskStats (E3../D8)
- GetPhysicalRecordLocksByFile (E3../DE)
- GetPhysRecLocksByConnectAndFile (E3../DD)
}
Type TFileServerInformation
=Record
ServerName : string[48];
NetwareVersion : Byte;
NetwareSubVersion : Byte; { 0..99 }
ConnectionsMax : word;
ConnectionsInUse : word;
MaxConnVol : word; { max connected volumes }
{---Advanced Netware 2.1x/3.x------------}
OS_revision : byte;
SFT_level : byte;
TTS_level : byte;
peak_conn_used : word; { max simult.used connections}
accounting_version : byte;
vap_version : byte;
queuing_version : byte;
print_server_version : byte;
virtual_console_version : byte;
security_restrictions_level : byte;
Internetwork_bridge_version : byte;
Undefined : Array [1..60] of Byte;
End;
Type TfileInfoRecord=record
TaskNbr :Word;
LockType :Byte; { 00 no lock; FE file lock; FF locked by Begin Share File Set }
AccessFlag :Byte;
LockFlag :Byte;
VolNbr :Byte; { 0..31 }
ParentEntryId:Longint;
DirEntryId :Longint;
ForkCount :Byte;
NStype :Byte;
FileName :String;
end;
TfileInfoRecList=array[1..28] of TfileInfoRecord;
Type TfileUsageList=record
UseCount :word;
OpenCount :word;
OpenForReadCount :word;
OpenForWriteCount:word;
DenyReadCount :word;
DenyWriteCount :word;
LockFlag :Byte; { boolean }
NStype :Byte; { Fork Count = File siz? of NStype? }
NbrOfRec :word; { max 70 }
FileUsage:array[1..70] of record
ConnNbr :word;
TaskNbr :word;
LockType :byte;
AccessFlag:Byte;
LockFlag :Byte;
end;
end;
{F217/C8 [2.15c+]}
FUNCTION CheckConsolePrivileges : Boolean;
{F217/D2 [2.15c+]}
Function ClearConnectionNumber(connectionNbr:byte):boolean;
{ Console Rights needed;
-Terminates a connection. }
{F217/CB [2.15c+]}
FUNCTION DisableFileServerLogin : Boolean;
{F217/CF [2.15c+]}
FUNCTION DisableTransactionTracking : Boolean;
{F217/D3 [2.15c+]}
FUNCTION DownFileServer (ForceFlag : Boolean) : Boolean;
{F217/CC [2.15c+]}
FUNCTION EnableFileServerLogin : Boolean;
{F217/D0 [2.15c+]}
FUNCTION EnableTransactionTracking : Boolean;
{F217/EB [3.0+]}
FUNCTION GetConnectionsOpenFiles
( ConnNumber : Byte;
{i/o:} var LastRecordSeen : word;
{out:} var NbrOfRecords : word;
var FileInfo : TfileInfoRecList ) : Boolean;
{F217/0E [2.15c+]}
FUNCTION GetDiskUtilization(volNbr:byte; objID:Longint;
Var usedDirs,usedFiles,usedBlocks:Word ):Boolean;
{F214 [2.15c+]}
FUNCTION GetFileServerDateAndTime ( Var time:TnovTime): Boolean;
{F217/C9 [2.15c+]}
FUNCTION GetFileServerDescriptionStrings(Var companyName,
VersionAndRevision,revisionDate,
copyrightNotice:String
):Boolean;
{F217/CD [2.15c+]}
FUNCTION GetFileServerLoginStatus (Var LoginEnabled:Boolean): Boolean;
{ if Login is enabled then returns TRUE in LoginEnabled }
{F217/12 [2.15c+]}
Function GetNetworkSerialNumber(Var serialNbr:LongInt; Var ApplicNbr:Word ):Boolean;
{return the serial number and application number for the software
installed on the file server}
{F217/11 [2.15c+]}
Function GetFileServerInformation (Var serverInfo:TFileServerInformation):boolean;
{determine the version of software installed on the file server and how it is configured}
{F217/CA [2.15c+]}
FUNCTION SetFileServerDateAndTime(time:TnovTime):Boolean;
{need console operator privileges to do this}
{F217/OC [2.15c+]}
Function VerifyNetworkSerialNumber(serialNbr: LongInt ;
Var ApplicNbr: Word ):Boolean;
{if the network serial number to be verified is correct, the reply
buffer will contain the corresponding application number }
{*********************** Secondary Functions ******************************}
{ [1.x/2.x/3.x] }
FUNCTION CheckNetwareVersion(MinimumVersion,MinimumSubVersion,
MinimumRevision,MinimumSFT,MinimumTTS:word):Boolean;
IMPLEMENTATION{=============================================================}
{F217/D2 [2.15c+]}
Function ClearConnectionNumber(connectionNbr:byte):boolean;
{ Console Rights needed;
-Terminates a connection. }
Type Treq=record
len : word;
subf: byte;
_connNbr:byte;
end;
TPreq=^Treq;
begin
With TPreq(GlobalReqBuf)^
do begin
len:=2;
subf:=$D2;
_connNbr:=connectionNbr
end;
F2SystemCall($17,SizeOf(Treq),0,result);
ClearConnectionNumber:=(result=0);
{result codes: 00 successful; C6 No Console Rights}
end;
{F214 [2.15c+]}
FUNCTION GetFileServerDateAndTime ( Var time:TnovTime): Boolean;
Type Trep=TnovTime;
TPrep=^Trep;
BEGIN
F2SystemCall($14,0,SizeOf(Trep),result);
Time:=TPrep(GlobalreplyBuf)^;
if time.year>100
then time.year:=time.year-100;
{ year<80 : 21st century }
result:=0;
getFileServerDateAndTime:=TRUE;
end;
{F217/CA [2.15c+]}
FUNCTION SetFileServerDateAndTime (time:TnovTime): Boolean;
Type Treq=record
Len:word;
subF:byte;
_time:TnovTime
end;
TPreq=^Treq;
BEGIN
{ year<80 : 21st century }
WITH TPreq(GlobalReqBuf)^
do begin
Len:=SizeOf(Treq)-3; { dow is not a parameter }
subF:=$CA;
_time:=time;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
SetFileServerDateAndTime:=(Result=$00);
{ Resulcodes: $00 Success; $C6 No Console Operator Rights }
end;
{F217/11 [2.15c+]}
Function GetFileServerInformation (Var serverInfo:TFileServerInformation):boolean;
{determine the version of software installed on the file server and how it is configured}
{SeeAlso: GetDiskUtilization, GetNetworkSerialNumber, GetFileServerLoginStatus,
GetFileServerDateAndTime}
Type TReq=Record
Len : word;
SubF : Byte;
End;
TRep=TFileServerInformation;
TPreq=^Treq;
TPrep=^Trep;
Var t:word;
Begin
With TPreq(GlobalReqBuf)^
Do Begin
Len := 1;
SubF:= $11;
End;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep)-1,result);
Move(GlobalReplyBuf^[1],GlobalReplyBuf^[2],SizeOf(Trep)-1);
serverInfo:=TPrep(GlobalReplyBuf)^;
With serverinfo
do begin
connectionsMax :=Swap(connectionsMax); { force lo-hi again }
ConnectionsInUse:=Swap(connectionsInUse);
MaxConnVol :=Swap(maxConnVol);
peak_conn_used :=Swap(peak_conn_used);
for t:=48 downto 1
do if serverInfo.serverName[t]=#0
then serverInfo.serverName[0]:=chr(t-1);
end;
GetFileServerInformation:=(result=0);
End;
{F217/C9 [2.15c+]}
FUNCTION GetFileServerDescriptionStrings(Var companyName,
VersionAndRevision,revisionDate,
copyrightNotice:String
):Boolean;
{SeeAlso: GetFileServerLoginStatus, GetFileServerInformation. }
Type Treq=record
len : word;
subf: byte;
end;
Trep=record
stuff : array [1..512] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
Var x,xofs:word;
begin
With TPreq(GlobalReqBuf)^
do begin
len := 1;
subf := $c9;
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
companyName:=''; VersionAndRevision:='';
revisionDate:=''; copyrightNotice:='';
if result=$00
then with TPrep(GlobalReplyBuf)^
do begin
x:=1;xofs:=x;
while (stuff[x]<>$00) and (x<512) do inc(x);
ZStrCopy(companyName,stuff[xofs],x-xofs);
inc(x);xofs:=x; { skip 1 zero. ? skip more zero's? }
While (stuff[x]<>$00) and (x<512) do inc(x);
ZStrCopy(VersionAndRevision,stuff[xofs],x-xofs);
inc(x);xofs:=x;
While (stuff[x]<>$00) and (x<512) do inc(x);
ZStrCopy(revisionDate,stuff[xofs],x-xofs); { mm/dd/yy }
inc(x);xofs:=x;
While (stuff[x]<>$00) and (x<512) do inc(x);
ZStrCopy(copyrightNotice,stuff[xofs],x-xofs);
end;
GetFileServerDescriptionStrings:=(Result=$00);
end;
{F217/D3 [2.15c+]}
FUNCTION DownFileServer (ForceFlag : Boolean) : Boolean;
Type Treq=record
len : word;
subf : byte;
flag : byte;
end;
TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
len := 2;
subf := $D3;
if ForceFlag then flag := $FF { non-zero }
else flag := $00;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
DownFileServer:=(result=0);
{ resultcodes: 00=successful; C6 No Console Rights ; FF Open Files}
end;
{F217/CF [3.x]}
FUNCTION DisableTransactionTracking : Boolean;
{ Caller must have console-operator rights. }
Type Treq=record
len : word;
subf: byte
end;
TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
len := 1;
subf:= $CF;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
DisableTransactionTracking:=(result=0);
{ resultcodes: 00=successful; C6 No Console Rights }
end;
{F217/D0 [3.x]}
FUNCTION EnableTransactionTracking : Boolean;
{ Caller must have console-operator rights. }
Type Treq=record
len : word;
subf: byte
end;
TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
len := 1;
subf:= $D0;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
EnableTransactionTracking:=(result=0);
{ resultcodes: 00=successful; C6 No Console Rights }
end;
{F217/CB [2.15c+]}
FUNCTION DisableFileServerLogin : Boolean;
{ Caller must have console-operator rights. }
Type Treq=record
len : word;
subf: byte
end;
TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
len := 1;
subf:= $CB;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
DisableFileServerLogin:=(result=0);
{ resultcodes: 00=successful; C6 No Console Rights }
end;
{F217/CC [2.15c+]}
FUNCTION EnableFileServerLogin : Boolean;
{ Caller needs console-operator rights. }
Type Treq=record
len : word;
subf: byte
end;
TPreq=^Treq;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
len := 1;
subf:= $CC;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
EnableFileServerLogin:=(result=0);
{ resultcodes: 00=successful; C6 No Console Rights }
end;
{F217/CD [2.15c+]}
FUNCTION GetFileServerLoginStatus( Var LoginEnabled:Boolean ): Boolean;
{ if Login is enabled then returns TRUE in LoginEnabled }
{ result byte: 00h - Success, C6h No Console Rights }
{ Caller must have operator status.}
Type TReq=record
Len : Word;
SubF : Byte;
end;
TRep=record
Flag : Byte;
end;
TPreq=^Treq;
TPrep=^Trep;
begin
with TPreq(GlobalReqBuf)^
do begin
Len := 1;
SubF := $CD;
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
LoginEnabled:=Boolean(TPrep(GlobalReplyBuf)^.Flag);
GetFileServerLoginStatus := (result=0);
end;
{F217/C8 [2.15c+]}
FUNCTION CheckConsolePrivileges : Boolean;
Type TReq=record
Len : Word;
SubF : Byte;
end;
TPreq=^Treq;
begin
with TPReq(GlobalReqBuf)^
do begin
Len := 1;
SubF := $C8;
end;
F2SystemCall($17,SizeOf(Treq),0,result);
CheckConsolePrivileges := (Result=$00);
{ result byte: 00h - Success, C6h No Console Rights }
end;
{F217/EB [3.0+]}
FUNCTION GetConnectionsOpenFiles
( ConnNumber : Byte;
{i/o:} var LastRecordSeen : word;
{out:} var NbrOfRecords : word;
var FileInfo : TfileInfoRecList ) : Boolean;
{ the calling workstation must have console operator privileges }
{ LastRecordSeen is an i/o parameter;
-An initial value of 0 has to be supplied;
-The function can be called until LastRecordSeen becomes 0,
indicating the end of the FIR-list.
to be called iteratively. }
Type TReq=record
len :word;
subf :byte;
logicalConnNbr:word;
lastRecSeen :word; {lo-hi, $0000 on first call }
end;
TRep=record
nextReqRec : word; { lo-hi, use as lastRecSeen in next iterative call }
{ $0000 if no more records }
RecCount : word;
FIRbuf:array[1..508] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
Var t,Foff:Word;
begin
With TPreq(GlobalReqBuf)^
do begin
len:=sizeof(Treq)-2;
subf:=$EB;
logicalConnNbr:=connNumber;
lastRecSeen:=LastRecordSeen; { force hi-lo }
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
if result=$00
then with TPrep(GlobalReplyBuf)^
do begin
{ Copy recCount FIRs from FIRbuf to the FileInfo[] array }
LastRecordSeen:=NextReqRec;
NbrOfrecords:=RecCount;
Foff:=0;
For t:=1 to RecCount
do begin
Move(FIRbuf[1+Foff],FileInfo[t],17+FIRbuf[Foff+17]);
inc(Foff,17+FIRbuf[Foff+17]);
{ Direntry and ParentEntry may have to be swapped lo-hi }
end;
end
else begin
NbrOfRecords:=0;
LastRecordSeen:=0;
end;
GetConnectionsOpenFiles:=(result=$00);
{ errorcodes: $00 Success; $C6 no console privileges }
end;
{F217/EC }
Function GetConnectionsUsingAFile(VolNbr:Byte; EntryId:Longint; NStype:byte;
{i/o} Var LastRecordSeen:word;
Var NbrOfRecords:Word;
Var FileInfo:TfileUsageList):boolean;
{ This call returns all connection numbers using the file specified
by the Volume Number and Directory Entry Id. }
{ !! UNDER CONSTRUCTION !! }
Type TReq=record
len :word;
subf :byte;
NStype :Byte; {= data stream type / Fork type }
VolNbr :Byte;
DirEntryId :Longint;
LastRecSeen:Word; {initially set to 0}
end;
TRep=record
NextRec :word; { iteration }
UseCount :word;
OpenCount :word;
OpenForReadCount :word;
OpenForWriteCount:word;
DenyReadCount :word;
DenyWriteCount :word;
LockFlag :Byte; { boolean }
NStype :Byte; { Fork Count -> ?? NStype }
NbrOfRec :word; { max 70 }
FileUsage:array[1..70] of record
ConnNbr :word;
TaskNbr :word;
LockType :byte;
AccessFlag:Byte;
LockFlag :Byte;
end;
end;
TPreq=^Treq;
TPrep=^Trep;
begin
With TPreq(GlobalReqBuf)^
do begin
len:=sizeof(Treq)-2;
subf:=$EC;
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
if result=$00
then with TPrep(GlobalReplyBuf)^
do begin
end
else begin
NbrOfRecords:=0;
LastRecordSeen:=0;
end;
GetConnectionsUsingAFile:=(result=$00);
{ errorcodes: $00 Success; $C6 no console privileges }
end;
{F217/0E [2.15c+]}
FUNCTION GetDiskUtilization(volNbr:byte; objID:Longint;
Var usedDirs,usedFiles,usedBlocks:Word ):Boolean;
{ SeeAlso: GetFileServerInformation,getBinderyObjectDiskSpaceLeft }
Type TReq=record
Len : Word;
SubF : Byte;
_volNbr:Byte;
_objID:longInt; { hi-lo }
end;
TRep=record
_volNbr:Byte;
_objID:Longint; {hi-lo}
_usedDirs,
_usedFiles,
_usedBlocks:Word; { all hi-lo }
end;
TPreq=^Treq;
TPrep=^Trep;
begin
with TPReq(GlobalReqBuf)^
do begin
Len := SizeOf(TReq)-2;
SubF := $0E;
_volNbr:=volNbr;
_objID:=Lswap(objID);
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
if result=$00
then begin
with TPrep(GlobalReplyBuf)^
do begin
usedDirs:=swap(_usedDirs); { force lo-hi }
usedFiles:=swap(_usedFiles); { force lo-hi }
usedBlocks:=swap(_usedBlocks);{ force lo-hi }
end;
end;
GetDiskUtilization:=(result=$00);
{Resultcodes: 00h successful; 98h volume doesn't exist
89h No Search Privileges
F2h no Object read privileges }
end;
{F217/12 [2.15c+]}
Function GetNetworkSerialNumber(Var serialNbr:LongInt; Var ApplicNbr:Word ):Boolean;
{return the serial number and application number for the software
installed on the file server}
{SeeAlso: VerifyNetworkSerialNumber,GetFileServerInformation}
Type TReq=record
Len : Word;
SubF : Byte;
end;
TRep=record
_serNbr : LongInt; {hi-lo}
_applicNbr: Word; {hi-lo}
end;
TPreq=^Treq;
TPrep=^Trep;
begin
with TPreq(GlobalReqBuf)^
do begin
Len := 1;
SubF := $12;
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
with TPrep(GlobalReplyBuf)^
do begin
ApplicNbr:=swap(_applicNbr); { force lo-hi }
serialNbr:=Lswap(_serNbr); { force lo-hi }
end;
GetNetworkSerialNumber := (result=0);
end;
{F217/OC [2.15c+]}
Function VerifyNetworkSerialNumber(serialNbr: LongInt ;
Var ApplicNbr: Word ):Boolean;
{if the network serial number to be verified is correct, the reply
buffer will contain the corresponding application number }
{SeeAlso: GetNetworkSerialNumber}
Type Treq=record
Len : Word;
SubF : Byte;
_netwSerNbr: LongInt; {hi-lo}
end;
TRep=record
_applicNbr: word; {hi-lo}
end;
TPreq=^Treq;
TPrep=^Trep;
begin
with TPReq(GlobalReqBuf)^
do begin
Len := 1;
SubF := $0C;
_netwSerNbr:=Lswap(serialNbr);
end;
F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result);
with TPrep(GlobalReplyBuf)^
do begin
ApplicNbr:=swap(_applicNbr); { force lo-hi }
end;
VerifyNetworkSerialNumber := (result=0);
end;
{****************** secondary functions ************************************}
FUNCTION CheckNetwareVersion(MinimumVersion,MinimumSubVersion,
MinimumRevision,MinimumSFT,MinimumTTS:word):Boolean;
{ checks if the current OS/TTS/SFT version is greater or equal to the minimal version }
Var info:TFileServerInformation;
res:boolean;
begin
IF GetFileServerInformation(info)
then begin
IF (info.NetwareVersion>MinimumVersion)
then res:=true
else if (info.NetwareVersion=MinimumVersion)
AND (info.NetwareSubVersion>MinimumSubVersion)
then res:=true
else if (info.NetwareVersion=MinimumVersion)
AND (info.NetwareSubVersion=MinimumSubVersion)
AND (info.OS_Revision>=MinimumRevision)
then res:=true
else res:=false
end
else res:=false;
CheckNetwareVersion:=res AND (info.SFT_Level>=MinimumSFT)
AND (info.TTS_Level>=MinimumTTS)
end;
end. {unit nwServ}

315
NWTP/NWSPX.PAS Normal file
View File

@@ -0,0 +1,315 @@
{$B-,V-,X+}
UNIT nwSPX;
{ nwSPX unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk }
{ NOTE: These SPX calls are not documented in this version }
INTERFACE
Uses Dos,nwMisc,nwIPX;
{ Primary SPX calls: Subf: Comments:
SPXabortConnection 14
SPXGetConnectionStatus 15
SPXestablishConnection 11
* SPXinitialize 10
SPXlistenForConnection 12
SPXlistenForSequencedPacket 17
SPXsendSequencedPacket 16
SPXTerminateConnection 13
Secondary calls:
* SPXpresent
Notes: (1) These functions use INT 21 and are not to be called from
within an ESR.
}
Var Result:word; { unit errorcode variable }
Type TspxHeader=Record
IPXhdr :TipxHeader; { SPX will set packetType to 5 }
connControl :byte; { rarely used, set to $00 }
{ ignored by SPX, but passed on to receiver:
$10 End of message; $20 Attention packet }
dataStreamType:Byte; { to be used by higher level protocols.
nust be < $FE, passed on to receiver }
sourceConnId,
destConnId :Word;
sequenceNbr,
acknowledgeNbr,
allocationNbr :Word;
end;
{ Fields within IPX and SPX are high-low. Byte swapping will be done
by the IPX functions, except network and node addresses. }
Type TSPXconnectionInformation
=record
ConnectionState :Byte; { all fields are returned hi-lo }
WatchDogState :Byte;
LocalSPXConnectionId :Word;
RemoteSPXConnectionId :Word;
SequenceNumber :Word;
LocalAcknowledgeNumber :Word;
LocalAllocationNumber :Word;
RemoteAcknowledgeNumber:Word;
RemoteAllocationNumber :Word;
LocalSocket :Word;
ImmediateAddress :TnodeAddress;
RemoteAddress :TinterNetworkAddress;
RetransmissionCount :Word;
EstimatedRoundTripDelay:Word;
RetransmittedPackets :Word;
SuppressedPackets :Word;
end;
Function SPXpresent:boolean;
{ Determines if SPX is installed. Calls SPXInitialize. }
{IPX/SPX: 10h}
Function SpxInitialize(Var SPXhiVer,SPXloVer:Byte;
Var MaxConn,AvailConn:word):boolean;
{ Determines if SPX is loaded. (this function also tests the presence of IPX, }
{ as IPX is required for running SPX. Remember: Netware 2.2 allows IPX and SPX }
{ to be loaded seperately, so only IPX may be present. }
{IPX/SPX: 11h}
Function SPXestablishConnection(retryCount:byte; WatchdogFlag:Byte;
{i/o} Var ECB:Tecb;
{out} Var SPXconnectionID:Word):boolean;
{IPX/SPX: 12h}
Function SPXlistenForConnection(retryCount:Byte; WatchdogFlag: Byte;
Var ECB:Tecb ):boolean;
{IPX/SPX: 15h}
Function SPXGetConnectionStatus(SPXconnectionID:word;
Var connInfo:TSPXconnectionInformation):boolean;
{IPX/SPX: 13h}
Function SPXTerminateConnection(SPXconnectionID:Word; ECB:Tecb):boolean;
{IPX/SPX: 14h}
Function SPXabortConnection(SPXconnectionID:Word):boolean;
{IPX/SPX: 16h}
Function SPXsendSequencedPacket(SPXconnectionID:Word; Var ECB:Tecb):boolean;
{IPX/SPX: 17h}
Function SPXlistenForSequencedPacket(Var ECB:Tecb):boolean;
{************** Secondary Procedures ***************************************}
IMPLEMENTATION {==============================================================}
CONST
SPX_WATCHDOG_ENABLED =1;
SPX_WATCHDOG_DISABLED =0;
SPX_DEFAULT_RETRY_COUNT =0;
SPX_POOL_SIZE =10;
SPX_MAX_DATA_LENGTH =534;
{IPX/SPX: 10 }
Function SpxInitialize(Var SPXhiVer,SPXloVer:Byte;
Var MaxConn,AvailConn:word):boolean;
Var Regs:registers;
begin
With regs
do begin
al:=$00;
bx:=$0010;
IpxSpxSystemCall(Regs);
result:=regs.al;
if AL<>$FF
then begin
result:=$FF;
SpxInitialize:=false
end
else begin
SPXhiVer:=BH;
SPXloVer:=BL;
MaxConn:=CX;
AvailConn:=DX;
result:=$00;
SpxInitialize:=true;
end;
end; {with}
{ resultcodes: $00 successfull (SPX installed); $FF SPX not installed }
end;
Function SpxPresent:boolean;
Var SpxHi,SpxLo:Byte;
MaxConn,AvConn:word;
begin
SpxPresent:=( IpxPresent and SpxInitialize(SpxHi,SpxLo,MaxConn,AvConn) );
end;
{IPX/SPX: 11h}
Function SPXestablishConnection(retryCount:byte; WatchdogFlag:Byte;
{i/o} Var ECB:Tecb;
{out} Var SPXconnectionID:Word):boolean;
Var regs:registers;
begin
With regs
do begin
BX:=$0011;
AL:=retryCount;
AH:=WatchDogFlag;
ES:=Seg(ECB);
SI:=ofs(ECB);
end;
IpxSpxSystemCall(Regs);
result:=regs.AL;
SPXconnectionID:=regs.DX;
SPXestablishConnection:=(result=$00);
{ resultcodes: $00 SPX Attempting to contact destination socket;
$EF Local connection table full;
$FD Fragment count not 1 AND/OR Buffer size not 42;
$FF Send Socket not open OR IPX/SPX not initialized. }
end;
{IPX/SPX: 12h}
Function SPXlistenForConnection(retryCount:Byte; WatchdogFlag: Byte;
Var ECB:Tecb ):boolean;
Var regs:Registers;
begin
With regs
do begin
BX:=$0012;
AL:=retryCount;
AH:=WatchdogFlag;
ES:=Seg(ECB);
SI:=Ofs(ECB);
IpxSpxSystemCall(Regs);
result:=AL;
if result<>$FF
then result:=$00;
end;
SPXlistenForConnection:=(result=$00);
end;
{IPX/SPX: 15h}
Function SPXGetConnectionStatus(SPXconnectionID:word;
Var connInfo:TSPXconnectionInformation):boolean;
Var regs:Registers;
begin
With regs
do begin
BX:=$0015;
DX:=SPXconnectionID;
ES:=Seg(connInfo);
SI:=Ofs(connInfo);
IpxSpxSystemCall(Regs);
Result:=AL;
end;
if result=0
then begin
With ConnInfo
do begin { force all returned words lo-hi }
LocalSPXConnectionId :=Swap(LocalSPXconnectionID);
RemoteSPXConnectionId :=Swap(RemoteSPXconnectionID);
SequenceNumber :=swap(SequenceNumber);
LocalAcknowledgeNumber :=swap(LocalAcknowledgeNumber);
LocalAllocationNumber :=swap(LocalAllocationNumber);
RemoteAcknowledgeNumber:=swap(RemoteAcknowledgeNumber);
RemoteAllocationNumber :=swap(RemoteAllocationNumber);
LocalSocket :=swap(LocalSocket);
RemoteAddress.socket :=swap(remoteAddress.socket);
RetransmissionCount :=swap(RetransmissionCount);
EstimatedRoundTripDelay:=swap(EstimatedRoundTripDelay);
RetransmittedPackets :=swap(RetransmittedPackets);
SuppressedPackets :=swap(SuppressedPackets);
end;
end;
SPXGetConnectionStatus:=(result=0);
{ Resulcodes: $00 Connection is active; $EE No such connection }
end;
{IPX/SPX: 13h}
Function SPXTerminateConnection(SPXconnectionID:Word; ECB:Tecb):boolean;
Var regs:Registers;
begin
with regs
do begin
BX:=$0013;
DX:=SPXconnectionID;
ES:=seg(ECB);
SI:=Ofs(ECB);
end;
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF
then result:=$00;
SPXterminateConnection:=(result=0);
{resultcodes: $00 SPX attempting to break connection;
$FF IPX/SPX not loaded. }
end;
{IPX/SPX: 14h}
Function SPXabortConnection(SPXconnectionID:Word):boolean;
Var regs:Registers;
begin
with regs
do begin
BX:=$0014;
DX:=SPXconnectionID;
end;
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF
then result:=$00;
SPXabortConnection:=(result=0);
{resultcodes: $00 SPX trying to unilateral break the connection;
$FF IPX/SPX not loaded. }
end;
{IPX/SPX: 16h}
Function SPXsendSequencedPacket(SPXconnectionID:Word; Var ECB:Tecb):boolean;
Var regs:Registers;
begin
with regs
do begin
BX:=$0016;
DX:=SPXconnectionID;
ES:=Seg(ECB);
SI:=Ofs(ECB);
end;
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF
then result:=$00;
SPXsendSequencedPacket:=(result=0);
{resultcodes: $00 SPX will attempt to send packet;
$FF IPX/SPX not loaded. }
end;
{IPX/SPX: 17h}
Function SPXlistenForSequencedPacket(Var ECB:Tecb):boolean;
Var regs:Registers;
begin
with regs
do begin
BX:=$0017;
ES:=Seg(ECB);
SI:=Ofs(ECB);
end;
IpxSpxSystemCall(Regs);
result:=regs.al;
if result<>$FF
then result:=$00;
SPXlistenForSequencedPacket:=(result=0);
{resultcodes: $00 SPX waits for incoming packets;
$FF IPX/SPX not loaded. }
end;
{************** Secondary Procedures ***************************************}
end.

198
NWTP/NWTP.FAQ Normal file
View File

@@ -0,0 +1,198 @@
FAQ for the NWTP API
====================
B01. How am I knwon at the server ?
B02. How do I give someone Console Operator rights ?
C01. How can I reset the servertime ?
C02. How can I synchronize the workstation's time to that of the server ?
L01. How can I place a limit on the number of concurrent users of my
program ? (licensing)
M01. How can I send a message to another user ?
S01. How do I determine whether or not I'm logged into a server ?
S02. Is the shell installed ?
S03. What is the name of the server I'm logged into ?
******************************** Answers ********************************
B01. What name do I have ?
--------------------------
A: You are known at the server by two names: a short (object) name
(i.e. the name you use to login) and a full name stored in the
bindery.
Var SecurityLevel:Byte;
ObjectID:Longint;
ObjectType:Word;
ObjectName,LongName:String;
begin
GetBinderyAccessLevel(SecurityLevel,ObjectID);
GetBinderyObjectname(ObjectID,ObjectName,ObjectType);
writeln('You''re known to the server as:',ObjectName);
GetRealUserName(ObjectName,LongName);
writeln('And to the supervisor as:',LongName);
if LongName=''
then writeln('<Your full name wasn''t set by the Supervisor>');
end.
B02. How do I give someone Console Operator rights?
---------------------------------------------------
A: You'll have to add the ObjectID of the target user to the OPERATORS
property of the supervisor object in the bindery. Note that having
console operator rights differs significantly from being supervisor
equivalent. Console operator rights allow the user to perform actions
from a workstation that could also be done on the server console.
Var UserName:string;
begin
UserName='Goofy';
IF NOT CreateProperty('SUPERVISOR',OT_USER,'OPERATORS',
BF_SET or BF_STAT_OBJ,
BS_LOGGED_READ or BS_SUPER_WRITE)
then if nwBindry.result<>$ED { property already exists }
then begin
writeln('Error creating operators property.');
Halt(1);
end;
IF AddBinderyObjectToSet('SUPERVISOR',OT_USER,'OPERATORS',
UserName,OT_USER)
then writeln('User ',UserName,' is now a console operator.');
end.
C01. How can I reset the servertime ?
-------------------------------------
A: Use the SetFileServerDateAndTime function in the nwServ unit. In order
for this call to be successful, you have to either be the supervisor
or have console operator privileges.
Var newTime:TnovTime;
begin
WITH newTime
do begin
year:=94; month:=6; day:=1;
hour:=5; min:=0; sec:=0;
end;
IF NOT SetFileServerDateAndTime(newTime)
then writeln('You need to have console operator rights.');
end.
C02. How can I synchronize the workstation's time to that of the server ?
-------------------------------------------------------------------------
A: Use Pascal's SetTime and SetDate functions in combination with the
GetFileServerDateAndTime function.
Var time:TnovTime;
year:word;
begin
GetFileServerDateAndTime(time);
if time.year<80
then year:=2000+time.year
else year:=1900+time.year;
setdate(year,time.month,time.day);
settime(time.hour,time.minute,time.second,0);
end.
L01. How can I place a limit on the number of concurrent users of my program ?
------------------------------------------------------------------------------
A: Use the semaphore functions in the nwSema unit. Note that these enable
you to limit the number of concurrent users on a server basis. When a
user is refused access because the limit for his current fileserver is
exceeded, he can simply login to another fileserver (if available) and
try to use the program there. Limiting the number of concurrent users
on multiple servers in an internetwork is quite a problem: Novell doesn't
provide a method to synchronize semaphore values between servers.
CONST
INITIAL_SEMAPHORE_VALUE=10;
{ suppose a licence for 10 concurrent users }
SEMAPHORE_NAME='YourProgramName';
{ anything goes, as long as it's unique. Max. 128 characters.}
VAR openCount :Word;
semValue :Integer;
semHandle :LongInt;
BEGIN {main}
{ Open Semaphore }
semValue := INITIAL_SEMAPHORE_VALUE;
{ Need in case we're creating the semaphore }
IF NOT OpenSemaphore( SEMAPHORE_NAME, semValue, semHandle, openCount )
then begin
writeln('Error opening semaphore. error #',nwSema.Result);
Halt(1);
end;
{ Wait on the Semaphore (get permission to use the program) }
IF NOT WaitOnSemaphore( semHandle, 0 )
then begin
if ( nwSema.Result = $FE )
then begin
writeln( 'Sorry, license exceeded. Please try again later.' );
halt(1);
end
else begin
writeln('WaitOnSemaphore returned eror# ',nwSema.result);
halt(1);
end;
end;
{ <===== INSERT YOUR to be licensed PROGRAM HERE =====> }
{ Signal Semaphore (that we're through with the program) }
SignalSemaphore( semHandle );
{ Close Semaphore }
CloseSemaphore( semHandle );
end.
M01. How can I send a message to another user ?
-----------------------------------------------
A: Use the SendMessageToUser function in the nwMess unit. This
function allows you to send a message to a user or to the members
of a group. If there are more than 64 members in the group, only the
first 64 members of the group will receive the message due to the way
this function is implemented on the server.
var name : string;
message : string;
begin
name := 'MBRAMWEL';
message := 'Hi Mark, how is it going?';
SendMessageToUser(name,message);
SendMessageToUser('FINANCE_DEPT','Hand over the money..');
SendMessageToUser('*','Goodmorning');
end.
Note that unlike the messages broadcasted by the SEND utility, the
source of the message is not automatically put in the message itself.
S01. How do I determine whether or not I'm logged into a server ?
-----------------------------------------------------------------
A: Use the nwBindr IsUserLoggedOn function.
S02. Is the shell installed ?
----------------------------------------------
A: Use the nwBindy IsShellLoaded function or query the variables
NETX_EXE_Loaded or VLM_EXE_Loaded. (see nwIntr)
S03. What is the name of the server I'm logged into ?
-----------------------------------------------------
A: If you already know that you're logged in:
Var ConnId:Byte;
ServerName:string;
begin
GetEffectiveConnectionID(ConnId);
IF GetFileserverName(connId,ServerName)
then Writeln('You''re logged into server :',ServerName);
end.

BIN
NWTP/NWTP.TPH Normal file
View File

Binary file not shown.

9
NWTP/NWTP06.TXT Normal file
View File

@@ -0,0 +1,9 @@
Netware Interface Units for Pascal.
(Novell Netware 3.x and TP/BP 6.x/7.x)
Freeware. Full sources, over 300 kb. of
documentation and lots of examples. The
most complete API available for PASCAL.
KEYWORDS: LAN, Network, Novell, API,
Library, Bindery, IPX, SPX, Queue,
Tool, Reference, Workstation, Client,
Real Mode, Protected Mode, Windows.

22
NWTP/README.1ST Normal file
View File

@@ -0,0 +1,22 @@
Netware Interface Libraries for Borland/Turbo Pascal (NwTP) version 0.6
=======================================================================
A set of libraries (units) that allow Pascal programmers to write
Netware-aware programs. Includes functionalty ranging from reading
the bindery to multi-threaded peer tot peer communication. Supports
Real, DPMI, and Windows protected mode. Full sources included. Fully
documented. Ample examples.
Required: -Knowledge of Pascal;
-BP/TP 6.x/7.x
-Netware 2.15c/2.2/3.x
A few notes on some files:
README.EXE Full documentation
NWTP .TPH Turbo Pascal helpfile, use within the 7.x IDE or with THELP.
See Readme.EXE for help on how to install.
NW____.PAS Source code of the units
X_____.ZIP Source code of examples
REL .TXT Release note

BIN
NWTP/README.EXE Normal file
View File

Binary file not shown.

96
NWTP/REL.TXT Normal file
View File

@@ -0,0 +1,96 @@
Netware Interface Libraries for Borland/Turbo Pascal (NwTP)
===========================================================
> Release note for NwTP Version 0.6
NwTP is a set of libraries (units) that allow Pascal
programmers to write Netware-aware programs. Included
functionalty ranges from reading the bindery to multi-
threaded IPX peer tot peer communication.
> Some characteristics:
-Over 250 interface functions / Full sources included
-Bindery, Connection, Workstation, Server, Message,
Semaphore, Locking, Accounting and Communication services
-More than 500 Kb of documentation (English)
-Turbo Pascal Helpfile (use within the IDE or with THELP)
-Real mode, DPMI and Windows protected mode supported
-Numerous examples & testprograms (over 200 kb.)
-Free software (GNU)
If I may be so bold as to quote some users:
> .... die Unit-Sammlung NwTP, da ist alles dabei,
> was ein Novell-Herz h”her schlagen l„sst :-))
---------
Wenn es NWTP nicht kostenlos geben wuerde, ich muessste es
glatt kaufen, vor allendingen, weil [der Author sich] die
Arbeit gemacht hat, Hilfs Files fuer Pascal dazu zu schreiben.
Ich muss sagen ich finde das Paket in seiner jetzigen
Ausbaustufe fuer mich (und bestimmt auch fuer andere) voll
gut. Es beinhaltet alles was ich fuers taegliche Novell
Client Leben brauche.
> Een een echt goede gedocumenteerde unit voor Netware !
> Ik heb er al naar gekeken en denk dat ik toch wel aardig
> wat aardigheidjes voor ons netwerk [..] kan maken :))
-------
Een heel interessante verzameling van routines die ik prima
kan gebruiken bij het schrijven van NetWare-aware programma's.
> ..when NWTP wouldn't be free, I'd have to buy it, especially
> since help files are included.
--------
.. the Unit collection NWTP, which has everything to make a Novell
minded heart beat somewhat faster ;-))
(Woops.. back to Earth again: )
>*** A few Notes:
-NwTP V0.6, Netware API for TP.
Copyright (C) 1993,1995 by R.Spronk
NwTP is free software; The terms of the GNU General Public
License as published by the Free Software Foundation apply.
-Minimum Development Environment
- NetWare 2.15c+ / 3.x
- Turbo/Borland Pascal Compiler (6.x/7.x)
>*** Availability
Anonymous FTP:
novftp.rc.rug.nl:/proglibs/NWTP06.ZIP
Filerequest/Downloads:
Germany 04:30-02:30 CET [UTC+1]
Heinz Veenker NWTP (Magic Filename)
Smalltown BBS 2:2426/4030 V.FC/V.32B +49-5935-1224
2:2426/4031 ZyX+/V.32B +49-5935-1225
2:2426/4032 V.34/V.FC +49-5935-1226
2:2426/4033 ISDN X.75/V.110 +49-5935-925254
Downloading of NWTP at first logon is supported.
Germany 00:00-24:00
Stefan Braunstein NWTP (Magic Filename)
Pandora BBS 2:2476/709, Zyxel E+ +49-781-65066
2:2476/719, Creatix 1400 (mail only system)
Downloading of NWTP at first logon is supported.
The Netherlands 08:30-02:00 CET [UTC+1]
Rolf Mulder NWTP (Magic Filename)
Fawlty Towers 2:282/601 Tron 28k8 +31-50-717051
Osterreich 00:00-24:00
Josef Braun NWTP (Magic filename)
Joe's BBS Corner 2:313/2 28k8 +43-2758-3357
2:313/22 19k2 +43-2758-3233
No downloading at first logon. Use guest account.
United Kingdom 03:30-02:30 GMT [UTC]
Michael Turner NWTP (Magic Filename)
Wizard's Haunt 2:254/80 +44-181-491-0795
Downloading of NWTP at first logon is supported.

3
NWTP/THELP.CFG Normal file
View File

@@ -0,0 +1,3 @@
/fC:\BP\BIN\TURBO.TPH
/fC:\BP\BIN\TVISION.TPH
/fC:\BP\BIN\NWTP.TPH

BIN
NWTP/THELP.COM Normal file
View File

Binary file not shown.

63
NWTP/XACCT/ACCT.PAS Normal file
View File

@@ -0,0 +1,63 @@
Program ACCT;
{ Example for the NwAcct unit / NWTP 0.6, (c) 1995, R. Spronk }
{ Displays all login/logout account notes in the HET$ACCT.DAT file. }
uses nwMisc,nwAcct;
LABEL q;
{$I-}
Var f:File of byte;
b,b2 :Byte;
t,w :word;
s :string;
nTime:TnovTime;
buf :Array[1..4096] of byte;
NoteAKA :TNoteRecord ABSOLUTE buf;
ChargeAKA:TChargeRecord ABSOLUTE buf;
Begin
FileMode:=0; {open file read-only }
assign(f,'F:\system\net$acct.dat');
reset(f);
IF Ioresult<>0
then begin
writeln('Accounting file couldn''t be found..');
halt(1);
end;
REPEAT
read(f,b); {length of record}
read(f,b2);
If IOresult<>0 then goto q;
buf[1]:=b2;
buf[2]:=b;
for t:=1 to NoteAKA.Length
do begin
read(f,buf[t+2]);
if IOresult>0 then goto q;
end;
IF (NoteAKA.RecType=RT_ACCOUNT_NOTE) and (swap(NoteAKA.CommentType) IN [3,4])
then with NoteAKA
do begin
If swap(CommentType)=3
then write('Logon of ')
else write('Logoff of ');
write(HexStr(Lswap(ClientObjId),8));
write(' from address ',HexDumpStr(Comment.Net,8),':',
HexDumpStr(Comment.Node,12));
Move(TimeStamp,ntime.year,6);
ntime.dayOfWeek:=0;
NovTime2String(ntime,s);delete(s,1,4);
write(' at: ',s);
writeln;
end;
UNTIL eof(f);
q: ;
close(f);
end.

171
NWTP/XACCT/TSTACCT.PAS Normal file
View File

@@ -0,0 +1,171 @@
{$X+,V-,B-}
Program tstacct; {as of 940601}
{ Testprogram for the nwAcct unit / NwTP 0.5 API. (c) 1993,1994, R.Spronk }
{ Tests the following nwAcct functions:
AccountingInstalled
AddAccountingServer
DeleteAccountHolds
DeleteAccountingServer
GetAccountStatus
SetAccountStatus
SubmitAccountCharge
SubmitAccountHold
SubmitAccountNote
}
uses nwBindry,nwConn,nwAcct;
CONST testObjName='TEST';
Var connId :byte;
currServer:string;
balance,limit,holds :Longint;
newBalance,newLimit :LongInt;
nCharge,nCancelHoldAmount:Longint;
oldBalance,Oldholds :LongInt;
begin
writeln('Test of the accounting functions.');
writeln;
writeln('You have to be logged in as SUPERVISOR');
writeln('User ',testObjName,' has to exists. (hardcoded in source, change if needed).');
writeln;
If NOT AccountingInstalled
then begin
writeln('error#:',nwAcct.result);
write('Err:Accounting isn''t installed on the current effective server:');
GetEffectiveConnectionID(ConnID);
GetFileServerName(connId,currServer);
writeln(currServer);
halt(1);
end;
AddAccountingServer('SUPERVISOR',OT_USER);
IF GetAccountStatus(testObjName,OT_USER,balance,limit,holds)
then begin
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
end
else writeln('Err: GetAccountStatus failed. error #',nwAcct.result);
writeln('Setting new account values..');
newBalance:=1020304;
newLimit:=123456;
IF NOT SetAccountStatus(testObjName,OT_USER,newBalance,newLimit)
then writeln('Err: SetAccountStatus failed. error #',nwAcct.result);
IF GetAccountStatus(testObjName,OT_USER,balance,limit,holds)
then begin
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
if (balance<>newBalance) or (newLimit<>Limit)
then writeln('Err: the new account values where not set!');
end
else writeln('Err: GetAccountStatus failed. error #',nwAcct.result);
OldBalance:=balance;
nCharge:=100;
nCancelHoldAmount:=0;
Writeln('Submitting an account charge. charge=',ncharge,',CancelHold=',ncancelholdamount);
IF NOT SubmitAccountCharge(testObjName,OT_USER,nCharge,nCancelHoldAmount,
OT_USER,0,'no note')
then writeln('Err: SubmitAccountCharge failed. error #',nwAcct.result);
IF GetAccountStatus(testObjName,OT_USER,balance,limit,holds)
then begin
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
if (balance<>(oldBalance-nCharge))
then writeln('Err: the account charge was not carried out !');
end
else writeln('Err: GetAccountStatus failed. error #',nwAcct.result);
OldBalance:=balance;
nCharge:=-200;
nCancelHoldAmount:=0;
Writeln('Submitting a NEGATIVE account charge. charge=',ncharge,',CancelHold=',ncancelholdamount);
Writeln(' (in fact increasing the balance of the ',testObjName,' object.');
IF NOT SubmitAccountCharge(testObjName,OT_USER,nCharge,nCancelHoldAmount,
OT_USER,99,'charge! charge!')
then writeln('Err: SubmitAccountCharge failed. error #',nwAcct.result);
IF GetAccountStatus(testObjName,OT_USER,balance,limit,holds)
then begin
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
if (balance<>(oldBalance-nCharge))
then writeln('Err: the account charge was not carried out !');
end
else writeln('Err: GetAccountStatus failed. error #',nwAcct.result);
OldHolds:=holds;
writeln('Submit an hold in the amount of 1234');
IF SubmitAccountHold(testObjName,OT_USER,1234)
then begin
GetAccountStatus(testObjName,OT_USER,balance,limit,holds);
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
if (holds<>(OldHolds+1234))
then writeln('Err: the account hold was not carried out !');
end
else writeln('Err: SubmitAccountHold failed. error #',nwAcct.result);
Writeln('Submit a charge of 1000, unhold 1234');
OldHolds:=holds;
nCharge:=1000;
nCancelHoldAmount:=1234;
IF SubmitAccountCharge(testObjName,OT_USER,nCharge,nCancelHoldAmount,
OT_USER,99,'let''s charge a few bucks :-)')
then begin
GetAccountStatus(testObjName,OT_USER,balance,limit,holds);
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
if (holds<>(OldHolds-1234))
then writeln('Err: the account hold was not carried out !');
end
else writeln('Err: SubmitAccountHold failed. error #',nwAcct.result);
IF DeleteAccountHolds(testObjName,OT_USER)
then begin
writeln('All further holds bythis accounting server were released.');
GetAccountStatus(testObjName,OT_USER,balance,limit,holds);
writeln('Current account status for user ',testObjName,' :');
writeln('Balance :',balance);
writeln('Credit Limit:',limit);
writeln('Holds :',holds);
end
else writeln('Err: DeleteAccountHolds failed. error #',nwAcct.result);
IF SubmitAccountNote(testObjName,OT_USER,
OT_USER,99,'<<TEST OF ACCOUNTNOTE>>')
then begin
writeln('Accountnote was submitted correctly.');
writeln('Please use a hexeditor and have look at \system\net$acct.dat');
writeln('to check if the accountnote was added to the file.');
end
else writeln('Err: SubmitAccountNote failed. error #',nwAcct.result);
IF NOT DeleteAccountingServer('SUPERVISOR',1)
then writeln('Err: DeleteAccountServer failed. error #',nwacct.result);
end.

143
NWTP/XBINDRY/BACKBIN.PAS Normal file
View File

@@ -0,0 +1,143 @@
{$X+,B-,V-,S-,I-} {essential compiler directives}
Program Backbin; { as of 950301}
{ Example for the nwBindry unit / NwTP 0.6 API. (c) 1994,1995 R.Spronk }
{ Purpose: Backs up the bindery files to the a: drive. }
{ You need to be supervisor-equivalent to run this. }
{ Tests the following nwBindry calls:
OpenBindery
CloseBindery
}
Uses DOS,nwMisc,nwBindry;
Var BindSeq:byte;
myObjID:LongInt;
Version:word;
s :string;
LABEL enable;
Procedure FileCopy(fn1,fn2:string);
LABEL 1;
Var f1,f2 :file;
buffer :array[1..4096] of byte;
BytesRead:word;
begin
assign(f1,fn1);
reset(f1,1);
if ioresult<>0
then begin
writeln('Error opening input file:',fn1);
writeln('>> File wasn''t copied.');
goto 1;
end;
assign(f2,fn2);
rewrite(f2,1);
if ioresult<>0
then begin
writeln('Error opening output file :',fn2);
writeln('>> File wasn''t copied.');
goto 1;
end;
REPEAT
BlockRead(f1,buffer[1],4096,BytesRead);
BlockWrite(f2,buffer[1],BytesRead);
UNTIL (BytesRead<4096);
1: ;
close(f1);
close(f2);
{$I+}
end;
begin
writeln('BACKBIN Test program for the nwBindry unit of the NwTP package.');
writeln('-Backs up the bindery files to drive A');
writeln;
IF NOT IsShellLoaded
then begin
writeln('Load network shell before executing this program.');
halt(1);
end;
{ need supervisor privileges to run this test }
GetBinderyAccessLevel(BindSeq,myObjId);
if bindSeq<>(BS_SUPER_WRITE OR BS_SUPER_READ) { $33}
then begin
writeln('You need to be supervisor equivalent to run this program.');
halt(1);
end;
writeln;
writeln('WARNING:');
writeln('Continue this program ONLY WHEN:');
writeln('-You are the only user logged in.');
writeln('-No other users will login in next few minutes.');
writeln('-You are running Netware 2.15c, 2.2 or 3.x');
writeln('-A diskette with sufficient space is in the A drive.');
writeln;
writeln('-If you have doubts about any of the above points: PLEASE ABORT NOW');
writeln('-This program was made for test purposes only.');
writeln;
write('Type Y <return> to continue, <return> to abort.');
readln(s);
if NOT ( s[1] IN ['y','Y'])
then begin
writeln('Program aborted..');
halt(1);
end;
{determine Advanced Netware version. }
nwMisc.GetNWVersion(version);
if (Version<215) or (version>399)
then begin
writeln('This util only works with NW 2.15+ or 3.x');
writeln('The bindery files were NOT backed up.');
halt(1);
end;
version:=(version DIV 100);
{Note for final version: make sure no users are logged in. (NwConn functions)}
{Note for final version: disable user login (see nwServ) }
{close the bindery to backup the files..}
IF NOT CloseBindery
then begin
writeln('Couldn''t close the bindery.');
writeln('The bindery files were NOT backed up');
writeln('Error : $',HexStr(NwBindry.Result,2));
goto enable;
end;
{back up the bindery files}
if version=2
then begin
FileCopy('SYS:\SYSTEM\NET$BIND.SYS','A:\NET$BIND.OLD');
FileCopy('SYS:\SYSTEM\NET$BVAL.SYS','A:\NET$BVAL.OLD');
end
else begin {3.x}
FileCopy('SYS:\SYSTEM\NET$OBJ.SYS' ,'A:\NET$OBJ.OLD');
FileCopy('SYS:\SYSTEM\NET$PROP.SYS','A:\NET$PROP.OLD');
FileCopy('SYS:\SYSTEM\NET$VAL.SYS' ,'A:\NET$VAL.OLD');
end;
{open the bindery again}
IF NOT OpenBindery
then begin
writeln('Couldn''t open the bindery after copying the bindery files.');
writeln('Error : $',HexStr(NwBindry.Result,2),' (',NwBindry.result,')');
end
else writeln('The bindery files were successfully backed up.');
{Note for final version: enable users to login (see nwServ) }
enable: ;
end.

69
NWTP/XBINDRY/NEW.TXT Normal file
View File

@@ -0,0 +1,69 @@
ScanBind V1.2
Provides information about all accessible bindery objects.
All objects with a read security level <= Sup (3) will be shown.
01000001 EVERYONE
The object type is :User group
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
GROUP_MEMBERS (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*SUPERVISOR (User)(00000001)
*DALEK (User)(00010002)
*TARDIS (User)(00010003)
00010002 DALEK
The object type is :User
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
UNIX_USER (Static Item-Property)
Security: Read: Any (0) /Write: Sup (3)
*64 61 6C 65 6B 00 00 00 00 00 00 00 00 00 00 00 dalek
SECURITY_EQUALS (Static Set-Property)
Security: Read: Obj (2) /Write: Sup (3)
*EVERYONE (Group)(01000001)
GROUPS_I'M_IN (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*EVERYONE (Group)(01000001)
03000001 DOCTORWHO
The object type is :Fileserver
The object is a dynamic object.
Security: Read: Any (0) / Write: Netw(4)
The object has the following properties:
NET_ADDRESS (Static property), Property type= 1 (Unknown, not Item or Set)
Security: Read: Any (0) /Write: Netw(4)
*C0 A8 01 02 00 00 00 00 00 01 04 51 00 00 00 00 <20><> Q
00000001 SUPERVISOR
The object type is :User
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
GROUPS_I'M_IN (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*EVERYONE (Group)(01000001)
UNIX_USER (Static Item-Property)
Security: Read: Any (0) /Write: Sup (3)
*72 6F 6F 74 00 00 00 00 00 00 00 00 00 00 00 00 root
SECURITY_EQUALS (Static Set-Property)
Security: Read: Obj (2) /Write: Sup (3)
*EVERYONE (Group)(01000001)
00010003 TARDIS
The object type is :User
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
GROUPS_I'M_IN (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*EVERYONE (Group)(01000001)
UNIX_USER (Static Item-Property)
Security: Read: Any (0) /Write: Sup (3)
*74 61 72 64 69 73 00 00 00 00 00 00 00 00 00 00 tardis
SECURITY_EQUALS (Static Set-Property)
Security: Read: Obj (2) /Write: Sup (3)
*EVERYONE (Group)(01000001)

53
NWTP/XBINDRY/NEW2.TXT Normal file
View File

@@ -0,0 +1,53 @@
ScanBind V1.2
Provides information about all accessible bindery objects.
All objects with a read security level <= Sup (3) will be shown.
01000001 EVERYONE
The object type is :User group
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
GROUP_MEMBERS (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*SUPERVISOR (User)(00000001)
*DALEK (User)(00010002)
00010002 DALEK
The object type is :User
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
UNIX_USER (Static Item-Property)
Security: Read: Any (0) /Write: Sup (3)
*64 61 6C 65 6B 00 00 00 00 00 00 00 00 00 00 00 dalek
SECURITY_EQUALS (Static Set-Property)
Security: Read: Obj (2) /Write: Sup (3)
*EVERYONE (Group)(01000001)
GROUPS_I'M_IN (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*EVERYONE (Group)(01000001)
03000001 DOCTORWHO
The object type is :Fileserver
The object is a dynamic object.
Security: Read: Any (0) / Write: Netw(4)
The object has the following properties:
NET_ADDRESS (Static property), Property type= 1 (Unknown, not Item or Set)
Security: Read: Any (0) /Write: Netw(4)
*C0 A8 01 02 00 00 00 00 00 01 04 51 00 00 00 00 <20><> Q
00000001 SUPERVISOR
The object type is :User
The object is a static object.
Security: Read: Log (1) / Write: Sup (3)
The object has the following properties:
GROUPS_I'M_IN (Static Set-Property)
Security: Read: Log (1) /Write: Sup (3)
*EVERYONE (Group)(01000001)
UNIX_USER (Static Item-Property)
Security: Read: Any (0) /Write: Sup (3)
*72 6F 6F 74 00 00 00 00 00 00 00 00 00 00 00 00 root
SECURITY_EQUALS (Static Set-Property)
Security: Read: Obj (2) /Write: Sup (3)
*EVERYONE (Group)(01000001)

BIN
NWTP/XBINDRY/NONAME00.EXE Normal file
View File

Binary file not shown.

199
NWTP/XBINDRY/NWPN9401.TXT Normal file
View File

@@ -0,0 +1,199 @@
NWTP Note 0501 "About the encryption mechanism"
This note discribes the password encryption mechanisms as used by Novell
Netware 3.x/4.x. Passwords are encrypted by workstations
and servers. The password verification process is also based on encryption.
This note describes the entire process of password verification and
password change. It has 3 appendices:
1. A description of the ASM calls involved with encrypted passwords;
2. Sourcecode of the encryption routines and tables in Turbo Pascal;
3. Sourcecode of the encryption routines and tables in C.
Initial state
=============
Our transaction model starts with a description of the initial state
of the server.
The following tables are stored at the server:
-The EncryptionKeyTable, containing an 8 byte EncryptionKey for
every workstation connection. This table can be queried by
workstations using the GetEncryptionKey (INT 21h, AX=F217h, subf. 17h).
Table entry [c] is renewed whenever connection c used a call using
encrypted passwords.
-The PasswordTable containing an 16 Byte encrypted password
(socalled "Shuffled" Password) for every connection.
A short description of the various encryption mechanisms involved:
-Shuffling. ('S' for short)
The encryption of the password (string of char) into 16 bytes (the
shuffled password), using a number of static tables and the objectID
of the object the password is associated with.
In Mathematical terms:
ShuffledPassWord=S(PasswordString) or Spw=S(pw)
-Encryption ('E' for short)
The main encryption process, encrypting the shuffled password (S(pw)
for short) into 8 bytes, using the same static tables as the Shuffling
functions and a dynamic encryption key requested from the server.
In mathematical terms:
EncryptedPassWord=E(EncryptionKey,ShuffledPassword) or Epw=E(Ekey,Spw)
-EncryptDifference ('D' for short)
Encrypts the 'difference' between the Shuffled old password and the
Shuffled new password, using a static table. The encrypted difference
is passed to the server. The computed 'difference' consist of
16 bytes of data and 1 checksum byte.
In mathematical terms:
PasswordDiff=D(ShuffledOldPW,ShuffledNewPW) or pwDiff=D(SOpw,SNpw)
-DecryptDifference ('Dinv' for short)
Server decryption process. Decrypts a 'password-difference'
encrypted block as suplied by a workstation to a shuffled version
of the new password. The shuffled old password, as stored in the
servers' EncryptionKeyTable is used in the decryption process.
In mathematical terms:
ShuffledNewPW=Dinv(ShuffledOldPW,PasswordDiff) or SNpw=Dinv(SOpw,pwDiff)
Notes:-ShuffledOldPassword is taken by the server from its'
EncryptionKeyTable, i.e. ShuffledOldPassword=EncryptionKeyTable[c]
where c is the connection number of the object the password
is associated with.
-SNpw=Dinv(SOpw,D(SNpw,Opw)), hence the name "D inverse".
-GenerateNewKey ('GNK' for short)
The server process creating a new encryption key for a certain
connection after the previous one has been used by that connection.
In mathematical terms:
EncryptionKeyTable[c]:=GenerateNewKey(EncryptionTable[c])
Password Verification
=====================
Password verification procedure when the encrypted password calls
(VerifyEncrBinderyObjectPassword and LoginEncrToFileServer)
are used:
Workstation Server
=========== ======
GetEncryptionKey ----------------> Return EncryptionKeyTable[c]
EncrKey <---------------------
Epw:=E(EncrKey,S(pw))
Verify/Login(Epw) ---------------> Epw'=E(EncryptionKeyTable[c],
PasswordTable[c])
Epw'=Epw ?
completion code <--------------------
EncryptionKeyTable[c]=
GNK(EncryptionKeyTable[c])
Note: c = Workstation connection number
pw = Password (string, max. 128 characters)
Epw= Encrypted Password (8 bytes)
Password verification procedure when the calls using unencrypted
passwords (VerifyBinderyObjectPassword and LoginToFileserver)
are used in combination with a 3.x server:
Workstation Server
=========== ======
Verify/Login(pw) ---------------->
S(pw)=PasswordTable[c] ?
completion code <--------------------
EncryptionKeyTable[c]=
GNK(EncryptionKeyTable[c])
Note: c = Workstation connection number
pw = Password (string, max. 128 characters)
Changing Passwords
==================
The process of changeing a password using encrypted passwords:
Workstation Server
=========== ======
GetEncryptionKey ----------------> Return EncryptionKeyTable[c]
EncrKey <---------------------
SOpw=S(oldPW)
SNpw=S(newPW)
EOpw=E(encrKey,SOpw)
PWdif=D(SNpw,SOpw)
ChangeEncrBinderyObjPW
(EOpw,PWdiff)
--------------> Epw'=E(EncryptionKeyTable[c],
PasswordTable[c])
Epw'=Epw ?
completion code <--------------------
SNpw'=Dinv(PasswordTable[c],
PWdiff)
PasswordTable[c]=SNpw'
EncryptionKeyTable[c]=
GNK(EncryptionKeyTable[c])
Note: c = Workstation connection number
OldPW = Old password (string, max. 128 characters)
NewPW = New password (string, max. 128 characters)
SNpw = Shuffled new password (12 bytes)
SOpw = Shuffled old password (12 bytes)
EOpw = Encrypted old Password (8 bytes)
THe process of chageing a password when using unencrypted passwords:
Workstation Server
=========== ======
ChangeBinderyObjPW
(OldPW,NewPW)
-------------->
S(OldPW)=PasswordTable[c] ?
completion code <--------------------
PasswordTable[c]=S(NewPW)
EncryptionKeyTable[c]=
GNK(EncryptionKeyTable[c])
Note: c = Workstation connection number
OldPW = Old password (string, max. 128 characters)
NewPW = New password (string, max. 128 characters)
Sources: NVPW.C by Itsme [Itsme@Hacktic.nl]
LOGON.PAS by Barry Nance/Terje Mathesen, Byte, March 1993.

1212
NWTP/XBINDRY/OT_XXX Normal file
View File

File diff suppressed because it is too large Load Diff

381
NWTP/XBINDRY/SCANBIND.BAK Normal file
View File

@@ -0,0 +1,381 @@
{$X+,B-,V-,S-,I-} {essential compiler directives}
Program ScanBind;
{ Example for the nwBindry unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: Dumps the entire contents of the bindery. }
{ Tests the following nwBindry calls:
IsShellLoaded
GetBinderyAccessLevel
ScanBinderyObject
ScanProperty
ReadPropertyValue
GetRealUserName
}
Uses nwMisc,nwBindry;
Type string30=string[30];
PobjRec =^objRec;
objRec =Record
objId:LongInt;
name:string30;
next:PobjRec;
end;
Var PstartObj:Pobjrec;
GlobalPath:string;
f:text;
procedure WriteReadSecurity(sec:Byte);
begin
Case LoNibble(Sec) of
BS_ANY_READ :write('Any (0)');
BS_LOGGED_READ :write('Log (1)');
BS_OBJECT_READ :write('Obj (2)');
BS_SUPER_READ :write('Sup (3)');
BS_BINDERY_READ :write('Netw(4)');
else writeln('Unknown. (Read Rights Flag=$',HexStr(LoNibble(Sec),2),')');
end;{case}
end;
Procedure WriteWriteSecurity(Sec:Byte);
begin
Case (HiNibble(Sec) SHL 4) of
BS_ANY_WRITE :write('Any (0)');
BS_LOGGED_WRITE :write('Log (1)');
BS_OBJECT_WRITE :write('Obj (2)');
BS_SUPER_WRITE :write('Sup (3)');
BS_BINDERY_WRITE :write('Netw(4)');
else writeln('Unknown. (Write Rights Flag=$',HexStr(HiNibble(Sec) SHL 4,2),')');
end; {case}
end;
Procedure PutInLinkedList(objId:LongInt;objName:String;objType:Word);
Var rp,np,lp:PobjRec;
lName :string;
begin
lName:=objname;
if lName[0]>#20
then lName[0]:=#20; { shorten object name; }
New(np);
if objType=OT_USER
then lname:=lname+' (User)'
else if objType=OT_USER_GROUP
then lname:=lname+' (Group)';
np^.name:=lname;
np^.objId:=objId;
np^.next:=NIL;
If PstartObj=NIL
then PstartObj:=np
else begin
lp:=PstartObj;
while (lp^.next<>NIL) do lp:=lp^.next;
lp^.next:=np;
end;
end;
Function getNameFromLL(id:Longint):String;
Var rp:PobjRec;
begin
rp:=PstartObj;
While ((rp<>NIL) and (rp^.objId<>id)) do rp:=rp^.next;
if rp=NIL then getNameFromLL:='!error: ID not found in stored ID List.'
else getNameFromLL:=rp^.name;
end;
Procedure ShowSet(pset:Tproperty);
Var i :Byte;
objId:LongInt;
begin
{ A segment of a set-property consists of a list of object IDs,
each ID 4 bytes long, stored hi-lo.
The end of the list (within THIS segment) is marked by an ID of 00000000. }
i:=1;
Repeat
objId:=MakeLong((pset[i] *256 +pset[i+1]), ( pset[i+2] *256 + pset[i+3] ) );
if objId<>0
then writeln(' *',GetNameFromLL(objId),'(',HexStr(objId,8),')');
inc(i,4);
Until (i>128) or (objId=0);
end;
Procedure DumpPropVal(DontSkipZeros:boolean;pv:Tproperty);
Var t,g,skip:Byte;
c :char;
s :string;
begin
if DontSkipZeros
then skip:=7
else begin
skip:=128;
while (pv[skip]=$00) and (skip>1) do dec(skip);
skip:=(skip-1) DIV 16;
end;
t:=0;
While t<=skip
do begin
s:='';
write(' *');
for g:=1 to 16
do begin
write(HexStr(pv[t*16+g],2),' ');
c:=chr(pv[t*16+g]);
if c>=' ' then s:=s+c else s:=s+' ';
end;
writeln(s);
inc(t);
end;
end;
Var lastObjSeen:LongInt;
objName :String;
objType :Word;
objId :LongInt;
objFlag :Byte;
objSec :Byte;
objHasProp :Boolean;
SecAccessLevel:Byte;
MyObjId :LongInt;
SeqNumber :LongInt;
propName :String;
propFlags,
propSecurity :Byte;
propHasValue,
moreProperties:Boolean;
SegNbr :Byte;
propValue:Tproperty; { array[1..128] of byte }
accVal: record
balance :LongInt; {hi-lo}
limit :LongInt; {hi-lo}
Reserved:array[1..120] of byte; { NW internal info }
end ABSOLUTE PropValue;
holdVal: array[1..16]
of record
AccountServerID:Longint; {hi-lo}
HoldAmount :LongInt; {hi-lo}
end ABSOLUTE PropValue;
holds :Longint;
moreSeg:boolean;
t :word;
tempString:String;
OTfileFound:Boolean;
ObjTypeStr,s:string;
begin
Writeln('ScanBind V1.2');
Writeln('Provides information about all accessible bindery objects.');
GlobalPath:=ParamStr(0);
while NOT (GlobalPath[ord(GlobalPath[0])] IN [':','\','/'])
do dec(GlobalPath[0]);
assign(f,GlobalPath+'OT_XXX.');
reset(f);
OTfileFound:=(IOresult=0);
IF NOT OTfileFound
then begin
writeln('WARNING: OT_XXX. file with object types not found.');
writeln(' A limited number of object type descriptions will be shown.');
writeln;
end;
If NOT ({IpxInitialize and} IsShellLoaded)
then begin
writeln('Error: Scanbind requires:');
writeln(' -IPX to be loaded;');
writeln(' -The Netware Shell to be loaded.');
halt(1);
end;
GetBinderyAccessLevel(SecAccessLevel,MyObjId);
write('All objects with a read security level <= ');
WriteReadSecurity(SecAccessLevel); writeln(' will be shown.');
writeln;
{ put all objects in a table}
lastObjSeen:=-1;
PstartObj:=NIL;
While ScanBinderyObject('*',OT_WILD,lastObjSeen,
objName,objType,objID,objFlag,objSec,objHasProp)
do PutInLinkedList(objId,objName,objType);
if nwBindry.Result<>$FC { no such object }
then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
{ show all objects and asociated properties/values:}
lastObjSeen:=-1;
While ScanBinderyObject('*',OT_WILD,lastObjSeen,
objName,objType,objID,objFlag,objSec,objHasProp)
do begin
writeln(HexStr(objId,8),' ',objName);
write('The object type is :');
Case objType of
OT_UNKNOWN :writeln('Unknown Object Type ');
OT_USER :writeln('User ');
OT_USER_GROUP :writeln('User group ');
OT_PRINT_QUEUE :writeln('Print Queue ');
OT_FILE_SERVER :writeln('Fileserver ');
OT_JOB_SERVER :writeln('Jobserver ');
OT_GATEWAY :writeln('Gateway ');
OT_PRINT_SERVER :writeln('Printserver ');
OT_ARCHIVE_QUEUE :writeln('Archive Queue ');
OT_ARCHIVE_SERVER :writeln('Archive Server ');
OT_JOB_QUEUE :writeln('Job Queue ');
OT_ADMINISTRATION :writeln('Administration Object');
OT_RSPCX_SERVER :writeln('RSPCX Server (Rconsole) ');
else begin
if OTfileFound
then begin
reset(f);
ObjTypeStr:=HexStr(objType,4);
REPEAT
readln(f,s);
UNTIL eof(f) or (pos(ObjTypeStr,s)=1);
if pos(ObjTypeStr,s)=1
then begin
delete(s,1,5);
writeln(s);
end;
end
else writeln('objType= 0x',HexStr(objType,4),' (unknown)');
end;
end; {case}
Case objFlag of
0:writeln('The object is a static object.');
1:writeln('The object is a dynamic object.');
else writeln('Unknown objectFlag:',objFlag);
end; {case}
write('Security: Read: ');WriteReadSecurity(objSec);
write(' / Write: ');WriteWriteSecurity(objSec); writeln;
if objHasProp
then begin
SeqNumber:=-1;
writeln('The object has the following properties:');
While ScanProperty({in} objName,objType,'*',
{i/o} SeqNumber,
{out} propName,propFlags,propSecurity,
propHasValue,moreProperties)
do begin
write(' ',propName);
if HiNibble(propFlags)=0
then write (' (Static') { 0 }
else write (' (Dynamic'); { 1 }
Case LoNibble(propFlags) of
BF_ITEM:writeln(' Item-Property)');
BF_SET :writeln(' Set-Property)');
else writeln(' property), Property type= ',LoNibble(propFlags),' (Unknown, not Item or Set)');
end; {case}
write(' Security: Read: ');WriteReadSecurity(propSecurity);
write(' /Write: ');WriteWriteSecurity(propSecurity); writeln;
{ show value of properties: }
if propHasValue
then begin
if LoNibble(propFlags)=BF_SET
then begin
SegNbr:=1;
While ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
do begin
ShowSet(propValue);
inc(SegNbr);
end;
If nwBindry.Result<>$EC { no such segment }
then writeln('Error Reading Property Values: $',
HexStr(nwBindry.Result,2));
end
else begin { item property }
if propName='IDENTIFICATION'
then begin
getRealUserName(objName,tempString);
writeln(' *',tempString)
end
else if propname='Q_DIRECTORY'
then begin
{ asciiz string in 1st seg }
SegNbr:=1;
IF ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
then begin
ZStrCopy(tempString,propValue,127);
writeln(' *',tempString);
end
end
else if propname='ACCOUNT_BALANCE'
then begin
{ conversion of 1st 4 bytes to longint }
SegNbr:=1;
IF ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
then writeln(' * Balance:',Lswap(accVal.balance),' Limit: ',Lswap(accVal.Limit));
end
else if propname='ACCOUNT_HOLDS'
then begin
SegNbr:=1;
IF ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
then begin
holds:=0;
for t:=1 to 16
do if holdVal[t].AccountServerID<>0
then holds:=holds+Lswap(holdVal[t].HoldAmount);
writeln(' * Total holds:',holds)
end;
end
else begin { structure not known, dump it }
SegNbr:=1;
While ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
do begin
inc(segNbr);
DumpPropVal(moreSeg,propValue);
end;
If nwBindry.Result<>$EC { no such segment }
then writeln('Error Reading Property Values: $',
HexStr(nwBindry.Result,2));
end
end;
end {if propHasValue then }
else begin { prop has NO value }
writeln(' *<property has no value>');
end;
end; { While scanProperty do }
If nwBindry.Result<>$FB { no such property }
then writeln('Error Scanning Properties: $',HexStr(nwBindry.Result,2));
end { if objHasProp then }
else begin { object has NO properties }
writeln(' <object has no properties>');
end;
writeln;
end; { While scanObject }
if nwBindry.Result<>$FC { no such object }
then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
IF OTfileFound
then close(f);
end.

BIN
NWTP/XBINDRY/SCANBIND.EXE Normal file
View File

Binary file not shown.

376
NWTP/XBINDRY/SCANBIND.PAS Normal file
View File

@@ -0,0 +1,376 @@
{$X+,B-,V-,S-,I-} {essential compiler directives}
Program ScanBind;
{ Example for the nwBindry unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: Dumps the entire contents of the bindery. }
{ Tests the following nwBindry calls:
IsShellLoaded
GetBinderyAccessLevel
ScanBinderyObject
ScanProperty
ReadPropertyValue
GetRealUserName
}
Uses nwMisc,nwBindry;
Type string30=string[30];
PobjRec =^objRec;
objRec =Record
objId:LongInt;
name:string30;
next:PobjRec;
end;
Var PstartObj:Pobjrec;
GlobalPath:string;
f:text;
procedure WriteReadSecurity(sec:Byte);
begin
Case LoNibble(Sec) of
BS_ANY_READ :write('Any (0)');
BS_LOGGED_READ :write('Log (1)');
BS_OBJECT_READ :write('Obj (2)');
BS_SUPER_READ :write('Sup (3)');
BS_BINDERY_READ :write('Netw(4)');
else writeln('Unknown. (Read Rights Flag=$',HexStr(LoNibble(Sec),2),')');
end;{case}
end;
Procedure WriteWriteSecurity(Sec:Byte);
begin
Case (HiNibble(Sec) SHL 4) of
BS_ANY_WRITE :write('Any (0)');
BS_LOGGED_WRITE :write('Log (1)');
BS_OBJECT_WRITE :write('Obj (2)');
BS_SUPER_WRITE :write('Sup (3)');
BS_BINDERY_WRITE :write('Netw(4)');
else writeln('Unknown. (Write Rights Flag=$',HexStr(HiNibble(Sec) SHL 4,2),')');
end; {case}
end;
Procedure PutInLinkedList(objId:LongInt;objName:String;objType:Word);
Var rp,np,lp:PobjRec;
lName :string;
begin
lName:=objname;
if lName[0]>#20
then lName[0]:=#20; { shorten object name; }
New(np);
if objType=OT_USER
then lname:=lname+' (User)'
else if objType=OT_USER_GROUP
then lname:=lname+' (Group)';
np^.name:=lname;
np^.objId:=objId;
np^.next:=NIL;
If PstartObj=NIL
then PstartObj:=np
else begin
lp:=PstartObj;
while (lp^.next<>NIL) do lp:=lp^.next;
lp^.next:=np;
end;
end;
Function getNameFromLL(id:Longint):String;
Var rp:PobjRec;
begin
rp:=PstartObj;
While ((rp<>NIL) and (rp^.objId<>id)) do rp:=rp^.next;
if rp=NIL then getNameFromLL:='!error: ID not found in stored ID List.'
else getNameFromLL:=rp^.name;
end;
Procedure ShowSet(pset:Tproperty);
Var i :Byte;
objId:LongInt;
begin
{ A segment of a set-property consists of a list of object IDs,
each ID 4 bytes long, stored hi-lo.
The end of the list (within THIS segment) is marked by an ID of 00000000. }
i:=1;
Repeat
objId:=MakeLong((pset[i] *256 +pset[i+1]), ( pset[i+2] *256 + pset[i+3] ) );
if objId<>0
then writeln(' *',GetNameFromLL(objId),'(',HexStr(objId,8),')');
inc(i,4);
Until (i>128) or (objId=0);
end;
Procedure DumpPropVal(DontSkipZeros:boolean;pv:Tproperty);
Var t,g,skip:Byte;
c :char;
s :string;
begin
if DontSkipZeros
then skip:=7
else begin
skip:=128;
while (pv[skip]=$00) and (skip>1) do dec(skip);
skip:=(skip-1) DIV 16;
end;
t:=0;
While t<=skip
do begin
s:='';
write(' *');
for g:=1 to 16
do begin
write(HexStr(pv[t*16+g],2),' ');
c:=chr(pv[t*16+g]);
if c>=' ' then s:=s+c else s:=s+' ';
end;
writeln(s);
inc(t);
end;
end;
Var lastObjSeen:LongInt;
objName :String;
objType :Word;
objId :LongInt;
objFlag :Byte;
objSec :Byte;
objHasProp :Boolean;
SecAccessLevel:Byte;
MyObjId :LongInt;
SeqNumber :LongInt;
propName :String;
propFlags,
propSecurity :Byte;
propHasValue,
moreProperties:Boolean;
SegNbr :Byte;
propValue:Tproperty; { array[1..128] of byte }
accVal: record
balance :LongInt; {hi-lo}
limit :LongInt; {hi-lo}
Reserved:array[1..120] of byte; { NW internal info }
end ABSOLUTE PropValue;
holdVal: array[1..16]
of record
AccountServerID:Longint; {hi-lo}
HoldAmount :LongInt; {hi-lo}
end ABSOLUTE PropValue;
holds :Longint;
moreSeg:boolean;
t :word;
tempString:String;
OTfileFound:Boolean;
ObjTypeStr,s:string;
begin
Writeln('ScanBind V1.2');
Writeln('Provides information about all accessible bindery objects.');
assign(f,'OT_XXX.');
reset(f);
OTfileFound:=(IOresult=0);
IF NOT OTfileFound
then begin
writeln('WARNING: OT_XXX. file with object types not found.');
writeln(' A limited number of object type descriptions will be shown.');
writeln;
end;
If NOT ({IpxInitialize and} IsShellLoaded)
then begin
writeln('Error: Scanbind requires:');
writeln(' -IPX to be loaded;');
writeln(' -The Netware Shell to be loaded.');
halt(1);
end;
GetBinderyAccessLevel(SecAccessLevel,MyObjId);
write('All objects with a read security level <= ');
WriteReadSecurity(SecAccessLevel); writeln(' will be shown.');
writeln;
{ put all objects in a table}
lastObjSeen:=-1;
PstartObj:=NIL;
While ScanBinderyObject('*',OT_WILD,lastObjSeen,
objName,objType,objID,objFlag,objSec,objHasProp)
do PutInLinkedList(objId,objName,objType);
if nwBindry.Result<>$FC { no such object }
then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
{ show all objects and asociated properties/values:}
lastObjSeen:=-1;
While ScanBinderyObject('*',OT_WILD,lastObjSeen,
objName,objType,objID,objFlag,objSec,objHasProp)
do begin
writeln(HexStr(objId,8),' ',objName);
write('The object type is :');
Case objType of
OT_UNKNOWN :writeln('Unknown Object Type ');
OT_USER :writeln('User ');
OT_USER_GROUP :writeln('User group ');
OT_PRINT_QUEUE :writeln('Print Queue ');
OT_FILE_SERVER :writeln('Fileserver ');
OT_JOB_SERVER :writeln('Jobserver ');
OT_GATEWAY :writeln('Gateway ');
OT_PRINT_SERVER :writeln('Printserver ');
OT_ARCHIVE_QUEUE :writeln('Archive Queue ');
OT_ARCHIVE_SERVER :writeln('Archive Server ');
OT_JOB_QUEUE :writeln('Job Queue ');
OT_ADMINISTRATION :writeln('Administration Object');
OT_RSPCX_SERVER :writeln('RSPCX Server (Rconsole) ');
else begin
if OTfileFound
then begin
reset(f);
ObjTypeStr:=HexStr(objType,4);
REPEAT
readln(f,s);
UNTIL eof(f) or (pos(ObjTypeStr,s)=1);
if pos(ObjTypeStr,s)=1
then begin
delete(s,1,5);
writeln(s);
end;
end
else writeln('objType= 0x',HexStr(objType,4),' (unknown)');
end;
end; {case}
Case objFlag of
0:writeln('The object is a static object.');
1:writeln('The object is a dynamic object.');
else writeln('Unknown objectFlag:',objFlag);
end; {case}
write('Security: Read: ');WriteReadSecurity(objSec);
write(' / Write: ');WriteWriteSecurity(objSec); writeln;
if objHasProp
then begin
SeqNumber:=-1;
writeln('The object has the following properties:');
While ScanProperty({in} objName,objType,'*',
{i/o} SeqNumber,
{out} propName,propFlags,propSecurity,
propHasValue,moreProperties)
do begin
write(' ',propName);
if HiNibble(propFlags)=0
then write (' (Static') { 0 }
else write (' (Dynamic'); { 1 }
Case LoNibble(propFlags) of
BF_ITEM:writeln(' Item-Property)');
BF_SET :writeln(' Set-Property)');
else writeln(' property), Property type= ',LoNibble(propFlags),' (Unknown, not Item or Set)');
end; {case}
write(' Security: Read: ');WriteReadSecurity(propSecurity);
write(' /Write: ');WriteWriteSecurity(propSecurity); writeln;
{ show value of properties: }
if propHasValue
then begin
if LoNibble(propFlags)=BF_SET
then begin
SegNbr:=1;
While ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
do begin
ShowSet(propValue);
inc(SegNbr);
end;
If nwBindry.Result<>$EC { no such segment }
then writeln('Error Reading Property Values: $',
HexStr(nwBindry.Result,2));
end
else begin { item property }
if propName='IDENTIFICATION'
then begin
getRealUserName(objName,tempString);
writeln(' *',tempString)
end
else if propname='Q_DIRECTORY'
then begin
{ asciiz string in 1st seg }
SegNbr:=1;
IF ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
then begin
ZStrCopy(tempString,propValue,127);
writeln(' *',tempString);
end
end
else if propname='ACCOUNT_BALANCE'
then begin
{ conversion of 1st 4 bytes to longint }
SegNbr:=1;
IF ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
then writeln(' * Balance:',Lswap(accVal.balance),' Limit: ',Lswap(accVal.Limit));
end
else if propname='ACCOUNT_HOLDS'
then begin
SegNbr:=1;
IF ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
then begin
holds:=0;
for t:=1 to 16
do if holdVal[t].AccountServerID<>0
then holds:=holds+Lswap(holdVal[t].HoldAmount);
writeln(' * Total holds:',holds)
end;
end
else begin { structure not known, dump it }
SegNbr:=1;
While ReadPropertyValue(objName,objType,propName,SegNbr,
propValue,moreSeg,propFlags)
do begin
inc(segNbr);
DumpPropVal(moreSeg,propValue);
end;
If nwBindry.Result<>$EC { no such segment }
then writeln('Error Reading Property Values: $',
HexStr(nwBindry.Result,2));
end
end;
end {if propHasValue then }
else begin { prop has NO value }
writeln(' *<property has no value>');
end;
end; { While scanProperty do }
If nwBindry.Result<>$FB { no such property }
then writeln('Error Scanning Properties: $',HexStr(nwBindry.Result,2));
end { if objHasProp then }
else begin { object has NO properties }
writeln(' <object has no properties>');
end;
writeln;
end; { While scanObject }
if nwBindry.Result<>$FC { no such object }
then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
IF OTfileFound
then close(f);
end.

38
NWTP/XBINDRY/SUPEQ.PAS Normal file
View File

@@ -0,0 +1,38 @@
{$X+,B-,V-,S-} {essential compiler directives}
Program SupEq; {as of 950301}
{ Example for the nwBindry unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: Shows all supervisor equivalent users. }
uses nwMisc,nwBindry;
Var Info :TobjIdArray;
SeqNbr :Longint;
NbrOfObj:word;
ObjName :string;
ObjType :word;
NbrOfEqUsers:word;
t :word;
begin
writeln('Objects that are supervisor equivalent:');
writeln;
NbrOfEqUsers:=0;
SeqNbr:=-1;
REPEAT
if GetRelationOfBinderyObject('SUPERVISOR',1,'SECURITY_EQUALS',
SeqNbr,NbrOfObj,Info)
then for t:=1 to NbrOfObj
do begin
inc(NbrOfEqUsers);
write(HexStr(Info[t],8));
GetBinderyObjectName(Info[t],ObjName,ObjType);
writeln(' ',ObjName);
end;
UNTIL SeqNbr=-1;
if nwBindry.result<>0
then writeln('Search for security equivalent users aborted due to an error.');
if NbrOfEqUsers=0
then writeln('No supervisor equivalent users found');
end.

96
NWTP/XBINDRY/SWAPNAME.PAS Normal file
View File

@@ -0,0 +1,96 @@
{$X+,B-,V-} {essential compiler directives}
program swapnames; { as of 950301 }
{ Example for the nwBindry unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ AREA:NOVELL
(1394) Thu 30 Sep 93 16:07
By: JAMES SIMONSON
To: All
Re: Novell 3.11/4.01 bindery access
------------------------------------------------------------
Is there a way to access the full name information inthe bindery files?
Here's the scoop:
We've got "firstname mi lastname" in the FULLNAME space in the user record.
We need to convert that to "lastname, firstname mi" & place that
information BACK into the FULLNAME field. Is there any relatively fast way
to do this conversion?
--- SLMAIL v3.0 (#0623)
* Origin: WorkStations Unlimited / 312-404-2824 (1:115/404) }
{ This program will reverse all first & last names in the bindery.
Lastname is defined as being everything after the last space in the full name.
This may not be true for all names.
If there is no space in the full name, nothing changes. }
uses nwBindry;
Var lastObjSeen:LongInt;
objName :string;
objType :word;
objId :LongInt;
objFlag,objSec:Byte;
hasProp :boolean;
propVal :Tproperty;
moreseg :boolean;
propFlags:Byte;
NewName,FullName:string;
t:byte;
s:string;
begin
IF NOT IsShellLoaded
then begin
writeln('Load network shell before executing this testprogram.');
halt(1);
end;
writeln('SWAPNAME: Will swap the first and last names of the IDENTIFICATION');
writeln(' property in the bindery. (Full Name of an object)');
writeln;
writeln('--WARNING: Changes the property values irrevokably ! --');
writeln;
writeln('Type ''y'' and <Return> to continue.. (all else will abort)');
readln(s);
if (s[0]=#0) or ((s[1]<>'y') and (s[1]<>'Y'))
then halt(1);
LastObjSeen:=-1;
WHILE ScanBinderyObject('*',1,LastObjSeen,
objName,objType,objId,objFlag,objSec,hasProp)
do begin
IF ReadPropertyValue(objName,objType,'IDENTIFICATION',1,
propVal,moreSeg,propFlags)
then begin
t:=1;
while (propVal[t]<>0)
do begin FullName[t]:=chr(propVal[t]);inc(t) end;
FullName[0]:=chr(t-1);
IF pos(',',FullName)=0
then begin
writeln(FullName);
while fullName[ord(fullName[0])]=' '
do dec(FullName[0]);
t:=ord(FullName[0]);
while (t>0) and (FullName[t]<>' ') do dec(t);
if t>0
then begin
NewName:=copy(FullName,t+1,255)+', '
+copy(FullName,1,t-1);
writeln(newname);
fillChar(propVal,SizeOf(propVal),#0);
for t:=1 to ord(newName[0])
do propVal[t]:=ord(newName[t]);
WritePropertyValue(objName,objType,
'IDENTIFICATION',1,propVal,FALSE);
end;
end;
end;
end;
if nwBindry.result<>$FC then writeln('error scanning bindery');
end.

249
NWTP/XBINDRY/TSTBIND.PAS Normal file
View File

@@ -0,0 +1,249 @@
{$X+,B-,V-,S-} {essential compiler directives}
Program TSTBin; { as of 950301 }
{ Testprogram for the nwBindry unit / NwTP 0.6 API. (c) 1994,1995 R.Spronk }
{ Purpose: Testing only. }
{ Tests the following nwBindry calls:
AddBinderyObjectToSet
ChangeBinderyObjectSecurity
ChangeBinderyObjectPassword
ChangeEncrBinderyObjectPassword
ChangePropertySecurity
CreateBinderyObject
CreateProperty
DeleteBinderyObject
DeleteBinderyObjectFromSet
DeleteProperty
GetBinderyAccessLevel
GetBinderyObjectID
GetBinderyObjectName
IsBinderyObjectInSet
RenameBinderyObject
VerifyBinderyObjectPassword
VerifyEncrBinderyObjectPassword
WritePropertyValue
}
Uses nwMisc,nwBindry;
Procedure Warning(mess:string);
begin
writeln(' ERROR:',mess);
writeln(' ERROR#: $',hexstr(result,2),' (',result,')');
end;
Function ExistsProperty(objName:string;objType:word;propertyName:String):boolean;
Var propName:string;
pf,ps :byte;
phv,mp :boolean;
seqNbr :LongInt;
begin
seqNbr:=-1;
ExistsProperty:=ScanProperty(objName,objType,propertyname,
seqNbr,propName,pf,ps,phv,mp);
end;
Var myObjId:longInt;
BindSeq:Byte;
ObjId :longint;
usrName,TrueName:string;
pTrueName:Tproperty;
replyUsrName:string;
replyObjType:word;
t:byte;
s:string;
begin
writeln('BINTEST Test program for the nwBindry unit of the NwTP package.');
IF not IsShellLoaded
then begin
writeln('Please load shell before running.');
halt(1);
end;
{ need supervisor privileges to run this test }
GetBinderyAccessLevel(BindSeq,myObjId);
if bindSeq<>(BS_SUPER_WRITE OR BS_SUPER_READ) { $33}
then begin
writeln('you need to be supervisor equivalent to run this test program.');
halt(1);
end;
writeln('-Assumes there is a group ''EVERYONE''');
writeln('-Non destructive to the bindery. ');
writeln(' (unless you already have a user named ''USR_OINK'' or ''THE_DIVA'')');
writeln;
writeln('For testing of the unencrypted calls, you must have');
writeln(' SET ALLOW UNENCRYPTED PASSWORDS=ON on the server--');
writeln(' Otherwise these calls will fail and trigger the servers'' intruder detection.');
writeln;
writeln('<ENTER> To Continue..');
readln;
{ you are reminded that the bindery functions turn all object names, property
names and passwords to upcase. Returned strings are also upcase. }
usrName:='UsR_OiNk';
TrueName:='Miss Piggy';
writeln('Creating Bindery object :',usrName);
IF NOT CreateBinderyObject(usrName,OT_USER,
BF_ITEM,BS_ANY_READ OR BS_ANY_WRITE)
then Warning('couldn''t create a bindery object.');
IF NOT GetBinderyObjectID(usrName,OT_USER,objID)
then Warning('couldn''t find the created user object');
writeln('Changing object security.');
IF NOT ChangeBinderyObjectSecurity(usrName,OT_USER,BS_LOGGED_READ OR BS_SUPER_WRITE)
then warning('Couldn''t change object security.');
{ this program assumes there is a group called everyone. }
writeln('Making ',usrName,' a member of the group EVERYONE.');
IF IsBinderyObjectInSet(usrName,OT_USER,
'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP)
then writeln('??: object already is a member of everyone (group)');
IF NOT AddBinderyObjectToSet('EVERYONE',OT_USER_GROUP,'GROUP_MEMBERS',
usrName,OT_USER)
then Warning('couldn''t make user a member of everyone');
IF NOT IsBinderyObjectInSet('EVERYONE',OT_USER_GROUP,'GROUP_MEMBERS',
usrName,OT_USER)
then writeln('??: user is NOT a member of everyone.');
{ ------------AND NOW: the property test.
create a static property with default security... }
writeln;
writeln('Creating a property IDENTIFICATION associated withe the ',usrName,' object.');
IF NOT CreateProperty(usrName,OT_USER,
'IDENTIFICATION',BF_ITEM,BS_ANY_WRITE OR BS_ANY_READ)
then writeln('Couldn''t create property.');
IF NOT ChangePropertySecurity(usrName,OT_USER,'IDENTIFICATION',
BS_LOGGED_READ or BS_SUPER_WRITE)
then writeln('Couldn''t change property security.');
writeln('Writing the property value: ',trueName);
FillChar(pTrueName[1],SizeOf(pTrueName),#0);
for t:=1 to ord(truename[0]) do pTrueName[t]:=ord(TrueName[t]);
IF NOT WritePropertyValue(usrName,OT_USER,'IDENTIFICATION',1,pTrueName,FALSE)
then Warning('Couldn''t write the property value.');
{ The next calls were tested before, so they are not tested again.
They create the minimal properties needed to login as the new object. }
CreateProperty(usrName,OT_USER,'GROUPS_I''M_IN',
BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ);
AddBinderyObjectToSet(usrName,OT_USER,'GROUPS_I''M_IN',
'EVERYONE',OT_USER_GROUP);
CreateProperty(usrName,OT_USER,'SECURITY_EQUALS',
BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ);
AddBinderyObjectToSet(usrName,OT_USER,'SECURITY_EQUALS',
'EVERYONE',OT_USER_GROUP);
{------------- Renaming the object. }
writeln;
writeln('Renaming the object.');
UpString(usrName); { make usrName upstring for comparison with found name.}
GetBinderyObjectName(objId,replyUsrName,replyObjType);
IF (nwBindry.result>0) or (replyUsrName<>usrName) or (replyObjType<>OT_USER)
then Warning('Something very wrong here.');
writeln(' Object name was :',replyUsrName);
IF NOT RenameBinderyObject(usrName,'THE_DIVA',OT_USER)
then Warning('Couldn''t rename the object.');
usrName:='THE_DIVA'; {that's what it should be now}
GetBinderyObjectName(objId,replyUsrName,replyObjType);
IF (nwBindry.result<>0) or (replyUsrName<>usrName) or (replyObjType<>OT_USER)
then Warning('Object was NOT renamed.');
writeln(' Object name now is:',replyUsrName);
{------------ Change and verify bindery object password. }
writeln;
writeln('Changing Object Password. (encrypted)');
IF ChangeEncrBinderyObjectPassword(usrName,OT_USER,'','KERMIT')
then writeln('Password successfully changed. (encrypted)')
else Warning('Couldn''t change password. (encrypted)');
writeln('Verifying new password. (encrypted)');
IF VerifyEncrBinderyObjectPassword(usrName,OT_USER,'wrong password')
then Warning('A wrong (encrypted) password was verified as being OK.');
IF NOT VerifyEncrBinderyObjectPassword(usrName,OT_USER,'KERMIT')
then Warning('The correct (encrypted) Password was NOT verified.');
{ If you stop execution of this program AT THIS POINT, you will
have added a user THE_DIVA with password KERMIT, member of the
group EVERYONE to your bindery. }
{ halt(0); }
writeln;
writeln('WARNING: If you didn''t SET ALLOW UNENCRYPTED PASSWORDS=ON,');
writeln(' -The server will beep;');
writeln(' -Supervisor(s) will receive a 1 line message.');
writeln(' (unless CASTOFF ALL was used);');
writeln(' -The next(unencrypted) calls will fail.');
writeln(' (All the above is essentially harmless)');
writeln;
writeln(' <ENTER> to continue...');
readln;
writeln;
writeln('Changing Object Password. (unencrypted)');
IF ChangeBinderyObjectPassword(usrName,OT_USER,'KERMIT','SECRET')
then writeln('Password successfully changed. (unencrypted)')
else Warning('Couldn''t change password. (unencrypted)');
writeln('Verifying new password. (unencrypted)');
IF VerifyBinderyObjectPassword(usrName,OT_USER,'wrong password')
then Warning('A wrong (unencrypted) password was verified as being OK.');
IF NOT VerifyBinderyObjectPassword(usrName,OT_USER,'SECRET')
then Warning('The correct (unencrypted) Password was NOT verified.');
{------------ Deleting properties and objects }
writeln;
writeln('Deleting a property.');
IF NOT DeleteProperty(usrName,OT_USER,'IDENTIFICATION')
then writeln('Couldn''t delete property.');
IF ExistsProperty(usrName,OT_USER,'IDENTIFICATION')
then writeln('??:Property wasn''t deleted.');
writeln('Removing the user object from the group EVERYONE.');
DeleteBinderyObjectFromSet(usrName,OT_USER,
'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP);
IF IsBinderyObjectInSet(usrName,OT_USER,
'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP)
then writeln('Couldn''t throw '+usrName+' out of everyone (group)');
writeln('Deleting the ',usrName,' object and all related properties.');
IF NOT DeleteBinderyObject(usrName,OT_USER)
then writeln('Couldn''t delete object.');
IF GetBinderyObjectID(usrName,OT_USER,objID)
then writeln('??: deleted object still exists.');
end.

66
NWTP/XCONN/CEXPPW.PAS Normal file
View File

@@ -0,0 +1,66 @@
{$X+,B-,V-} {essential compiler directives}
Program CexpPw;
{ Example for the nwConn unit / NwTP 0.6 API. (c) 1993,1995, R. Spronk }
{ Andre Middendorp [2:512/220] wrote on Sun 3 Jul 94
Q: Ik ben op zoek naar een tooltje waarmee ik op een NW 3.1x server
een file aan kan maken met daarin alle gebruikers waarvan het
wachtwoord is vervallen. Wie weet iets....?
A: Here's a short program that will check whether or not the password
has expired of any user object. It will present you with a list of
all accounts that are expired.}
Uses nwMisc,nwBindry,nwConn,nwServ;
{ nwServ used for GetFileServerDateAndTime only }
{ Demonstates the GetObjectLoginControl function.
see also the information provided with the ObjectCanLoginAt call }
Var TimeNow :TnovTime;
lastObjSeen :Longint;
RepName :String;
RepType :Word;
RepId :LongInt;
RepFlag :Byte;
RepSecurity :Byte;
RepHasProperties:Boolean;
LogControlInfo :TloginControl;
NbrOfExp :word;
Begin
Writeln('CEXPPW: Check Expired Passwords.');
IF NOT (IsShellLoaded and IsUserLoggedOn)
then begin
writeln('Load network shell and logon before running this program');
halt(1);
end;
GetFileServerDateAndTime(TimeNow);
NbrOfExp:=0;
lastObjSeen:=-1;
WHILE
ScanBinderyObject('*',OT_USER,lastObjSeen,
RepName, RepType, RepId,
RepFlag, RepSecurity, RepHasProperties)
do begin
IF GetObjectLoginControl(RepName,RepType,LogControlInfo)
then with LogControlInfo.AccountExpirationDate
do if (year>0) { year=0: no expiration date was set }
and (TimeNow.year>=year)
and (TimeNow.month>=month)
and (TimeNow.day>=day)
then begin
writeln('Account of ',Repname,' expired on: ',day,'/',month,'/',year);
inc(NbrOfExp);
end;
end;
if nwBindry.Result<>$FC { NO_SUCH_OBJECT, indicates end of search }
then writeln('Error scanning bindery : $',HexStr( nwBindry.Result,2));
if NbrOfExp=0
then writeln(#10#13,'No expired passwords found.')
else writeln('(dates expressed in dd/mm/yy format.');
end.

44
NWTP/XCONN/CHKATT.PAS Normal file
View File

@@ -0,0 +1,44 @@
{X+,V-,B-}
program ChkAtt;
{ Example for the nwConn unit/ NwTP 0.6 API. (c) 1993,1995, R. Spronk }
uses nwMisc,nwBindry,nwConn;
Var srvr,usr:string;
connId,PrConnId:Byte;
MyObjName:string;
MyObjType:word;
MyObjId:Longint;
accLev:byte;
begin
if ParamCount<>2
then begin
writeln('CHKATT - Batch file utility to check for an attachment.');
writeln;
writeln('Supply 2 parameters : CHKATT <servername> <username>');
writeln('If attached/logged on : ChkAtt returns errorlevel 0');
writeln('in *all* other circumstances, errorlevel 1 will be returned.');
halt(1);
end;
srvr:=ParamStr(1);UpString(srvr);
Usr:=paramStr(2);UpString(usr);
IF NOT GetConnectionId(srvr,connId)
then halt(1);
{ ok.. attachment to <servername> exists... am I logged in as <username> ? }
GetPreferredConnectionId(prConnId);
SetPreferredConnectionId(connId);
IF GetBinderyAccessLevel(accLev,MyObjId)
and GetBinderyObjectName(MyObjId,MyObjName,MyObjType)
and (MyObjName=usr)
then begin
SetPreferredConnectionId(PrConnId);
halt(0);
end
else begin
SetPreferredConnectionId(PrConnId);
halt(1);
end
end.

31
NWTP/XCONN/DETACH.PAS Normal file
View File

@@ -0,0 +1,31 @@
Program Detach;
{ Example for the NwConn unit / NwTP 0.6, (c) 1993,1995 R.Spronk }
{ Detach from the fileserver whose name is in parameter #1,
delete all drivemappings to directories of target server's volumes }
Uses nwMisc,nwConn,nwFile;
Var ConnId:Byte;
Srvr:String;
begin
If paramCount<>1
then begin
writeln('ERR: Supply name of server to detach from as a parameter.');
writeln;
writeln('Detaches from server/ removes all drive mappings to server.');
writeln('Returns errorlevel 1 when detaching was successful. 0 otherwise.');
halt(0);
end;
Srvr:=ParamStr(1);UpString(Srvr);
IF NOT GetConnectionId(Srvr,connId)
then begin
writeln('ERR: Not attached to server ',Srvr);
halt(0);
end;
DeleteConnectionsDriveMappings(connId);
IF DetachFromFileServer(connId)
then halt(1)
else halt(0);
end.

81
NWTP/XCONN/LOGCON.PAS Normal file
View File

@@ -0,0 +1,81 @@
{$X+,V-,B-}
program LogCon;
{ Example program for the nwConn unit/ NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Shows the use of the GetObjectLoginControl Function. }
uses nwMisc,nwConn;
CONST TestObjName='TEST';
{ name of the object whose LOGIN_CONTROL property is read. }
{ must be of objecttype 'ot_user' }
Var li:TloginControl;
s :string;
{
BadLoginCount :byte;
AccountResetTime :TnovTime; dmy, hms valid only
LastIntruderAdress :TinterNetworkAdress;
MaxConcurrentConnections :byte;
LoginTimes :array[1..42] of byte;
unknown1 :byte;
unknown2 :array[1..6] of byte;
}
begin
IF NOT GetObjectLoginControl('TEST',1,li)
then begin
writeln('GetObjectLoginControl Failed. error#',nwConn.result);
writeln;
writeln('(Hint: change the hardcoded username in the source to a username that exists.)');
halt(1);
end;
writeln('Logincontrol Information:');
writeln;
if li.AccountDisabled then writeln('The account is DISABLED.');
NovTime2String(li.AccountExpirationDate,s);delete(s,1,5);
if pos('lid date &',s)>0 then s:='No expiration date set.';
writeln('Account Expires: ',s);
writeln;
writeln('Minimum Password length =',li.MinimumPasswordLength);
writeln('Days between password changes =',li.DaysBetweenPasswordChanges);
NovTime2String(li.PasswordExpirationDate,s);delete(s,1,5);
if pos('lid date &',s)>0 then s:='No Expiration date set.';
writeln('Password Expiration date: ',s);
write('Password control flag: ');
CASE li.PasswordControlFlag of
0:writeln('User is allowed to change password.');
1:writeln('Supervisor must change password.');
2:writeln('User is allowed to change password. Passwords must be unique.');
3:writeln('Supervisor must change passwords. Passwords must be unique.');
else writeln('Unknown Password control Flag:',li.PasswordControlFlag);
end; {case}
writeln;
IF li.MaxGraceLoginsAllowed=0
then writeln('Grace logins are unlimited.')
else begin
writeln('Max. Grace Logins: ',li.MaxGraceLoginsAllowed);
writeln('Remaining Grace Logins: ',li.GraceLoginsRemaining);
end;
writeln;
NovTime2String(li.LastLoginTime,s);delete(s,1,5);
if pos('lid date &',s)>0 then s:='Object has never logged in.';
writeln('Last login time: ',s);
writeln;
NovTime2String(li.AccountResetTime,s);delete(s,1,5);
if pos('lid date &',s)>0 then s:='?? time not set.';
writeln('Date of last Account reset: ',s);
end.

214
NWTP/XCONN/LOGOUT.PAS Normal file
View File

@@ -0,0 +1,214 @@
{$X+,B-,V-} {essential compiler directives}
Program Logout;
{ Fixed by RPL }
uses crt,dos,graph,nwConn;
{ demo of a program that logs out the user, and fills the screen with
a worm, functionally equal to the worm of the netware console monitor. }
const
MaxTailLen = 30;
MaxDeviations = 15;
MaxSymbols = 5;
TailSegments : array[1..MaxSymbols] of byte
= (32,176,177,178,219);
type
BorderColl = (left,right,upside,downside);
var
gd,gm : integer;
color : boolean;
wormrecord : record
x_head,y_head : integer;
ChosenDir : integer;
PreferredDir : integer;
LengthFactor : integer;
TailLen : integer;
x,y : array[1..MaxTailLen] of integer;
end;
procedure Initialization;
var CurrSegment : integer;
begin
randomize;
with wormrecord
do begin
LengthFactor:=random(5)+3;
TailLen:=MaxSymbols*LengthFactor;
if TailLen>MaxTailLen then TailLen:=MaxTailLen;
x_head:=40;
y_head:=12;
PreferredDir:=random(8);
for CurrSegment:=1 to MaxTailLen
do begin
x[CurrSegment]:=0;
y[CurrSegment]:=0;
end;
end;
end;
procedure ChooseDir;
{ This procedure determines the future direction of the worm. }
VAR NbrOfDev : integer;
begin
NbrOfDev:=0;
with wormrecord
do begin
repeat
repeat
inc (NbrOfDev);
ChosenDir:=random(8);
until (NbrOfDev>=MaxDeviations)
or (ChosenDir=PreferredDir);
until abs(PreferredDir-ChosenDir)<>4;
PreferredDir:=ChosenDir;
end;
end;
procedure DrawWorm;
var CurrSegment : integer;
SegmentSym : integer;
begin
with wormrecord
do begin
if color then textcolor (7);
for CurrSegment:=1 to TailLen
do begin
SegmentSym:=(CurrSegment-1) div LengthFactor+1;
if (x[CurrSegment]<>0)
then begin
gotoxy (x[CurrSegment],y[CurrSegment]);
write (chr(TailSegments[SegmentSym]),
chr(TailSegments[SegmentSym]));
end;
if (CurrSegment<TailLen)
then begin
x[CurrSegment]:=x[CurrSegment+1];
y[CurrSegment]:=y[CurrSegment+1];
end;
end;
gotoxy (x[TailLen],y[TailLen]);
x[TailLen]:=x_head;
y[TailLen]:=y_head;
end;
if color then textcolor (7);
end;
procedure ReverseDir (ScreenBorder:BorderColl);
{ Bounce directions on screenborders }
begin
with wormrecord
do case ScreenBorder of
left : case PreferredDir of
3 : PreferredDir:=1;
4 : PreferredDir:=0;
5 : PreferredDir:=7;
end;
right : case PreferredDir of
1 : PreferredDir:=3;
0 : PreferredDir:=4;
7 : PreferredDir:=5;
end;
upside : case PreferredDir of
1 : PreferredDir:=7;
2 : PreferredDir:=6;
3 : PreferredDir:=5;
end;
downside : case PreferredDir of
5 : PreferredDir:=3;
6 : PreferredDir:=2;
7 : PreferredDir:=1;
end;
end;
end;
procedure DeterminePos;
begin
with wormrecord
do begin
if (ChosenDir in [1..3])
then dec (y_head);
if (ChosenDir in [5..7])
then inc (y_head);
if (ChosenDir in [3..5])
then dec (x_head);
if (ChosenDir<2) or (ChosenDir=7)
then inc (x_head);
if (ChosenDir=0)
then inc (x_head);
if (ChosenDir=4)
then dec (x_head);
if (x_head<1)
then begin
x_head:=2-x_head;
ReverseDir (left);
end;
if (x_head>77)
then begin
x_head:=77-(x_head-77);
ReverseDir (right);
end;
if (y_head<1)
then begin
y_head:=2-y_head;
ReverseDir (upside);
end;
if (y_head>24)
then begin
y_head:=24-(y_head-24);
ReverseDir (downside);
end;
end; {with}
end;
procedure logoutservers;
{ Logs you out form all servers by logging out and detaching on
a server by server basis. You are not detached from your primary server. }
Var connId:byte;
servName:string;
primserv:byte;
begin
GetPrimaryConnectionId(primServ);
for connId:=1 to 8
do begin
IF GetFileServerName(ConnId,servName)
then begin
IF LogoutFromFileServer(ConnId)
then begin
if (connId<>PrimServ)
then begin
DetachFromFileServer(connId);
writeln('You are now detached from fileserver ',servName);
end
else writeln('You are now logged out from fileserver ',servName);
end;
end
end;
delay(2500);
end;
begin
color:=false;
detectgraph (gd,gm);
color:=(gd<>7);
logoutservers;
clrscr;
Initialization;
repeat
ChooseDir ;
DeterminePos;
DrawWorm ;
delay (150);
until keypressed;
clrscr;
end.

63
NWTP/XCONN/PWEXP.PAS Normal file
View File

@@ -0,0 +1,63 @@
{$X+,B-,V-} {essential compiler directives}
program pwexp;
{ Example for the nwConn unit / NwTP 0.6 API. (c) 1993,1995, R. Spronk }
{ Q: We're forcing our users to change their passwords every 40 days.
After the password expiration date, they have 3 grace logins, one
of which they should use to change their password. To force them
to change their passwords whenever they login after the expiration
date, we need an utility that returns a distinctive Errorlevel
whenever the password has expired.
The following program will return an errorlevel 0 whenever the calling
station's password has expired (current date later than expiration
date). In all other cases (i.e. an expiration date wasn't set, 1 will
be returned.
}
Uses nwMisc,NwBindry,nwConn,nwServ;
Function LaterDate(Var t1,t2):Boolean;
Type Tascii3=array[1..3] of char;
Var ta:Tascii3 ABSOLUTE t1;
tb:Tascii3 ABSOLUTE t2;
begin
if ta[1]<#80 then inc(ta[1],100);
if tb[1]<#80 then inc(tb[1],100);
LaterDate:=(ta>tb);
end;
Var AccLev:Byte;
MyObjId:Longint;
MyObjName:string;
MyObjType:word;
Info:TloginControl;
Now:TnovTime;
begin
IF GetBinderyAccessLevel(AccLev,MyObjId)
and GetBinderyObjectname(MyObjId,MyObjName,MyObjType)
then begin
IF GetObjectLoginControl(MyObjName,MyObjType,info)
then with Info.PasswordExpirationDate
do begin
if (year=0) and (month=0) and (day=0)
then begin
writeln('PWEXP: Expiration date not set.');
halt(1); { exp. date not set }
end;
GetFileServerDateAndTime(now);
IF LaterDate(now,info.PasswordExpirationDate)
then begin
writeln('PWEXP: Password expired !');
halt(0) { PW expired }
end
else halt(1);
end;
end;
writeln('PWEXP: Bindery read error. Shell wel geladen ? Ingelogd ?');
halt(1);
end.

188
NWTP/XCONN/TRCOPY.PAS Normal file
View File

@@ -0,0 +1,188 @@
{$X+,B-,V-} {essential compiler directives}
Program TrCopy;
{ Example for the nwConn unit/ NwTP 0.6 API. (c) 1993,1995, R. Spronk }
{ Copies the time restrictions of a supplied user to amother user,
or another user group. The destination may conatain wildcards. }
{ Note that it is possible to change the time restrictions of a number of
users by tagging them with F5 (in SYSCON) and then changing the time
restrictions. }
{(4395) Tue 8 Feb 94 8:43
By: Jos Cobbenhagen
To: Allen
Re: MUTATIE TIME-RESTR.
St:
------------------------------------------------------------
Aan :Allen Van :Jos Cobbenhagen Betreft :Mutaties Time-restrictions
Ik moet incidenteel voor een aantal wisselende afdelingen/gebruikers de
time-restrictions aanpassen. Dit komt voor bij crises en apparte gebeurtenissen
waarbij users ijdelijk 's avonds en in weekenden moeten werken. Enige
mogelijkheid die ik hiervoor ken is voor de betreffende users appart deze
restricties aanpassen, en voor 50+ gebruikers is dat vrij omslachtig. Vraag is
of er een bindery utility is die dit in een keer voor een bepaalde groep
gebruikers kan regelen?
}
uses nwMisc,nwBindry;
Var source :string;
TimeRestr:array[1..42] of byte;
Function ChangeTRforUser(dest:string):boolean;
Var res:boolean;
ObjName :string;
ObjType :word;
ObjId :LongInt;
Iter :LongInt;
Flag,Sec :byte;
HasProperties:boolean;
propValue:Tproperty;
moreSegs :boolean;
propFlags:byte;
begin
res :=false;
iter:=-1;
WHILE ScanBinderyObject(dest,OT_USER,iter,
ObjName,ObjType,ObjId, Flag,Sec,HasProperties)
do begin
res:=true;
IF (source<>ObjName)
and ReadPropertyValue(ObjName,OT_USER,'LOGIN_CONTROL',1,
propValue,moreSegs,propFlags)
then begin
Move(TimeRestr[1],propValue[15],42);
IF WritePropertyvalue(ObjName,ObjType,'LOGIN_CONTROL',1,
propValue,FALSE)
then writeln('Time restrictions of user ',ObjName,' changed.');
end;
end;
ChangeTRForUser:=res;
end;
Function ChangeTRforGroup(GroupDest:string):boolean;
Var res:boolean;
ObjName :string;
ObjType :word;
ObjId :LongInt;
Iter :LongInt;
Flag,Sec :byte;
HasProperties:boolean;
propValue:Tproperty;
moreSegs :boolean;
propFlags:byte;
seg,i :byte;
UserObjId :LongInt;
UserObjName:string;
begin
res :=false;
iter:=-1;
WHILE ScanBinderyObject(GroupDest,OT_USER_GROUP,iter,
ObjName,ObjType,ObjId, Flag,Sec,HasProperties)
do begin
res:=true;
seg:=1;
WHILE ReadPropertyValue(ObjName,OT_USER_GROUP,'GROUP_MEMBERS',seg,
propValue,moreSegs,propFlags)
do begin
i:=1;
Repeat
UserObjId:=MakeLong((propValue[i] *256 + PropValue[i+1] ),
(propValue[i+2] *256 + PropValue[i+3] ) );
if UserObjId<>0
then begin
IF GetBinderyObjectName(UserObjId,UserObjName,ObjType)
and (UserObjName<>Source)
then ChangeTRForUser(UserObjName);
end;
inc(i,4);
Until (i>128) or (objId=0);
inc(seg);
end;
end;
ChangeTRForGroup:=res;
end;
Procedure GetSourceTR(source:string);
Var propValue:Tproperty;
MoreSegs :boolean;
PropFlags:byte;
begin
IF NOT ReadPropertyValue(source,OT_USER,'LOGIN_CONTROL',1,
propValue,moreSegs,propFlags)
then begin
writeln;
Case nwBindry.result OF
$F0 :writeln('Wildcards in source not allowed.');
$FC,$FB:writeln('No such userobject');
$F9,$F1:writeln('Not enough privileges..');
else writeln('General error reading the bindery.');
end;{case}
Halt(1);
end;
Move(propValue[15],TimeRestr[1],42);
end;
{--------------------------------- main -------------------------------------}
Var dest :string;
MyObjId :Longint;
secLevel:byte;
version :word;
begin
If ParamCount<>2
then begin
writeln('----- TRCOPY: Copy Login Time Restrictions from one user to another. -----');
writeln;
writeln('Usage: TRCOPY <source> <dest>');
writeln;
writeln('Where <source> is the name of a USER,');
writeln('and <dest> the name of a user or group the time restrictions');
writeln('are to be copied to. <dest> may contain wildcards.');
writeln;
writeln('----- Use with NetWare 3.x only ---------- Written with the NwTP API -----');
halt(0);
end;
writeln('TRCOPY: Copy Time Restrictions.');
source:=ParamStr(1);
dest :=ParamStr(2);
UpString(Source);
UpString(dest);
IF (NOT GetBinderyAccessLevel(secLevel,MyObjId))
or (secLevel<>$33)
then begin
writeln;
writeln('You need to be logged in as a Supervisor equivalent user');
writeln('to use this utility.');
halt(1);
end;
GetNWversion(version);
if (version DIV 100)<>3
then begin
writeln;
writeln('TRCOPY runs with NetWare 3.X only.');
halt(1);
end;
GetSourceTR(source);
IF NOT ChangeTRforUser(dest)
then IF NOT ChangeTRforGroup(dest)
then writeln('Error: destination user or group doesn''t exist.');
end.

172
NWTP/XCONN/TSTCONN.PAS Normal file
View File

@@ -0,0 +1,172 @@
{$X+,V-,B-}
Program testconn;
{ Testprogram for the nwConn unit / NwTP 0.6 API. (c) 1993, 1995, R.Spronk }
{ Purpose: testing of nwConn calls }
{ Tests the following nwConn functions:
GetConnectionId
GetConnectionInformation
GetConnectionNumber
GetDefaultConnectionId
GetFileserverName
GetInternetAddress
GetObjectConnectionNumbers
GetPreferredConnectionId
GetPrimaryConnectionId
GetWorkstationNodeAddress
GetUserAtConnection
}
Uses nwMisc,nwConn;
Procedure Warning(s:string);
begin
writeln(s);
writeln(' ERROR #: $',HexStr(nwConn.Result,2),' (',nwConn.result,')');
writeln;
writeln('...Press <Enter> to Continue..');
readln;
end;
Var myConnNumber:byte;
myConnId :byte; { connID of server I'm attached to }
myPhysNode2:TnodeAddress;
myObjName :string;
myObjType :word;
myObjId :longInt;
myLoginTime :TnovTime;
myAddress:TinternetworkAddress;
nbrOfConn:byte;
connList :TconnectionList;
objName :string;
objType :word;
objId :LongInt;
LoginTime:TnovTime;
connId :byte;
serverName:string;
routeInfo :string;
t :byte;
tempStr:string;
begin
IF GetConnectionNumber(myConnNumber)
then writeln('Your connection number is:',myConnNumber)
else warning('!!! The GetConnectionNumber call failed');
IF GetInterNetAddress(myConnNumber,myAddress)
then begin
write('Your Netw.:Node:Socket Nbr is: [$');
for t:=1 to 4 do write(hexStr(myAddress.Net[t],2));
write(':');
for t:=1 to 6 do write(HexStr(myAddress.Node[t],2));
writeln(':',hexstr(myAddress.socket,4),']');
end
else warning('!!! GetInterNetAdress failed.');
IF GetWorkstationNodeAddress(myPhysNode2)
and (myAddress.Node[6]=myPhysNode2[6])
and (myAddress.Node[5]=myPhysNode2[5])
and (myAddress.Node[4]=myPhysNode2[4])
then { ok }
else begin
warning('!!! GetStationadress failed');
write('returned: $');
for t:=1 to 6 do write(HexStr(myPhysNode2[t],2));
end;
IF GetConnectionInformation(myConnNumber,
myObjName,myObjType,myObjId,myLoginTime)
then begin
writeln('You are :',myObjName);
if myObjType=$1 { OT_USER}
then writeln(' of object type : USER')
else writeln(' of object type : $',HexStr(myObjType,4));
writeln(' with object ID: $',HexStr(myObjId,8));
NovTime2String(myLoginTime,tempStr);
writeln(' logged in at ',tempStr);
end
else warning('!!! GetConnectionInformation failed.');
if NOT (GetUserAtConnection(myConnNumber,tempStr) and (tempStr=myObjName))
then warning('!!! GetUserAtConnection (2) failed.');
IF GetObjectConnectionNumbers(myObjName,1 {OT_USER},
nbrOfConn,connList)
then begin
writeln('User ',myObjName,' has ',nbrOfConn,' active connection(s).');
t:=nbrOfConn;
if t>0
then begin
t:=1;
while t<=nbrOfConn
do begin
writeln(' at connectionNumber:',connList[t]);
inc(t);
end;
end;
end
else warning('!!! GetObjectConnectionNumbers failed.');
writeln;
t:=1;
writeln('ConnNbr Name LoginTime');
WHILE t<250 { nw 3.x / 2.x 100 }
do begin
IF GetConnectionInformation(t, objName,objType,objId,LoginTime)
then begin
PstrCopy(TempStr,objName,15);
objName:=TempStr;
NovTime2String(LoginTime,TempStr);
writeln(t:4,' ',objName,' ',TempStr);
end
else if nwConn.result<>$FD { bad_station_number / nbr not in use }
then warning('!!! GetConnectionInformation failed.');
inc(t);
end;
{*********** connection ID's ( server numbers in server table )************ }
{ to which server have we been sending all the above requests? }
routeInfo:='preferred';
GetPreferredConnectionID(ConnId);
{ if set previously, this server has the highest priority. }
if connId=0 { preferred server was not set }
then begin
RouteInfo:='default';
GetDefaultConnectionID(ConnId);
end;
{ your current default drive is attached to this server }
if connId=0
then begin
RouteInfo:='primary';
GetPrimaryConnectionID(ConnId);
end;
{ the server your shell initially attached to, used if the default drive
is a local drive. Lowest priority. }
{ These three calls are also incorporated in the secondary function:
GetEffectiveConnectionID. }
writeln;
writeln('All requests are routed to the ',RouteInfo,'-server with conn.ID=',connId);
GetFileServerName(connId,{out:} serverName);
GetConnectionID(serverName,{out} t);
if t<>connId
then warning('!!! GetFileServerName and GetConnectionId report different values.')
else writeln('Name of the server: ',serverName);
end.

127
NWTP/XCONN/TSTCONN2.PAS Normal file
View File

@@ -0,0 +1,127 @@
{$X+,V-,B-}
program tstconn2;
{ Testprogram for the nwConn unit / NwTP 0.6 API. (c) 1993, 1995, R.Spronk }
{ Purpose: testing of nwConn calls }
{ Tests the following nwConn functions:
GetConnectionIdTable
GetEndOfJobStatus
GetPrimaryConnectionId
GetNetwareErrorMode
GetNetwareShellVersion
GetWorkstationEnvironment
SetEndOfJobStatus
SetNetwareErrorMode
SetPrimaryConnectionId
}
uses nwMisc,nwConn;
Var MajorVersion,MinorVersion,RevisionLevel:byte;
OStype,OSversion,HardwareType,ShortHWType :string;
primConnId,TestConnId:byte;
c:byte;
ConnInfo:TconnectionIDtableEntry;
status,status1:boolean;
mode,mode1:byte;
begin
Writeln('Testing GetNWshellVersion.');
IF GetNetwareShellVersion(MajorVersion,MinorVersion,RevisionLevel)
then begin
write(' Shell version: ',MajorVersion,'.',Minorversion);
if RevisionLevel>0
then writeln(' Rev.',chr(ord('A')+RevisionLevel-1))
else writeln;
if MajorVersion>=3
then begin
writeln;
Writeln('Testing GetWSEnvironment.');
IF GetWorkstationEnvironment(OStype,OSversion,
HardwareType,ShortHWType)
then begin
writeln(' OStype :',OStype);
writeln(' OSversion :',OSversion);
writeln(' HardwareType:',HardwareType);
writeln(' ShortHWtype :',ShortHWtype);
end
else writeln('GetWSenvironment returned error#:',HexStr(nwConn.result,2));
end;
end
else writeln('GetNWshellversion returned error#:',HexStr(nwConn.result,2));
writeln;
writeln('Tesing SetPrimaryConnectionId.');
GetPrimaryConnectionId(primConnId);
writeln(' Primary connId=',primConnId);
IF SetPrimaryConnectionId(0)
then begin
writeln(' OK. prim.connid set to 0');
GetPrimaryConnectionId(testConnId);
if testConnId<>0
then writeln('ERR. primary connection wasn''t changed.');
end;
SetPrimaryConnectionId(primConnId);
GetPrimaryConnectionId(testConnId);
If testConnId=primConnId
then writeln(' Primary connId reset to ',testConnId)
else writeln('Error setting primary connectionId');
writeln;
writeln('Testing GetConnectionIDtable.');
for c:=1 to 8
do begin
GetConnectionIdTable(c,ConnInfo);
if ConnInfo.SlotInuse>0
then with ConnInfo
do begin
writeln(' Data for server with connId=',c);
Writeln(' Adress of server :$',HexDumpstr(ServerAddress,24),' (net,node HI-LO, socket LO-HI)');
Writeln(' Router address :$',HexDumpStr(RouterAddress,12));
writeln(' My connection Nbr:',ConnectionNumber);
writeln(' Connection Status:$',hexStr(connectionStatus,2));
end;
end;
writeln;
writeln('Testing Set/Get endOfJobStatus');
GetEndOfJobStatus(status);
SetEndOfJobStatus(NOT status);
GetEndOfJobStatus(status1);
if status1=NOT status
then writeln(' Tested OK.')
else writeln(' Error: test failed.');
SetEndOfJobStatus(status);
GetEndOfJobStatus(status1);
if status1=status
then writeln(' EOJ status reset to original mode.')
else writeln('Err: status not reset to original mode.');
writeln;
writeln('Testing Set/Get netwareErrorMode.');
GetNetwareErrorMode(mode);
SetNetwareErrorMode(2);
GetNetwareErrorMode(mode1);
if mode1=2
then writeln(' Tested OK.')
else writeln(' Error: test failed.');
SetNetwareErrorMode(mode);
GetNetwareErrorMode(mode1);
if mode1=mode
then writeln(' Error Mode reset to original mode.')
else writeln('Err: error mode not reset to original mode.');
end.

53
NWTP/XCONN/TSTCONN3.PAS Normal file
View File

@@ -0,0 +1,53 @@
{$X+,V-,B-}
program tstconn3;
{ Testprogram for the nwConn unit / NwTP 0.6 API. (c) 1993, 1995, R.Spronk }
{ Purpose: testing of nwConn calls }
{ Tests the following nwConn functions:
AttachToFileServer
AttachToFileServerWithAddress (called by AttachToFileServer)
}
uses nwMisc,nwConn;
Var connId,PrimConnId,t:byte;
serverName:string;
begin
writeln('This program tests the AttachToFileServer call.');
writeln('Can be tested in a multi-server network only.');
getPrimaryConnectionId(PrimConnId);
GetFileServerName(PrimConnId,serverName);
writeln;
writeln('Your primary server is ',serverName,' with connectionId ',PrimConnId);
writeln;
writeln('ConnectionIDtable:');
for t:=1 to 8
do If GetFileServerName(t,servername)
and (serverName<>'')
then writeln('ConnId: ',t:2,' Servername: ',serverName);
writeln;
write('Enter name of new server (not in above list) to attach to:');
readln(servername);
IF NOT AttachToFileServer(serverName,connId)
then begin
writeln('AttachtoFileserver returned error: $',HexStr(nwConn.result,2));
if nwconn.result=$7D
then writeln(' (wrong servername or server unknown)');
halt(1);
end;
writeln;
writeln('ConnectionIDtable:');
for t:=1 to 8
do If GetFileServerName(t,servername)
and (serverName<>'')
then writeln('ConnId: ',t:2,' Servername: ',serverName);
end.

307
NWTP/XCONN/WHO.PAS Normal file
View File

@@ -0,0 +1,307 @@
{$X+,V-,B-}
program who;
{ Adaption of a similar program privided with one of the other public
domain TP API's.
Example program for the nwConn unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
uses nwMisc,nwBindry,nwConn,nwServ;
{nwServ used for GetFileServerDateAndTime only}
Type String25=string[25];
PTuserInfo=^TuserInfo;
TuserInfo=record
objName :string25;
objId :LongInt;
TrueName :string25;
LoginTime:TnovTime; { time of last logon }
ConnNbr :byte; { 0= not logged on}
next :PTuserInfo;
end;
var Param : string;
DispAll,DispHelp : boolean;
MyConnNbr : byte;
MyServer : string;
ConnInUse,UsersConnected,ConnNotLogIn:byte;
startPtr : PTuserInfo;
Procedure ScanBinderyUsers;
Var lastObjSeen:LongInt;
UserName :string;
UserType :word;
UserId :LongInt;
Flag,Security:Byte;
hp :boolean;
nUser,lUser,wUser:PTuserInfo;
tempStr :string;
LogInfo :TloginControl;
begin
LastObjSeen:=-1;
WHILE ScanBinderyObject('*',1 {OT_USER},LastObjSeen,
UserName,UserType,UserId,Flag,Security,hp)
do begin
New(nUser);
PstrCopy(nUser^.objName,UserName,25);
nUser^.objId:=UserId;
nUser^.ConnNbr:=0;
nUser^.next:=NIL;
GetObjectLoginControl(UserName,1 {ot_user},LogInfo);
nUser^.LoginTime:=LogInfo.LastLoginTime;
IF nwBindry.GetRealUserName(UserName,tempstr)
then if (tempStr='')
then tempStr:='_';
PstrCopy(nUser^.TrueName,tempStr,25);
wUser:=startPtr;
While (wUser<>NIL) and (wUser^.objName<nUser^.objName)
do begin lUser:=wUser;wUser:=wUser^.next; end;
nUser^.next:=wUser;
lUser^.next:=nUser;
end;
if nwBindry.Result<>$FC { no such object}
then writeln('Error scanning Bindery.');
end;
Procedure DumpLoginTime(connNbr:byte;objName:string;objId:LongInt;time:TnovTime);
Var nUser,lUser:PTuserInfo;
begin
lUser:=startPtr^.next;
while (lUser<>NIL) and (luser^.objId<>objId)
do lUser:=lUser^.next;
if lUser<>NIL
then begin
if lUser^.ConnNbr=0 { first time the user is found at some connection }
then begin
lUser^.LoginTime:=time;
lUser^.ConnNbr:=ConnNbr;
end
else begin { user logged in at multiple connections }
new(nUser);
nUser^:=lUser^;
{nUser^.next:=lUser^.next}
nUser^.LoginTime:=time;
nUser^.ConnNbr:=ConnNbr;
lUser^.next:=nUser;
end;
end
else begin
writeln('SECURITY WARNING: USER ''',objName,''' @ connection:',connNbr);
writeln(' IS LOGGED IN W/O CORRESPONDING BINDERY OBJECT.');
end
end;
procedure DisplayHeader;
Var connId :byte;
username:string;
objType :word;
objID :LongInt;
dateTime:TnovTime;
begin
UpString(Param);
If NOT (GetPreferredConnectionID(connId) and (connId<>0))
then if NOT (GetDefaultConnectionID(connId) and (connId<>0))
then GetPrimaryConnectionId(connId);
GetFileServerName(connId,MyServer);
GetConnectionNumber(MyConnNbr);
GetConnectionInformation(MyconnNbr,username,objType,objID,datetime);
if Param='' then writeln('List of currently logged on users for server ',MyServer)
else writeln('List for user ',Param,' on ',MyServer,'.');
writeln;
writeln('Con: Name: Login/off Time:');
writeln('--- -------------------- -------------------------');
end;
procedure GetConnectedUsers;
Var connNbr:byte;
objName:string;
objType:word;
objId :LongInt;
LogTime:TnovTime;
{serverInfo:TFileServerInformation;}
begin
ConnInUse:=0;
UsersConnected:=0;
ConnNotLogIn:=0;
{ To determine the maximum number of connections allowed by the
license, you would normally use the
nwServ.GetFileServerInformation(servername,serverInfo)
call. For now, we'll suppose there are max. 250 connectios allowed. }
for connNbr := 1 to 250 {serverinfo.ConnectionsMax}
do begin
IF GetConnectionInformation(connNbr,objName,objType,objId,LogTime)
then begin
if objName='NOT-LOGGED-IN'
then begin
inc(ConnNotLogIn);
inc(connInUse);
DumpLoginTime(connNbr,objName,objId,LogTime);{ logOUT time }
end
else if objType=1 {OT_USER}
then begin
inc(ConnInUse);
inc(UsersConnected);
DumpLoginTime(connNbr,objName,objId,LogTime);{ logIN }
end
else inc(connInUse);
end
end; {do}
end;
procedure DisplayAllUsers;
Var lUser :PTuserInfo;
time,tempStr:string;
Begin
lUser:=startPtr^.next;
while lUser<>NIL
do begin
if (param='') or (pos(param,lUser^.objName)>0)
then begin
if lUser^.ConnNbr=0
then begin
if DispAll and (lUser^.objName<>'NOT-LOGGED-IN')
then begin
PstrCopy(tempStr,lUser^.objName,20);
write('N/A ',tempStr);
if lUser^.LoginTime.day<>0
then begin
NovTime2String(lUser^.LoginTime,time);
time[1]:='?';time[2]:='?';time[3]:='?';
writeln(' ',time);
end
else writeln(' ------not available------');
writeln('':5,lUser^.TrueName);
end
end
else begin
NovTime2String(lUser^.LoginTime,time);
PstrCopy(tempStr,lUser^.objName,20);
write(lUser^.connNbr:3);
if Luser^.ConnNbr=MyConnNbr
then write(' *')
else write(' ');
writeln(tempstr,' ',time);
writeln('':5,lUser^.TrueName);
end;
end;
lUser:=lUser^.next
end;
end;
procedure DisplayFooter;
Var now:TnovTime;
nowStr:string;
remainder:byte;
begin
getFileServerDateAndTime(now);
NovTime2String(now,nowStr);
If UsersConnected=1 then write('1 user is');
if UsersConnected>1 then write(UsersConnected,' users are');
if UsersConnected>0 then writeln(' logged into ',MyServer,' as of ',nowStr);
IF ConnNotLogIn=1 then write('1 connection is');
IF ConnNotLogIn>1 then write(ConnNotLogIn,' connections are');
IF ConnNotLogIn>0 then writeln(' in use, but the workstation has logged out.');
remainder:=ConnInUse-UsersConnected-ConnNotLogIn;
IF remainder>0 then writeln(remainder,' connection(s) used by non-user objects.');
end;
procedure credits;
begin
writeln;
writeln('WHO: Displays a list of currently logged in users.');
writeln;
writeln('SYNTAX: WHO [servername/][username] [/A]');
writeln;
writeln('Servername has to match an existing server.');
writeln('All users with ''username'' contained in them wil be displayed.');
writeln;
writeln('Example: WHO Display everyone');
writeln(' WHO username Display a particular user.');
writeln(' WHO server/ Display a different server.');
writeln;
halt(0);
end;
procedure ChangeServer; { change default server to something else }
var ServerChanged:Boolean;
p,connId:byte;
NewServer : string;
servername : string;
begin
ServerChanged:=False;
p := pos('/',Param);
NewServer := copy(Param,1,p-1);
UpString(NewServer);
Param := copy(Param,p+1,255);
for connId := 1 to 8
do begin
GetFileServerName(connId,servername);
if servername=NewServer
then begin
serverChanged:=True;
SetPreferredConnectionId(connId);
end;
end;
if NOT ServerChanged
then begin
writeln('Server ',NewServer,' not found.');
halt(1);
end;
end;
Var OldConnId:Byte;
nliConn:PTuserInfo;
begin {---------main-----------------------------------------------------}
New(startPtr);
New(nliConn);
nliConn^.objName:='NOT-LOGGED-IN';
nliConn^.objId:=0;
nliConn^.TrueName:='';
nliConn^.next:=NIL;
nliConn^.connNbr:=0;
startPtr^.next:=nliConn;
startPtr^.objName:=#0;
if paramcount > 0
then Param := paramstr(1)
else Param := '';
DispAll:=(paramCount > 0)
and ( (pos('/A',paramstr(1))=1)
or (pos('/a',paramStr(1))=1)
);
If dispall then param:='';
DispAll:=DispAll or ( (paramCount > 1)
and ( (pos('/A',paramstr(2))=1)
or (pos('/a',paramStr(2))=1)
)
);
UpString(Param);
DispHelp:=(Param = '?') or (Pos('/H',Param)=1);
GetPreferredConnectionId(OldConnId);
if DispHelp then credits;
if pos('/',Param) > 1 then ChangeServer;
ScanBinderyUsers;
GetConnectedUsers;
DisplayHeader;
DisplayAllUsers;
DisplayFooter;
SetPreferredConnectionId(OldConnId);
end.

87
NWTP/XFILE/GETOFIL.PAS Normal file
View File

@@ -0,0 +1,87 @@
program GetOFil;
{ Testprogram for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Uses the following calls:
GetConnectionsOpenFiles (nwServ)
MapDirEntryIdToPath (nwFile)
}
uses nwMisc,nwConn,nwFile,nwServ;
Var ConnNumber : Byte;
LastRecordSeen : word;
NbrOfRecords : word;
FileInfo : TfileInfoRecList;
t : Byte;
ExtPath,DosPath: string;
VolName : string;
errCode:Integer;
dHelp:byte;
INaddress:TinternetworkAddress;
begin
dHelp:=0;
If (NOT CheckConsolePrivileges)
then dHelp:=4;
IF (ParamCount<>1)
then dHelp:=1;
if dHelp=0
then begin
Val(ParamStr(1),ConnNumber,errCode);
if (errCode<>0) then dHelp:=2;
end;
{ determine whether connectionnumber is valid.
Remember: using invalid connectionnumbers in combination with the
GetConnection'sOpenFiles function may result in an Abend.. }
if (dHelp=0) and (NOT GetInterNetAddress(connNumber,INaddress))
then dHelp:=3;
if dHelp>0
then begin
if (dHelp=2) or (dHelp=3)
then writeln('Error: invalid connection number specified.');
if dHelp=4
then writeln('!! You need console operator privileges to use this utility.');
writeln;
writeln('GETOFIL - Get connection''s open files.');
writeln;
writeln('Usage: GETOFIL <connection number>');
halt(1);
end;
LastRecordSeen:=0;
Writeln('Files currently held open by connection ',ConnNumber);
REPEAT { iterate / "only" 28 files (max.) returned per call }
IF GetConnectionsOpenFiles (ConnNumber, LastRecordSeen,
NbrOfRecords ,FileInfo)
then begin
for t:=1 to NbrOfRecords
do with FileInfo[t]
do begin
IF MapDirEntryIdToPath(VolNbr,ParentEntryID,NStype,
FileName)
then begin
NovPath2DosPath(ExtPath,DosPath);
GetVolumeName(VolNbr,VolName);
writeln(VolName,':',DosPath,'\',FileName)
end
else writeln('Error calling MapDirEntryIdToPath, err#',nwFile.result);
end;
end
else begin
writeln('err: ',nwServ.result);
halt(1);
end;
UNTIL LastRecordSeen=0;
end.

243
NWTP/XFILE/LDIR.PAS Normal file
View File

@@ -0,0 +1,243 @@
program ldir;
{ Testprogram for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ LDIR is an alternative for NDIR, showing the use of the
ScanDirectoryEntry function. }
uses nwMisc,nwBindry,nwFile;
Function GetEntryAttributeString(Attr:Longint):string;
Var res:string;
begin
if (Attr and A_DIRECTORY)=0
then res:=' RwSAXHSyTPCDR '
else res:=' -----HSy-P-DR ';
if (Attr and A_HIDDEN)=0 then res[7]:='-';
if (Attr and A_SYSTEM)=0 then begin res[8]:='-';res[9]:='-'; end;
if (Attr and A_RENAME_INHIBIT)=0 then res[14]:='-';
if (Attr and A_DELETE_INHIBIT)=0 then res[13]:='-';
if (Attr and A_PURGE)=0 then res[11]:='-';
if (Attr and A_DIRECTORY)=0
then begin
if ((Attr and A_READ_ONLY)>0) then res[3]:='o';
if (Attr and A_EXECUTE_ONLY)=0 then res[6]:='-';
if (Attr and A_NEEDS_ARCHIVED)=0 then res[5]:='-';
if (Attr and A_SHAREABLE)=0 then res[4]:='-';
if (Attr and A_TRANSACTIONAL)=0 then res[10]:='-';
if (Attr and A_COPY_INHIBIT)=0 then res[12]:='-';
end;
GetEntryAttributeString:=res;
end;
Var DirHandle:Byte;
DirPath:String;
SequenceNumber:Byte;
TrusteeInfo: TtrusteeInformation;
t:Byte;
ObjName:string;
ObjType:word;
ObjId:Longint;
DH,EffRights:byte;
EntryName:string;
SearchFlags:Longint;
EntryId:Longint;
Entry:Tentry;
s,s1:string;
p:byte;
OwnerName:string;
OwnerType:word;
entry2:Tentry;
begin
DirHandle:=0;
if ParamCount>0
then s:=paramStr(1)
else s:='.';
IF NOT GetTrueEntryName(s,DirPath)
then begin
writeln('Error resolving given filename (err: 0-',nwfile.result,')');
halt(1);
end;
if pos(':',DirPath)=2
then begin
writeln('You cannot use this program on a local drive.');
halt(1);
end;
{ ok. Try to separate EntryName from path }
p:=ord(DirPath[0]);
while (p>0) and (DirPath[p]<>'\') do dec(p);
s:=copy(DirPath,p+1,255);
if (pos('.',s)>0) or (pos('*',s)>0) or (pos('?',s)>0)
then begin { last part is definately a filename }
EntryName:=s;
DirPath[0]:=chr(p-1);
IF NOT AllocTemporaryDirHandle(31,0,DirPath,DH,EffRights)
then begin
writeln('Could not locate directory (err: 1-',nwfile.result,')');
halt(1);
end;
end
else begin
IF AllocTemporaryDirHandle(31,0,DirPath,DH,EffRights) { assume it's a path}
then begin
{ whole thing appears to be a path.. }
EntryName:='*';
end
else begin
{ whoops.. not a path, but a filename without an extension }
EntryName:=s;
DirPath[0]:=chr(p-1);
IF NOT AllocTemporaryDirHandle(31,0,DirPath,DH,EffRights)
then begin
writeln('Could not locate directory (err: 2-',nwfile.result,')');
halt(1);
end;
end;
end;
writeln('EntryName Size Flags EntryID Creation Owner');
writeln('------------+---------+---------------+--------+---------------+----------');
SearchFlags:=$ef; { all NON directories, i.e. all files }
EntryId:=-1;
While ScanDirectoryEntry(DH,EntryName,SearchFlags,EntryID,Entry)
do begin
s:=entry.EntryName;
p:=pos('.',s);
if p=0
then begin
s:=s+' ';
s[0]:=#12;
end
else begin
s1:=copy(s,1,p-1)+' ';
s1[0]:=#8;
s:=s1+copy(s,p,255)+' ';
s[0]:=#12;
end;
write(s);
write(entry.FileSize:10);
s:=GetEntryAttributeString(entry.Attributes);
write(' F',s);
write(HexStr(entryId,8));
NovTime2String(entry.CreationTime,s);
delete(s,1,5);dec(s[0],3);
delete(s,8,2);
s[3]:='-';s[7]:='-';
write(' ',s);
GetBinderyObjectName(entry.OwnerId,OwnerName,OwnerType);
s:=ownerName+' ';
s[0]:=#10; write(' ',s);
writeln;
end;
if nwFile.result<>$FF { no more matching entries }
then writeln('Error scanning directory information (err : 3-',nwfile.result,')');
{-- As an extra gimmick: if you DEFINE ShowScan, salvagable files will
also be shown.. }
{$IFDEF ShowScan}
{ Scan salvagable files.. }
EntryId:=-1;
WHILE ScanSalvagableFiles(DH,EntryId,Entry)
do begin
s:=entry.EntryName;
p:=pos('.',s);
if p=0
then begin
s:=s+' ';
s[0]:=#12;
end
else begin
s1:=copy(s,1,p-1)+' ';
s1[0]:=#8;
s:=s1+copy(s,p,255)+' ';
s[0]:=#12;
end;
write(s);
write(entry.FileSize:10);
s:=GetEntryAttributeString(entry.Attributes);
write(' S',s);
write(HexStr(entryId,8));
NovTime2String(entry.CreationTime,s);
delete(s,1,5);dec(s[0],3);
delete(s,8,2);
s[3]:='-';s[7]:='-';
write(' ',s);
GetBinderyObjectName(entry.OwnerId,OwnerName,OwnerType);
s:=ownerName+' ';
s[0]:=#10; write(' ',s);
writeln;
end;
If nwFile.result<>$FF { normal iteration end }
then writeln('Error using ScanSalvagableFiles.');
{$ENDIF}
{------------------ show subdir info }
SearchFlags:=$3f;
EntryId:=-1;
While ScanDirectoryEntry(DH,EntryName,SearchFlags,EntryID,Entry)
do begin
s:=entry.EntryName;
p:=pos('.',s);
if p=0
then begin
s:=s+' ';
s[0]:=#11;
end
else begin
delete(s,p,1);
s:=s+' ';
s[0]:=#11;
end;
write('\',s);
write(0:10); { filesize }
s:=GetEntryAttributeString(entry.Attributes);
write(' D',s);
write(HexStr(entryId,8));
NovTime2String(entry.CreationTime,s);
delete(s,1,5);dec(s[0],3);
delete(s,8,2);
s[3]:='-';s[7]:='-';
write(' ',s);
GetBinderyObjectName(entry.OwnerId,OwnerName,OwnerType);
s:=ownerName+' ';
s[0]:=#12; write(' ',s);
writeln;
end;
if nwFile.result<>$FF { no more matching entries }
then writeln('Error scanning directory information (err : 4-',nwfile.result,')');
DeallocateDirHandle(DH);
end.

211
NWTP/XFILE/TSTDH.PAS Normal file
View File

@@ -0,0 +1,211 @@
program tstdh;
{ Testprogram for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
uses nwMisc,nwConn,nwFile;
{ Test the following drive(handle) related calls:
GetDirectoryHandle
GetDirectoryPath
GetDriveConnectionId
GetDriveHandle
GetDriveFlag
GetNumberOfLocalDrives (nwConn)
GetVolumeNameWithHandle
IsNetworkDrive
GetEnvPath
GetSearchDriveVector
IsSearchDrive
SetEnvPath
SetSearchDriveVector
}
Var t,dirhandle,status:byte;
status2,dirHandle2:byte;
volname:string;
connId:byte;
locDrives:byte;
dirPath:string;
serverName:string;
NewDirHandle, EffectiveRights:byte;
connId2,Dflag:byte;
vector,vector2:TsearchDriveVector;
pth,pth2:string;
begin
{-- drivenumbers, dirhandles --}
nwconn.GetNumberofLocalDrives(locDrives);
writeln('Local Drives:',locDrives); { Drivenumbers 0..locDrives-1 taken by local drives }
writeln;
for t:=0 to locDrives-1
do If IsNetworkDrive(t)
then writeln('Error?: IsNetworkDrive failed for drive ',chr(ord('A')+t));
for t:=locDrives to 31
do begin
IF GetDirectoryHandle(t,dirHandle,status)
then begin
writeln(chr(t+ord('A')),' handle=',dirHandle,' status=',status);
GetDriveHandle(t,dirHandle2);
GetDriveFlag(t,status2);
if (status<>status2) or (dirHandle<>dirHandle2)
then writeln('Error: GetDirectoryHandle data differs from GetDriveHandle/Flag data.');
if IsNetworkDrive(t) XOR ((status AND $80)=0)
then writeln('Error: IsNetworkDrive failed.');
GetDirectoryPath(dirHandle,dirpath);
write('=> ',dirpath);
if GetDriveConnectionId(t,connId)
then begin
write(' connId=',connId);
nwConn.GetFileServerName(connId,serverName);
write(' volume=\\',servername,'\');
end;
IF (status<3) {temporary or permanent mapping}
and GetVolumeNameWithHandle(dirHandle,volName)
then write(volName);
writeln;
end
end;
{-- seachdrives, searchdrive vector-- }
writeln;
writeln('<RETURN> to continue..');
writeln;
readln;
GetSearchDriveVector(vector);
write('Searchdrivevector: ');
for t:=1 to 17
do if vector[t]<255
then write(chr(byte(vector[t]+ord('A'))),' ')
else write('$FF ');
writeln;
FillChar(vector2,Sizeof(TsearchDriveVector),#$FF);
SetSearchDriveVector(vector2);
FillChar(vector2,Sizeof(TsearchDriveVector),#$00);
GetSearchDriveVector(vector2);
if (vector2[1]<>$FF)
then writeln('Error: SetSearchdriveVector Failed.');
SetSearchDriveVector(vector); { restore old vector }
GetEnvPath(pth);
writeln('PATH setting in the master environment=',pth);
SetEnvPath('this_is_a_bogus_path;');
GetEnvPath(pth2);
writeln('Path is temporarily set to: ',pth2);
SetEnvPath(pth);
writeln('Path reset to original value.');
Write('Searchdrives (using IsSearchDrive):');
for t:=locDrives to 31
do If IsSearchDrive(t)
then write(chr(t+ord('A')),' ');
writeln;
{----------------- directory handles ---------------------}
writeln('<RETURN> to continue..');
writeln;
t:=locDrives;
While (t<26) and GetDirectoryHandle(t,dirHandle,status)
do inc(t);
Writeln('First free drive: ',chr(t+ord('A')));
IF NOT AllocPermanentDirHandle(t,0,'SYS:LOGIN',NewDirHandle, EffectiveRights)
then writeln('Error calling AllocPermanentDirHandle: ',nwFile.result);
GetDirectoryPath(NewDirHandle,pth);
IF SetDriveHandle(t,NewDirHandle)
then writeln('SetDriveHandle: drive ',chr(t+ord('A')),' asociated with dirHandle to path ',pth)
else writeln('Error using SetDriveHandle: ',nwFile.result);
GetDriveHandle(t,dirHandle);
if dirHandle<>NewDirHandle
then writeln('Error in SetDriveHandle.');
GetEffectiveConnectionId(connId);
{ all requests have been sent to the effective server up to now, so
that's the server the drive is connected to }
SetDriveConnectionId(t,connId);
GetDriveConnectionId(t,connId2);
If ConnId2<>ConnId
then writeln('Error in Set/GetDriveConnectionId');
GetDriveFlag(t,Dflag);
SetDriveFlag(t,(Dflag and $80) or 1);
writeln('(non-root) Mapping completed.');
{ see the MAPDRIVE function in nwFile;
it creates (temporary) mappings in much the same way as above }
{map a temporary drive}
IF MapDrive(31,'SYS:MAIL',{root drive:} false, {permanent mapping:} false {true})
then begin
GetDriveHandle(31,dirHandle);
GetDirectoryPath(dirHAndle,pth);
Writeln('Temporary! drive ',chr(31+ord('A')),' mapped to ',pth);
{ If mapdrive works, so must
DeleteFakeRootDirectory
GetTrueEntryName
MapFakeRootDirectory
}
end
else writeln('Error using MapDrive: ',nwFile.result);
writeln;
t:=locDrives;
While (t<26) and GetDirectoryHandle(t,dirHandle,status)
do inc(t);
Writeln('Another free drive: ',chr(t+ord('A')));
IF MapSearchDrive(t,'SYS:PUBLIC',16,{insert:}false,
{root:}false,{permanent:}true)
then begin
GetDriveHandle(t,dirHandle);
GetDirectoryPATh(dirHAndle,pth);
Writeln('drive ',chr(t+ord('A')),' mapped (as a searchdrive) to ',pth);
end
else writeln('Error using MapSearchDrive: ',nwFile.result);
writeln;
t:=locDrives;
While (t<26) and GetDirectoryHandle(t,dirHandle,status)
do inc(t);
Writeln('Another free drive: ',chr(t+ord('A')));
IF MapPermanentDrive(t,'SYS:PUBLIC',{root:}true)
then begin
GetDriveHandle(t,dirHandle);
GetDirectoryPATh(dirHAndle,pth);
Writeln('drive ',chr(t+ord('A')),' mapped (permanently) to ',pth);
IF NOT SetDirectoryHandle(0,'SYS:MAIL',dirHandle)
then writeln('Error using SetDirectoryHandle: ',nwFile.result)
else begin
GetDirectoryPATh(dirHAndle,pth);
Writeln('drive ',chr(t+ord('A')),' => handle changed to ',pth);
end;
end
else writeln('Error using MapPermanentDrive: ',nwFile.result);
end.

138
NWTP/XFILE/TSTENT2.PAS Normal file
View File

@@ -0,0 +1,138 @@
Program tstent2;
{ Testprogram for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Tests the following nwFile calls:
GetDirectoryEntry
ScanDirectoryInformation
ScanFileInformation
ScanSalvagableFiles
}
uses nwMisc,nwBindry,nwFile;
Procedure PrintEntry(e:Tentry);
VAr s,ObjName:String;
ObjType:Word;
begin
with e
do begin
writeln('----------------------------------');
writeln('Name:',EntryName);
writeln('FileSize :',FileSize);
writeln('Name space :',NStype);
writeln('Data fork size :',DataForkSize);
writeln;
writeln('Attributes:',HexStr(Attributes,8));
writeln('RightsMask:',HexStr(RightsMask,4));
writeln;
objName:='';
NovTime2String(CreationTime,s);
GetBinderyObjectName(OwnerId,ObjName,ObjType);
writeln('Created at :',s,' by ',ObjName,' (',HexStr(OwnerId,8),')');
objName:='';
NovTime2String(ArchiveTime,s);
GetBinderyObjectName(ArchiverId,ObjName,ObjType);
writeln('Last archived at :',s,' by ',ObjName,' (',HexStr(ArchiverId,8),')');
objName:='';
NovTime2String(ModifyTime,s);
GetBinderyObjectName(ModifierId,ObjName,ObjType);
writeln('Last modified at :',s,' by ',ObjName,' (',HexStr(ModifierId,8),')');
NovTime2String(LastAccessTime,s);
writeln('Last accessed at :',s);
objName:='';
NovTime2String(DeleteTime,s);
GetBinderyObjectName(DeletorId,ObjName,ObjType);
writeln('Deleted at :',s,' by ',ObjName,' (',HexStr(DeletorId,8),')');
writeln;
end;
end;
Var DirHandle,EffRights:Byte;
DirEntry:Tentry;
SearchFlags,EntryId:Longint;
PathNAme:STring;
SeqNbr:Integer;
WseqNbr:word;
begin
AllocPermanentDirHandle(7,0,'SYS:PUBLIC',DirHandle,EffRights);
writeln;
writeln('Test of GetDirectoryEntry (get entry SYS:\PUBLIC');
write('<RETURN> to contimue...');
readln;
IF GetDirectoryEntry(dirHandle,dirEntry)
then PrintEntry(dirEntry)
else writeln('Error using GetDirectoryEntry, err#',nwFile.result);
SetDirectoryHandle(0,'SYS:',DirHandle);
GetDirectoryPAth(DirHandle,PathNAme);
writeln('handle ass. with:',PathName);
writeln;
writeln('Test of ScanDirectoryInformation (scan subdirs of SYS:\PUBLIC');
write('<RETURN> to contimue...');
readln;
WseqNbr:=0;
while ScanDirectoryInformation(dirHandle,'PUBLIC\*',WseqNbr,dirEntry)
do begin
writeln('SeqNbr now is: ',WseqNbr);
PrintEntry(DirEntry);
end;
if nwFile.result<>$9C
then writeln('error using ScanDirInfo :',nwFile.result);
writeln;
writeln('Test of ScanFileInformation (scan *.EXE files in SYS:\PUBLIC');
write('<RETURN> to contimue...');
readln;
seqNbr:=-1;
while ScanFileInformation(DirHandle,'PUBLIC\*.EXE',
$FF,
SeqNbr,
dirEntry)
do begin
PrintEntry(DirEntry);
end;
if nwFile.result<>$FF
then writeln('error using ScanFileInfo :',nwFile.result);
writeln;
writeln('Test of ScanSalvagableFiles (erased files in SYS:\PUBLIC');
write('<RETURN> to contimue...');
readln;
SetDirectoryHandle(0,'SYS:\PUBLIC',DirHandle);
EntryId:=-1;
WHILE ScanSalvagableFiles(DirHandle,
EntryId,
dirEntry)
do begin
PrintEntry(dirEntry);
writeln('NextEntryId:',hexStr(entryId,8));
end;
if nwFile.result<>$FF
then writeln('error using ScanSalvagable files :',nwFile.result);
DeallocateDirHandle(DirHandle);
end.

91
NWTP/XFILE/TSTENTRY.PAS Normal file
View File

@@ -0,0 +1,91 @@
Program tstentry;
{ Example for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Tests the following nwFile calls:
AllocPermanentDirHandle
CreateDirectory
DeallocateDirHandle
RenameDirectory
ScanDirRestrictions
SetDirectoryHandle
SetDirRestriction
}
uses nwMisc,nwFile;
Var DirHandle:Byte;
NumberOfEntries:Byte;
RestrInfo:TdirRestrList;
t,EffRights:Byte;
begin
AllocPermanentDirHandle(7,0,'SYS:',DirHandle,EffRights);
IF NOT CreateDirectory(DirHandle,'NWTP',$FF)
then writeln('Error using CreateDirectory, err# ',nwFile.result);
SetDirectoryHandle(DirHandle,'NWTP',DirHandle);
IF NOT SetDirRestriction(DirHandle,4096) { 4096 blocks = 16 Mb }
then writeln('Error using SetDirRestriction, err# ',nwFile.result);
IF NOT ScanDirRestrictions(DirHandle,NumberOfEntries,RestrInfo)
then writeln('Error calling ScanDirRestrictions:',nwFile.result);
writeln(NumberOfEntries);
For t:=1 to NumberOfEntries
do begin
writeln;
writeln('Level :',RestrInfo[t].level);
writeln('MaxBlocks :',HexStr(RestrInfo[t].MaxBlocks,8));
writeln('AvailBlocks:',HexStr(RestrInfo[t].AvailableBlocks,8));
end;
writeln('------');
IF NOT CreateDirectory(DirHandle,'TEST',$FF)
then writeln('Error using CreateDirectory, err# ',nwFile.result);
IF NOT RenameDirectory(DirHandle,'TEST','TESTDIR')
then writeln('Error using RenameDirectory, err# ',nwFile.result);
IF NOT SetDirectoryHandle(DirHandle,'TESTDIR',DirHandle)
then writeln('Error using SetDirectoryHandle, err# ',nwFile.result)
else writeln('SetDirHandle: ok');
IF NOT SetDirRestriction(DirHandle,8192)
then writeln('Error using SetDirRestriction, err# ',nwFile.result);
IF NOT ScanDirRestrictions(DirHandle,NumberOfEntries,RestrInfo)
then writeln('Error calling ScanDirRestrictions:',nwFile.result);
writeln(NumberOfEntries);
For t:=1 to NumberOfEntries
do begin
writeln;
writeln('Level :',RestrInfo[t].level);
writeln('MaxBlocks :',HexStr(RestrInfo[t].MaxBlocks,8));
writeln('AvailBlocks:',HexStr(RestrInfo[t].AvailableBlocks,8));
end;
writeln('<Return> to continue...........');
readln;
SetDirRestriction(DirHandle,0);
SetDirectoryHandle(0,'SYS:NWTP',DirHandle);
IF Not DeleteDirectory(DirHandle,'TESTDIR')
then writeln('Error using DeleteDirectory, err#', nwFile.result);
{SetDirRestriction(DirHandle,0);}
SetDirectoryHandle(0,'SYS:',DirHandle);
IF Not DeleteDirectory(DirHandle,'NWTP')
then writeln('Error using DeleteDirectory, err#', nwFile.result);
DeallocateDirHandle(DirHandle);
end.

58
NWTP/XFILE/TSTTRUST.PAS Normal file
View File

@@ -0,0 +1,58 @@
program tsttrust;
{ Testprogram for the NwFile unit / NwTP 0.6, (c) 1993,1995 R.Spronk }
uses nwMisc,nwBindry,nwFile;
Var DirHandle:Byte;
DirPath:String;
SequenceNumber:Byte;
TrusteeInfo: TtrusteeInformation;
t:Byte;
ObjName:string;
ObjType:word;
ObjId:Longint;
DH,EffRights:byte;
begin
DirHandle:=0;
DirPath:='SYS:SYSTEM';
IF NOT AllocTemporaryDirHandle(31,0,DirPath,DH,EffRights)
then writeln('allocTempDH returned err: ',nwfile.result);
{ Before scanning the trustees, you might add or delete a
trustee for testing purposes.
ObjId:=$06000006;
IF NOT DeleteTrustee(0,DirPath,ObjId)
then writeln('DeleteTrustee returned error: ',nwFile.result);
ObjId:=$06000006;
IF NOT SetTrustee(0,DirPath,ObjId,TA_READ or TA_SEARCH)
then writeln('SetTrustee returned error: ',nwFile.result); }
SequenceNumber:=0;
While ScanEntryForTrustees(DirHandle,DirPath,
SequenceNumber,TrusteeInfo)
do begin
with TrusteeInfo
do begin
for t:=1 to TrusteeInfo.NumberOfTrustees
do begin
write(HexStr(TrusteeID[t],8));
GetBinderyObjectName(TrusteeId[t],ObjName,oBjType);
writeln(' ',HexStr(TrusteeRights[t],4),' ',ObjName);
end;
end;
end;
if nwFile.result<>$9C { no more trustees }
then writeln('ScanEntryForTrustees returned error :',nwfile.result);
DeallocateDirHandle(DH);
readln;
end.

170
NWTP/XFILE/TSTVOL.PAS Normal file
View File

@@ -0,0 +1,170 @@
{$X+,B-,V-} {essential compiler directives}
program tstvol;
{ Example for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Tests the following volume related functions in nwFile and nwServ:
ClearObjectVolRestriction
GetDiskUtilization (nwServ)
GetObjectVolRestriction
GetVolumeName
GetVolumeNumber
GetVolumeUsage
IsVolumeRemovable
SetObjectVolRestriction
}
uses nwMisc,nwServ,nwFile;
Var volNbr :byte;
volName:string;
volUsage :TvolUsage;
isremovable:boolean;
MaxAllowedBlocks,
BlocksInUse:Longint;
VolumeNbr :byte;
sequenceNbr :LongInt;
NbrOfObjects:byte;
ResultBuffer:TobjVolRestr;
usedDirs,usedFiles,usedBlocks:word;
t:byte;
begin
writeln('Testing GetVolumeNumber');
IF GetVolumeNumber('XXXX',volNbr)
then writeln('--Err. GetVolumeNuber returned a volumenumber when it should have failed.');
IF GetVolumeNumber('VOL',volNbr)
then writeln(' VolNbr of ''VOL:'' equals ',volNbr)
else writeln(' Volume VOL appears not to exist.');
IF GetVolumeNumber('SYS',volNbr)
then writeln(' VolNbr of SYS: equals ',volNbr)
else begin
writeln('Error Using GetVolumeNumber, err#',nwFile.result);
writeln('Critical error. Test aborted.');
halt(1);
end;
writeln;
writeln('Testing GetVolumeName');
for volNbr:=0 to 31
do begin
IF GetVolumeName(volNbr,volName)
then writeln(' VolNbr ',volNbr,' is ''',volName,'''')
else if result<>$98 { no such volume }
then writeln('--Error testing GetVolumeName, err#',result);
end;
writeln;
writeln('Testing GetVolumeUsage.');
IF GetVolumeNumber('SYS:',volNbr) and GetVolumeUsage(volNbr,VolUsage)
then with VolUsage
do begin
writeln(' Volume Usage Information:');
writeln(' Total Blocks: ',totalBlocks,' Free: ',freeBlocks);
writeln(' Total Dir entries: ',totalDirEntries,' Free: ',availDirEntries);
writeln(' Volumename: ''',volumename,'''');
writeln(' Blocksize: ',SectorsPerBlock*512,' bytes.');
end;
writeln;
writeln('Testing IsVolumeRemovable');
IF IsVolumeRemovable(0,isremovable)
then writeln(' Removable: ',isremovable)
else writeln('--IsVolumeRemovable failed.');
{==================Testing the volume restriction calls====================}
GetVolumeNumber('SYS',volNbr);
writeln('Getting the volume restrictions for user supervisor on SYS volume..');
IF GetObjectVolRestriction(volNbr,1 {objectId of Supervisor},
MaxAllowedBlocks,BlocksInUse)
then begin
writeln(' GetObjectVolRestriction:');
writeln(' Supervisor on volume SYS');
write(' Restricted to:');
if MaxAllowedBlocks=$40000000
then write('(unlimited)')
else write(MaxAllowedBlocks);
writeln(' Blocks ,BlocksInUse: ',BlocksInUse);
end
else writeln('--Error returned by GetObjectVolRestriction, err#',nwFile.result);
writeln;
writeln('Testing GetDiskUtilization (nwServ) for user supervisor');
IF NOT nwServ.GetDiskUtilization(volNbr,1 {supervisor ObjId},usedDirs,usedFiles,usedBlocks)
then begin
writeln('--Error returned by nwServ.GetDiskUtilization, err#',nwServ.result);
if nwServ.result>=$89
then writeln('--( Object Search/Read rights are necessary.)');
end
else begin
writeln(' dirs in use :',usedDirs);
writeln(' files in use :',usedFiles);
writeln(' blocks in use:',usedBlocks);
{ note that blocksinuse is a word (Max ownership= 262 Mb.)
GetObjectVolRestriction returns the BlocksInUse value as a LongInt }
writeln(' (created/owned dirs/files/blocks)');
end;
writeln('Test of SetObjectVolRestriction:');
IF NOT SetObjectVolRestriction(volNbr,$1,BlocksInUse+100)
then begin
writeln('--Error returned by setObjectVolRestriction, err#',nwFile.result);
if nwFile.result=140
then writeln('--( Supervisor equivalent rights are necessary.)');
end
else writeln('--OK, volume restriction set.');
IF GetObjectVolRestriction(volNbr,$1 {objectId of Supervisor},
MaxAllowedBlocks,BlocksInUse)
then begin
if MaxAllowedBlocks=$40000000 { no restriction }
then writeln('--SetObjectVolRestriction failed.');
end;
writeln;
writeln('Testing ScanVolForRestrictions:');
sequenceNbr:=0;
While ScanVolForRestrictions(volNbr,sequenceNbr,NbrOfObjects,ResultBuffer)
do begin
for t:=1 to NbrOfObjects
do begin
write(' ObjectId:',HexStr(resultbuffer[t].objId,8));
writeln(' /Restriction: ',resultBuffer[t].MaxallowedBlocks,' Blocks');
end;
end;
IF nwFile.result=$FF { NO MORE DATA, normal iteration end }
then writeln('--No (more) volume restrictions.')
else writeln('--Error returned by ScanVolForRestrictions, err#',nwFile.result);
writeln;
writeln('Clearing SUPERVISOR restrictions using ClearObjectVolRestriction.');
IF NOT ClearObjectVolRestriction(VolNbr,$1)
then begin
writeln('--Error calling ClearObjectVolRestriction, err#',nwFile.result);
if nwFile.result=140
then writeln('--( Supervisor equivalent rights are necessary.)');
end;
IF GetObjectVolRestriction(volNbr,1 {objectId of Supervisor},
MaxAllowedBlocks,BlocksInUse)
then begin
if MaxAllowedBlocks=$40000000
then writeln('--OK, user now has no restriction.')
else writeln('--Error: ClearObjectVolRestriction Failed.');
end;
end.

100
NWTP/XFILE/USPACE.PAS Normal file
View File

@@ -0,0 +1,100 @@
{$X+,B-,V-} {essential compiler directives}
program uspace;
{ Example for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: A quick way of telling how much space each of your users is
taking up. For Novell 3.x networks.
(3867) Tue 29 Mar 94 19:01
By: Richard Jary
To: All
Re: Disk Space by Login Name
St:
------------------------------------------------------------
After a quick way of telling how much space each of our users is
taking up. Novell 3.11 system, same info as you get by SYSCON ->
UserInfo -> Volume/Disk Restrictions. But preferably for all
users in a text file format, rather than one by one.
Reason - we have a shared area with many directories. All with
fun names like CAMBODIA, where any one of 10 people could be
saving stuff. I'd like to go the the (l)users and say "OI! -
You've got 40MB of stuff on this server - Clean It Up!" sort
of thing. Either more or less polite depending on the user
involved!
Richard
Internet: rjary@nibueng.ccdn.otc.com.au
--- msgedsq 2.1a
* Origin: Networking from Narara. (3:711/445) }
Uses nwMisc,nwBindry,nwFile;
Var lastObjSeen : Longint;
RepName : String;
RepType : Word;
RepId : LongInt;
RepFlag : Byte;
RepSecurity : Byte;
RepHasProperties: Boolean;
FullUserName : string;
MaxAllowedBlocks,BlocksInUse:Longint;
VolumeNbr : Byte;
VolUsageInfo : TvolUsage;
Version : Word;
VolInfo:array[0..31] of record
Name :string;
SectorsPerBlock:Byte;
end;
begin
If NOT IsShellLoaded
then begin
writeln('USPACE requires:');
writeln(' -The shell to be loaded;');
halt(1);
end;
GetNWversion(version);
if version<300
then begin
writeln('Netware 3.x only.');
halt(1);
end;
for VolumeNbr:=0 to 31
do begin
IF GetVolumeName(VolumeNbr,VolInfo[VolumeNbr].name)
and GetVolumeUsage(VolumeNbr,VolUsageInfo)
then VolInfo[VolumeNbr].SectorsPerBlock:=VolUsageInfo.SectorsPerBlock;
end;
lastObjSeen:=-1;
While ScanBinderyObject('*',OT_USER,
lastObjSeen,
RepName,RepType,RepId,RepFlag,RepSecurity,RepHasProperties)
do begin
GetRealUserName(RepName,FullUserName);
writeln(Repname+' ('+FullUserName+')');
For VolumeNbr:=0 to 31
do if GetObjectVolRestriction(VolumeNbr,RepId,MaxAllowedBlocks,BlocksInUse)
then begin
write(' ',volInfo[VolumeNbr].Name,' :',
BlocksInUse*(VolInfo[VolumeNbr].SectorsPerBlock DIV 2),' Kb.');
if MaxAllowedBlocks=$40000000
then writeln
else writeln(' Restriction: ',MaxAllowedBlocks*4,' Kb.');
end;
end;
if nwBindry.Result=$FC { NO_SUCH_OBJECT, indicates end of search }
then writeln('')
else writeln('error scanning bindery:',HexStr( nwBindry.Result,2));
end.

111
NWTP/XFILE/VOLSTAT.PAS Normal file
View File

@@ -0,0 +1,111 @@
{$X+,B-,V-} {essential compiler directives}
program volstat;
{ Example for the nwFile unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: Lists all volume information for each volume on all
servers logged in to. If used with the parameter 'c',
the volume information will be displayed in a condensed
form and will be updated every 5 seconds.
Tests the following functions in the nwDir Unit:
GetVolumeUsage
GetVolumeName
GetVolumeNumber
(3410) Thu 10 Feb 94 11:24
By: Frank Van.Wensveen
To: All
Re: MULTISERVER VOLINFO
St:
------------------------------------------------------------
Ik zoek z.s.m. een utility waarmee ik de volspace van meerdere
servers tegelijk in de gaten kan houden. Een soort multi-server
VolInfo dus. Er zijn pakketten om dat heel mooi te doen (ik heb
er zelfs een ter evaluatie liggen momenteel) maar ik zoek nu
even snel (want de nood is hoog) iets eenvoudigs.
FVW
---
* Origin: * NGN Point-Service -31-4752-6190 * (2:512/250) }
Uses Crt,nwMisc,nwBindry,nwConn,nwFile;
CONST testing=TRUE;
Var volNbr:Byte;
volumeName:String;
volInfo:TvolUsage;
cont:Boolean;
ConnId,OldConnId:Byte;
ServerName:string;
version:word;
Begin
If NOT (IsShellLoaded and IsUserLoggedOn)
then begin
writeln('VolStat requires:');
writeln(' -The shell to be loaded;');
writeln(' -You to be logged in.');
halt(1);
end;
GetNWversion(version);
if version<300
then begin
writeln('Netware 3.x only.');
halt(1);
end;
cont:=(ParamCount>0) and ((pos('c',paramstr(1))>0) or (pos('C',paramStr(1))>0));
GetPreferredConnectionId(OldConnId);
REPEAT
clrscr;
For ConnId:=1 to MaxServers
do begin
IF GetFileServerName(connId,ServerName)
then begin
SetPreferredConnectionId(connId);
volNbr:=0;
While volNbr<32
do begin
If GetVolumeUsage(volNbr,volInfo)
then with volInfo
do begin
if cont { condensed output }
then begin
writeln('\\'+Servername+'\'+VolumeName);
writeln(' VS: ',totalblocks*(sectorsPerBlock div 2),' ',freeblocks*(sectorsperBlock div 2),' '+
'DE: ',totalDirentries,' ',AvailDirEntries);
end
else begin { normal output }
writeln;
writeln('Servername : ',ServerName);
writeln('Volumenumber: ',volNbr);
writeln('Volume name : ',volumeName);
writeln('Blocksize : ',SectorsPerBlock * 512,' bytes.');
writeln('Total blocks: ',totalblocks,' (=',(totalblocks * (sectorsPerBlock div 2)),' Kb.)');
writeln('Free blocks : ',freeblocks,' (=',(freeblocks * (sectorsPerBlock div 2)),' Kb.)');
writeln('Purgable blocks : ',purgableblocks,' (=',
purgableblocks * (sectorsPerBlock div 2),' Kb.)');
writeln('TotalDirEntries : ',totalDirEntries);
writeln('Available DE : ',availDirEntries);
end;
end;
inc(volNbr);
end;
end;
end;
if cont
then delay(5000); { 5 second interval }
UNTIL KeyPressed or (not cont);
SetPreferredConnectionId(OldConnId);
end.

1644
NWTP/XIPX/APPN9001.TXT Normal file
View File

File diff suppressed because it is too large Load Diff

288
NWTP/XIPX/APPN9008.TXT Normal file
View File

@@ -0,0 +1,288 @@
(Note: AppNote August 1990)
A Comparison of NetWare IPX, SPX and NetBIOS
Bill Bodine
Consultant
Systems Engineering Division
Abstract:
One of the first questions always asked during comparisons of NetWare
IPX, SPX and NetBIOS is which of these protocols will transfer data
the fastest, and how much slower the others are. This AppNote details
the results of four benchmarks written to illustrate the relative
speed of each of these communication interfaces. Performance, maximum
packet length, naming capabilities and memory usage are each singled
out as additional factors in the decision to implement systems using
these protocols. Clarification and explanation of SHELL.CFG parameters
are also included.
Novell, Inc. makes no representations or warranties with respect to
the contents or use of these Application Notes, or any of the third-party
products discussed in the AppNotes. Novell reserves the right to revise
these Application Notes and to make changes in their contents at any
time, without obligation to notify any person or entity of such revisions
or changes. These AppNotes do not constitute an endorsement of the
third-party product or products that were tested. The configuration
or configurations tested or described may or may not be the only available
solution. Any test is not a determination of product quality or
correctness, nor does it ensure compliance with any federal, state or local
requirements. Novell does not warranty products except as stated in
applicable Novell product warranties or license agreements.
Copyright { 1990 by Novell, Inc., Provo, Utah. All rights reserved.
As a means of promoting NetWare Application Notes, Novell grants you
without charge the right to reproduce, distribute and use copies of
the AppNotes provided you do not receive any payment, commercial benefit
or other consideration for the reproduction or distribution, or change
any copyright notices appearing on or in the document.
Introduction
When Novell began operations in 1982, several proprietary protocols
for transferring data between workstations were used. As time went
on, the decision was made to base Novell's network communications
on a fast and efficient networking standard. Xerox's XNS protocol
was determined to be one of the best available at the time so Novell's
Internetwork Packet Exchange (IPX) protocol was developed to conform
to the XNS standard. NetWare IPX is functionally equivalent to Xerox's
Internet Datagram Protocol (IDP).
This AppNote discusses the three primary peer-to-peer protocols
that are supported in the NetWare LAN environment-NetWare IPX, SPX
and NetBIOS. Additional protocols supported include the Transport
Layer Interface (TLI), Named Pipes, LU6.2 and others, but are not
covered in this AppNote.
NetWare IPX
NetWare IPX is a true datagram protocol. It makes a best-effort
attempt to send packets by using a 12-byte addressing scheme.
The 12-byte address is split into three addresses: the network
address, which is used to address individual workgroups; the node
address, which addresses network nodes within the workgroups; and
the socket address, which can be used to multiplex between functions
within a network node. When sending an NetWare IPX packet from one
node to another, the sending node must know the receiving node's 12-byte
address.
SPX
The Sequenced Packet Exchange protocol (SPX) is a connection-oriented
communications protocol that is built upon NetWare IPX. When a call
is made to SPX to send a packet by an application program, SPX will
do some housekeeping-type work on the packet, but will call NetWare
IPX to actually send the packet. SPX guarantees packet delivery, whereas
NetWare IPX only gives a best effort to deliver packets. This added
feature of SPX has obvious advantages, but as we shall see later in
the paper, it also adds overhead to the data transfer cycle and is
slower.
NetBIOS
The Network Basic Input/Output System (NetBIOS) functions in either
a connectionless mode or a connection-oriented mode. An application
written to the NetBIOS interface can be designed to use either of
these modes. For instance, if an application functions in a request/reply
mode with a transfer size of only one packet, then the connectionless
mode should be used to take advantage of connectionless response times.
On the other hand, if most of the transfers are one-sided or consist
of large numbers of packets, the transfers should use the connection-
oriented mode in order to ensure packet delivery and integrity of data.
Novell's NetBIOS emulator is built upon NetWare IPX in the same way
that SPX is.
The NetBIOS emulator is called an emulator because it is implemented
entirely in software, whereas the original NetBIOS introduced by IBM
and Sytek was located in firmware.
Because NetBIOS was introduced by IBM, it was almost instantly accepted
as an industry standard. Most networking vendors have implemented
the specification given by IBM that allows almost any application
written to the NetBIOS interface to operate in any environment.
A common problem with the NetBIOS specification, however, is that
it only deals with the upper layer functions of the interface. It
does not specify what communications protocol should be used underneath
it. As a result, almost every networking vendor has written NetBIOS
on top of their own proprietary communications protocol, which cannot
communicate with other vendors' protocols.
A nice feature that NetBIOS has to offer the networking industry is
its allowance of easy address resolution among locally-connected
workstations. All nodes on a network that use NetBIOS register a unique
name. When a node desires to communicate with another node, all it
needs to know is the node's unique NetBIOS name and NetBIOS will ensure
that the packet arrives at the proper location.
Performance Results
One of the first questions regarding the comparison of NetWare IPX,
SPX and NetBIOS is which of these protocols will transfer data the
fastest, and how much slower the others are. As part of this AppNote,
four benchmarks have been written to illustrate the relative speed
of each of these communications interfaces. The scope of the benchmark
is relatively simple-to send 2,000 255-byte packets and to record
the time that it takes for the transfer to complete. All the programs
were written by the same person and were intentionally kept as simple
as possible to make each benchmark represent the speed of the interface
and not efficiencies or lack thereof in the benchmark tests.
Each of the benchmarks encompassed two programs. One program
was used to send packets and the other was used to receive. The sending
side sent a packet and then incremented a counter. Before the packet
was sent, a call was made by the sender to the system clock. Once
the 2,000th packet had been sent successfully, another call was made
to the system clock. The first value was subtracted from the second
and the result represented the time in clock ticks that it took to
send 2,000 packets on the given communication interface. The receiving
side did nothing but receive packets and count the number that arrived.
No other processing took place within the code.
The following results were achieved on standard 8MHz 80286-based
machines on a 4MB Token-Ring network. While the test does not
represent any real-world scenario, it does indicate the relative
speed of each interface tested.
NetWare IPX 366.0 packets per second
SPX 140.3 packets per second
Novell NetBIOS datagram 224.8 packets per second
Novell NetBIOS session 135.9 packets per second
NetWare IPX is the fastest protocol available from Novell. This is
expected since all others are written in terms of NetWare IPX. SPX
and NetBIOS are slower than NetWare IPX due to the extra overhead
they introduce into the communications process. SPX and the NetBIOS
session level interface run at virtually the same speed. They both
have to maintain the same level of connection overhead for the
guaranteeing of packets and are both written in terms of another
interface.
Other Decision Criteria
There are a few primary differences between writing an application
to NetWare IPX or SPX and writing an application to NetBIOS. Two of
these differences deal with the maximum length of packets that can
be sent and the address resolution.
Maximum Packet Length
With NetWare IPX and SPX the maximum packet size that can be sent
by an application depends on either of two things. If the packet to
be sent must cross a NetWare bridge, the maximum packet size possible
is 576 bytes. The bridge will drop any packets that exceed this size.
On the other hand, if the packet will not be crossing any bridges,
the network interface card (NIC) drivers limit the size. While most
drivers allow packets of 1,024 bytes or larger to be transferred,
NetWare documentation recommends that the maximum size transferred
be 576 bytes. This is in case the packet crosses a bridge or the driver
cannot handle larger packets.
NetBIOS allows an application to send packets up to 64KB in size.
This is possible because the NetBIOS emulator breaks the packet into
smaller packets for the application and sends them out in sizes that
can be handled by NetWare IPX and the NIC drivers. While this feature
is useful, some developers choose to split packets up themselves in
order to optimize the NetWare IPX bandwidth for their application.
This may or may not be a factor in different situations.
Naming Capabilities
The second primary difference is the naming capability supplied with
NetBIOS. NetBIOS makes it convenient for an application to determine
the addresses of other nodes on the network. Each workstation identifies
itself with a particular name. Once any other workstation on the LAN
knows that name, data can be sent between the two workstations.
Novell recognized the need for this easy address resolution when it
developed NetWare IPX, so the Service Advertising Protocol (SAP) was
developed. With SAP, a node advertises, or broadcasts to the entire
network its name and address. This name and address are stored internally
on all NetWare network file servers. When any other node wants to
find an address, it queries a NetWare file server and the necessary
information is returned. There are also other ways of finding an address
without accessing the NetWare file server, but they are not as common.
Both of these methods have advantages and disadvantages. While it
is probably easier for an application with the naming capability of
NetBIOS to be developed, using the SAP provided by NetWare does not
require much more work. The advantage gained by using the SAP is that
once the address is resolved, the underlying protocol is very fast.
The SAP is designed for a client-server environment, which means
that a client always initiates a dialogue with the server. The client
can always find the server's address through the SAP. Since all packets
on the network contain the 12-byte address of the node they were
sent from, the server will know which address to send responses to.
Memory Usage
When an application runs on a network workstation, particularly in
the DOS environment, the amount of memory that is free for the application
to use is often a primary concern. In NetWare the first software to
load on the network is a terminate-and-stay-resident (TSR)
program called IPX.COM. This program contains all the interfaces needed
to run NetWare IPX programs and SPX, and uses about 14KB of workstation
memory. This is the only piece of NetWare software that needs to be
run in the workstation if no communications are needed with any file
servers. If a file server is needed, the TSR NET3.COM is loaded after
IPX.COM. This program contains all the functions needed by the workstation
to communicate with any NetWare file server on the LAN. It uses about
38KB of workstation memory. NetBIOS is an optional TSR like NET3.
IPX.COM must be loaded first. When NetBIOS is loaded it takes up about
30KB of workstation memory. Just as NET3 is only used when communications
are sent to a NetWare file server, NetBIOS is only run if an application
needs to use the NetBIOS services. Native NetWare does not use NetBIOS
for any of its communications services.
Appendix A lists parameters that have been modified in the recent
versions of NetBIOS. Because of the differences among versions, they
will be discussed as they relate to the specific versions.
The values listed in Appendix A are approximates. It is not possible
to state exactly how much memory any of the three protocols will use
up because they all contain custom parameters that change their sizes
and configurations. The parameters that alter these configurations
are located in a file named SHELL.CFG. As IPX.COM or NetBIOS.EXE is
loaded, it looks for this file in the local directory or a search
directory. Once it locates SHELL.CFG it searches within the file to
determine if any of its default parameters have been altered. These
parameters can be configured from within the SHELL.CFG file. Appendix
B of the NetWare Supervisor Reference manual also explains
the parameters.
Conclusion
While the primary advantage of writing to NetWare IPX is speed, the
main advantage of writing to NetBIOS is that the application will
work on other environments in addition to NetWare. This should obviously
be considered for applications that are marketed on a variety of platforms.
Even though different vendors' NetBIOSs can rarely communicate with
each other, most applications do port well over these vendors'
implementations.
There are a variety of reasons applications are developed to
one protocol or another. One reason a protocol is chosen is because
it is perceived as the defacto standard. For many developers, NetBIOS
is seen as a standard. Applications are developed to that platform
for reasons of portability to a variety of environments. On the other
hand, many developers are developing to NetWare IPX because they recognize
NetWare's large market share and want to reach the greatest market
possible with the most efficient protocol available.
Sometimes, one protocol may be perceived as easier to develop to than
another. Of course whether one is actually easier than another depends
entirely on the resources that are available, such as the Novell C
Interface libraries for NetWare IPX and SPX, the experience of the
development team or even available documentation and training.
Appendix A: SHELL.CFG Parameters
******* Note: The appendix (mostly outdated info) has been removed ********

758
NWTP/XIPX/BLTS9401.TXT Normal file
View File

@@ -0,0 +1,758 @@
ARTICLES: IPX/SPX for NetBIOS Developers
Original article: (c) Copyright Novell, 1994
Novell Professional Developer BULLETS
January 1994 (Volume 6, Number 1)
NwTP additions : (between angular brackets/ minus signs [- ... -])
NetBIOS is a popular peer-to-peer communication method that it is
supported under NetWare through a NetBIOS emulator. However, even though
NetBIOS is supported, there are definite advantages to using Novell's
"native tongue" protocols, IPX (Internet Packet eXchange) and SPX
(Sequenced Packet eXchange), when doing peer-to-peer communication.
This article discusses the advantages of using IPX/SPX and provides an
introduction to Novell's IPX and SPX protocols for developers who have a
working familiarity with NetBIOS.
Why Use IPX/SPX?
The most obvious reason to use IPX and SPX is to improve performance;
since NetWare emulates NetBIOS, processing NetBIOS commands involves more
overhead than processing IPX/SPX commands. NetWare encapsulates emulated
NetBIOS packets within IPX packets before they go out on the wire, so
moving to IPX/SPX allows you to "cut out the middleman."
You lose no connectivity by switching protocols either, since the
emulated NetBIOS layer cannot communicate with hardware NetBIOS systems.
In fact, moving to IPX/SPX gives you a net gain in connectivity; NetWare
has a 70% share of the network operating system market.
Also, since the NetBIOS emulator adds an additional layer of complexity
to packets being sent out, it is more difficult to troubleshoot problems.
Emulating NetBIOS involves an extra driver and an extra set of potential
incompatibilities. Generally speaking, since IPX and SPX are not
dramatically different from NetBIOS, it makes your job easier to work
with the protocols that NetWare is designed to support.
Datagram Services
Novell's IPX protocol provides almost the same functionality as NetBIOS
datagrams. Both specifications deliver packets on a best-effort basis,
but with no guarantee of delivery or sequencing. Both IPX and NetBIOS
also provide the capability to send packets either to a single node or to
multiple nodes. NetBIOS supports the multicast, or the sending of a
datagram to a selected group of nodes with the same group name. Since IPX
is address-based instead of name-based, this capability is not directly
supported; instead IPX must send an individual packet to each node.
NetBIOS also supports the broadcast datagram, a datagram that is
broadcast to the entire internetwork. IPX supports broadcasts, but only
to one subnet at a time. Usually, this restriction poses no problem,
since mechanisms such as the NetWare Service Advertising Protocol (SAP)
overcome this limitation.
The data portion of a NetBIOS datagram is limited in length to 512 bytes,
whereas IPX packets allow 546 bytes of data on all networks and can
sometimes be substantially larger than that depending on the maximum
packet size supported by network routers. Some networks can handle packet
sizes of 4096 bytes or more.
Session Services
As in the relationship between IPX and NetBIOS datagrams, Novell's SPX
protocol serves much the same function as the NetBIOS session. Both SPX
and NetBIOS sessions provide guaranteed delivery and sequencing of
packets, but at the cost of increased overhead.
The primary difference between the two is the supported packet size.
NetBIOS sessions support 64K packet sizes (128K with Chain Sends). SPX
has the same 546-byte packet size limitation as IPX and, in fact, SPX
allows slightly less data in a packet than IPX, since the SPX header
requires an additional 12 bytes. SPX therefore supports 534 bytes of data
on all networks with the potential for much larger packets if supported
by the routers, although attaining a 64K packet size is unlikely.
Probably the most noticeable difference between IPX/SPX and NetBIOS is
how each addresses packets. IPX/SPX addresses packets using network,
node, and socket numbers. NetBIOS uses unique names to address packets.
Each workstation can be uniquely addressed using the network and node
numbers.
A workstation can then have as many open sockets as desired for receiving
peer-to-peer data packets. Many methods exist for determining a
workstation's network, node, and destination socket number, but for
simplicity the example code in this article uses SAP to obtain this
information.
The Waiting Game
With NetBIOS, you can choose to allow most NetBIOS commands to complete
before returning control to the application, but most IPX/SPX commands
return control immediately. In other words, most IPX/SPX commands are
"no-wait" commands; there is no IPX/SPX "wait" counterpart.
Since most NetBIOS developers use the "no-wait" variants, this difference
should not pose a problem, but if you need to use a "wait," you can code
it very simply by issuing the command and then looping on the in use
field.
Asynchronous Events
IPX/SPX also has a feature that is not used with NetBIOS: the
asynchronous event. An asynchronous event can be initiated at any time
and, as the name implies, can be set to occur independent of an
application's execution path. An event could be set up, for example, to
automatically broadcast an IPX packet every 45 seconds. The application
initiating this event could then continue processing and leave the timing
and broadcasting of packets to the IPX event handler.
The Network Control Block & the Event Control Block
From a developer's perspective, the "core" of NetBIOS is the Network
Control Block (NCB). IPX and SPX are based on an Event Control Block
(ECB) and an IPX/SPX header. Figure 1 describes the fields in the ECB.
*********************************************************
Figure 1: The IPX/SPX Event Control Block [- C structure -]
void far *linkAddress Set by IPX
void (far *ESRAddress)() Equivalent to NetBIOS POST routine
BYTE inUseFlag Set when the ECB is in use, zero
when it is available
BYTE completionCode Equivalent to NetBIOS Command
Completion
WORD socketNumber Socket number associated with ECB
BYTE IPXWorkspace[4] Set by IPX
BYTE driverWorkspace[12] Set by IPX
BYTE immediateAddress[6] Node address of next "hop"
WORD fragmentCount Number of buffer fragments in packet
ECBFragment fragmentDescriptor[2] Address and size of fragment(s)
END of FIGURE 1
*********************************************************
[- *********************************************************
Figure 1a: The IPX/SPX Event Control Block (Pascal syntax)
linkAddress :Pointer Set by IPX
ESRAddress :Pointer Equivalent to NetBIOS
POST routine
InUseFlag :Byte; Set when the ECB is in use,
zero when it is available
CompletionCode :Byte; Equivalent to NetBIOS Command
Completion
SocketNumber :Word; Socket number associated
with ECB
IPXWorkspace :array[1..4] of byte; Set by IPX
DriverWorkspace :array[1..12] of byte; Set by IPX
ImmediateAddress:array[1..6] of byte; (Tnodeaddress)
Node address of next "hop"
FragmentCount :word; Number of buffer fragments
in packet
Fragment :array[1.. ] of Tfragment Address and size of
fragment(s)
(Note: this structure is declared as the Tecb type in the nwIPX unit)
END of FIGURE 1a
********************************************************* -]
Note that the ECB contains a field that has no equivalent in the NCB
called the immediate address field. This field should be populated with
the node address of the first "hop" on the way to the packet's ultimate
destination. Novell provides an API call to populate this field, the
IPXGetLocalTarget() API available in the NetWare Client SDK.
IPX Send Example
The sample code in this article includes simple examples written under
DOS with the NetWare Client SDK. Figure 2 shows a routine sending an IPX
packet.
*********************************************************
Figure 2: IPX Send [- C example -]
/* Send "Hello!" to the station at network 0x11111111, node
0x222222222222, socket 0x3333 using IPX */
void IPXSayHello()
{
char buffer[] = "Hello!";
ECB ecb;
IPXHeader header;
int transTime;
header.packetType = 4;
memset(header.destination.network, 0x11, 4);
memset(header.destination.node, 0x22, 6);
memset(header.destination.socket, 0x33, 2);
ecb.ESRAddress = NULL;
ecb.socketNumber = 0x4444;
IPXGetLocalTarget(header.destination,
ecb.immediateAddress, &transTime);
ecb.fragmentCount = 2;
ecb.fragmentDescriptor[0].address = &header;
ecb.fragmentDescriptor[0].size = sizeof(IPXHeader);
ecb.fragmentDescriptor[1].address = buffer;
ecb.fragmentDescriptor[1].size = strlen(buffer) + 1;
IPXSendPacket(&ecb);
}
END of FIGURE 2
*********************************************************
[- *********************************************************
Figure 2a: IPX Send (Pascal example)
{ Send "Hello!" to the station at network $11111111, node
$222222222222, socket $3333 using IPX }
Procedure IPXSayHello;
Var buffer:string;
ecb:Tecb;
header:TipxHeader;
transTime:Word;
begin
Buffer:="Hello!";
header.packetType := 4;
FillChar(header.destination.network,4,$11);
FillChar(header.destination.node, 6,$22);
FillChar(header.destination.socket, 2,$33);
ecb.ESRAddress:=NIL;
ecb.socketNumber:=$4444;
IPXGetLocalTarget(header.destination,
ecb.immediateAddress, transTime);
ecb.fragmentCount:=2;
ecb.fragment[1].address:= @header;
ecb.fragment[1].size := SizeOf(TIPXHeader);
ecb.fragment[2].address:= @buffer[1];
ecb.fragment[2].size:= ord(buffer[0]);
IPXSendPacket(ecb);
end;
END of FIGURE 2a
********************************************************* -]
The first apparent difference between IPX and NetBIOS is that IPX uses
two buffers where NetBIOS would use one. The first buffer is the IPX
Header containing the source and destination addresses, the packet type,
and several "housekeeping" fields. Refer to Figure 3 for a description of
the IPX header.
*********************************************************
Figure 3: IPX Header
WORD checkSum Included to conform to Xerox IDP standard
Set to FFFF by IPX
WORD length Length of entire IPX packet including
header
Set by IPX
BYTE transportControl Hop count - Set to zero by IPX
BYTE packetType IPX packet type is 4
IPXAddress destination Address the packet is sent to
[- Pascal: of type TInternetworkAddress -]
IPXAddress source Address of node sending packet set by IPX
[- Pascal: of type TinternetworkAddress -]
END of FIGURE 3
*********************************************************
The second buffer is the data to be sent. Two fields in the IPX header
must be set for an IPX send: the packet type and the destination address.
IPX packets are type 4, SPX packets are type 5. [- Note that according
to the original xerox definitions this statement is not correct. Type 4
packets are reserved for the PEP protocol. Use type 0 (undefined) when
transmitting standard IPX packets-] The destination address consists
of a four-byte network number, a six-byte node number, and a two-byte
socket number.
If these examples used an Event Service Routine (ESR), the ESR address
would be filled with the address of a procedure to be run when the send
completes, but since NULL is specified, this routine will not be run. The
ESR is equivalent to the NetBIOS POST routine. When the IPX send
executes, the rest of the fields in the IPX header are filled in
automatically, including the source address. You must specify the socket
number to be included in the source address, but the socket need not be
open to send a packet. For this example, socket number 0x4444 was
arbitrarily chosen.
The immediate address field described above must be filled in as well,
and the IPXGetLocalTarget() API call fills in this field with the
appropriate value. It is passed the final destination of the packet and
it calculates the address of the "first hop" on the way to the final
destination. Note that if the target workstation is on the same subnet as
the sending workstation the immediate address will be the same as the
final destination. Otherwise, it will be a bridge or router on the
subnet.
Each of the buffers sent in the IPX packet is considered to be a
fragment. Since there are two buffers (the IPX header and the data), the
fragment count is equal to two. The address and size of the fragments are
then entered, starting with the IPX header. As soon as all of the
relevant fields are filled, the example calls IPXSendPacket() and passes
it the address of the ECB.
Receiving an IPX packet is much like sending one from a programming
standpoint, except that you do not need to set the IPX header fields. In
the ECB, you should set the ESR address, socket number, immediate
address, and fragment descriptors.
Note about socket numbers: the socket number specified for an IPX send
does not need to be open, but for an IPX receive the socket must be open.
The API call to receive an IPX packet is IPXListenForPacket().
SPX Connection Example
Figure 4 contains a code sample that establishes an SPX connection.
Before the request for an SPX connection is submitted, several ECBs are
already listening for data (this is important). SPX temporarily "steals"
two ECBs from the available and waiting ones for connection maintenance,
and then it puts the stolen ECBs back in the pool when finished. If there
are no pending ECBs for SPX to use, it cannot send an acknowledgement to
the remote site and the connection will stall and time out.
*********************************************************
Figure 4: Establishing an SPX Connection [- C code example -]
/* Start an SPX connection with the station at network
0x11111111, node 0x222222222222, socket 0x3333, use
local socket 0x4444 */
#define NUM_BUFFS 5
void call()
{
ECB send, receive[NUM_BUFFS], connect, term;
SPXHeader sendHdr, rcvHdr[NUM_BUFFS], connHdr;
char buffer[NUM_BUFFS][80], sendbuf[] = "Hello!";
int i, ccode, packetsReceived;
WORD spxConnectionID;
for (i = 0; i < NUM_BUFFS; i++) {
receive[i].ESRAddress = NULL;
receive[i].socketNumber = 0x4444;
receive[i].fragmentCount = 2;
receive[i].fragmentDescriptor[0].address
= &(rcvHdr[i]);
receive[i].fragmentDescriptor[0].size
= sizeof(SPXHeader);
receive[i].fragmentDescriptor[1].address
= &(buffer[i]);
receive[i].fragmentDescriptor[1].size = 80;
SPXListenForSequencedPacket(receive[i]);
}
connect.ESRAddress = NULL;
connect.socketNumber = 0x4444;
connect.fragmentCount = 1;
connect.fragmentDescriptor[0].address = &connHdr;
connect.fragmentDescriptor[0].size
= sizeof(SPXHeader);
memset(connHdr.destination.network, 0x11, 4);
memset(connHdr.destination.node, 0x22, 6);
memset(connHdr.destination.socket, 0x33, 2);
ccode = SPXEstablishConnection(0, 0,
&spxConnectionID,
&connect);
printf("SPXEstablishConnection return code
= 0x%x\n", ccode);
if (ccode != 0)
return;
while (connect.inUseFlag != 0)
IPXRelinquishControl();
if (connect.completionCode != 0)
return;
send.ESRAddress = NULL;
send.fragmentCount = 2;
send.fragmentDescriptor[0].address = &sendHdr;
send.fragmentDescriptor[0].size = sizeof(SPXHeader);
send.fragmentDescriptor[1].address = sendbuf;
send.fragmentDescriptor[1].size = 7;
SPXSendSequencedPacket(spxConnectionID, &send);
packetsReceived = 0;
while (packetsReceived < 10) {
for (i = 0; i < NUM_BUFFS; i++) {
if (receive[i].inUseFlag != 0) {
if (receive[i].completionCode != 0) {
packetsReceived = 10;
/* If we get an error, terminate */
break;
}
printf("Received: %s\n", buffer[i]);
packetsReceived++;
}
SPXListenForSequencedPacket(receive[i]);
}
IPXRelinquishControl();
}
term.ESRAddress = NULL;
term.fragmentCount = 1;
term.fragmentDescriptor[0].address = &connHdr;
term.fragmentDescriptor[0].size = sizeof(SPXHeader);
SPXTerminateConnection(spxConnectionID, &term);
while (term.inUseFlag != 0)
IPXRelinquishControl();
for (i = 0; i < NUM_BUFFS; i++)
IPXCancelEvent(receive[i]);
}
END of FIGURE 4
*********************************************************
[- *********************************************************
Figure 4a: Establishing an SPX Connection (Pascal example)
{ Start an SPX connection with the station at network
$11111111, node $222222222222, socket $3333, use
local socket $4444 }
CONST NUM_BUFFS=5;
Procedure call;
Var send,connect,term:Tecb;
receive :array[1..NUM_BUFFS] of Tecb;
sendHdr, connHdr : TspxHeader;
rcvHdr :array[1..NUM_BUFFS] of TspxHeader;
buffer :array[1..NUM_BUFFS] of string[80];
sendBuf :string;
i,packetsReceived:Integer;
spxConnectionId :word;
begin;
sendbuf:="Hello!";
for i:= 1 to NUM_BUFFS
do begin
receive[i].ESRAddress := NIL;
receive[i].socketNumber := $4444;
receive[i].fragmentCount = 2;
receive[i].fragment[1].address := @rcvHdr[i];
receive[i].fragment[1].size := sizeof(TSPXHeader);
receive[i].fragment[2].address := @buffer[i];
receive[i].fragment[2].size := 80;
SPXListenForSequencedPacket(receive[i]);
end;
connect.ESRAddress := NIL;
connect.socketNumber := $4444;
connect.fragmentCount := 1;
connect.fragment[1].address := @connHdr;
connect.fragment[1].size := sizeof(TSPXHeader);
FillChar(connHdr.destination.network, 4, $11);
FillChar(connHdr.destination.node, 6, $22);
FillChar(connHdr.destination.socket, 2, $33);
IF NOT SPXEstablishConnection(0, 0,
spxConnectionID,
connect)
then begin
writeln('SPXEstablishConnection return code',
HexStr(nwSpx.result,2));
exit;
end;
while (connect.inUseFlag <> 0)
do IPXRelinquishControl();
if (connect.completionCode <> 0)
then exit;
send.ESRAddress := NIL;
send.fragmentCount := 2;
send.fragment[1].address = @sendHdr;
send.fragment[1].size := sizeof(TSPXHeader);
send.fragment[2].address := @sendbuf[0];
send.fragment[2].size := ord(sendBuf[0])+1;
SPXSendSequencedPacket(spxConnectionID, send);
packetsReceived := 0;
while (packetsReceived < 10)
do begin
for i :=1 to NUM_BUFFS
do begin
if (receive[i].inUseFlag <> 0)
and (receive[i].completionCode <> 0)
then begin
packetsReceived := 10;
exit;
{ If we get an error, terminate }
end;
writeln('Received: ", buffer[i]);
inc(packetsReceived);
SPXListenForSequencedPacket(receive[i]);
end;
IPXRelinquishControl;
end;
term.ESRAddress := NIL;
term.fragmentCount := 1;
term.fragment[1].address := @connHdr;
term.fragment[1].size := sizeof(TSPXHeader);
SPXTerminateConnection(spxConnectionID, term);
while (term.inUseFlag <> 0)
do IPXRelinquishControl;
for i:=1 to NUM_BUFFS
do IPXCancelEvent(receive[i]);
end;
END of FIGURE 4a
********************************************************* -]
This process may sound complicated, but everything happens transparently.
As long as there are extra ECBs available, the application never knows
they have been borrowed, since SPX puts them back in the exact same state
they were in when they were pressed into service.
If the connection is established with the SPX watchdog enabled, the
watchdog monitors the connection and notifies the application if the
connection fails, even if the application is not currently sending data
over the connection. This feature is useful for applications that start
SPX connections, but use them infrequently. For simplicity, however, the
example does not use the SPX watchdog.
After the listen ECBs have been posted, the connection ECB is then set up
in much the same way the IPX send ECB was, except that this ECB has only
one fragment: the SPX header. The destination network, node, and socket
also are set the same way they were in the previous example.
SPXEstablishConnection() is passed a retry count of zero, indicating that
you should use the default value for number of retries. This value is set
in the workstation's NET.CFG file using the IPX RETRY COUNT parameter,
which defaults to 20. The last zero passed in SPXEstablishConnection()
indicates not to use the SPX watchdog. The SPX connection ID is returned
as the third parameter. The SPX connection ID can be considered
equivalent to the NetBIOS local session number.
Next, the sample code attempts to establish a connection. It polls the
ECB's in use flag waiting for the event to complete. The
IPXRelinquishControl() call is very important at this stage. If the code
did nothing but sit in a tight loop, IPX and SPX would never get the
chance to do any processing. IPXRelinquishControl() allows the IPX/SPX
layer to get some work done.
Once the in use flag is set to zero, the example checks the return code
to see if the attempt to establish a connection was successful. The code
does not illustrate how to handle the various failure cases, but the most
likely cause of a failure would be that the other side is not yet
listening for a connection, just like in NetBIOS. After establishing the
connection, packets can be sent to the remote station.
The SPXSendSequencedPacket() call requires much less information than its
IPX counterpart. Since the connection is already established, all
SPXSendSequencedPacket() needs is the SPX connection ID, an ESR address,
and the fragment information.
After sending a packet, the example program waits for ten packets to
arrive. When an ECB comes back, the example displays the data and then
re-submits the ECB so that it can be used to receive a packet again.
After receiving ten packets, it issues an SPXTerminateConnection() call
to notify the other side that it is done.
The call to terminate the connection takes almost the same parameters
that the establish connection call does, except that there is no need to
fill out any information in the SPX header. Once the connection has been
terminated, the pending listen ECBs must be cancelled. To do so, the
example calls IPXCancelEvent(). Unlike most other ECB-related calls,
IPXCancelEvent() does not return until the ECB has been cancelled so
there is no need to poll the in use flag.
Event Service Routines
Event Service Routines (ESRs) serve the same purpose as the NetBIOS POST
routines, but require a little more setup than the standard POST routine.
Most ESRs are written in Assembly, although some call C functions.
Figure 5 shows a generic ESR that calls a C function after allocating its
own stack. This is very important since the amount of free stack space
(if any) at interrupt time is unknown, and any attempt by a C function to
use the stack could result in memory corruption if the stack is
overflowed. The only way to guarantee that this will not occur is to
allocate sufficient stack space in the ESR.
*********************************************************
Figure 5: Example Event Service Routine (ESR) [- C/ASM code -]
.MODEL LARGE
public _ReceiveESRHandler
extrn _ProcessReceiveData:PROC
.DATA
; The stack segment and pointer must be saved so that you can set up
; your own stack.
stk_seg dw 0 ; variable to store old stack segment
stk_ptr dw 0 ; variable to store old stack pointer
stk_stk dw 512 dup (0) ; new stack of 1024 bytes in length
stk_end dw 0 ; the end of the stack
.CODE
; @datasize is TRUE if the model is MEDIUM or LARGE and FALSE if the
; model is SMALL or COMPACT. Just modify the .MODEL ???? above for the
; model you want. ES/SI holds the seg/offset of the currently used ECB
; that ProcessReceivedData needs to process.
_ReceiveESRHandler PROC far
mov ax,DGroup
mov ds,ax
mov stk_seg,ss ; Save the stack segment
mov stk_ptr,sp ; Save the stack pointer
mov ss,ax ; move the segment of new_stk into ss
mov sp,offset stk_end ; move offset of new_stk to sp
IF @datasize
push es ; push es if mem. model medium/large
ENDIF
push si
call _ProcessReceivedData
mov ss,stk_seg ; Restore old stack segment
mov sp,stk_ptr ; Restore old stack pointer
retf
_ReceiveESRHandler ENDP
END END of FIGURE 5
*********************************************************
[- *********************************************************
Figure 5a: Example Event Service Routine (ESR) (BASM/Pascal)
{ The stack segment and pointer must be saved so that you can set up
your own stack. }
Var stk_stk:array[1..512] of word; { new stack of 1024 bytes in length }
stk_end:word; { the end of the stack }
{$F+}
Procedure ESRhandler(Var p:Tpecb); { * Type TPecb=^Tecb }
begin
.
.
end;
{$F-}
{$F+}
Procedure ListenESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stk_stk { = seg @DATA }
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stk_end
push dx { push old ss:sp on new stack }
push bx
push es { * push es:si on stack as local vars }
push si { * }
mov di,sp { * }
push ss { * push address of local ptr on stack }
push di { * }
CALL EsrHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Note that a local stack of 1024 bytes (512 words) may not be large
enough for some applications calling other functions within the
ESRhandler. Increase the stacksize by 1024 bytes at a time to
determine the stack requirement.
END END of FIGURE 5a
********************************************************* -]
Figure 6 contains a code fragment demonstrating the use of an ESR. It
receives ten SPX packets just like the example in Figure 3 does, but it
uses an ESR instead of polling the in use flag. The assembly language
routine from Figure 4 is declared as the ESR, and it in turn calls the
C [-/Pascal-] function ProcessReceivedData().
*********************************************************
Figure 6: Using an Event Service Routine (ESR) [- C Code -]
int packetCount = 0;
void ProcessReceivedData(ECB *ecb)
{
packetCount++;
printf("%s\n", ecb->fragmentDescriptor[1].address);
SPXListenForSequencedPacket(ecb); /* Re-issue the listen */
}
main()
{
.
. /* This code is identical to SPX setup code in Fig. 4, except */
. /* for receive[i].ESRAddress line, which will be as follows: */
receive[i].ESRAddress = (void (far *) () ) ReceiveESRHandler;
.
. /* The send ECB does not normally use an ESR. */
.
while (packetCount < 10)
IPXRelinquishControl();
.
. /* Shut down connection, cancel ECBs */
.
}
END of FIGURE 6
*********************************************************
[- *********************************************************
Figure 6a: Using an Event Service Routine (ESR) (Pascal)
Var PacketCount;
Procedure ProcessReceivedData(Var ECB:Tecb)
begin
inc(packetCount);
writeln(string(ecb^.fragment[2].address^));
SPXListenForSequencedPacket(ecb); { Re-issue the listen }
end;
begin { main body }
PacketCount:=0;
.
. { This code is identical to SPX setup code in Fig. 4a, except }
. { for receive[i].ESRAddress line, which will be as follows: }
receive[i].ESRAddress := @ReceiveESRHandler;
.
. { The send ECB does not normally use an ESR. }
.
while (packetCount < 10)
do IPXRelinquishControl;
.
. { Shut down connection, cancel ECBs }
.
end;
END of FIGURE 6a
********************************************************* -]
IPX and SPX may look a little more complicated than NetBIOS at first, but
as soon as you begin using these protocols, you see how similar they
really are. Using IPX/SPX requires slightly more effort, but the
performance and compatibility gains when running under NetWare more than
compensate. If you are thinking about becoming more familiar with IPX and
SPX development, feel free to contact Novell's Developer Support group at
1-800-NETWARE (1-800-638-9273) or 1-801-429-5588.

105
NWTP/XIPX/CHKVEND.PAS Normal file
View File

@@ -0,0 +1,105 @@
program chkvend;
{$I-}
{ Testprogram checking all nodes on all attached servers and
showing the manifacturers of the corresponding ethernet cards. }
uses nwMisc,nwConn,nwServ;
var PleaseMail:Boolean;
Path :string;
StationNbr : byte;
StationAddress: TinternetworkAddress;
Sinfo : TFileServerInformation;
t,conn : byte;
ObjName :string;
objType :word;
ObjId :Longint;
LoginTime:TnovTime;
s,ts,subs:string;
f :text;
fnd :boolean;
p :byte;
begin
PleaseMail:=False;
Path:=ParamStr(0);
while NOT (path[ord(path[0])] IN [':','\','/']) do dec(Path[0]);
{Path now holds the name of the path where the chkvend.exe file is located }
assign(f,Path+'VEND_XXX.');
reset(f);
IF IOresult<>0
then begin
writeln('Couldn''t open VEND_XXX');
writeln('<CHKVEND expects the file to in the same directory as the executable>');
halt(1);
end;
{ Check all 8 possible server attchments }
For conn:=1 to 8
do begin
SetPreferredConnectionId(conn);
If IsConnectionIdInUse(conn)
then begin
GetFileServerInformation(Sinfo); { Get maximum number of conections }
for t:=1 to Sinfo.ConnectionsMax
do begin
{ check all connections }
IF GetInternetAddress(t,StationAddress)
then begin
GetConnectionInformation(t,objName,objType,ObjId,LoginTime);
objname:=objName+' ';
objName[0]:=#16;
ts:=HexDumpStr(StationAddress.node,12);
{ check file if vendor's code known }
fnd:=False;
reset(f);
REPEAT
readln(f,s);
p:=pos('#',s);
if p>0 then s[0]:=chr(p-1);
p:=pos(' ',s);
if p=0
then suBs:=''
else begin
subS:=copy(s,1,p-1);
if pos(subs,ts)=1
then begin
fnd:=true;
writeln(ts,' ',objName,' -',s);
end;
end;
UNTIL eof(f) or fnd;
if (NOT fnd)
then begin
PleaseMail:=true;
writeln(ts,' ',objname,' -????');
end;
end;
end;
end;
end;
IF PleaseMail
then begin
writeln;
writeln('A number of unknown Vendor codes have been found.');
writeln('If you know the vendor(s) of the Ethernet cards in question,');
writeln('you can update the VEND_XXX. file with a text editor.');
writeln;
writeln('You are also kindly requested to mail the information to us.');
writeln('Fido : 2:512/250.4064 or 2:2426/4030.13');
writeln('InterNet: Rene.Spronk@p4064.f250.n512.z2.fidonet.org');
writeln;
end;
SetPreferredConnectionId(0);
close(f);
end.

201
NWTP/XIPX/FGET.PAS Normal file
View File

@@ -0,0 +1,201 @@
{$X+,V-,B-,I-}
program Fget; { Listening Process / receiver / Slave }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{$DEFINE noTRACE}
uses crt,nwMisc,nwIPX,nwPEP;
Var ListenECB :Tecb; { used to listen for packets }
ListenPepHdr :TpepHeader;
SendECB :Tecb; { used to send acknowledgements }
SendPepHdr :TpepHeader;
IOsocket :word;
DataBuffer :array[1..546] of byte;
SendDataBuffer:byte;
PacketReceived :Boolean;
LastTransactionID:LongInt;
NewStack:array[1..8192] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
Procedure CheckError(err:boolean; errNbr:word);
begin
if err
then begin
CASE errNbr of
$0100:writeln('IPX needs to be installed.');
$0101:writeln('ERROR: Connection not established. A Timeout occured');
$0102:writeln('ERROR: The transfer is aborted; A timeout occured.');
$0108:writeln('Transfer aborted.');
$0300:writeln('The supplied path doesn'' exist / no write rights in directory.');
$0301:writeln('Error writing to file / no write rights in directory.');
$10FE:writeln('Error opening socket: Socket Table Is Full.');
$10FF:writeln('Error opening socket: Socket is already open.');
else writeln('Unspecified error.');
end; {case}
IPXcloseSocket(IOsocket);
halt(1);
end;
end;
Function TimeOut(t1,t2:word;n:byte):boolean;
{ ticks t2 - ticks t1 > n seconds ? }
Var lt1,lt2:LongInt;
begin
lt2:=t2;
if t1>t2 then lt2:=lt2+$FFFF;
TimeOut:=(lt2-t1)>(n*18);
end;
{$F+}
Procedure ListenAndAckHandler;
begin
If (ListenECB.CompletionCode<>0)
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE)
or (ListenPepHdr.clienttype<>$EA)
or (ListenPepHdr.TransactionID<LastTransactionID) { discard dupe old packet }
then IPXlistenForPacket(ListenECB)
else begin
PacketReceived:=(ListenPepHdr.transactionID>LastTransactionID); { new packet received }
{ Acknowledge new packets and duplicates of the latest packet, }
{ as the original acknowledgement may have been lost. }
LastTransactionID:=ListenPepHdr.TransactionID;
{ Setup acknowledgement ECB and PEPheader, and send it. }
if SendECB.InUseFlag=0
then begin
ListenPepHdr.IPXhdr.source.socket:=swap(ListenPepHdr.IPXhdr.source.socket);
{ socket is hi-lo in IPX/PEPHeaders. SetupSendECB expects lo-hi }
PEPsetupSendECB(NIL,IOsocket,ListenPepHdr.IPXhdr.source,
@SendDataBuffer,0,
SendPepHdr,SendECB);
SendPepHdr.TransactionId:=LastTransactionID;
SendPepHdr.ClientType:=$EA;
IPXsendPacket(SendECB);
end;
end;
end;
{$F-}
{$F+}
Procedure ListenAndAckESR; assembler;
asm
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
CALL ListenAndAckHandler
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var ticks,ticks2 :word;
FileName:string;
FileSize:LongInt;
DirName:string;
f:file;
BytesToWrite,BytesWritten:word;
begin
IpxInitialize;
CheckError(nwIPX.result>0,$100);
If (pos('?',ParamStr(1))>0) or (paramcount>1)
then begin
writeln('Usage: FGET <directory>');
writeln('-The File sent by FSEND on another workstation');
writeln('will be copied to the supplied directory.');
halt(1);
end;
If paramcount=1
then DirName:=ParamStr(1)
else DirName:='.';
IF NOT (DirName[ord(dirName[0])] IN [':','\'])
then DirName:=DirName+'\';
assign(f,DirName+'temp.$$$');
rewrite(f,1);
CheckError(IOresult<>0,$0300);
close(f);
IOSocket:=$5678;
IPXopenSocket(IOsocket,SHORT_LIVED_SOCKET);
CheckError(nwIPX.result>0,$1000+nwIPX.result);
{ Setup of ECB and PepHeader, start listening for incoming packets. }
LastTransactionID:=0;
PacketReceived:=False;
PEPSetupListenECB(Addr(ListenAndAckESR),IOsocket,@DataBuffer,546,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
writeln('Waiting for FSEND to start sending.. (any key to abort)');
IPXGetIntervalMarker(ticks);
REPEAT
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2);
CheckError(TimeOut(ticks,ticks2,130),$101);{ error if a timeout occurred }
CheckError(Keypressed,$108);
UNTIL PacketReceived;
writeln('Handshaking.. Initiating transfer process.');
{$IFDEF TRACE}
writeln('Received PacketID:',LastTransactionID);
{$ENDIF}
{ do something with DataBuffer: the data that was just received. }
{ the first packet contains the filename and filesize }
Move(DataBuffer[1],FileName[0],15);
Move(DataBuffer[16],FileSize,4);
writeln('Receiving file ',FileName,', size: ',FileSize);
assign(f,DirName+filename);
rewrite(f,1);
BytesToWrite:=512;
REPEAT { Listen for remaining packets }
Packetreceived:=false;
While SendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXListenForPacket(ListenECB);
IPXGetIntervalMarker(ticks);
Repeat
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2);
CheckError(TimeOut(ticks,ticks2,10),$102); { error if Timeout occurred }
CheckError(Keypressed,$108);
until PacketReceived;
{$IFDEF TRACE}
writeln('Received packet#:',LastTransactionID);
{$ENDIF}
{ Write DataBuffer to disk. }
IF FileSize<512
then BytesToWrite:=FileSize;
BlockWrite(f,DataBuffer,BytesToWrite,BytesWritten);
CheckError(BytesToWrite<>BytesWritten,$0301);
FileSize:=FileSize-512;
UNTIL (FileSize<=0); { entire file received }
writeln('Transfer complete.');
IPXcloseSocket(IOsocket);
close(f);
end.

255
NWTP/XIPX/FSEND.PAS Normal file
View File

@@ -0,0 +1,255 @@
{$X+,V-,B-,I-}
program Fsend; { Master / Sender }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{$DEFINE noTRACE}
uses dos,crt,nwMisc,nwBindry,nwConn,nwIPX,nwPEP;
CONST IOSocket=$5678; { socket to transmit/receive on }
Var ListenECB :Tecb; { ECB and header, to listen for acknowledgement }
ListenPepHdr :TpepHeader;
SendECB :Tecb; { ECB and header, used to send the data }
SendPepHdr :TpepHeader;
socket :word;
SendDataBuffer :array[1..546] of byte; { SendDataBufferfer for data to be sent }
ListenDataBuffer:array[1..8] of byte;
AckReceived :boolean; { set to true within the ListenForAckESR }
SendTransId :LongInt; { transactionID. This uniquely identifies
the packet. The slave/receiver has to
reply with the same transactionID in the
header of the acknowledgement. Only if
this number is the same as the transactioID
of the sent packet, the pavket is considered
successfully delivered. }
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
f:file;
Procedure CheckError(err:boolean; errNbr:word);
begin
if err
then begin
writeln;
CASE errNbr of
$0100:writeln('IPX needs to be installed.');
$0200:writeln('Error: can''t locate the spcified username.');
$0201:begin
writeln('The specified user has multiple connections.');
writeln('This demonstation program doesn''t support multiple connections.');
end;
$0202:writeln('Error: can''t find the address of the supplied username.');
$0204:writeln('Transfer aborted after 50 retries.');
$0205:writeln('Key pressed: Transfer aborted.');
$0206:writeln('The supplied file couldn''t be found. Please supply full path.');
$0300:writeln('Error reading file.');
$10FE:writeln('Error opening socket: Socket Table Is Full.');
$10FF:writeln('Error opening socket: Socket is already open.');
end; {case}
IPXcloseSocket(IOsocket);
close(f);
halt(1);
end;
end;
Function TimeOut(t1,t2:word;n:byte):boolean;
{ ticks t2 - ticks t1 > n seconds ? }
Var lt1,lt2:LongInt;
begin
lt2:=t2;
if t1>t2 then lt2:=lt2+$FFFF;
TimeOut:=(lt2-t1)>(n*18);
end;
{$F+}
Procedure ListenForAckHandler(Var p:TPecb);
{ Interrupts are turned off -and should remain turned off- }
begin
IF (ListenECB.CompletionCode<>0) { packet must be suucessfully received.. }
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE) { of type PEP.. }
or (ListenPepHdr.ClientType<>$EA) { of client type $EA }
or (ListenPepHdr.TransactionID<>SendTransId) { with a correct clientID (of the packet the master sent) }
then IPXListenForPacket(ListenECB) { Invalid packet => listen again }
else AckReceived:=true; { valid packet => ACK received ! }
end;
{$F-}
{$F+}
Procedure ListenForAckESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
{ interrupts are turned off -and should remain turned off- }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL ListenForAckHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var dest:TinternetworkAddress;
ticks,ticks2:word;
retries :word;
Uname,Fname:string;
NbrOfConn:byte;
connList:TconnectionList;
p:byte;
FileInfo:searchrec;
FileSize:LongInt;
BytesRead:word;
TransferStartTicks,TransferEndTicks:word;
OriginalFileSize:LongInt;
begin
If paramcount<>2
then begin
writeln('Usage: FSEND <username> <filename>');
writeln('-The file will be sent to the workstation of the supplied username.');
writeln('-Run FGET on that workstation to receive the file.');
halt(1);
end;
Uname:=ParamStr(1);
UpString(Uname);
NbrOfConn:=0;
GetObjectConnectionNumbers(Uname,OT_USER,NbrOfConn,connList);
CheckError((nwConn.result>0) or (NbrOfConn=0),$200);
CheckError(NbrOfConn>1,$0201);
GetInternetAddress(connList[1],dest);
CheckError(nwconn.result>0,$0202);
dest.socket:=IOsocket;
Fname:=ParamStr(2);
Assign(f,Fname);
Reset(f,1);
CheckError(IOresult<>0,$0206);
IpxInitialize;
CheckError(nwIPX.result>0,$0100);
socket:=IOSocket;
IPXopenSocket(Socket,SHORT_LIVED_SOCKET);
CheckError(nwIPX.result>0,$1000+nwIPX.result);
{ setup listening for ack }
AckReceived:=False;
PEPsetupListenECB(Addr(ListenForAckESR),IOsocket,@ListenDataBuffer,8,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
{ send initial packet with the name and size of the file to be sent. }
findfirst(Fname,$FF,FileInfo);
Move(FileInfo.size,SendDataBuffer[16],4);
FileSize:=Fileinfo.size;
p:=length(Fname);
while (p>0) and (Fname[p]<>':') and (Fname[p]<>'\')
do dec(p);
If p>0
then delete (Fname,1,p);
Move(Fname[0],SendDataBuffer[1],15);
PEPsetupSendECB(NIL,IOsocket,dest,@SendDataBuffer[1],512,
SendPepHdr,SendECB);
SendTransID:=1;
SendPepHdr.ClientType:=$EA;
OriginalFileSize:=FileSize;
FileSize:=FileSize+512; { compensate length for information header }
writeln('FSEND waiting for remote handshake. (any key to abort)');
While Filesize>0
do begin
ackreceived:=false;
SendPepHdr.TransactionId:=SendTransId;
IPXsendPacket(SendECB);
{$IFDEF TRACE}
write('Packet#',SendTransID,' sent.');
{$ENDIF}
while sendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
retries:=0;
REPEAT
IPXrelinquishcontrol;
IPXGetIntervalMarker(ticks2);
if (ticks2-ticks)>2
then begin
inc(retries);
{$IFDEF TRACE}
writeln;
write('Timeout: resending packet#',SendTransID);
{$ENDIF}
IPXsendPacket(SendECB);
while sendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
end;
CheckError(retries>50,$0204);
CheckError(Keypressed,$0205);
UNTIL AckReceived;
if SendTransID=1
then begin
writeln('Handshake received. Starting file transfer.');
IPXGetIntervalMarker(TransferStartTicks);
end;
{$IFDEF TRACE}
writeln(' Ackn.#',ListenPepHdr.TransactionID,' received.');
{$ENDIF}
FileSize:=FileSize-512;
{ fill buffer with next block of data }
IF FileSize>0
then begin
BlockRead(f,SendDataBuffer,512,bytesread);
CheckError((bytesread<512) and (filesize<>bytesread),$0300);
end;
inc(SendTransID);
IPXListenForPacket(ListenECB); { start listening for acks again }
end;
IPXGetIntervalMarker(TransferEndTicks);
IPXcancelEvent(ListenECB);
Writeln('Transfer completed.');
writeln('Throughput: ', 18*OriginalFileSize/(TransferEndTicks-TransferStartTicks):4:2,' bps');
IPXcloseSocket(IOsocket);
close(f);
end.

230
NWTP/XIPX/M1_PEP.PAS Normal file
View File

@@ -0,0 +1,230 @@
{$X+,V-,B-,I-}
program M1_PEP; { Master / Sender }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
uses dos,crt,nwMisc,nwBindry,nwConn,nwIPX,nwPEP;
CONST IOSocket=$5678; { socket to transmit/receive on }
Var ListenECB :Tecb; { ECB and header, to listen for acknowledgement }
ListenPepHdr :TpepHeader;
SendECB :Tecb; { ECB and header, used to send the data }
SendPepHdr :TpepHeader;
socket :word;
SendDataBuffer :array[1..546] of byte; { SendDataBufferfer for data to be sent }
ListenDataBuffer:array[1..8] of byte;
AckReceived :boolean; { set to true within the ListenForAckESR }
SendTransId :LongInt; { transactionID. This uniquely identifies
the packet. The slave/receiver has to
reply with the same transactionID in the
header of the acknowledgement. Only if
this number is the same as the transactioID
of the sent packet, the pavket is considered
successfully delivered. }
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
f:file;
Procedure CheckError(err:boolean; errNbr:word);
begin
if err
then begin
CASE errNbr of
$0100:writeln('IPX needs to be installed.');
$0200:writeln('Error: can''t locate the spcified username.');
$0201:begin
writeln('The specified user has multiple connections.');
writeln('This demonstation program doesn''t support multiple connections.');
end;
$0202:writeln('Error: can''t find the address of the supplied username.');
$0204:writeln('Transfer aborted after 50 retries.');
$0205:writeln('Key pressed: Transfer aborted.');
$0206:writeln('The supplied file couldn''t be found. Please supply full path.');
$10FE:writeln('Error opening socket: Socket Table Is Full.');
$10FF:writeln('Error opening socket: Socket is already open.');
end; {case}
IPXcloseSocket(IOsocket);
close(f);
halt(1);
end;
end;
Function TimeOut(t1,t2:word;n:byte):boolean;
{ ticks t2 - ticks t1 > n seconds ? }
Var lt1,lt2:LongInt;
begin
lt2:=t2;
if t1>t2 then lt2:=lt2+$FFFF;
TimeOut:=(lt2-t1)>(n*18);
end;
{$F+}
Procedure ListenForAckHandler(Var p:TPecb);
{ Interrupts are turned off -and should remain turned off- }
begin
IF (ListenECB.CompletionCode<>0) { packet must be suucessfully received.. }
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE) { of type PEP.. }
or (ListenPepHdr.ClientType<>$EA) { of client type $EA }
or (ListenPepHdr.TransactionID<>SendTransId) { with a correct clientID (of the packet the master sent) }
then IPXListenForPacket(ListenECB) { Invalid packet => listen again }
else AckReceived:=true; { valid packet => ACK received ! }
end;
{$F-}
{$F+}
Procedure ListenForAckESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
{ interrupts are turned off -and should remain turned off- }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL ListenForAckHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var dest:TinternetworkAddress;
ticks,ticks2:word;
retries :word;
Uname,Fname:string;
NbrOfConn:byte;
connList:TconnectionList;
p:byte;
FileInfo:searchrec;
FileSize:LongInt;
begin
If paramcount<>2
then begin
writeln('Usage: M1_PEP <username> <filename>');
writeln('-The file will be sent to the workstation of the supplied username.');
writeln('-Run S1_PEP on that workstation to receive the file.');
halt(1);
end;
Uname:=ParamStr(1);
UpString(Uname);
NbrOfConn:=0;
GetObjectConnectionNumbers(Uname,OT_USER,NbrOfConn,connList);
CheckError((nwConn.result>0) or (NbrOfConn=0),$200);
CheckError(NbrOfConn>1,$0201);
GetInternetAddress(connList[1],dest);
CheckError(nwconn.result>0,$0202);
dest.socket:=IOsocket;
Fname:=ParamStr(2);
Assign(f,Fname);
Reset(f);
CheckError(IOresult<>0,$0206);
IpxInitialize;
CheckError(nwIPX.result>0,$0100);
socket:=IOSocket;
IPXopenSocket(Socket,SHORT_LIVED_SOCKET);
CheckError(nwIPX.result>0,$1000+nwIPX.result);
{ setup listening for ack }
AckReceived:=False;
PEPsetupListenECB(Addr(ListenForAckESR),IOsocket,@ListenDataBuffer,8,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
{ send initial packet with the name and size of the file to be sent. }
findfirst(Fname,$FF,FileInfo);
Move(FileInfo.size,SendDataBuffer[16],4);
FileSize:=Fileinfo.size;
p:=length(Fname);
while (p>0) and (Fname[p]<>':') and (Fname[p]<>'\')
do dec(p);
If p>0
then delete (Fname,1,p);
Move(Fname[0],SendDataBuffer[1],15);
PEPsetupSendECB(NIL,IOsocket,dest,@SendDataBuffer[1],512,
SendPepHdr,SendECB);
SendTransID:=1;
SendPepHdr.ClientType:=$EA;
FileSize:=FileSize+512; { compensate length for information header }
While Filesize>0
do begin
ackreceived:=false;
SendPepHdr.TransactionId:=SendTransId;
IPXsendPacket(SendECB);
writeln('Packet#',SendTransID,' was sent.');
while sendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
retries:=0;
REPEAT
IPXrelinquishcontrol;
IPXGetIntervalMarker(ticks2);
if (ticks2-ticks)>2
then begin
inc(retries);
writeln('Timeout: resending pkt#',SendTransID);
PEPsetupSendECB(NIL,IOsocket,dest,@SendDataBuffer[1],512,
SendPepHdr,SendECB);
SendPepHdr.ClientType:=$EA;
SendPepHdr.TransactionId:=SendTransId;
IPXsendPacket(SendECB);
while sendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
end;
CheckError(retries>50,$0204);
CheckError(Keypressed,$0205);
UNTIL AckReceived;
writeln('Ack ',ListenPepHdr.TransactionID,' was received.');
FileSize:=FileSize-512;
inc(SendTransID);
{XXX fill buffer met volgende fileblock }
IPXListenForPacket(ListenECB); { start listening for acks again }
end;
IPXcloseSocket(IOsocket);
close(f);
end.

176
NWTP/XIPX/M_PEP.PAS Normal file
View File

@@ -0,0 +1,176 @@
{$X+,V-,B-}
program M_PEP; { Master / Sender }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Sents a single packet, waits for acknowledgement }
uses crt,nwMisc,nwBindry,nwConn,nwIPX,nwPEP;
CONST IOSocket=$5678; { socket to transmit/receive on }
Var ListenECB :Tecb; { ECB and header, to listen for acknowledgement }
ListenPepHdr :TpepHeader;
SendECB :Tecb; { ECB and header, used to send the data }
SendPepHdr :TpepHeader;
socket :word;
buf :array[1..546] of byte; { buffer for data to be sent }
AckReceived :boolean; { set to true within the ListenForAckESR }
SendTransId :LongInt; { transactionID. This uniquely identifies
the packet. The slave/receiver has to
reply with the same transactionID in the
header of the acknowledgement. Only if
this number is the same as the transactioID
of the sent packet, the pavket is considered
successfully delivered. }
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
{$F+}
Procedure ListenForAckHandler(Var p:TPecb);
{ Interrupts are turned off -and should remain turned off- }
begin
IF (ListenECB.CompletionCode<>0) { packet must be suucessfully received.. }
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE) { of type PEP.. }
or (ListenPepHdr.ClientType<>$EA) { of client type $EA }
or (ListenPepHdr.TransactionID<>SendTransId) { with a correct clientID (of the packet the master sent) }
then IPXListenForPacket(ListenECB) { Invalid packet => listen again }
else AckReceived:=true; { valid packet => ACK received ! }
end;
{$F-}
{$F+}
Procedure ListenForAckESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
{ interrupts are turned off -and should remain turned off- }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL ListenForAckHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var dest:TinternetworkAddress;
ticks,ticks2:word;
retries :word;
Uname:string;
NbrOfConn:byte;
connList:TconnectionList;
begin
If paramcount<>1
then begin
writeln('Usage: M_PEP <username>');
writeln('-a test pep packet will be sent to the workstation of this user.');
writeln('-run S_PEP on that workstation to receive the packet.');
halt(1);
end;
Uname:=ParamStr(1);
UpString(Uname);
NbrOfConn:=0;
IF (NOT GetObjectConnectionNumbers(Uname,OT_USER,NbrOfConn,connList))
or (NbrOfConn=0)
then begin
writeln('Error: can''t locate user ',Uname);
halt(1);
end;
IF NbrOfConn>1
then begin
writeln('The specified user has multiple connections.');
writeln('This demonstation program doesn''t support multiple connections.');
halt(1);
end;
IF NOT GetInternetAddress(connList[1],dest)
then begin
writeln('Error: can''t find the address of user ',Uname);
halt(1);
end;
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
{ setup listening for ack }
AckReceived:=False;
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
PEPsetupListenECB(Addr(ListenForAckESR),IOsocket,@buf,546,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
{ send packet }
dest.socket:=IOsocket;
buf[1]:=ord('s');buf[2]:=ord('m');
PEPsetupSendECB(NIL,IOsocket,dest,@buf[1],2,
SendPepHdr,SendECB);
SendTransID:=1;
SendPepHdr.TransactionId:=SendTransId;
SendPepHdr.ClientType:=$EA;
IPXsendPacket(SendECB);
writeln('Packet was sent.');
while sendECB.InuseFlag<>0 do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
{ wait for acknowledgement or timeout }
retries:=0;
REPEAT
IPXrelinquishcontrol;
IPXGetIntervalMarker(ticks2);
if (ticks2-ticks)>4
then begin
inc(retries);
writeln('Timeout: resending');
IPXsendPacket(SendECB);
while sendECB.InuseFlag<>0 do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
end;
UNTIL AckReceived or Keypressed or (retries>50);
if AckReceived
then writeln('Ack was received.');
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

97
NWTP/XIPX/NWPEP.PAS Normal file
View File

@@ -0,0 +1,97 @@
{$B-,V-,X+}
UNIT nwPEP;
{ nwPEP unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
INTERFACE
Uses Dos,nwIPX,nwMisc;
{ Primary IPX calls: Subf: Comments:
Secondary calls:
PEPsetupSendECB
PEPsetupListenECB
}
Var Result:word; { unit errorcode variable }
Type TpepHeader=Record
IPXhdr :TipxHeader; { set packettype to $04 }
TransactionID:Longint;
clientType :word;
end;
Procedure PEPSetupListenECB(ESRptr:Pointer; ReceiveSocket:word;
BufPtr:Pointer; BufSize:word;
{out:} Var PepHdr:TpepHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
Procedure PEPSetupSendECB(ESRptr:pointer; SourceSocket:word;
DestAddr:TinterNetworkAddress;
BufPtr:pointer; BufSize:word;
{out:} Var PepHdr:TpepHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
IMPLEMENTATION {==============================================================}
Procedure PEPSetupListenECB(ESRptr:Pointer;ReceiveSocket:word;
BufPtr:Pointer;BufSize:word;
{out:} Var PepHdr:TpepHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
{ ECB: ESR adress field, socket number, fragment count, frag.descriptor fields }
begin
FillChar(ecb,SizeOf(Tecb),#0);
FillChar(pepHdr,SizeOF(TpepHeader),#0);
WITH ECB
do begin
if ESRptr<>NIL
then ESRaddress:=ESRptr;
Fragmentcount:=2;
socketNumber:=swap(ReceiveSocket); {hi-lo}
Fragment[1].Address:=@pepHdr;
Fragment[2].Address:=BufPtr;
Fragment[1].size:=SizeOf(Tpepheader);
Fragment[2].size:=BufSize;
end;
end;
Procedure PEPsetupSendECB(ESRptr:pointer; SourceSocket:word;
DestAddr:TinterNetworkAddress;
BufPtr:pointer; BufSize:word;
{out:} Var PepHdr:TpepHeader; Var ecb:Tecb);
{ Clears IPXheader and ECB, sets values of the required fields within
the ecb and IPX header. }
Var ImmAddr:TnodeAddress;
Ticks:word;
begin
fillchar(pepHdr,SizeOf(TpepHeader),#0);
with pepHdr.IPXhdr
do begin
PacketType:=PEP_PACKET_TYPE;
Move(DestAddr,Destination,10);
destination.socket:=swap(DestAddr.socket); {hi-lo}
end;
IPXGetLocalTarget(DestAddr,ImmAddr,Ticks);
fillchar(ecb,sizeOf(ecb),#0);
With ecb
do begin
if ESRptr<>NIL
then ESRaddress:=ESRptr;
socketNumber:=swap(SourceSocket); {hi-lo}
Move(ImmAddr,ImmediateAddress,6);
FragmentCount:=2;
fragment[1].Address:=@pephdr;
fragment[1].size:=SizeOf(TpepHeader);
fragment[2].Address:=BufPtr;
fragment[2].size:=BufSize;
end;
end;
end.

152
NWTP/XIPX/NWRIP.PAS Normal file
View File

@@ -0,0 +1,152 @@
Unit NwRIP;
{ NwTP Version 0.6, Copyright 1993,1994 R. Spronk
WARNING: Test your program thoroughly if you're using nwRip functions.
----------------------------------------------------------------------
Using the RIP functionality the wrong way may very well result in
aborting servers ! (no kidding.)
As far as I know the diagnostic RIP function(s) included in this unit
are perfectly safe to use.
Based on:
-GETALL, written in C by Barry Lagerweij of 2:2802/110.2
posted in the Fido NOVELL area on Tue 7 Sep 93 0:36.
-GETRIP, written in C by Koos van den Hout of 2:500/101.11012
last updated 8 Feb 93 }
INTERFACE
Uses nwMisc,nwIPX;
CONST ECB_COUNT=10;
{ assumption : 10 receiveECBs are used, which means a max of 500 networks }
{ Type definitions for RIP request/response structures}
type TRIPentry=record
network:TnetworkAddress;
hops :word;
ticks :word;
end;
TRIPanswerPacket=record
operation:word;
entry :array[1..50] of TRIPEntry;
end;
TRIPinfo=array[1..50*ECB_COUNT] of record
address:TnetworkAddress;
hops :byte;
Ticks :word;
end;
Function GetAllNetworks(SegmentNetworkAddress:TnetworkAddress;
Var NetInfo:TRIPinfo):word;
{SegmentNetworkAddress: The target network whose routers
will be queried. Set to all zeroes (00 00 00 00)
if querying your own segment.
NetInfo : the buffer where the network-info is stored.
Returns : the number of known networks.
Assumed is that IPXInitialize is already called. }
IMPLEMENTATION {===========================================================}
Function GetAllNetworks(SegmentNetworkAddress:TnetworkAddress;
Var NetInfo:TRIPinfo):word;
Var
RIPrequest :TRIPanswerPacket;
RIPanswer :array[1..ECB_COUNT] of TRIPanswerPacket;
RequestEcb :Tecb;
RequestIPXheader:TipxHeader;
ReplyECB :array[1..ECB_COUNT] of Tecb;
ReplyIPX :array[1..ECB_COUNT] of TipxHeader;
Target :TinternetworkAddress;
Sourcesocket :word;
RIPsocket :word;
NumberOfNets :word;
cnt :word;
n :word;
RoutableNetworks:word;
timer1,timer2:word;
Begin
RIPsocket:=$0453;
SourceSocket:=0;
{ open socket for receiving the RIP packets }
IF NOT IPXopenSocket(SourceSocket,SHORT_LIVED_SOCKET)
then begin
result:=nwIPX.result;
GetAllnetworks:=0;
exit;
end;
{set-up sendpacket }
target.net:=SegMentNetworkAddress;
fillchar(target.node,6,#$FF); { all nodes i.e. all routers }
target.socket:=RIPsocket;
IPXsetUpSendECB(NIL,SourceSocket,target,@RIPrequest,SizeOf(RIPrequest),
RequestIPXheader, RequestECB);
RequestIPXheader.packetType := 1;
{ 1=RIP / Any value will work/ type seems to be ignored by Routers
as long as socket is OK. }
{ set-up the RIP request }
FillChar(RIPrequest,SizeOf(RIPrequest),#$FF);
RIPrequest.operation := $0100; { hi-lo, RIP request }
FillChar(RIPanswer,SizeOf(RIPanswer),#$00);
{ set-up the receive ECBs }
for n:=1 to ECB_COUNT
do begin
IPXsetupListenECB(NIL,SourceSocket,
@RIPanswer[n],SizeOf(TRIPanswerPacket),
ReplyIpx[n],ReplyECB[n]);
IPXListenForPacket(ReplyECB[n]);
end;
{ send the RIP request }
IPXSendPacket(RequestECB);
{ wait a while for answers }
IPXgetIntervalMarker(timer1);
REPEAT
IPXrelinquishcontrol;
IPXGetIntervalMarker(timer2);
UNTIL abs(timer2-timer1)>20;
NumberOfNets := 0;
{ check all possible RIP responses, and fill the tables }
for n:=1 to ECB_COUNT
do if (ReplyECB[n].INuseFlag=0) and (RIPanswer[n].operation=$0200)
then begin
RoutableNetworks:=(swap(ReplyIPX[n].Length)-32) DIV SizeOf(TRIPentry);
for cnt:=1 to RoutableNetworks
do begin
inc(NumberOfNets);
With NetInfo[NumberOfNets]
do begin
Address:=RIPanswer[n].entry[cnt].network;
hops:=swap(RIPanswer[n].entry[cnt].hops);
ticks:=swap(RIPanswer[n].Entry[cnt].ticks);
end;
end;
end
else IPXcancelEvent(ReplyECB[n]);
{ our socket is no longer needed }
IPXCloseSocket(SourceSocket);
{ return the number of networks we found }
GetAllNetworks:=NumberOfNets;
end;
end.

50
NWTP/XIPX/NWSAP.PAS Normal file
View File

@@ -0,0 +1,50 @@
Unit NwSAP;
{ NwTP Version 0.6, Copyright 1993,1995 R. Spronk
WARNING: Test your program thoroughly if you're using nwSAP functions.
----------------------------------------------------------------------
Using the SAP functionality the wrong way may very well result in
aborting servers ! (no kidding.)
NOTE: Type Declarations only. See SHWSAPS.PAS for an example }
INTERFACE
Uses nwMisc,nwIPX;
CONST { server SAP priodic broadcast type }
PERIODIC_ID_PACKET = $0002;
{ server SAP (reply) packet types }
GENERAL_SERVICE_RESPONSE=$0002;
NEAREST_SERVICE_RESPONSE=$0004;
{ client SAP (request) packet types }
GENERAL_SERVICE_QUERY =$0001;
NEAREST_SERVICE_QUERY =$0003;
{ Type definitions for SAP request/response structures}
Type TSAPserver=record
ObjType:word;
Name :array[1..48] of byte; { asciiz }
Address:TinternetworkAddress;
Hops :word;
end;
TSAPresponse=record
ResponseType:word; { 0002 General server; 0004 nearest server }
ServerEntry:array[1..7] of TSAPserver;
end;
TSAPrequest=record
RequestType:word; {hi-lo}
ServerType :word; {hi-lo}
end;
IMPLEMENTATION {===========================================================}
end.

136
NWTP/XIPX/R1_HELLO.PAS Normal file
View File

@@ -0,0 +1,136 @@
{$X+,V-,B-}
program RecHello1;
{ Simple IPX demonstration program, that uses one receive ESR.
Run this program on 1 workstation, run S_HELLO or S1_HELLO on another.
S_HELLO will send "hello world" messages,
this workstation will receive them. }
uses crt,nwMisc,nwIPX;
CONST IOSocket=$5678;
Var ReceiveEcb :Tecb;
IpxHdr :TipxHeader;
socket :word;
buf :array[1..546] of byte;
t :byte;
ReceivedBufLen:word;
PacketReceived:boolean;
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
{$F+}
Procedure ListenESRhandler;
begin
PacketReceived:=true;
end;
{$F-}
{$F+}
Procedure ListenESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx
push bx
CALL ListenEsrHandler
pop bx
pop dx
mov sp,bx { restore stack }
mov ss,dx
end;
{$F-}
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
Repeat
PacketReceived:=False;
{ Empty receive buffer (ReceiveEcb.fragment[2].address^) }
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
IPXsetupListenECB(Addr(ListenESR),IOsocket,@buf,546,
IpxHdr,ReceiveEcb);
IPXListenForPacket(ReceiveECB);
REPEAT
delay(1000);
Writeln('Packet received: ',PacketReceived);
IF PacketReceived { ESR has signalled that a packet has been received }
then begin
Case ReceiveECB.CompletionCode OF
$00:begin { Dump received bytes.. }
Write('Data received : ');
ReceivedBufLen:=swap(IpxHdr.length)-SizeOf(TipxHeader);
for t:=1 to ReceivedBufLen
do write(chr(buf[t]));
writeln;
end;
$FC:Writeln('The listen request has been canceled.');
{ impossible, as the cancelation has to be done by this program, and it doesn't }
$FD:Writeln('Packet overflow error.');
{ 0 fragments, or receiving buffer too small. }
$FF:Writeln('The socket is closed.');
{ Impossible. The socket is definitely open. See above. }
end;
{ Now we're going to squeeze all information out of the IpxHdr }
writeln('*IPX header info*');
writeln('-total length : ',swap(IpxHdr.length):0);
writeln('-data length : ',swap(IpxHdr.Length)-SizeOf(TipxHeader));
writeln('-number of hops: ',(IpxHdr.TransportControl AND $0F):0);
write('-sending adress: [');
for t:=1 to 4
do write(HexStr(IpxHdr.source.net[t],2));
write('|');
for t:=1 to 6
do write(HexStr(IpxHdr.source.node[t],2));
write('|');
writeln(HexStr(swap(IpxHdr.source.socket),4),']');
write('-destined for : [');
for t:=1 to 4
do write(HexStr(IpxHdr.destination.net[t],2));
write('|');
for t:=1 to 6
do write(HexStr(IpxHdr.destination.node[t],2));
write('|');
writeln(HexStr(swap(IpxHdr.destination.socket),4),']');
writeln;
end;
UNTIL (KeyPressed or PacketReceived);
UNTIL keypressed;
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

107
NWTP/XIPX/R2_HELLO.PAS Normal file
View File

@@ -0,0 +1,107 @@
{$X+,V-,B-}
program RecHello2;
{ Simple IPX demonstration program, that uses one receive ESR.
Run this program on 1 workstation, run S_HELLO or S1_HELLO on another.
S_HELLO will send "hello world" messages,
this workstation will receive them. }
uses crt,nwMisc,nwIPX;
CONST IOSocket=$5678;
Var ReceiveEcb :Tecb;
IpxHdr :TipxHeader;
socket :word;
buf :array[1..546] of byte;
t :byte;
ReceivedBufLen:word;
PacketReceived:boolean;
RecString :string;
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
{$F+}
Procedure ListenESRhandler(Var p:Tpecb);
begin
RecString[0]:=chr(p^.fragment[2].size);
move(p^.fragment[2].address^,RecString[1],byte(RecString[0]));
PacketReceived:=true;
IPXListenForPacket(ReceiveECB);
end;
{$F-}
{$F+}
Procedure ListenESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL ListenEsrHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
PacketReceived:=False;
{ Empty receive buffer (ReceiveEcb.fragment[2].address^) }
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
IPXsetupListenECB(Addr(ListenESR),IOsocket,@buf,546,
IpxHdr,ReceiveEcb);
IPXListenForPacket(ReceiveECB);
REPEAT
IPXrelinquishControl;
IF PacketReceived { ESR has signalled that a packet has been received }
then begin
writeln(RecString);
PacketReceived:=false;
end;
UNTIL KeyPressed;
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

146
NWTP/XIPX/R3_HELLO.PAS Normal file
View File

@@ -0,0 +1,146 @@
{$X+,V-,B-}
program RecHello3;
{ Simple IPX demonstration program, that uses one receive ESR.
Run this program on 1 workstation, run S_HELLO or S1_HELLO on another.
S_HELLO will send "hello world" messages,
this workstation will receive them. }
{ This program consists of two concurrent processes:
1. (background) An ESR that fills a global receive buffer with
incoming packets. Only when the buffer is full
will packets be discarded.
2. (foreground) A process that performs its regular task. Whenever
there is time, the process will process the
received packets. }
uses crt,nwMisc,nwIPX;
CONST IOSocket=$5678;
Var ReceiveEcb :Tecb;
IpxHdr :TipxHeader;
socket :word;
buf :array[1..546] of byte;
t :byte;
ReceivedBufLen:word;
ReceivedMsg:array[1..100] of record
InUse:Boolean;
Message:string[25];
end;
EsrBufInd :Byte; { used by ESR }
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
{$F+}
Procedure ListenESRhandler(Var p:Tpecb);
begin
{ look for an empty spot in the global buffer }
EsrBufInd:=1;
while (EsrBufInd<=100) and ReceivedMsg[EsrBufInd].Inuse
do inc(EsrBufInd);
IF EsrBufInd<=100
then begin
{ empty place found. Insert msg }
with ReceivedMsg[EsrBufInd]
do begin
Message[0]:=chr(p^.fragment[2].size);
if Message[0]>#25 then Message[0]:=#25;
move(p^.fragment[2].address^,Message[1],ord(Message[0]));
InUse:=True;
end;
end
else ; { entire buffer is filled => discard packet }
{ Setup to listen for next incoming packet }
IPXListenForPacket(ReceiveECB);
end;
{$F-}
{$F+}
Procedure ListenESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL ListenEsrHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
IPXsetupListenECB(Addr(ListenESR),IOsocket,@buf,546,
IpxHdr,ReceiveEcb);
IPXListenForPacket(ReceiveECB);
writeln('ESR will start filling a global buffer with packets received.');
writeln('Starting foreground process...');
writeln;
writeln('Foreground process just writes a ''dot'' to the screen every second.');
writeln('When a key is pressed, this process is terminated and the received');
writeln('packets are shown.');
REPEAT
IPXrelinquishControl;
delay(1000);
write('.');
UNTIL KeyPressed;
writeln;
writeln('Dumping global receive buffer -- filled by background process.');
for t:=1 to 100
do if ReceivedMsg[t].Inuse
then begin
writeln(ReceivedMsg[t].Message);
ReceivedMsg[t].Inuse:=False; { give entry in buffer free }
end;
{ You may also choose to process just 1 entry in the received buffer.
Set Inuse to False after processing, so the ESR can fill it again }
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

92
NWTP/XIPX/R_HELLO.PAS Normal file
View File

@@ -0,0 +1,92 @@
{$X+,V-,B-}
program RecHello;
{ Simple IPX demonstration program. Run this program on 1 workstation,
run S_HELLO on another. S_HELLO will send "hello world" messages,
this workstation will receive them.
Polls the ECB until a packet is received. No ESR used. }
uses crt,nwMisc,nwIPX;
CONST IOSocket=$5678;
Var ReceiveEcb:Tecb;
IpxHdr:TipxHeader;
socket:word;
buf:array[1..546] of byte;
t:byte;
w:word;
s:string;
ReceivedBufLen:word;
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
Repeat
{ Empty receive buffer (ReceiveEcb.fragment[2].address^) }
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
IPXsetupListenECB(NIL,IOsocket,@buf,546,
IpxHdr,ReceiveEcb);
IPXListenForPacket(ReceiveECB);
{ Poll InUse flag until a packet was received }
while ReceiveECB.InUseFlag<>0
do IPXrelinquishControl;
Case ReceiveECB.CompletionCode OF
$00:begin { Dump received bytes.. }
Write('Data received : ');
ReceivedBufLen:=swap(IpxHdr.length)-SizeOf(TipxHeader);
for t:=1 to ReceivedBufLen
do write(chr(buf[t]));
writeln;
end;
$FC:Writeln('The listen request has been canceled.');
{ impossible, as the cancelation has to be done by this program, and it doesn't }
$FD:Writeln('Packet overflow error.');
{ 0 fragments, or receiving buffer too small. }
$FF:Writeln('The socket is closed.');
{ Impossible. The socket is definitely open. See above. }
end;
{ Now we're going to squeeze all information out of the IpxHdr }
writeln('*IPX header info*');
writeln('-total length : ',swap(IpxHdr.length):0);
writeln('-data length : ',swap(IpxHdr.Length)-SizeOf(TipxHeader));
writeln('-number of hops: ',(IpxHdr.TransportControl AND $0F):0);
write('-sending adress: [');
for t:=1 to 4
do write(HexStr(IpxHdr.source.net[t],2));
write('|');
for t:=1 to 6
do write(HexStr(IpxHdr.source.node[t],2));
write('|');
writeln(HexStr(swap(IpxHdr.source.socket),4),']');
write('-destined for : [');
for t:=1 to 4
do write(HexStr(IpxHdr.destination.net[t],2));
write('|');
for t:=1 to 6
do write(HexStr(IpxHdr.destination.node[t],2));
write('|');
writeln(HexStr(swap(IpxHdr.destination.socket),4),']');
writeln;
UNTIL keypressed;
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

114
NWTP/XIPX/S1_HELLO.PAS Normal file
View File

@@ -0,0 +1,114 @@
{$X+,B-,V-}
program SendHello;
{ Simple IPX demonstration program with 1 ESR.}
uses crt,nwMisc,nwIPX;
CONST IOSocket=$5678;
Var NewStack :array[1..512] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
SendEcb :Tecb;
IpxHdr :TipxHeader;
socket :word;
dest :TinternetworkAddress;
buf :array[1..546] of byte;
t :byte;
w :word;
s :string;
PacketSent :boolean;
{$F+}
Procedure SendESRhandler;
begin
PacketSent:=true;
end;
{$F-}
{$F+}
Procedure SendESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push bx
push dx
CALL SendEsrHandler
pop dx
pop bx
mov sp,bx { restore stack }
mov ss,dx
end;
{$F-}
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
for t:=1 to 4 do dest.net[t]:=$00; { this net / segment }
for t:=1 to 6 do dest.node[t]:=$FF; { all nodes }
dest.socket:=IOsocket;
w:=0;
Repeat
inc (w);
{ Fill buffer (ECB.fragment[2]^) }
str(w:4,s);
s:=s+' IPX: Hello World';
FillChar(buf,546,#0);
move(s[1],buf,ord(s[0]));
{ setup ECB and IPX header }
PacketSent:=False;
IPXsetupSendECB(Addr(SendESR),IOsocket,dest,@buf,ord(s[0]),
IpxHdr,SendEcb);
IPXsendPacket(SendEcb);
REPEAT
IpxRelinquishControl;
delay(100);
IF PacketSent
then begin
{ ECB.InUseFlag was lowered, now determine if packet was sent: }
CASE SendEcb.CompletionCode OF
$00:writeln('IPX packet #',w:0,' was sent.');
$FC:writeln('The send of packet #',w:0,' was canceled.');
{ impossible, as this cancelation to be done by THIS program, and it doesn't }
$FD:writeln('Packet# ',w:0,' is malformed and was not sent.');
{ illegal param: packet length, number of fragments, fragment size. }
$FE:writeln('Packet# ',w:0,' was undelivered. No stations listening.');
$FF:writeln('Packet# ',w:0,' not sent due to a hardware error.');
end;
end;
UNTIL PacketSent or Keypressed;
delay(750); { delay 0.75 sec before sending another packet }
UNTIL keypressed;
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

170
NWTP/XIPX/S1_PEP.PAS Normal file
View File

@@ -0,0 +1,170 @@
{$X+,V-,B-}
program S1_PEP; { Listening Process / receiver / Slave }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
uses crt,nwMisc,nwIPX,nwPEP;
Var ListenECB :Tecb; { used to listen for packets }
ListenPepHdr :TpepHeader;
SendECB :Tecb; { used to send acknowledgements }
SendPepHdr :TpepHeader;
IOsocket :word;
DataBuffer :array[1..546] of byte;
SendDataBuffer:byte;
PacketReceived :Boolean;
LastTransactionID:LongInt;
BytesReceived :Word;
NewStack:array[1..8192] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
lnr:word;
Procedure CheckError(err:boolean; errNbr:word);
begin
if err
then begin
CASE errNbr of
$0100:writeln('IPX needs to be installed.');
$0101:writeln('ERROR: Connection not established. A Timeout occured');
$0102:writeln('ERROR: The transfer is aborted; A timeout occured.');
$10FE:writeln('Error opening socket: Socket Table Is Full.');
$10FF:writeln('Error opening socket: Socket is already open.');
else writeln('Unspecified error.');
end; {case}
IPXcloseSocket(IOsocket);
halt(1);
end;
end;
Function TimeOut(t1,t2:word;n:byte):boolean;
{ ticks t2 - ticks t1 > n seconds ? }
Var lt1,lt2:LongInt;
begin
lt2:=t2;
if t1>t2 then lt2:=lt2+$FFFF;
TimeOut:=(lt2-t1)>(n*18);
end;
{$F+}
Procedure ListenAndAckHandler;
begin
lnr:=ListenPepHdr.TransactionID;
If (ListenECB.CompletionCode<>0)
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE)
or (ListenPepHdr.clienttype<>$EA)
or (ListenPepHdr.TransactionID<LastTransactionID) { discard dupe old packet }
then IPXlistenForPacket(ListenECB)
else begin
PacketReceived:=(ListenPepHdr.transactionID>LastTransactionID); { new packet received }
{ Acknowledge new packets and duplicates of the latest packet, }
{ as the original acknowledgement may have been lost. }
BytesReceived:=swap(ListenPepHdr.IPXhdr.length)-SizeOf(TpepHeader);
LastTransactionID:=ListenPepHdr.TransactionID;
{ Setup acknowledgement ECB and PEPheader, and send it. }
if 1=1 {SendECB.InUseFlag=0}
then begin
ListenPepHdr.IPXhdr.source.socket:=swap(ListenPepHdr.IPXhdr.source.socket);
{ socket is hi-lo in IPX/PEPHeaders. SetupSendECB expects lo-hi }
PEPsetupSendECB(NIL,IOsocket,ListenPepHdr.IPXhdr.source,@SendDataBuffer,0,
SendPepHdr,SendECB);
SendPepHdr.TransactionId:=LastTransactionID;
SendPepHdr.ClientType:=$EA;
IPXsendPacket(SendECB);
end;
end;
end;
{$F-}
{$F+}
Procedure ListenAndAckESR; assembler;
asm
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
CALL ListenAndAckHandler
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var ticks,ticks2 :word;
FileName:string;
FileSize:LongInt;
begin
lnr:=0;
IpxInitialize;
CheckError(nwIPX.result>0,$100);
IOSocket:=$5678;
IPXopenSocket(IOsocket,SHORT_LIVED_SOCKET);
CheckError(nwIPX.result>0,$1000+nwIPX.result);
{ Setup of ECB and PepHeader, start listening for incoming packets. }
LastTransactionID:=0;
PacketReceived:=False;
PEPSetupListenECB(Addr(ListenAndAckESR),IOsocket,@DataBuffer,546,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
writeln('Listening for incoming packet.');
IPXGetIntervalMarker(ticks);
REPEAT
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2);
CheckError(TimeOut(ticks,ticks2,130),$101);{ error if a timeout occurred }
UNTIL PacketReceived;
writeln('Packet received.. initiating transfer process.');
writeln('Received PacketID:',LastTransactionID);
writeln('len of data:',BytesReceived);
{ do something with DataBuffer: the data that was just received. }
{ the first packet contains the filename and filesize }
Move(DataBuffer[1],FileName[0],15);
Move(DataBuffer[16],FileSize,4);
writeln('Receiving file ',FileName,', size: ',FileSize);
REPEAT { Listen for remaining packets }
Packetreceived:=false;
While SendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXListenForPacket(ListenECB);
IPXGetIntervalMarker(ticks);
writeln(FileSize);
Repeat
{write(lnr);}
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2);
CheckError(TimeOut(ticks,ticks2,10),$102); { error if Timeout occurred }
until PacketReceived;
writeln('Packet#:',LastTransactionID);
writeln('len of data:',BytesReceived);
FileSize:=FileSize-BytesReceived;
{ do something with DataBuffer: the data that was just received. }
UNTIL (FileSize<=0); { entire file received }
writeln('Transfer complete.');
IPXcloseSocket(IOsocket);
end.

189
NWTP/XIPX/SHWSAPS.PAS Normal file
View File

@@ -0,0 +1,189 @@
{$X+,V-,B-}
program ShSAPs;
{ Testprogram for the nwSAP unit / NwTP 0.6 (c) 1993,1995 R.Spronk }
{ Dump all incoming SAP broadcasts on screen;
Sends -no- packets; receiving packets only }
{ Demonstrates
-The use of the Service Advertizing Protocol;
-Asynchronous handling of receiving and processing
(using 1 receive ESR and intermediate buffers }
uses crt,nwMisc,nwIPX,nwSAP;
CONST SAPsocket=$0452;
BUFSIZ=511;
{ May 'hang' your WS if more than 70 SAP broadcast were received
in a short interval (a few ticks). Increase the BUFSIZ value. }
Type TSAPserver=record
ObjType:word;
Name :array[1..48] of byte; { asciiz }
Address:TinternetworkAddress;
Hops :word;
end;
TSAPresponse=record
ResponseType:word; { 0002 General server; 0004 nearest server }
ServerEntry:array[1..7] of TSAPserver;
end;
Type String48=string[48];
Tservices=record
InUseFlag :Byte; { 0: not being accessed by other threads }
TimeStamp :Word; { Ticks / max 60. minutes }
ObjType:word;
Name :array[1..48] of byte; { asciiz }
Address:TinternetworkAddress;
Hops :word;
end;
Var ServBuf:array[0..BUFSIZ] of TServices;
ECBServBufInd:word; { 0..BUFSIZ }
ServBufInd :word; { 0..BUFSIZ }
StartTicks:Longint;
PktCount:word;
Var ReceiveEcb :Tecb;
IpxHdr :TipxHeader;
socket :word;
IPXreceiveBuffer: array[1..546] of byte;
SAPreceiveBuffer: TSAPresponse absolute IPXreceiveBuffer;
ReceivedBufLen:word;
PacketReceived:boolean;
RecString :string;
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
ESRctr:byte; { !! used by SAP ESR }
{$F+}
Procedure SAPListenESRhandler(Var p:Tpecb);
begin
if SAPreceiveBuffer.Responsetype=$0200 { 0002 hi-lo: general server SAP reply }
then begin
ESRctr:=1;
while (ESRctr<=7) and (SAPreceiveBuffer.ServerEntry[ESRctr].ObjType>$0000)
do begin
while ServBuf[ECBservBufInd].inUseFlag>0
do begin
inc(ECBServBufInd);
ECBservBufInd:=ECBservBufInd and BUFSIZ;
end;
with SAPreceiveBuffer.ServerEntry[ESRctr]
do begin
Move(ObjType,ServBuf[ECBServBufInd].ObjType,SizeOf(TSAPserver));
ObjType:=$0000; { To mark that the entry has been dealt with;
to 'clear' receive buffer }
end;
with ServBuf[ECBServBufInd]
do begin
IPXgetIntervalMarker(TimeStamp);
InUseFlag:=$FF;
end;
inc(ESRctr);
end;
PacketReceived:=true;
inc(PktCount);
end;
IPXListenForPacket(ReceiveECB);
end;
{$F-}
{$F+}
Procedure SAPListenESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL SAPListenEsrHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var ServerName:string;
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=SAPSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
PktCount:=0;
ECBservBufInd:=0;
PacketReceived:=False;
{ Empty receive buffer (ReceiveEcb.fragment[2].address^) }
FillChar(IPXreceiveBuffer,546,#0);
{ Setup ECB and IPX header }
IPXsetupListenECB(Addr(SAPListenESR),SAPsocket,@IPXreceiveBuffer,546,
IpxHdr,ReceiveEcb);
IPXListenForPacket(ReceiveECB);
ServBufInd:=0;
REPEAT
WHILE (ServBufInd<512) and (NOT keypressed)
do begin
IPXrelinquishControl;
IF ServBuf[ServBufInd].InUseFlag>0
then begin
with ServBuf[ServBufInd]
do begin
writeln('---------');
writeln('BufIndex:',ServBufInd);
writeln('Timestamp: ',HexStr(TimeStamp,4));
writeln('ObjType : ',HexStr(swap(ObjType),4));
ZStrCopy(ServerName,name[1],48);
writeln('ServerNm : ',ServerName);
writeln('Address : ',HexDumpStr(Address,24));
writeln('Hops : ',HexStr(swap(Hops),4));
end;
ServBuf[ServBufInd].InUseFlag:=0;
end;
inc(ServBufInd);ServBufInd:=ServBufInd and BUFSIZ;
end;
UNTIL KeyPressed;
IF NOT IPXcloseSocket(SAPsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

1881
NWTP/XIPX/SKT_XXX Normal file
View File

File diff suppressed because it is too large Load Diff

76
NWTP/XIPX/S_HELLO.PAS Normal file
View File

@@ -0,0 +1,76 @@
{$X+,B-,V-}
program SendHello;
{ Simple IPX demonstration program. Run this program on 1 workstation,
run R_HELLO on another. R_HELLO will receive the "hello world" messages
that this program sends.
Polls the ECB until a packet is sent. No ESR used. }
uses crt,nwMisc,nwIPX;
CONST IOSocket=$5678;
Var SendEcb:Tecb;
IpxHdr:TipxHeader;
socket:word;
dest:TinternetworkAddress;
buf:array[1..546] of byte;
t:byte;
w:word;
s:string;
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
for t:=1 to 4 do dest.net[t]:=$00; { this net / segment }
for t:=1 to 6 do dest.node[t]:=$FF; { all nodes }
dest.socket:=IOsocket;
w:=0;
Repeat
inc (w);
{ Fill buffer (ECB.fragment[2]^) }
str(w:4,s);
s:=s+' IPX: Hello World';
FillChar(buf,546,#0);
move(s[1],buf,ord(s[0]));
{ setup ECB and IPX header }
IPXsetupSendECB(NIL,IOsocket,dest,@buf,ord(s[0]),
IpxHdr,SendEcb);
IPXsendPacket(SendEcb);
{ Poll the Inuse Flag until the packet is sent. }
While SendEcb.InUseFlag<>0
do IPXrelinquishControl;
{ ECB.InUseFlag was lowered, now determine if packet was sent: }
CASE SendEcb.CompletionCode OF
$00:writeln('IPX packet #',w:0,' was sent.');
$FC:writeln('The send of packet #',w:0,' was canceled.');
{ impossible, as this cancelation to be done by THIS program, and it doesn't }
$FD:writeln('Packet# ',w:0,' is malformed and was not sent.');
{ illegal param: packet length, number of fragments, fragment size. }
$FE:writeln('Packet# ',w:0,' was undelivered. No stations listening.');
$FF:writeln('Packet# ',w:0,' not sent due to a hardware error.');
end;
{ Wait 5 seconds between sending packets }
delay(5000);
UNTIL keypressed;
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

125
NWTP/XIPX/S_PEP.PAS Normal file
View File

@@ -0,0 +1,125 @@
{$X+,V-,B-}
program S_PEP;
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
uses crt,nwMisc,nwIPX,nwPEP; { Listener/ Slave }
{ Listen for incoming packet.. sent acknowledgement of receipt }
{ Note that the acknowledgement is done automatically by the receiving ESR }
CONST IOSocket=$5678;
Var ListenECB :Tecb;
ListenPepHdr :TpepHeader;
SendECB :Tecb;
SendPepHdr :TpepHeader;
socket :word;
buf :array[1..546] of byte;
t :byte;
ReceivedBufLen:word;
PacketReceived:boolean;
NewStack:array[1..1024] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
{$F+}
Procedure ListenAndAckHandler(Var p:TPecb);
begin
If (ListenECB.CompletionCode<>0)
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE)
or (ListenPepHdr.clienttype<>$EA)
then IPXlistenForPacket(ListenECB)
else begin
PacketReceived:=true;
ListenPepHdr.IPXhdr.source.socket:=swap(ListenPepHdr.IPXhdr.source.socket);
{ socket is hi-lo in IPX/PEPHeaders. SetupSendECB expects lo-hi }
PEPsetupSendECB(NIL,IOsocket,ListenPepHdr.IPXhdr.source,@buf,0,
SendPepHdr,SendECB);
SendPepHdr.TransactionId:=ListenPepHdr.TransactionId;
SendPepHdr.clientType:=$EA;
IPXsendPacket(SendECB);
end;
end;
{$F-}
{$F+}
Procedure ListenAndAckESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
push es { push es:si on stack as local vars }
push si
mov di,sp
push ss { push address of local ptr on stack }
push di
CALL ListenAndAckHandler
add sp,4 { skip stack ptr-copy }
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var dest:TinternetworkAddress;
ticks,ticks2:word;
begin
IF NOT IpxInitialize
then begin
writeln('Ipx needs to be installed.');
halt(1);
end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
then begin
writeln('IPXopenSocket returned error# ',nwIPX.result);
halt(1);
end;
{ listen for incoming pep-packet }
PacketReceived:=False;
{ Empty receive buffer (ListenECB.fragment[2].address^) }
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
PEPSetupListenECB(Addr(ListenAndAckESR),IOsocket,@buf,546,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
writeln('Listening for incoming packet.');
IPXGetIntervalMarker(ticks);
REPEAT
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2)
UNTIL PacketReceived or ((ticks2-ticks)>(30*18));
{ do something with received buffer }
IF PacketReceived
then writeln('Packet received and acknowledged.')
else writeln('Timeout: no packet received in 30 seconds.');
IF NOT IPXcloseSocket(IOsocket)
then writeln('IPXcloseSocket returned error# ',nwIPX.result);
end.

30
NWTP/XIPX/TSTRIP.PAS Normal file
View File

@@ -0,0 +1,30 @@
Program tstRIP;
USES NwMisc,NwIPX,NwRIP;
Var ripInfo:TRIPinfo;
k,n :word;
NetAddr:TnetworkAddress;
begin
IF NOT IPXinitialize
then begin
writeln('IPX must be loaded before this program can be ran.');
halt(1);
end;
FillChar(NetAddr,4,#$0); { own segment }
n:=GetAllNetworks(NetAddr,ripInfo);
writeln;
writeln('MAIN: ',n,' network segment(s) found.');
writeln('Dumping the RIP tables of all found segments...');
writeln;
writeln('NetAddr Tcks Hops');
for k:=1 to n
do begin
write(HexDumpStr(ripinfo[k].address,8));
write(' ',ripinfo[k].ticks:4);
writeln(' ',ripinfo[k].hops:4);
end;
writeln('End of RIP table dump.');
end.

246
NWTP/XIPX/VEND_XXX Normal file
View File

@@ -0,0 +1,246 @@
# -----------------------------------------------------------------------
# VEND_XXX Ethernet Vendor Address Components
# Ethernet Multicast Addresses
# -----------------------------------------------------------------------
# This list is in 'First Fit' format, i.e. the first entry that matches
# the ethernet address contains the 'most fitting' description.
# Example: cardno = 00001B40EF45. First Fit => 00001B4 'NE 2000'
# cardno = 00001B267EA7. First Fit => 00001B 'Novell Eagle'
000000000001 Netware Server (dynamically assigned address)
000002 BBN
00000C Cisco
00000E Fujitsu
00000F NeXT
000010 Sytek/Hughes LAN systems
000011 Tektronics
000015 Datapoint
000018 Webster
00001A AMD ?
00001B4 Novell Eagle NE2000 (v1.12?)
00001B3 Novell Eagle NE2000
00001B2 Novell Eagle NE2000
00001B1 Novell Eagle NE2000
00001B Novell Eagle
00001D Cabletron
000020 DIAB (Data Intdustrier AB)
000021 SC&C
000022 Visual Technology (Vistec)
000023 ABB
000029 IMC
00002A TRW
00003C Auspex
00003D ATT
000044 Castelle
000046 Bunker Ramo
000049 Apricot
00004B APT
00004F Logicraft
000051 Hob Electronic
000052 ODS
000055 AT & T
00005A S & Koch/ ?Xerox
00005D RCE
00005E IANA
000061 Gateway
000062 Honeywell
000065 Network General
000069 Silicon Graphics
00006B MIPS
00006E Artisoft
000077 MIPS
000078 Labtam
00007A Ardent
00007B Research Machines
00007D Cray Research/ ? Harris
00007F Linotronic
000080 Dowty Network Systems / ? Harris
000081 SynOptics
000084 ? Aquila
000086 Gateway
000089 Cayman Systems (Gatorbox)
00008A Datahouse Information Systems
00008E Jupiter ? Solbourne ?
000093 Proteon
000094 Asante
000095 Sony/Tektronics
000097 Epoch
000098 CrossCom
00009F Ameristar Technology
0000A0 Sanyo Electronics
0000A2 Wellfleet Communications
0000A3 Network Application Technology (NAT)
0000A6 Network General (internal assignment, not for products)
0000A7 NCD (X-terminals)
0000A8 Stratus
0000A9 Network Systems
0000AA Xerox
0000B3 CIMLinc
0000B7 Dove (Fastnet)
0000BC Allen-Bradley
0000C0 Western Digital (WD/SMC)
0000C6 HP Intelligent Networks Operation (formerly Eon Systems)
0000C8 Altos
0000C9 Emulex (Terminal Servers)
0000D7 Dartmouth College (NED Router)
0000D8 3Com? Novell? PS/2
0000DD Gould
0000DE Unigraph
0000E2 Acer (Counterpoint)
0000EF Alantec
0000FD High Level Hardware (Orion, UK)
000102 BBN (internal usage - not registered)
00082D Siemens Nixdorf: TACLAN ?
001700 Kabel
0020AF 3Com Etherlink III
0040F62 Novell Eagle NE2000 (v1.05EC?)
0040F6 Novell Eagle
00608CF 3Com
00608CB 3Com Etherlink III
00608C5 3Com
00608C 3Com
008029 Novell Eagle ? / NE2000 compat. ?
00802D Xylogics, Inc. Annex terminal servers
00805A0 Tulip NCC16
00805A1 AMD PCNTNW Ethernet
00805A Tulip
00805C Agilis ?
00808C Frontier Software Development
0080C2 IEEE (802.1 Committee)
0080D3 Shiva
00AA00 Intel (NetPort printserver)
00C002 Trust (printserver)
00DD00 Ungermann-Bass
00DD01 Ungermann-Bass
01005E1 IANA Internet Multicast (RFC-1112)
01005E2 IANA Internet Multicast (RFC-1112)
01005E3 IANA Internet Multicast (RFC-1112)
01005E4 IANA Internet Multicast (RFC-1112)
01005E5 IANA Internet Multicast (RFC-1112)
01005E6 IANA Internet Multicast (RFC-1112)
01005E6 IANA Internet Multicast (RFC-1112)
01005E7 IANA Internet Multicast (RFC-1112)
01005E8 IANA Internet reserved (Multicast)
01005E9 IANA Internet reserved (Multicast)
01005EA IANA Internet reserved (Multicast)
01005EB IANA Internet reserved (Multicast)
01005EC IANA Internet reserved (Multicast)
01005ED IANA Internet reserved (Multicast)
01005EE IANA Internet reserved (Multicast)
01005EF IANA Internet reserved (Multicast)
0180C2000000 Spanning tree (for bridges) (Multicast)
020701 Racal/Micom InterLan
020406 BBN (internal usage - not registered)
026086 Satelcom MegaPac (UK)
02608C 3Com (IBM PC; Imagen; Valid; Cisco)
02CF1F CMC (Masscomp; Silicon Graphics; Prime EXL)
080001 CmpVsn ?
080002 3Com (Formerly Bridge)
080003 ACC (Advanced Computer Communications)
080005 Symbolics (LISP machines)
080006 Siemens-Nixdorf
080007 Apple
080008 BBN
080009 Hewlett-Packard
08000A Nestar Systems
08000B Unisys
080010 AT & T
080011 Tektronix, Inc.
080014 Excelan (BBN Butterfly, Masscomp, Silicon Graphics)
080017 NSC
08001A Data General
08001B Data General
08001E Apollo
080020 Sun (Sun microsystems)
080022 NBI
080025 CDC
080026 Norsk Data (Nord)
080027 PCS Computer Systems GmbH
080028 Texas Instruments (Explorer)
08002B DEC
08002E Metaphor
08002F Prime Computer (Prime 50-Series LHC300)
080036 Intergraph (CAE stations)
080037 Fujitsu-Xerox
080038 Bull
080039 Spider Systems
080041 DCA Digital Comm. Assoc.
080045 Xylogic !? (they claim not to know this number)
080046 Sony
080047 Sequent
080049 Univation
08004C Encore
08004E BICC
080056 Stanford University
080058 DECsystem-20
08005A IBM
08005C Agilis ??
080067 Comdesign
080068 Ridge
080069 Silicon Graphics
08006A AT & T
08006E Excelan
080075 DDE (Danish Data Elektronik A/S)
08007C Vitalink (TransLAN III)
080080 XIOS
080086 Imagen/QMS
080087 Xyplex (terminal servers)
080089 Kinetics (AppleTalk-Ethernet interface)
08008B Pyramid
08008D XyVision (XyVision machines)
080090 Retix Inc. (Bridges)
090002040001 ? Vitalink printer (Multicast)
090002040002 ? Vitalink management (Multicast)
090009000001 HP Probe (Multicast)
090009000001 HP Probe (Multicast)
090009000004 HP DTC (Multicast)
09001E000000 Apollo DOMAIN (Multicast)
09002B000000 DEC MUMPS? (Multicast)
09002B000001 DEC DSM/DTP? (Multicast)
09002B000002 DEC VAXELN? (Multicast)
09002B000003 DEC Lanbridge Traffic Monitor (LTM) (Multicast)
09002B000004 DEC MAP End System Hello (Multicast)
09002B000005 DEC MAP Intermediate System Hello (Multicast)
09002B000006 DEC CSMA/CD Encryption? (Multicast)
09002B000007 DEC NetBios Emulator? (Multicast)
09002B00000F DEC Local Area Transport (LAT) (Multicast)
09002B00001 DEC Experimental (Multicast)
09002B010000 DEC LanBridge Copy packets (All bridges) (Multicast)
09002B010001 DEC LanBridge Hello packets (All local bridges) (Multicast)
09002B020000 DEC DNA Lev.2 Routing Layer routers? (Multicast)
09002B020100 DEC DNA Naming Service Advertisement? (Multicast)
09002B020101 DEC DNA Naming Service Solicitation? (Multicast)
09002B020102 DEC DNA Time Service? (Multicast)
09002B03 DEC default filtering by bridges? (Multicast)
09002B040000 DEC Local Area Sys. Transport (LAST)? (Multicast)
09002B230000 DEC Argonaut Console? (Multicast)
09004E000002 ? Novell IPX (Multicast)
090056FF Stanford V Kernel, version 6.0 (Multicast)
090056 ? Stanford reserved (Multicast)
090077000001 Retix spanning tree bridges (Multicast)
09007C020005 Vitalink diagnostics (Multicast)
09007C050001 Vitalink gateway? (Multicast)
0D1E15BADD06 HP (Multicast)
484453 HDS ???
800010 AT&T
AA0000 DEC - multicast (obsolete)
AA0001 DEC - multicast (obsolete)
AA0002 DEC - multicast (obsolete)
AA0003 DEC - multicast (Global physical address for some DEC machines)
AA0004 DEC - multicast (Local logical address for systems running DECNET)
AA002C Intel ?? (Multicast)
AB0000010000 DEC Maintenance Operation Protocol (MOP) Dump/Load Assistance (Multicast)
AB0000020000 DEC MOP (System ID packets) DEC LanBridge/DEUNA/DELUA/DEQNA) (Multicast)
AB0000030000 DECNET Phase IV (end node Hello packets) DECNET host (Multicast)
AB0000040000 DECNET Phase IV (Router Hello packets) DECNET router (Multicast)
AB00000 Reserved by DEC (Multicast)
AB0001 Reserved by DEC (Multicast)
AB0002 Reserved by DEC (Multicast)
AB0003000000 DEC Local Area Transport (LAT) -old (Multicast)
AB0003 Reserved by DEC (Multicast)
AB000400 Reserved DEC customer private use (Multicast)
AB000401 DEC Local Area VAX Cluster groups Sys. Communication Architecture (SCA) (Multicast)
CF0000000000 Ethernet Configuration Test protocol (Loopback) (Multicast)
FFFFFFFFFFFF (Multicast address - Used by numerous systems - see RFC 1340)

74
NWTP/XLOCK/TSTLRL.PAS Normal file
View File

@@ -0,0 +1,74 @@
Program TstLRL;
{ Example for the nwLock unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Tests the following nwLock calls: (Logical Record Locking)
LogLocalRecord
LockLogicalrecordSet
ReleaseLogicalRecord
ClearLogicalRecordSet
}
Uses nwLock; { using this unit will automatically set the locmode to 1 }
Var RecordName:string;
TimeOutTicks:word;
begin
TimeOutTicks:=360; {wait 20 seconds before locking process times out}
writeln('TSTLRL: Test of logical record locking.');
writeln(' -Start the exe on 2 or more workstations & enjoy the effect.');
writeln;
writeln('Suppose we want to perform a transaction on a file, where:');
writeln('-we want to update (read&write) Records # 123, 678 and 056.');
writeln;
writeln('To do this, this program uses logical record locking in the following manner:');
writeln('-It locks records #123,678 and 056 in Exclusive mode.');
writeln(' (denying all attempts at locking by other stations.');
{ Put the names of records-to-be-EXCLUSIVELY-locked in the 'logged record set' }
RecordName:='#123';
IF NOT LogLogicalRecord(RecordName,LD_LOG,0)
then writeln('LogRecord failed. Error# ',nwLock.result);
{ Note: The recordnames used have no linkage whatsover with physical
records. They form a logical representation of a physical record.
All processes involved in locking processes on the same data must
use the same naming convention }
RecordName:='#678';
IF NOT LogLogicalRecord(RecordName,LD_LOG,0)
then writeln('LogRecord failed. Error# ',nwLock.result);
RecordName:='#056';
IF NOT LogLogicalRecord(RecordName,LD_LOG,0)
then writeln('LogRecord failed. Error# ',nwLock.result);
{ Lock all records that are currently stored in the 'logged record set' }
writeln('Attempting to place locks on records.. ');
IF NOT LockLogicalRecordSet(LD_LOCK,TimeoutTicks)
then writeln('LockLogicalRecordSet (after TimeOut=20 sec) failed. Error# ',nwLock.result);
if nwlock.result=0 { locking of records was successful }
then begin
{ ---Update records, change records, etc.--- }
{ Readln to simulate update }
writeln('Now ''processing'' locked records. Press RETURN to release locks.');
readln;
{ Suppose we're done with record #123, but still need the other record
-unlock 1 record; keep record in log }
IF NOT ReleaseLogicalRecord('#123')
then writeln('ReleaseLogicalRecord Failed. Error# ',nwLock.result);
writeln('Now ''processing'' still locked records');
end;
{ unlock all records; clear 'logged record set' }
IF NOT ClearLogicalRecordSet
then writeln('ClearLogicalRecordSet Failed. Error# ',nwLock.result);
end.

65
NWTP/XLOCK/TSTPFL.PAS Normal file
View File

@@ -0,0 +1,65 @@
Program TstPFL;
{ Example for the nwLock unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Tests the following nwLock calls: (Physical File Locking)
ClearPhysicalFileSet
LogPhysicalFile
LockPhysicalFileSet
ReleasePhysicalFile
}
Uses nwFile,nwLock; { using this unit will automatically set the locmode to 1 }
Var FileName:string;
TimeOutTicks:word;
begin
TimeOutTicks:=360; {wait 20 seconds before locking process times out}
writeln('TSTLF: Test of logical file locking.');
writeln(' -Make sure the files referenced to in this example exist.');
writeln(' -Start the exe on 2 or more workstations & enjoy the effect.');
writeln;
{ Put the names of files-to-be-locked in the 'logged file set' }
FileName:='SYS:PUBLIC/SYSCON.EXE';
IF NOT LogPhysicalFile(FileName,LD_LOG,0)
then writeln('Logfile failed. Error# ',nwLock.result);
{ Note: The files specified have to exist, or an error 156 is
returned. Using EXE files instead of data files can be
a bit confusing in this example, but at least those
files are very likely to be there. }
FileName:='SYS:\PUBLIC\PCONSOLE.EXE';
IF NOT LogPhysicalFile(FileName,LD_LOG,0)
then writeln('Logfile failed. Error# ',nwLock.result);
{ Repeat logging process for other (if needed) }
{ Lock all files that are currently stored in the 'logged file set' }
writeln('Attempting to Lock files.. ');
IF NOT LockPhysicalFileSet(TimeOutTicks)
then writeln('LockFileSet (after TimeOut=20 sec) failed. Error# ',nwLock.result);
if nwlock.result=0 { locking of files was successful }
then begin
{ ---Update file, change file, etc.--- }
{ Readln to simulate update }
writeln('Now ''processing'' files. Press RETURN to release locks.');
readln;
{ Suppose we're done with the 1st datafile, but still need file #2:
-unlock 1 single file; keep in log }
IF NOT ReleasePhysicalFile('SYS:\PUBLIC\SYSCON.EXE')
then writeln('ReleaseFile Failed. Error# ',nwLock.result);
writeln('Now ''processing'' still locked file');
end;
{ unlock all files; clear 'logged file set' }
IF NOT ClearPhysicalFileSet
then writeln('ClearFileSet Failed. Error# ',nwLock.result);
end.

409
NWTP/XMESS/PMAIL.PAS Normal file
View File

@@ -0,0 +1,409 @@
{$X+,B-,V-} {essential compiler directives}
Unit pmail;
{Example unit for the nwMess unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
INTERFACE
uses nwMisc,nwBindry,nwMess,nwServ;
{nwserv used for GetFileServerDateAndTime only. }
CONST {Mail Options}
PM_NO_NOTIFY =$02;
PM_DELIVER_IF_AF=$10;
PM_NO_CONF_REQ =$08;
PM_NO_MAIL =$04;
Var result:word;
Function PMailInstalled:boolean;
{ Checks if an object PEGASUS_MAIL of type OT_PEGASUS_MAIL exists
in the bindery. If the object exists, pmail is installed.}
Function SendMailFile(DestObjectName:string;objType:word;
subject,fileName:string):boolean;
{ PEGASUS MAIL V3.0 Compatible:
Sends a messagebody textfile (ASCII) to the mail directory of the
destination object. The object can either be a user or a group object.
Wildcards are allowed.
The destination object will see the calling object as the message
originating object.
Notes:
-Autoforwarding will be ignored.
-This is a single server function.
-Possible resultcodes:
$0 Success;
$100 * The given file could not be found. Supply full path and filename.
$101 * User and Group objects only;
$102 ? Error scanning bindery, see Nwbindry.Result for netware error # ;
$110 ? Group has no members / error reading members of a group.
$111 * Group or user object doesn't exist
$200 * Insufficient privilege to use the mail system.
$201 * You are not allowed to send to groups.
$202 * The supplied receiver user object has no access to mail /
has halted all incoming mail OR
the receiving object equals the sending object.
-All msgs were sent when the resultcode is $00;
-No msgs are send. (resultcodes marked with *)
-Some or no msgs may have been sent before this error occured.(marked ?)
}
IMPLEMENTATION{=============================================================}
Function PMailInstalled:boolean;
Var lastObj :LongInt;
foundObjName:string;
rt :word;
rid :LongInt;
rf,rs :byte;
rhp :Boolean;
begin
{ Checks if an object PEGASUS_MAIL of type OT_PEGASUS_MAIL exists
in the bindery. If the object exists, pmail is installed.}
lastObj:=-1;
PmailInstalled:=ScanBinderyObject('PEGASUS_MAIL',OT_PEGASUS_MAIL,lastObj,
foundObjName,rt,rid,rf,rs,rhp);
end;
{------------------Send file as message--------------------------------------}
Type TPmailHdr=record
from,too,date,subject,xmailer:string;
end;
var senderObjId:LongInt;
warning :byte;
time :TnovTime;
Procedure getRandomFileName(Var filename:string);
{ construct a semi-random filename out of the current date & time }
Var tim:TnovTime;
t :byte;
begin
nwServ.GetFileServerDateAndTime(tim);
fileName[0]:=#8;
filename[1]:=chr(tim.month);
filename[2]:=chr(tim.day);
filename[3]:=chr(tim.hour);
filename[4]:=chr(tim.min DIV 2);
filename[5]:=chr(tim.sec DIV 2);
filename[6]:=chr(random(36));
filename[7]:=chr(random(36));
filename[8]:=chr(random(36));
for t:=1 to 8
do if filename[t]<=#9 then inc(filename[t],ord('0'))
else inc(filename[t],ord('A')-10);
end;
Function IsObjGroupMember(objId:longInt;GroupName:string):boolean;
Var objName:string;
objType:word;
begin
IsObjGroupMember:=GetBinderyObjectName(objId,objName,objType)
and IsBinderyObjectInSet(GroupName,OT_USER_GROUP,'GROUP_MEMBERS',
objName,OT_USER);
end;
Function PmailNotifyUser(objName:string):boolean;
{ Read the MAIL_OPTIONS property (created by Pmail) of the destination object.
Structure of the property:
01 len Pmail_forwarding_adress_(asciiz) [OPTIONAL]
02 len Internet_forwarding_adress_(asciiz) [OPTIONAL]
03 04 extended_features_byte ???_byte [NOT optional]
04 len Charon 3.5+ sender synonym. [OPTIONAL]
Notes: -len= 3+length of the next asciiz string (excluding trailing 0)
-the above fields appear within the property in random order.
If the PM_NO_NOTIFY or the PM_NO_MAIL flag within the extended features
byte is set, then the destination object won't be notified. }
Var segNbr :word;
propValue:Tproperty;
moreSeg :boolean;
propFlags:Byte;
t :word;
fieldFlag:byte;
Notify :boolean;
begin
SegNbr:=1;
warning:=$00;
IF ReadPropertyValue(objName,OT_USER,'MAIL_OPTIONS',SegNbr,
propValue,moreSeg,propFlags)
then begin
t:=1;
REPEAT
fieldFlag:=propValue[t];
if fieldFlag<>3 then t:=t+propValue[t+1];
UNTIL (t>127) or (fieldFlag=3);
if fieldFlag=3
then begin
Notify:=((propValue[t+2] and PM_NO_NOTIFY)=0)
and ((propValue[t+2] and PM_NO_MAIL)=0);
if (propValue[t+2] and PM_NO_MAIL)>0
then warning:=$02;
end;
end
else if nwBindry.result=$EC { empty property, default: notify. }
then Notify:=true
else Notify:=false; { when in doubt, don't notify }
PmailNotifyUser:=Notify;
end;
Procedure SendMsgToUser(UserObjID:LongInt;VAR Hdr:TPmailHdr;fileName:string);
{copy file as a msg to the users' mail directory.}
Var userObjName:string;
objType :word;
buffer :array[1..4096] of byte;
bytesRead,bufOffs:word;
MsgFilePath,MailDir,MailFile:string;
Fin,Fout :file;
sendIt,NotifyReceiver:boolean;
MsgFrom :string;
begin
SendIt:=NOT(UserObjId=SenderObjId); { don't mail yourself }
{ checking Pmail settings.. }
IF IsObjGroupMember(UserObjId,'NOMAILBOX')
then SendIt:=false;
IsObjGroupMember(UserObjId,'MAILUSERS');
if (nwBindry.result=$EA) { no such member }
OR IsObjGroupMember(UserObjId,'NOMAIL')
then sendit:=false;
GetBinderyObjectName(UserObjID,UserObjName,objType);
NotifyReceiver:=PmailNotifyUser(UserObjName);
if warning=$02 { receiving user has PM_NO_MAIL flag raised }
then sendit:=false;
if sendit
then begin
warning:=$00;
if pos('From',hdr.from)=0
then Hdr.from:= 'From: '+Hdr.from;
MsgFrom:=Hdr.From; delete(MsgFrom,1,16);
Hdr.too := 'To: '+UserObjName;
if pos('Date',Hdr.date)=0
then Hdr.date:= 'Date: '+Hdr.date;
if pos('Subj',Hdr.subject)=0
then Hdr.subject:='Subject: '+hdr.subject;
Hdr.xmailer:='X-mailer: NwTP gateway to Pmail.';
bufOffs:=1;
move(hdr.from[1],buffer[bufOffs],ord(hdr.from[0]));
inc(bufOffs,2+ord(hdr.from[0]));
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
move(hdr.too[1],buffer[bufOffs],ord(hdr.too[0]));
inc(bufOffs,2+ord(hdr.too[0]));
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
move(hdr.date[1],buffer[bufOffs],ord(hdr.date[0]));
inc(bufOffs,2+ord(hdr.date[0]));
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
move(hdr.subject[1],buffer[bufOffs],ord(hdr.subject[0]));
inc(bufOffs,2+ord(hdr.subject[0]));
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
move(hdr.xmailer[1],buffer[bufOffs],ord(hdr.xmailer[0]));
inc(bufOffs,2+ord(hdr.xmailer[0]));
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
buffer[bufOffs]:=13;buffer[bufOffs+1]:=10; { empty line }
inc(bufOffs,2);
MailDir:=HexStr(UserObjId,8);
while maildir[1]='0' do delete(Maildir,1,1);
GetRandomFileName(MailFile);
{$I-}
MsgFilePath:='SYS:MAIL\'+MailDir+'\'+MailFile+'.CNM';
assign(Fin,fileName);
reset(Fin,1);
assign(Fout,MsgFilePath);
rewrite(Fout,1);
{ buffOfs-1 = number of bytes in buffer already filled }
BlockRead(Fin,buffer[bufOffs],4096-(bufOffs-1),bytesRead);
BlockWrite(Fout,buffer[1],bytesRead+(bufOffs-1));
REPEAT
BlockRead(Fin,buffer[1],4096,bytesRead);
BlockWrite(Fout,buffer[1],bytesRead);
UNTIL bytesRead<4096;
close(Fin);
close(Fout);
{$I+}
IF NotifyReceiver
then nwMess.SendmessageToUser(UserObjName,
'(NwTP/Pmail:) You have mail. (From:'+MsgFrom+')')
end
else warning:=$01;
end;
Procedure SendMsgToGroup(GroupObjName:string;Hdr:TPmailHdr;fileName:string);
Label abrt;
Var NbrOfWrites:word;
i :byte;
lastObj :LongInt;
foundGroupName:string;
rt :word;
rid :LongInt;
rf,rs :byte;
rhp :boolean;
SegNbr :byte;
propValue:Tproperty;
moreSeg :boolean;
propFlags:byte;
objId : LongInt;
begin
NbrOfWrites:=0;
lastObj:=-1;
WHILE ScanBinderyObject(GroupObjName,OT_USER_GROUP,lastObj,
foundGroupName,rt,rid,rf,rs,rhp)
do begin {1}
if (GroupObjName<>'NOMAIL') and (GroupObjName<>'NOMAILBOX')
then begin {3}
SegNbr:=1;
While ReadPropertyValue(foundGroupName,OT_USER_GROUP,'GROUP_MEMBERS',
SegNbr,propValue,moreSeg,propFlags)
do begin {5}
i:=1;
Repeat
objId:=MakeLong((PropValue[i] *256 +PropValue[i+1]),
(PropValue[i+2] *256 + PropValue[i+3] ) );
if objId<>0
then begin
SendMsgToUser(objId,Hdr,fileName);
inc(NbrOfWrites);
end;
inc(i,4);
Until (i>128) or (objId=0);
inc(SegNbr);
end; {5}
If nwBindry.Result<>$EC {no such segment}
then begin
Result:=$110;
goto abrt;
end;
end; {3}
end; {1}
if nwBindry.Result<>$FC {no such object}
then begin
result:=$111;
goto abrt;
end;
if NbrOfWrites=0 {no users found}
then result:=$110;
abrt: ;
end;
Function SendMailFile(DestObjectName:string;objType:word;
subject,fileName:string):boolean;
Var secLevel :byte;
senderName:string;
SenderObjType:word;
Hdr :TPmailHdr;
lastObj :longInt;
foundUserName:string;
rt :word;
rf,rs :byte;
rhp :boolean;
DestObjId :longint;
testFile :file;
begin
Warning:=$00;
{ check: does filename exist? if not, stop right away. error $100 }
{$I-}
assign(testFile,filename);
reset(testFile);
if IOresult<>0
then begin
result:=$100;
SendmailFile:=False;
exit;
end
else close(testFile);
{$I+}
GetBinderyAccessLevel(secLevel,senderObjId);
GetBinderyObjectName(senderObjId,senderName,SenderObjType);
{checking pmail config. groups... }
IsObjGroupMember(senderObjId,'MAILUSERS');
if (nwBindry.result=$EA) { mailusers group exists, sender not a member }
OR IsObjGroupMember(senderObjId,'NOMAIL')
then begin
result:=$200; { Insufficient privilege to use the mail system. }
SendMailFile:=false;
exit;
end;
Hdr.from:=senderName;
Hdr.subject:=subject;
GetFileServerDateAndTime(time);
NovTime2String(time,Hdr.date);
Result:=0;
if objType=OT_USER
then begin
lastObj:=-1;
WHILE ScanBinderyObject(DestObjectName,OT_USER,lastObj,
foundUserName,rt,DestObjID,rf,rs,rhp)
do begin
SendMsgToUser(DestObjId,Hdr,fileName);
end;
IF nwBindry.result<>$FC { no such object } then result:=$102;
end
else if objType=OT_USER_GROUP
then begin
IsObjGroupMember(senderObjId,'GROUPMAIL');
if (nwBindry.result=$EA) { group groupmail exists, sender not a member }
OR IsObjGroupMember(senderObjId,'NOGROUPMAIL')
then result:=$201 { don't send }
else SendMsgToGroup(DestObjectName,Hdr,fileName)
end
else result:=$101;
if (warning=$01) and (objType=OT_USER) and (result=$00)
and (pos('*',DestObjectName)=0) and (pos('?',DestObjectName)=0)
then result:=$202;
SendMailFile:=(result=0);
{ possible resultcodes:
$0 Success;
$100 * The given file could not be found. Supply full path and filename.
$101 * User and Group objects only;
$102 ? Error scanning bindery, see Nwbindry.Result for netware error # ;
$110 ? Group has no members / error reading members of a group.
$111 * Group or user object doesn't exist
$200 * Insufficient privilege to use the mail system.
$201 * You are not allowed to send to groups.
$202 * The supplied receiver user object has no access to mail /
has halted all incoming mail OR
the receiving object equals the sending object.
Note: -All msgs were send when the resultcode is $00;
-No msgs are send. (resultcodes marked with *)
-Some or no msgs may have been send before this error occured.(marked ?)
}
end;
begin
Randomize;
end.

118
NWTP/XMESS/TSTMESS.PAS Normal file
View File

@@ -0,0 +1,118 @@
{$X+,B-,V-}
program test;
{ Test program for the nwMess unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Test the following nwMess functions:
BroadcastToConsole
GetBroadcastMessage
GetBroadCastMode
SetBroadcastMode
SendBroadcastMessage
SendConsoleBroadcast
}
uses nwmisc,nwMess;
Var t,tbm,bm:byte;
connL,connResultL:TconnectionList;
mess :string;
Procedure DisplayBrMode(bm:byte);
begin
Case bm of
00: begin writeln('Server Stores : Netware Messages and User Messages,');
writeln('Shell automaticly displays messages.')
end;
01: begin writeln('Server Stores : Server Messages. (User messages discarded)');
writeln('Shell automaticly displays messages.')
end;
02: begin writeln('Server stores : Server messages only.');
writeln('Applications have to use GetBroadCastMessage to see if there is a message.')
end;
03: begin writeln('Server stores : Server messages and User messages.');
writeln('Applications have to use GetBroadCastMessage to see if there is a message.')
end;
else writeln('Unknown broadcastMode')
end; {case}
end;
begin
writeln;
writeln('Testing BroadcastToConsole..');
writeln('This will make the server beep ! (NOT an error this time)');
writeln;
writeln('<Return> to continue..');
readln(mess);
if BroadcastToConsole('Hello, Console Operator!')
then writeln('BroadcastToConsole: Msg was broadcasted..')
else writeln('Broadcast To Console error:'+hexstr(nwMess.result,2));
writeln;
if GetBroadcastMode(bm)
then begin
writeln('GetBroadcastMode: $',HexStr(bm,2));
DisplayBrMode(bm);
t:=3;
while (t>=0) and (t<=3)
do if SetBroadcastMode(t) and GetBroadcastMode(tbm) and (tbm=t)
then dec(t) { ok, try next mode, alowed modes: 0,1,2,3 }
else begin
writeln('SetBroadcastMode/GetBroadcastMode test failed.');
t:=$80;
end;
if t=byte(-1)
then begin
SetBroadCastMode(bm); { restore old broadcastmode.. }
if nwmess.result=$00
then begin
writeln;
writeln('SetBroadcastMode tested OK..');
end
else writeln('SetBroadcastMode error: Old mode couldn''t be restored..');
end;
end
else writeln('GetBroadcastMode error:'+hexstr(nwMess.result,2));
writeln;
for t:=1 to 20 do connL[t]:=t;
IF sendBroadcastMessage('Hello u there!',20,connL,connResultL)
then begin
writeln('SendBroadcastMessage: Msg was broadcasted..');
writeln('--and displayed at the folowing connections:');
for t:=1 to 20 do if connResultL[t]=$00 then write(t,' ');
writeln;
end
else writeln('SendBroadcastMessage error:'+hexstr(nwMess.result,2));
writeln;
IF SendConsoleBroadcast('Testmessage from Console-operator..',0,connL)
then writeln('SendConsoleBroadcast: console message sent.')
else begin
write('SendConsoleBroadCast: Error ');
if nwMess.result=$C6
then writeln('! You need to have console privileges..')
else writeln(HexStr(nwMess.result,2));
end;
GetBroadCastMode(bm);
writeln;
if SetBroadCastMode(3) { store all messages at the server, no notification.. }
then begin
writeln('Test of getBroadCastMessage..');
writeln('--use SEND on another workstation and send a message to this station.');
writeln;
writeln('Polling for a message.....');
REPEAT {} UNTIL GetBroadCastMessage(mess);
writeln('Message: ',mess);
end;
SetBroadCastMode(bm); { restore broadcastmode }
end.

21
NWTP/XMESS/XPMAIL.PAS Normal file
View File

@@ -0,0 +1,21 @@
{$X+,B-,V-} {essential compiler directives}
Program xpmail;
{ Example program for the pmail unit / NwTP 0.6 API. (c) 1993,1994, R.Spronk }
uses nwMisc,nwBindry,pmail;
CONST MsgBodyTXTfile='a:testmsg.txt';
{ Simple program illustrating the use of the SendMailFile call. }
begin
IF NOT PmailInstalled
then begin
writeln('PMail not installed on the current server.');
halt(1);
end;
IF NOT SendMailFile('SUPERVISOR',OT_USER,
'testmessage',MsgBodyTXTfile)
then writeln('Error sending file as mail. err# :',HexStr(pmail.result,4));
end.

819
NWTP/XOTHER/PHONE.PAS Normal file
View File

@@ -0,0 +1,819 @@
Program Phone;
{$IFDEF VER70}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+}
{$ELSE}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
{$ENDIF}
{ Source code for Borland/Turbo Pascal 6/7.
To be compiled with NwTP version 0.6 or higher.
NwTP is a FreeWare Netware Interface for Pascal.
}
{ Based on the phone.pas program by Eduardo M. Serrat,
as published in Dr.Dobbs #207, November 1993.
The NwTP units and this adaption of his program are
(c) 1993,1995 by Rene Spronk ,Groningen, the Netherlands. }
uses dos,crt,nwMisc,nwBindry,nwConn,nwMess,nwServ,nwIPX;
const Socket = $80C3;
{ This socket was assigned by Novell to an IPX Chatprogram by OXXI }
{ Don't use this program in conjunction with theirs.. }
Var
SendECB,
ListenECB :TEcb; { Definition of ECBs }
SendIpxHeader,
ListenIPXheader:TIpxHeader; { Definition of IPX Headers }
SendData,
ReadData :Array [1..100] of Byte; { Data area of packets }
readflg :Boolean; { Flag to signal received packets }
MyConnNbr :Byte;
MyAddress :TinternetworkAddress;
MyName :String;
MyServerId :Byte;
MyServerName :String;
myx,myy :Byte; { my viewport cursor position }
RconnNbr :Byte;
Raddress :TinterNetworkAddress;
Rname :String;
RfullName :String;
RserverID :Byte;
RserverName :String;
LocalTarget :TnodeAddress; { Node Address of bridge to remote address }
NewStack :Array[1..256] of Word; { !! used by ESR }
StackBottom :Word; { !! used by ESR }
HeapCheckPtr :pointer; { Pointer that holds heapPointers }
{---------------------------------------------------------------------------}
Procedure CheckError(b:Boolean;errCode:Word; mess:String);
begin
IF b
then begin
writeln;
CASE errCode of
{ main body: 0000-000F }
$0001:writeln('IPX not installed.');
$0002:writeln('Error opening socket.');
{ Procedure whoami }
$0010:writeln('Error whilst determining connectionnumber.');
$0011:writeln('Error determining internet address.');
$0012:writeln('Error retreiving connection information.');
{ Procedure process input command }
$0022:writeln('Servername ',mess,' is invalid.');
$0023:writeln('Error interpreting connection number parameter :',mess);
$0025:begin
writeln('The supplied username is not unique,');
writeln('or the target user isn''t logged in.');
end;
$0026:writeln('Please select a target user from the above list.');
$0027:writeln('Phone cancelled.');
{ handshake with sender }
$0032:writeln('Packet received from a user claiming to be ConnectionNumber $',mess);
{ Sendbroadcast message in Procedure HandshakeWithreceiver }
$1000: writeln('Error: Broadcasting a message to the target user failed.');
$10FC: begin
Writeln('The target user is logged in, but appears not to be at his/her workstation:');
writeln('The (last) message was rejected, message buffer for the target station is full.');
end;
$10FD: begin
Writeln('The connection number of the target user has become invalid,');
Writeln('Most likely because the user has logged out.');
end;
$10FF: begin
Writeln('The target user is logged in, but has blocked incoming messages.');
end;
else writeln('An unspecified error occurred.');
end; {case }
if errCode>$000F then IPXcloseSocket(socket);
if errCode>$001F
then begin
SetPreferredConnectionId(MyServerId);
release(HeapCheckPtr);
end;
if ((errCode=$0026) or (errCode=$0027))
then halt(0)
else halt(1);
end;
end;
{-----------------------------------------------------------------------------}
Function Confirm:Boolean;
Var ch:char;
begin
repeat
repeat {} until keypressed;
ch:=readkey;
if ch=#0 then ch:=readkey;
until ch IN ['y','Y','n','N'];
Confirm:=((ch='Y') or (ch='y'))
end;
{-----------------------------------------------------------------------------}
{$F+}
Procedure ESRproc;
begin
ReadFlg:=true;
end;
Procedure ESRHandler; assembler;
asm { ES:SI are the only valid registers when entering this Procedure ! }
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx
push bx
CALL EsrProc
pop bx
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
{-----------------------------------------------------------------------------}
Function SameAddress(Var a,b):Boolean;
{ check if networkaddress a and b have the same net and node address }
Type Taddress=Array[1..10] of char;
Var addrA:Taddress ABSOLUTE a;
addrB:Taddress ABSOLUTE b;
begin
SameAddress:=(addrA=addrB);
end;
{----------------------------------------------------------------------------}
Function Time:String;
Function LeadingZero(w:Word):String;
Var s : String;
begin
Str(w:0,s);
if Length(s) = 1
then s := '0' + s;
LeadingZero := s;
end;
Var h, m, s, hund : Word;
begin
GetTime(h,m,s,hund);
Time:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s);
end;
{-----------------------------------------------------------------------------}
Procedure HandshakeWithReceiver;
const Progress : Array [1..4] of char = ('/','Ä','\','|');
Var
SecondInd :Word;
ProgressInd :Byte;
x,y :Byte;
KeyNbr :Byte;
ConnUp :Boolean;
ObjName :String;
ObjType :Word;
ObjId :LongInt;
LogonTime :TnovTime;
Message :String;
ConnList,
ResultList :TconnectionList;
begin
Writeln('Calling User ',Rname);
Write('Press <ESC> to cancel [ ]');
x:=wherex-2; y:=wherey;
Message:='User '+MyName+' is phoning you........... ['+Time+']';
SecondInd:=0; ProgressInd:=1;
SetPreferredConnectionId(RserverId);
ConnList[1]:=RconnNbr;
SendBroadcastMessage(message,1,ConnList,ResultList);
Checkerror(nwMess.result>0,$1000,'');
CheckError(ResultList[1]>0,$1000+ResultList[1],'');
IPXListenForPacket(ListenECB);
KeyNbr:=$ff;
ConnUp:=False;
FillChar(SendData,SizeOf(SendData),#0);
SendData[1]:=Hi(MyConnNbr);
SendData[2]:=Lo(MyConnNbr);
Move(MyServerName[1],SendData[3],ord(MyserverName[0]));
Move(MyName[1],SendData[50],ord(Myname[0]));
repeat { send a packet every 4 seconds and a broadcast message every 30 seconds }
gotoxy(x,y);
write(Progress[ProgressInd]);
inc(ProgressInd);
if ProgressInd > 4
then begin
ProgressInd:=1;
IPXSendPacket(SendECB);
end;
inc(SecondInd);
if SecondInd = 30
then begin
SendBroadcastMessage(message,1,ConnList,ResultList);
Checkerror(nwMess.result>0,$1000,'');
CheckError(ResultList[1]>0,$1000+ResultList[1],'');
SecondInd:=0;
end;
delay(1000);
if readflg
then begin
writeln('recieved a packet..');
if not SameAddress(ListenIPXheader.source,Raddress)
then begin
readflg:=false;
IPXListenForPacket(ListenECB);
end
else ConnUp:=TRUE;
end;
if keypressed
then KeyNbr:=ord(readkey);
until (KeyNbr = $1b) or ConnUp;
if KeyNbr = $1b
then begin
Writeln;
Write('Wait...');
Delay(5000);
SendData[1]:=$1b;
IPXSendPacket(SendECB);
message:='The user phoning you canceled the call... ['+Time+']';
SendBroadcastMessage(message,1,ConnList,ResultList);
IpxCloseSocket(Socket);
SetPreferredConnectionID(MyServerId);
halt(1);
end;
Writeln;
Write('User ',Rname,' answered your call......!');
delay(1200);
ReadFlg:=false;
end;
{--------------------------------------------------------------------------}
Procedure HandshakeWithSender;
const Progress:Array [1..4] of char = ('/','Ä','\','|');
Var p :Byte;
ObjType :Word;
ObjId :LongInt;
LoginTime:TnovTime;
ticks :Word;
x,y :Word;
begin
Writeln('Listening for calls..');
Write('Press <ESC> to cancel [ ]');
x:=wherex-2; y:=wherey;
IPXListenForPacket(ListenECB);
p:=1;
while(p<=4) and (not ReadFlg)
do begin
gotoxy(x,y);
write(Progress[p]);
delay(1200);
inc(p);
end;
If not readflg
then begin
Writeln;
Writeln('Nobody is Calling you..........');
writeln;
writeln('( PHONE ? for help )');
IpxCloseSocket(Socket);
SetPreferredConnectionId(MyServerId);
halt(1);
end
else begin
readflg:=false;
Raddress:=ListenIPXheader.source;
Raddress.socket:=Socket;
RconnNbr:=(ReadData[1]*256)+ReadData[2];
ZstrCopy(RserverName,ReadData[3],47);
ZstrCopy(Rname,ReadData[50],47);
IPXGetLocalTarget(Raddress,LocalTarget,ticks);
IPXSetupSendECB(NIL, Socket, Raddress,
Addr(SendData), SizeOf(SendData),
SendIPXheader,SendECB);
IPXSendPacket(SendECB); { acknowledge by sending a packet. Packet contents unimportant. }
end;
end;
{-----------------------------------------------------------------------------}
Procedure InitWindows;
Var i: Byte;
begin
ClrScr;
myx:=1; myy:=1;
gotoxy(1,1);
write('É'); for i:=2 to 79 do write('Í'); write('»');
write('º'); for i:=2 to 79 do write(' '); write('º');
gotoxy(3,2);
Write('User: '+MyName+' ° Server: '+MyServerName);
write(' ° Connection: '); write(MyConnNbr);
gotoxy(1,3);
write('È'); for i:=2 to 79 do write('Í'); write('¼');
gotoxy(1,13);
write('É'); for i:=2 to 79 do write('Í'); write('»');
write('º'); for i:=2 to 79 do write(' '); write('º');
gotoxy(3,14);
Write('User: '+Rname+' ° Server: '+RserverName);
Write(' ° Connection: '); write(RconnNbr);
Gotoxy(1,15);
write('È'); for i:=2 to 79 do write('Í'); write('¼');
gotoxy(26,25);
Write('±±±²²² Phone Utility ²²²±±±');
gotoxy(1,1);
HighVideo;
end;
{-----------------------------------------------------------------------------}
Procedure Talk;
Function Timeout(w1,w2:Word;sec:Byte):Boolean;
Var lw2:Longint;
begin
if w2<w1
then lw2:=$10000+w2
else lw2:=w2;
Timeout:=((lw2-w1) DIV 18)>sec;
end;
Procedure MyWindow;
begin
Window(1,5,80,12);
gotoxy(myx,myy);
end;
Procedure RemoteWindow;
begin
Window(1,17,80,24);
end;
Var currMarker,
SendMarker,
ListenMarker:Word;
ch :Char;
RlastChar,
RlastX,
RlastY :byte;
begin
MyWindow;
IPXListenForPacket(ListenECB);
IPXSetupSendECB(NIL, Socket, Raddress, Addr(SendData), 7,
SendIPXheader,SendECB); { make size of sendBuffer smaller }
IPXgetIntervalMarker(SendMarker);
ListenMarker:=SendMarker;
SendData[1]:=$FF;
RlastChar:=$FF;
REPEAT
if keypressed
then begin
MyWindow;
SendData[4]:=SendData[1]; { append last typed char to packet. }
SendData[5]:=SendData[2]; { original packet may have been lost }
SendData[6]:=SendData[3]; { Remember: IPX is unreliable ! }
ch:=readkey;
if ch=#0
then begin
ch:=readkey;
CASE ord(ch) of
75:begin { <- 'cursor left' }
SendData[2]:=myx-1;
if (myx=1) then SendData[2]:=1;
gotoxy(SendData[2],myy);
SendData[3]:=myy;
SendData[1]:=$00;
end;
77:begin { -> 'cursor right' }
SendData[2]:=myx+1;
if (myx=80) then SendData[2]:=80;
gotoxy(SendData[2],myy);
SendData[3]:=myy;
SendData[1]:=$00;
end;
else SendData[1]:=$FF;
end; {case}
end
else begin
SendData[1]:=ord(ch);
SendData[2]:=myx;
SendData[3]:=myy;
Case ord(SendData[1]) of
8 :write(#8+#$20+#8); { backspace }
13:writeln; { return }
else write(chr(SendData[1]));
end; {case}
end;
myx:=wherex;
myy:=wherey;
IPXSendPacket(SendECB); { send current and previous char }
IPXGetIntervalMarker(SendMarker);
end;
if readflg
then begin
If SameAddress(ListenIPXheader.source,Raddress)
then begin
if (readData[4]<>$FF)
and ( (readData[4]<>RlastChar)
or (readData[5]<>Rlastx)
or (readData[6]<>Rlasty)
)
then begin { if we missed a packet, display char now }
RemoteWindow;
Gotoxy(ReadData[5],ReadData[6]);
CASE ReadData[4] of
0:begin { don't print, cursor movement only }
end;
8:write(#8+#$20+#8); { backspace }
13:writeln; { return }
else write(chr(ReadData[1]));
end;{case}
end;
if ReadData[1]<>$FF
then begin
RemoteWindow;
Gotoxy(ReadData[2],ReadData[3]);
CASE ReadData[1] of
0:begin { don't print, cursor movement only }
end;
8:write(#8+#$20+#8);
13:writeln;
else write(chr(ReadData[1]));
end;{case}
end;
RlastChar:=ReadData[1];
RlastX :=ReadData[2];
RlastY :=ReadData[3];
IPXGetIntervalMarker(ListenMarker);
end;
readflg:=false;
IPXListenForPacket(ListenECB);
end;
IPXRelinquishControl;
IPXGetIntervalMarker(currMarker);
IF Timeout(SendMarker,currMarker,5) { send an "I'm alive" msg after 5 idle secs }
then begin
SendData[4]:=SendData[1]; { redundant info: append last char to packet. }
SendData[5]:=SendData[2];
SendData[6]:=SendData[3];
SendData[1]:=$FF;
IPXSendPacket(SendECB);
IPXGetIntervalMarker(SendMarker);
end;
IF Timeout(ListenMarker,currMarker,17) { fake an "hang-up" if no msgs received during 17 secs }
then begin
ReadData[1]:=$1B;
RemoteWindow;
end;
UNTIL (ReadData[1]=$1b) or (SendData[1]=$1b); { .. until either party has hung up }
SendData[1]:=$1b;
IPXSendPacket(SendECB);
IpxCloseSocket(Socket);
Writeln;
Writeln;
writeln('<Hanging Up...........>');
Delay(2000);
Window(1,1,80,25);
LowVideo;
gotoxy(80,25);
end;
{--------------- ProcessInputCommand----------------------------------------}
Type PusrInfo=^TusrInfo;
TusrInfo=record
ObjName :String[47];
FullName:String[40];
ConnId,
ConnNbr :Byte;
Address :TinterNetworkAddress; { socket field not used }
next :PusrInfo;
end;
Var startInfo:PusrInfo;
Procedure PushInLL(_objName,_objFullName:String;
_connId,_connNbr:Byte;
_address:TinternetworkAddress);
Var p,m,l:PusrInfo;
begin
p:=startInfo;
new(l);
With l^
do begin
if _objFullName[0]>#40
then _objFullName[0]:=#40;
objName:=_objName;
fullName:=_objFullName;
connId:=_connId;
connNbr:=_connNbr;
address:=_address;
next:=NIL;
end;
if p=NIL
then startInfo:=l
else begin
m:=p;
While (p<>NIL) and (p^.objName<=_obJname)
do begin m:=p;p:=p^.next; end;
if p=startInfo
then begin { insert before first LL entry }
l^.next:=startInfo;
startInfo:=l;
end
else begin { insert in LL or append to end }
l^.next:=m^.next;
m^.next:=l;
end;
end;
end;
Function GetTargetUser:PusrInfo;
{ returns NIL if a target user was not uniquely identified by the user }
Var l :PusrInfo;
serverName :String;
SelectedUsers:Word;
t :Word;
s :String;
ch :char;
Laddr :TinternetworkAddress;
AddrSame :boolean;
begin
{ are all objNames the same?
Yes => multple logins (connNbr must have been supplied)
or login on multiple servers (serverName must h.b. supplied)
No => the supplied userName is not unique. }
l:=startInfo;
SelectedUsers:=0;
IF l<>NIL
then Laddr:=l^.address;
AddrSame:=true;
While (l<>NIL)
do begin
inc(SelectedUsers);
AddrSame:=AddrSame and SameAddress(Laddr,l^.address);
l:=l^.next;
end;
If AddrSame { are all the users essentially the same ? }
then SelectedUsers:=1;
CASE SelectedUsers of
0:begin
GetTargetUser:=NIL;
end;
1:begin { OK! unique users identified }
GetTargetUser:=StartInfo;
end;
else begin
writeln('The target user has multiple connections.');
writeln('Please give connection number and/or server name of the intended user.');
writeln;
writeln('Username | Server | Con | Full Name');
writeln('---------------------+-----------------+-----+----------------------');
t:=3;
l:=startInfo;
while l<>NIL
do begin
GetFileServerName(l^.connId,servername);
PstrCopy(s,l^.objName,20);
write(s,' | ');
PstrCopy(s,serverName,15);
write(s,' | ',l^.connNbr:3,' | ');
PstrCopy(s,l^.fullname,30);
writeln(s);
l:=l^.next;
inc(t);
if t=20
then begin
writeln('--- more (any key)---');
repeat {} until keypressed;
ch:=readkey;
if ch=#0 then ch:=readkey;
t:=0;
end;
end;
GetTargetUser:=NIL;
end;
end; {case}
end;
Procedure ProcessInputCommand;
Var SearchStartServer,
SearchEndServer :Byte;
ConnIdCtr,
ConnNbrCtr :Byte;
LuserName,
LserverName :String;
LconnId :Byte;
LfullName :String;
LconnNbr :Byte;
ServerInfo :TFileServerInformation;
objName :String;
objType :Word;
objId :Longint;
ticks :Word;
LoginTime :TnovTime;
IntNWaddress :TinternetworkAddress;
TargetUserPtr :PusrInfo;
p :Byte;
errcode :Integer;
begin
StartInfo:=NIL;
If (ParamCount>0)
and ( (pos('?',paramstr(1))>0)
or (pos('help',paramstr(1))>0)
or (pos('HELP',paramstr(1))>0)
)
then begin
writeln;
writeln('** Phone V 1.3., By E.M. Serrat and R. Spronk');
writeln;
writeln('** Usage: PHONE');
writeln;
writeln('Listen for others calling you.');
writeln;
writeln;
writeln('** Usage: PHONE [servername/]UserName [connection]');
writeln;
writeln('Call someone.');
writeln('-Username may be a ''*'' wildcard.');
writeln(' All logged in users on all attached servers will be shown.');
writeln('-Sender and receiver must be attached to a common server in the internetwork.');
writeln('-The supplied username is compared with the first characters of');
writeln(' the login name and with the full user name, as set by SYSCON.');
writeln('-Servername must be supplied if the target user has connections');
writeln(' with more than one server.');
writeln('-ConnectionNumber must be supplied if the target user is logged in');
writeln(' at multiple workstations attached to the same server.');
writeln;
writeln('The program will timeout if the program on the other end of the link');
writeln('is terminated abnormally.');
halt(1);
end;
if paramcount=0 { ---- Listen if anyone is calling us ----- }
then begin
HandshakeWithSender;
InitWindows;
Talk;
IpxCloseSocket(Socket);
SetPreferredConnectionId(MyServerId);
halt(0);
end;
{ ** Paramcount>0, We're calling someone ** }
LconnNbr:=0;
SearchStartServer:=1;
SearchEndServer:=8;
LuserName:=ParamStr(1);
UpString(LuserName);
p:=pos('/',LuserName);
checkError((p=1) and (LuserName[0]=#1),$0020,'');
if p>0
then begin
LserverName:=copy(LuserName,1,p-1);
delete(LuserName,1,p);
if LuserName=''
then LuserName:='*';
if pos('*',LserverName)=0
then begin
GetConnectionId(LserverName,LconnId);
checkError(nwConn.result>0,$0022,LserverName);
SearchStartServer:=LconnId;
SearchEndServer:=LconnId;
end;
end;
if paramcount>1
then begin
Val(ParamStr(2),LconnNbr,errcode);
checkError(errcode<>0,$0023,Paramstr(2));
end;
writeln('Scanning logged in users..');
ConnIdCtr:=SearchStartServer;
While ConnIdCtr<=SearchEndServer
do begin
If IsConnectionIdInUse(ConnIdCtr)
then begin
SetPreferredConnectionId(ConnIdCtr);
IF NOT GetFileServerInformation(ServerInfo)
then ServerInfo.connectionsMax:=250; { patch value if call failed }
for ConnNbrCtr:=1 to ServerInfo.ConnectionsMax
do begin
IF GetConnectionInformation(ConnNbrCtr,ObjName,objType,objId,LoginTime)
and (objType=OT_USER)
then begin
GetInterNetAddress(ConnNbrCtr,IntNWaddress);
GetRealUserName(ObjName,LfullName);
UpString(LfullName);
IF (pos('NOT-LOGGED-',objName)=0) { skip not logged in connections }
and ((LconnNbr=0) or (LconnNbr=ConnNbrCtr)) { if user supplied connNbr, check it }
and (NOT SameAddress(MyAddress,IntNWAddress)) { no mail to yourself }
and ( (LuserName[1]='*') { wildcard overrules nameselection }
or (pos(LuserName,ObjName)=1) { username matched with firts few characters in objName? }
or (pos(LuserName,LfullName)>0) { usermane matches part of objects' Full_Name ? }
)
then PushInLL(objName,LfullName,ConnIdCtr,ConnNbrCtr,
IntNWaddress);
end;
end;
end;
inc(ConnIdCtr);
end;
TargetUserPtr:=GetTargetUser;
checkError((LuserName[1]<>'*') and (TargetUserPtr=NIL),$0025,''); { No user selected }
checkError(TargetUserPtr=NIL,$0026,'');
RconnNbr:=TargetUserPtr^.connNbr;
Raddress:=TargetUserPtr^.address;
Raddress.Socket:=Socket;
Rname:=TargetUserPtr^.objName;
RserverId:=TargetUserPtr^.connId;
GetFileServerName(RserverId,RserverName);
release(HeapCheckPtr);
SetPreferredConnectionId(RserverId);
GetRealUserName(Rname,RfullName);
writeln;
writeln(RserverName,'/',Rname,' Connection_Number= ',RconnNbr);
writeln('(Full name =',RfullName,')');
writeln;
write('Is the above user the intended chat partner ? (Y/N)');
checkError(NOT Confirm,$0027,''); { user abort }
writeln;
IPXGetLocalTarget(Raddress,LocalTarget,ticks);
IPXSetupSendECB(NIL, Socket, Raddress, Addr(SendData), SizeOf(SendData),
SendIPXheader,SendECB);
HandShakeWithReceiver;
InitWindows;
Talk;
IpxCloseSocket(Socket);
SetPreferredConnectionId(MyServerId);
halt(0);
end;
Procedure WhoAmI; {---------------------------------------------------------}
Var ObjType :Word;
ObjId :LongInt;
LogonTime:TnovTime;
begin
GetConnectionNumber(MyConnNbr);
checkError(nwConn.result>0,$0010,'');
GetInternetAddress(MyConnNbr,MyAddress);
checkError(nwConn.result>0,$0011,'');
MyAddress.Socket:=Socket;
GetConnectionInformation(MyConnNbr,MyName,ObjType,ObjId,LogonTime);
checkError(nwConn.result>0,$0012,'');
GetEffectiveConnectionID(MyServerId);
GetFileServerName(MyServerId,MyServerName);
end;
{-----------------------------------------------------------------------------}
Var LocSocket:Word;
begin
Writeln('*** PHONE V1.3 ***');
Mark(HeapCheckPtr);
LocSocket:=Socket;
readflg:=false;
Checkerror(NOT IpxPresent,$0001,'');
IpxOpenSocket(LocSocket,FALSE);
Checkerror(nwIPX.result>0,$0002,'');
WhoAmI;
IPXSetupListenECB(Addr(EsrHandler),socket,Addr(ReadData),SizeOf(ReadData),
ListenIPXheader,ListenECB);
ProcessInputCommand; {doesn't return}
end.

83
NWTP/XOTHER/TVLM.PAS Normal file
View File

@@ -0,0 +1,83 @@
program tvlm;
{$F+}
{ Example for the nwIntr unit / NwTP 0.6 (c) 1995, R.Spronk
Shows the same information as the VLM /X command.
Example for the use of the GetVLMHeader and GetVLMControlBlock
functions in the unit nwIntr }
uses dos,nwintr,nwmisc;
Var t:byte;
HDR:TVLMHeader;
CBL:TVLMcontrolBlockEntry;
s:string;
GlobSize,TransSize:longint;
regs:registers;
w:word;
begin
IF NOT VLM_EXE_Loaded
then begin
writeln('VLM.EXE not loaded.');
halt(0);
end;
GetVLMHeader(HDR);
regs.ax:=$7a20;
regs.bx:=$0000;
regs.cx:=$0000;
intr($2f,regs);
writeln('Handler entry point : ',HexStr(regs.es,4),':',HexStr(regs.bx,4));
writeln('Headerlength (or id?): ',HexStr(HDR.headerlen,2),'h');
writeln('IDstring : ',hdr.multiplexIdString[1],
hdr.multiplexIdString[2],
hdr.multiplexIdString[3]);
writeln('TransientSwitchCount : ',hdr.TransientSwitchCount);
writeln('CallCount : ',hdr.CallCount);
writeln('CurrentVLMid : ',HexStr(hdr.CurrentVLMID,4),'h');
writeln('MemoryType : ',HexStr(hdr.MemoryType,2),'h [04 = XMS]');
writeln('ModulesLoaded : ',hdr.ModulesLoaded);
writeln('BlockID : ',HexStr(hdr.BlockId,4),'h');
writeln('TransientBlock : ',HexStr(hdr.TransientBlock,4),'h');
writeln('GlobalSegment : ',HexStr(hdr.GlobalSegment,4),'h');
writeln('FullMapCount : ',hdr.FullMapCount);
GlobSize:=0;TransSize:=0;
writeln;
writeln('VLM control block information Address Memory size (bytes) ');
writeln('Name ID Flag Func Maps Call TSeg Gseg Low Hi TSize Gsize SSize ');
writeln('-------- ---- ---- ---- ---- ---- ---- ---- ---- ---- ------ ------ ------');
for t:=0 to hdr.modulesLoaded
do begin
GetVLMcontrolBlock(t,CBL);
With CBL
do begin
s[0]:=#8;
move(cbl.VLMname,s[1],8);
write(s,' ');
write(HexStr(id,4),' ');
write(HexStr(Flag,4),' ');
write(HexStr(Func,4),' ');
write(HexStr(Maps,4),' ');
write(HexStr(TimesCalled,4),' ');
write(HexStr(TransientSeg,4),' ');
write(HexStr(GlobalSeg,4),' ');
write(HexStr(AddressLow,4),' ');
write(HexStr(AddressHi,4),' ');
writeln(16*TsegSize:6,' ',16*GSegSize:6,' ',16*SSegSize:6);
if TsegSize>TransSize
then TransSize:=TsegSize;
GlobSize:=GlobSize+GSegSize;
end;
end;
writeln('Transient block size: ',TransSize*16);
writeln('Global segment size : ',GlobSize*16);
end.

95
NWTP/XQMS/QAVAIL.PAS Normal file
View File

@@ -0,0 +1,95 @@
program QAvailable;
{ QMS related utility / NwTP 0.5 API. (c) 1993,1994, R.Spronk }
uses nwMisc,nwBindry,nwQMS;
Var Qname :string;
QobjId:Longint;
Qtype :word;
BinAccLev:Byte;
MyObjId :Longint;
MyObjName:string;
MyObjType:word;
SegNbr :Byte;
propName :string;
propValue:Tproperty;
moreSeg :boolean;
propFlags:byte;
i :Byte;
GrpObjId :Longint;
GrpObjName:string;
GrpObjType:word;
begin
{--- Parameter section }
if paramCount<>1
then begin
writeln('QAVAIL usage: QAVAIL <queue name>');
writeln('Batch file utility to check for the availability of queues.');
writeln;
writeln('Errorlevel 0 : Queue exists, calling user is allowed to use Queue');
writeln(' 1 : Queue doesn''t exist on default fileserver.');
writeln(' 2 : Queue exists but calling user has no Queue rights.');
halt(1); { No queue available }
end;
Qname:=ParamStr(1);
{--- Startup checks }
IF Not (IsShellLoaded and IsUserLoggedOn)
then halt(1); { Queue not available }
{--- Queue name in bindery of effective server ? }
UpString(Qname);
IF not GetBinderyObjectId(Qname,3 {ot_print_queue},QobjId)
then halt(1);
{--- Queue exists. Does the caller have rights to use the queue ? }
IF NOT (GetBinderyAccessLevel(BinAccLev,MyObjId) and
GetBinderyObjectName(MyObjId,MyObjName,MyObjType))
then halt(1); { Oops.. some kind of bindery error }
IF IsBinderyObjectInSet(Qname,3 {OT_PRINT_QUEUE},'Q_USERS',MyObjName, MyObjType)
then halt(0); { OK. Caller has rights }
if nwbindry.result=$FB { According to QMS definitions, when the property }
then halt(0); { Q_USERS doesn't exist, all users have queue rights. }
{--- Is one of the groups I'm a member of a queue user ? }
SegNbr:=1;
propName:='GROUPS_I''M_IN';
While ReadPropertyValue(MyObjName,MyObjType,propName,SegNbr,
propValue,moreSeg,propFlags)
do begin
{ A segment of a set-property consists of a list of object IDs,
each ID 4 bytes long, stored hi-lo.
The end of the list (within THIS segment) is marked by an ID of 00000000. }
i:=1;
Repeat
GrpObjId:=MakeLong((propValue[i] *256 +propValue[i+1]), ( propValue[i+2] *256 + propValue[i+3] ) );
if GrpObjId<>0
then begin
IF GetBinderyObjectName(GrpObjId,GrpObjName,GrpObjType)
and IsBinderyObjectInSet(Qname,3 {OT_PRINT_QUEUE},
'Q_USERS',GrpObjName, GrpObjType)
then halt(0); { OK. Caller's group has queue rights }
end;
inc(i,4);
Until (i>128) or (GrpObjId=0);
inc(SegNbr);
end;
{--- Still no rights found.. }
halt(2);
end.

91
NWTP/XSEMA/SEMATEST.PAS Normal file
View File

@@ -0,0 +1,91 @@
{$X+,V-,B-}
Program SemaTest;
{ */
/* SemaTest - Tests semaphores by showing application metering example */
/* */
/* by Charles Rose */
/* */}
{ Testprogram for the nwSema unit, this version (c) 1994,1995 R.Spronk }
USES Crt,nwMisc,nwSema;
CONST
INITIAL_SEMAPHORE_VALUE=2;
WAIT_SECONDS=2;
{ Global data }
VAR openCount :Word;
semValue :Integer;
semHandle :LongInt;
done :boolean;
t :Byte;
BEGIN {main}
done := False;
{ Open Semaphore }
semValue := INITIAL_SEMAPHORE_VALUE; { Need in case we're creating the semaphore }
IF NOT OpenSemaphore( 'TestSemaphore', semValue, semHandle, openCount )
then begin
writeln('Error opening semaphore. error #',nwSema.Result);
Halt(1);
end;
{ Wait on the Semaphore (get permission to use the resource) }
IF NOT WaitOnSemaphore( semHandle, 3*18 ) { 0 = Don't wait }
then begin
if ( nwSema.Result = $FE )
then begin
writeln( 'Sorry, all of the slots for this resource are currently in use' );
halt(1);
end
else begin
writeln('WaitOnSemaphore returned eror# ',nwSema.result);
halt(1);
end;
end;
clrscr;
gotoxy(1,4);
Writeln('Testing semaphore functions.');
writeln('Workstation ',INITIAL_SEMAPHORE_VALUE+1,' that starts this testprogram');
writeln('(concurrently) will be refused access to the (imaginary) resource.');
gotoxy( 24,24 );
write( 'Press any key to exit' );
IF NOT ExamineSemaphore( semHandle, semValue, openCount )
then begin
writeln('Error while examining semaphore value. Error #',nwSema.Result);
Halt(1);
end;
{ Wait loop }
while ( NOT done )
do begin
gotoxy( 1,23 );
write( 'Semaphore Test --> Open at [',openCount,
'] stations *** Value is [',semValue,'] ');
t:=0;
While (t<100) and (not done)
do begin
delay(WAIT_SECONDS*10); { wait a while };
done:=KeyPressed;
inc(t);
end;
gotoxy( 60,23 );
write( 'Checking...' ); Delay(500); { wait half a sec }
IF NOT ExamineSemaphore( semHandle, semValue, openCount )
then writeln('ExamnineSemaphore2 error#',nwsema.result);
end;
{ Signal Semaphore (that we're through with the resource) }
SignalSemaphore( semHandle );
{ Close Semaphore }
CloseSemaphore( semHandle );
end.

86
NWTP/XSEMA/TSTSEMA2.PAS Normal file
View File

@@ -0,0 +1,86 @@
{$X+,B-,V-}
Program tstsema2;
{ Example for the nwSema unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
uses nwMisc,nwConn,nwSema;
Var ConnNbr:Byte;
seqNbr:Word;
NbrOfSema:Byte;
SemaInfo:TconnSema;
SemValue:Integer;
info:TsemaInfoList;
t:byte;
s:string;
handle4,handle5,
handle6,handle7:LongInt;
openCount:word;
begin
connNbr:=2;seqNbr:=0;
OpenSemapHore('SEMA4',4,handle4,openCount);
OpenSemaphore('SEMAPHORE5',5,handle5,OpenCount);
OpenSemapHore('SEM6',6,handle6,OpenCount);
OpenSemapHore('SEMAP7',7,handle7,OpenCount);
writeln('Semaphores have been opened..');
writeln;
writeln('<RETURN> to continue..');
readln(s);
GetConnectionNumber(connNbr); { my connection number }
seqNbr:=1;
REPEAT
IF NOT GetConnectionsSemaphores(ConnNbr,seqNbr,NbrOfSema,SemaInfo)
then begin
writeln('GetConnectionsSemaphores returned error #', nwSema.result);
seqNbr:=0;
end
else begin
writeln;
writeln('NbrOfSema Left to Scan: ',NbrOfSema);
writeln('Next seq Nbr : ',seqNbr);
with SemaInfo
do begin
writeln('Sema Name:',Name);
writeln('Opencount:',OpenCount);
writeln('Value :',Value);
writeln('TaskNbr :',taskNbr);
end;
end;
UNTIL seqNbr=0;
seqNbr:=1;
REPEAT
IF GetSemaphoreInformation('SEMA4',seqNbr,
OpenCount,SemValue,NbrOfSema,info)
then begin
writeln;
writeln('Test of GetSemaphoreInformation...');
writeln('Connections using semaphore:',Opencount);
writeln('Semaphore value:',semvalue);
If NbrOfSema>100
then NbrOfSema:=100;
for t:=1 to NbrOfSema
do writeln('Record #:',t,' Connection: ',info[t].ConnNbr,' Task: ',info[t].taskNbr);
end
else writeln('GetSemaphoreInformation returned error #', nwSema.result);
UNTIL seqNbr=0;
CloseSemaphore(handle4);
CloseSemaphore(handle5);
CloseSemaPhore(handle6);
CloseSemaphore(handle7);
end.

59
NWTP/XSERV/CLRCONN.PAS Normal file
View File

@@ -0,0 +1,59 @@
{$X+,B-,V-} {essential compiler directives}
Program ClrConn;
{ Example for the nwServ unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: Utility for users with console privileges:
Terminate a connection on the current server. }
{ Tests the following nwServ functions:
CheckConsolePrivileges
ClearConnectionNumber
}
Uses nwMisc,nwServ;
Var errCode:Integer;
connNbr:byte;
connStr:String;
showHelp:boolean;
begin
IF NOT CheckConsolePrivileges
then begin
IF nwServ.result=$C6
then writeln('You need console privileges to run this util.')
else writeln('Error checking console privileges, err#',nwServ.result);
halt(1);
end;
IF ParamCount=1
then begin
connStr:=ParamStr(1);
Val(connStr,connNbr,errCode);
showhelp:=(errCode<>0);
end
else showHelp:=true;
IF showHelp
then begin
writeln('CLRCONN-- usage:');
writeln;
writeln('CLRCONN connection_number');
writeln;
writeln('the connection_number must be supplied.');
writeln('it should contain numbers only (range 1..255)');
halt(1);
end;
IF ClearConnectionNumber(connNbr)
then writeln('Connection ',connNbr,' was terminated.')
else if nwServ.result=253
then writeln('Connection NOT cleared. The supplied ConnectionNumber was too high.')
else if nwServ.result=162
then writeln('You cleared your own connection!')
else writeln('Connection NOT cleared. Error# ',nwServ.result);
end.

39
NWTP/XSERV/LOGLOCK.PAS Normal file
View File

@@ -0,0 +1,39 @@
{$X+,B-,V-} {essential compiler directives}
program loglock;
{ Example for the nwServ unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Purpose: This program toggles the login status..
If User Login was enabled, it will be diabled and v.v. }
{ Tests the following nwServ functions:
DisableFileServerLogin
EnableFileServerLogin
GetFileServerLoginStatus
}
uses nwMisc,nwServ;
Var allowed:boolean;
begin
IF GetFileServerLoginStatus(allowed)
then begin
if allowed
then begin
DisableFileServerLogin;
writeln('Login Disabled.')
end
else begin
EnableFileserverLogin;
writeln('Login Enabled.')
end
end
else begin
if nwServ.result=$C6
then writeln('You need console operator rights to run this utility.')
else writeln('GetFileserverLoginStatus Error : $',HexStr(nwServ.result,2));
end;
end.

122
NWTP/XSERV/TSTSERV.PAS Normal file
View File

@@ -0,0 +1,122 @@
{$X+,V-,B-}
program tstServ;
{ Testprogram for the nwServ unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{ Tests the following nwServ functions:
GetFileServerDateAndTime
GetFileServerDescriptionStrings
GetNetworkSerialNumber
GetFileServerInformation
SetFileServerDateAndTime
VerifyNetworkSerialNumber
}
uses nwMisc,nwServ;
Var t1,t2,t3:TnovTime;
s1,s3:string;
serialNbr:Longint;
appNbr,appNbr2:word;
Sinfo:TFileServerInformation;
companyName,VersionAndRevision,
revisionDate,copyrightNotice:String;
begin
writeln('TSTSERV: Test of some server function calls.');
writeln;
writeln('This program will change (and reset) the server time & date.');
writeln('--This will cause the server to beep (twice)--');
writeln;
writeln('Continue ? (Y/N) + <RETURN>');
readln(s1);
if (pos('y',s1)=0) and (pos('Y',s1)=0)
then halt(1);
writeln('Testing the Get/Set ServerTime Calls. (temporarily setting the year to 2020)');
IF GetFileServerDateAndTime(t1)
then begin
nwMisc.NovTime2String(t1,s1);
writeln('Original server time:',s1);
t2:=t1;
t2.year:=20; { set year to 2020 }
t2.day:=1;
t2.month:=4;
IF SetFileServerDateAndTime(t2)
then begin
GetFileServerDateAndTime(t3);
nwMisc.NovTime2String(t3,s3);
if t3.year<>t2.year
then writeln('Error: FileServerDateAndTime NOT changed..');
writeln('New server time:',s3);
SetFileServerDateAndTime(t1) {restore old date & time }
end
else begin
if nwServ.result=$C6
then writeln('Error: You need console privileges in order to change the server time.')
else writeln('SetFileServerDateAndTime Error: $',HexStr(nwServ.result,2));
end
end
else writeln('GetFileServerDateAndTime Error: $',HexStr(nwServ.result,2));
writeln;
IF GetFileServerInformation(Sinfo)
then begin
writeln('Testing GetServerInformation..');
writeln('Servername:',Sinfo.serverName);
writeln('NW version:',Sinfo.NetwareVersion,'.',Sinfo.NetwareSubVersion);
writeln('Conn Max,Current:',Sinfo.ConnectionsMax,',',Sinfo.ConnectionsInUse);
writeln('Peak Conn Used :',Sinfo.Peak_Conn_Used);
end
else writeln('GetFileServerDateAndTime Error: $',HexStr(nwServ.result,2));
writeln;
IF GetFileServerDescriptionStrings(companyName,VersionAndRevision,
revisionDate,copyrightNotice)
then begin
writeln('Testing GetFileServerDescriptionStrings');
writeln('Company :',companyName);
writeln('Version/Rev:',VersionAndRevision);
writeln('Rev.Date :',revisionDate);
writeln('Copyright :',copyRightNotice);
end
else writeln('GetFileServerDescriptionStrings Error: $',HexStr(nwServ.result,2));
writeln;
IF GetNetworkSerialNumber(serialNbr,appNbr)
then begin
writeln('Testing GetNetworkSerialNumber');
writeln('SerialNbr=',HexStr(serialNbr,8));
writeln('AppNbr =',HexStr(appNbr,4));
end
else writeln('GetNetworkServerSerialNumber Error: $',HexStr(nwServ.result,2));
{ The last test is commented out. It works, but it is a bit irritating to
be disconnected every time I'm testing a call.. }
writeln('Testing VerifyNetworkSerialNumber (will abort workstations'' connection)');
writeln('Continue ? (Y/N) + <RETURN>');
readln(s1);
if (pos('y',s1)=0) and (pos('Y',s1)=0)
then halt(1);
{
IF VerifyNetworkSerialNumber(serialNbr,appNbr2)
then begin
if appNbr2=appNbr then writeln('Serial Number Verified.');
writeln;
writeln('Verifying a wrong network serialnumber..');
writeln('**** THIS WILL TERMINATE THE CONNECTION **** (if the calls works..)');
If VerifyNetworkSerialNumber($12345678,appNbr2)
then writeln('false serialnumber verified as being OK');
end
else writeln('VerifyNetworkSerialNumber Error: $',HexStr(nwServ.result,2));
}
end.

92
README Normal file
View File

@@ -0,0 +1,92 @@
James@linux-box.demon.co.uk
README FOR NWE Admin 0.1
========================
Please read COPYING for licence and other important information.
This software is released unde the GNU General Public Licence.
The latest version of this software can be found
at http://www.linux-box.demon.co.uk.
Hi Folks! I'm James Jeffrey Thanks for trying my software and I hope
you like it.
!This software is in a very early state, the interface is fairly self!
!explanatory (I HOPE ;-) ) So I will let you work it out! !
VERY VERY VERY BUGGY BE VERY VERY VERY CAREFULL! BACK STUFF UP!
YOU COULD SCREW UP YOUR SERVER!
|============================================================|
|If you use this software, I ask you to mail me and tell me, |
|use James@linux-box.demon.co.uk. |
|============================================================|
If you hate this software tell me why, mabye I can fix it.
If you find a bug, have a suggetsion or a code fix, mail me it,
your name will be mentioned in the next release!
I am sorry, the source is next to unreadable, I will clear this
up for 0.2 if enough interest is shown.
If you wish to make a small donation to this hard-up student then
please feel free, I need UK currency if possible. Donations VERY
gratefully accepted.
James Jeffrey
41 West Park Avenue
Roundhay
Leeds
LS8 2EB
United Kingdom
PLEASE NOTE
===========
This program works with Mars_NWE, it runs under Windows 3+ and may
require some DLL's I have not shipped (If it needs them mail me
but they should be easily available.), it requires a running netware
client.
INSTRUCTIONS
============
Remove the supervisor password form nwserv.conf, also remove all user
entries in nwserv.conf.
Run NWADMIN.EXE on your windows machine when attached to the mars server.
Good Luck.
PLANS FOR 0.2 or 0.3 or 0.4 etc..
==================================
Write a TCP/IP demon to run under INETD on the unix system
to allow for automatic creation and deletion of unix users
and setting of quitas on ext2 file systems under linux, as
well as managing volumes.
German Language Version (I don't speak German...)
Any help welcome.
See Ya All
P.S. My congratulations to MArtin Stover and Team for a fantastic
piece of software - Mars NWE!
P.P.S.
This program was written in delphi using a GPL'd netware library
which I have slightly modified for Delphi. This library was mainly
written by R.Spronk. I have included both original and modified
versions.

339
SRC/COPYING Normal file
View File

@@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

BIN
SRC/DELUSER.DCU Normal file
View File

Binary file not shown.

BIN
SRC/DELUSER.DFM Normal file
View File

Binary file not shown.

29
SRC/DELUSER.PAS Normal file
View File

@@ -0,0 +1,29 @@
unit Deluser;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, ExtCtrls;
type
TBtnRightDlg = class(TForm)
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
HelpBtn: TBitBtn;
Bevel1: TBevel;
ListBox1: TListBox;
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
BtnRightDlg: TBtnRightDlg;
implementation
{$R *.DFM}
end.

Some files were not shown because too many files have changed in this diff Show More