diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..76ce5a6 --- /dev/null +++ b/COPYING @@ -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. + + + Copyright (C) 19yy + + 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. + + , 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. diff --git a/NWADMIN.EXE b/NWADMIN.EXE new file mode 100644 index 0000000..5f9ec39 Binary files /dev/null and b/NWADMIN.EXE differ diff --git a/NWTP/COPYING b/NWTP/COPYING new file mode 100644 index 0000000..e77696a --- /dev/null +++ b/NWTP/COPYING @@ -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. + + + Copyright (C) 19yy + + 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. + + , 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. diff --git a/NWTP/FILE_ID.DIZ b/NWTP/FILE_ID.DIZ new file mode 100644 index 0000000..81dee58 --- /dev/null +++ b/NWTP/FILE_ID.DIZ @@ -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. diff --git a/NWTP/NWACCT.PAS b/NWTP/NWACCT.PAS new file mode 100644 index 0000000..e6ad4ce --- /dev/null +++ b/NWTP/NWACCT.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/NWBINDRY.PAS b/NWTP/NWBINDRY.PAS new file mode 100644 index 0000000..0865434 --- /dev/null +++ b/NWTP/NWBINDRY.PAS @@ -0,0 +1,1442 @@ +{$X+,B-,V-,S-} {essential compiler directives} + +UNIT nwBindry; + +{ nwBindry unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk } + +INTERFACE + +USES nwIntr,nwMisc; + +{ Primary Functions: Interrupt: comments: + +* AddBinderyObjectToSet (F217/41) +* ChangeBinderyObjectPassword (F217/40) Unencrypted Passwords. +* ChangeEncrBinderyObjectPassword (F217/4B) Encrypted Passwords. +* ChangeBinderyObjectSecurity (F217/38) +* ChangePropertySecurity (F217/3B) +* CloseBindery (F217/44) +* CreateBinderyObject (F217/32) +* CreateProperty (F217/39) +* DeleteBinderyObject (F217/33) +* DeleteBinderyObjectFromSet (F217/42) +* DeleteProperty (F217/3A) +* GetBinderyAccessLevel (F217/46) +* GetBinderyObjectID (F217/35) +* GetBinderyObjectName (F217/36) +* GetEncryptionKey (F217/17) (1) +* GetRelationOfBinderyObject (F217/4C) +* IsBinderyObjectInSet (F217/43) +* IsStationAManager (F217/49) +* OpenBindery (F217/45) +* ReadPropertyValue (F217/3D) +* RenameBinderyObject (F217/34) +* ScanBinderyObject (F217/37) +* ScanProperty (F217/3C) +* VerifyBinderyObjectPassword (F217/3F) Unencrypted Passwords. +* VerifyEncrBinderyObjectPassword (F217/4A) Encrypted passwords +* WritePropertyValue (F217/3E) + + Secondary Functions: + +* IsShellLoaded +* IsUserLoggedOn +* ExistsUser +* ExistsFileServer +* GetRealUserName +* IsGroupMember +* AddUserToGroup +* DeleteUserFromGroup + +Not implemented: + +- ChangePassword (F217/01) (2) +- GetMemberSetMofGroupG (F217/09) (3) +- GetStationsRootMask (E3../06) (4) +- MapNumberToGroupName (F217/08) (5) +- MapNumberToObject (F217/04) (6) +- MapObjectToNumber (F217/03) (7) + +Notes: -Names of Objects & Properties (and Passwords) are converted to + uppercase by the above functions. + -Functions marked with a '*' are tested (with 3.1x) and found correct. + (See example programs in XBIND.ZIP, e.g. SCANBIND,TSTBIND,BACKBIN). + -(1): Called by other functions, e.g. ChangeEncrBinderObjectPassword, + VerifyEncrBinderyObjectPassword, LoginEncrToFileserver. + (2): This call has been replaced by F217/40 ChangeBinderyObjectPassword. + (3): replaced by F217/37 ScanBinderyObject and F217/3D ReadPropertyValue. + (4): -obsolete call- + (5,6): Replaced by F217/36 GetBinderyObjectName. + (7): Replaced by F217/35 GetBinderyObjectID. +} + +CONST + { known object types: (see the file OT_XXX for a full list)} + OT_WILD = Word(-1); + OT_UNKNOWN = 0; + OT_USER = 1; + OT_USER_GROUP = 2; + OT_PRINT_QUEUE = 3; + OT_FILE_SERVER = 4; + OT_JOB_SERVER = 5; + OT_GATEWAY = 6; + OT_PRINT_SERVER = 7; + OT_ARCHIVE_QUEUE = 8; + OT_ARCHIVE_SERVER = 9; + OT_JOB_QUEUE = $0A; + OT_ADMINISTRATION = $0B; + OT_ADVERTISING_PRINTSERVER = $47; + OT_NETWARE_ACCESS_SERVER = $98; + OT_NAMED_PIPES_SERVER = $9A; + OT_RSPCX_SERVER = $0107; { # Rconsole/FileServer, Sckt. 0451h, 8140h } + + { bindery security: } + BS_ANY_READ = $00; + BS_LOGGED_READ = $01; + BS_OBJECT_READ = $02; + BS_SUPER_READ = $03; + BS_BINDERY_READ = $04; + + BS_ANY_WRITE = $00; + BS_LOGGED_WRITE = $10; + BS_OBJECT_WRITE = $20; + BS_SUPER_WRITE = $30; + BS_BINDERY_WRITE = $40; + +{property & object objFlag/propFlags Constants:} + BF_ITEM = $00; + BF_SET = $02; + BF_DYN_PROP = $10; {1} + BF_STAT_PROP = $00; {1} + { or BF_ITEM/SET with BF_xx_PROP to obtain propFlags } + BF_STAT_OBJ = $00; {1} + BF_DYN_OBJ = $01; {1} + +{ Note 1: not available in the NW interface for C } + + +Type Tproperty=Array[1..128] of Byte; + + TobjIdArray=array[1..$20] of Longint; + +Var result:word; + +{F217/32 [2.15c+] } +Function CreateBinderyObject(objName:string; objType:Word; + objFlaG, objSecurity :Byte ):boolean; +{ Creates an object in the bindery. } + +{F217/33 [2.15c+] } +Function DeleteBinderyObject( objName:String; objType:Word ):boolean; +{ deletes a bindery object and all asociated properties. } + +{F217/34 [2.15c+]} +Function RenameBinderyObject( objName,NewObjName :string; objType :word ):boolean; +{ This function allows the (supervisor-equivalent) user to rename an object, + given its' type and old name. } + +{F217/35 [2.15c+] } +Function GetBinderyObjectID( objName:String; objType:word; + Var objID:Longint ):boolean; +{ returns the object ID of an object, given its type and name. } + +{F217/36 [2.15c+] } +Function GetBinderyObjectName( object_Id:LongInt; + Var objName:String; Var objType:word ):boolean; +{ returns the type and name of an object, given its four BYTE-id. } + +{F217/37 [2.15c+]} +Function ScanBinderyObject( SearchObjName: String; + SearchObjType: Word; + {i/o:} Var lastObjSeen : Longint; + {out:} Var RepName : String; + Var RepType : Word; + Var RepId : LongInt; + Var RepFlag : Byte; + Var RepSecurity : Byte; + Var RepHasProperties: Boolean + ) :boolean; +{ This function scans the bindery and returns complete information about + one or more bindery object(s). It can be called iteratively. } + +{F217/38 [2.15c+]} +Function ChangeBinderyObjectSecurity(objName :String; objType :Word; + NewObjSecurity :Byte ):boolean; +{ Changes the security of a Bindery object. } + +{F217/39 [2.15c+]} +Function CreateProperty( objName:String; objType:Word; + propertyName:String; propFlags,propSecurity:Byte ):boolean; +{ Creates a property to be associated with a bindery object. } + +{F217/3A [2.15c+]} +Function DeleteProperty( objName:String; objType:Word; + propertyName:String ):boolean; +{ Deletes a property from a bindery object. } + +{F217/3B [2.15c+] } +Function ChangePropertySecurity( objName:String; objType:Word; + propName:String; newPropSecurity:Byte ):boolean; +{ The call can't assign a greater access security level for the property + than the security level of the caller. } + +{F217/3C [2.15c+]} +Function ScanProperty( objName:String; objType:Word; searchPropName:String; + {i/o var:} Var SequenceNumber:LongInt; + { output:} Var propName:String; + Var propFlags:Byte; + Var propSecurity:Byte; + Var propHasValue:Boolean; + Var moreProperties:Boolean ):boolean; +{ return information about one or more properties. } + +{F217/3D [2.15c+]} +Function ReadPropertyValue( objName:String; objType:Word; + propName:String; segmentNumber:Word; + Var propValue : Tproperty; + Var moreSegments: Boolean; + Var propFlags : Byte ):boolean; +{ Returns the value of a property associated with a Bindery object. } + +{F217/3E [2.15c+]} +Function WritePropertyValue( objName:String; objType:Word; + propName:String; segmentNbr: Byte; propValue:Tproperty; + moreSegments:Boolean ):boolean; +{ Changes the value of a (NON-SET) property associated with a Bindery object. } + +{F217/3F [2.15c+]} +FUNCTION VerifyBinderyObjectPassword + ( objName:string; objType:Word; password:string):boolean; +{ Verifies the accuracy of a password for a bindery object. (UNencrypted version) } + +{F217/4A [2.15c+]} +FUNCTION VerifyEncrBinderyObjectPassword + ( objName:string; objType:Word; password:string):boolean; +{ Verifies the accuracy of a password for a bindery object. (ENcrypted version) } + +{F217/ [2.15c+] } +Function ChangeEncrBinderyObjectPassword(objName:String; objType:Word; + oldPassWord,newPassWord:String ):boolean; +{ Changes the password of a bindery object. (UNencrypted version) } + +{F217/40 [2.0/2.1/3.x] } +Function ChangeBinderyObjectPassword(objName:String; objType:Word; + oldPassWord,newPassWord:String ):boolean; +{ Changes the password of a bindery object. (UNencrypted version) } + +{F217/41 [2.15c+]} +Function AddBinderyObjectToSet(objName:String; objType:Word;propName, + memberName:String; memberType:Word ):boolean; +{ Adds a bindery object (member) to a property set. } + +{F217/42 [2.15c+]} +Function DeleteBinderyObjectFromSet(objName:String; objType:Word;propName, + memberName:String; memberType:Word ):boolean; +{ Deletes a (member) bindery object from a property set. } + +{F217/43 [2.15c+]} +Function IsBinderyObjectInSet(objName:String; objType:Word;propName, + memberName:String; memberType:Word ):boolean; +{ Allows the programmer to check whether a bindery object is a member of a + set-property. } + +{F217/44 [2.15c+]} +Function CloseBindery:boolean; +{ Closes the bindery files so they can be backed up. (Supervisor only) } + +{F217/45 [2.15c+]} +Function OpenBindery:boolean; +{ This call must be used after the CloseBindery call. No other bindery + call will work while the bindery is closed. } + +{F217/46 [2.15c+] } +Function getBinderyAccessLevel( {out:} Var SecurityAccesslevel:byte; + Var ObjId:Longint ): Boolean; +{ It returns the user's access level to the bindery. } + +{F217/17 [3.x]} +FUNCTION GetEncryptionKey(VAR key : TencryptionKey): Boolean; +{ Used by calls using encrypted passwords to query the target fileserver + for an encryption key. } + + +{F217/49 [2.15c+]} +Function IsStationAManager:boolean; +{ Is station a workgroup manager ? } + + +{F217/4C [2.15c+]} +Function GetRelationOfBinderyObject(ObjName:string;ObjType:word; + relationPropertyName:string; + {i/o} Var sequenceNbr:longint; + {out} Var NbrOfObjects:word; + Var Info:TobjIdArray ):boolean; + +{************************** secondary functions: ****************************} + +Function IsShellLoaded:boolean; +Function IsUserLoggedOn:boolean; +Function ExistsUser(userObjName:string):boolean; +Function GetRealUserName(userObjname:string; Var realname:string):boolean; +Function IsGroupMember(GroupName,UserObjName:String): Boolean; +Function AddUserToGroup(userName,GroupName:String):boolean; +Function DeleteUserFromGroup(userName,GroupName:String):boolean; +Function ExistsFileServer(ServerName:string):Boolean; + +IMPLEMENTATION{=============================================================} + + +{F217/17 [3.x]} +FUNCTION GetEncryptionKey(VAR key : TencryptionKey): Boolean; +Type Treq=RECORD + len : WORD; + func: BYTE; + END; + TPreq=^Treq; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + len := 1; + func := $17; + end; +F2SystemCall($17,sizeof(Treq),SizeOf(TencryptionKey),result); +Move(GlobalReplyBuf^,key,SizeOf(key)); +GetEncryptionKey:=(Result=0); +END; + + +{F217/3F [2.15c+]} +FUNCTION VerifyBinderyObjectPassword + ( objName:string;objType:Word; password : string):boolean; +{ Verifies the accuracy of a password for a bindery object. } +{ Passwords need to be converted to upper case, NULL if there is no password. } +Type TReq=record + buffer_length : Word; + subfunction : byte; + obj_type : word; { hi-lo } + _ObjectName : string[48]; + _PassWord : string[127]; + end; + TPreq=^Treq; +begin +With TPreq(GlobalReqBuf)^ +do begin + buffer_length := SizeOf(Treq)-2; + subfunction :=$3F; + obj_type:=swap(objType); { force hi-lo } + UpString(objName); + UpString(password); + PStrCopy(_ObjectName,objName,48); _ObjectName[48]:=#0; UpString(_ObjectName); + PStrCopy(_PassWord,password,127); Upstring(_PassWord); + end; +F2SystemCall($17,sizeof(Treq),0,result); +VerifyBinderyObjectPassword:=(result=0); +{ possible resultcodes: +$00 0 verification of object_name/password combination +$96 150 Sever out of memory +$C5 197 account disabled due to intrusion lockout +$D6 214 unencrypted password calls not allowed on this v3+ server +$F0 240 Wildcard not allowed +$FB 251 no such property +$FC 252 no such object_name on this server +$FE 254 Server Bindery Locked +$FF 255 Bindery failure (No such object or bad password) } +end; + + +{F217/4A [3.x]} +FUNCTION VerifyEncrBinderyObjectPassword(ObjName: String; ObjType: Word; PassWord: String): Boolean; + + FUNCTION VerifyEncrypted(ObjName : String; ObjType : Word; VAR key : TencryptionKey): Boolean; + Type TReq=RECORD + BufLen : Word; + _func : Byte; + _key : TencryptionKey; + _ObjType: Word; + _ObjName: String[48]; + End; + TPreq=^Treq; + Begin + With TPreq(GlobalReqBuf)^ + do Begin + _func := $4A; + _key := key; + _ObjType := Swap(objType); + PstrCopy(_ObjName,ObjName,48); UpString(_ObjName); + if ObjName[0]<#48 + then _objName[0]:=objName[0] + else _objname[0]:=#48; + BufLen:=ord(_ObjName[0])+12; + End; + F2SystemCall($17,sizeof(Treq),0,result); + VerifyEncrypted:=(result=0); + End; + +VAR + key : TencryptionKey; + ObjId:LongInt; + _pw:string; + +Begin +UpString(password); +_pw:=password; +if _pw[0]>#127 Then _pw[0]:=#127; + +IF GetEncryptionKey(key) + Then Begin + + IF GetBinderyObjectId(objName,objType,ObjId) + Then Begin + EncryptPassword(objId,_pw,key); + VerifyEncrypted(ObjName, ObjType, key); + End; + End + Else VerifyBinderyObjectPassword(ObjName, ObjType, Password); + +VerifyEncrBinderyObjectPassword := (result=0); +End; + + +{F217/37 [2.15c+]} +Function ScanBinderyObject( SearchObjName: String; + SearchObjType: Word; + {i/o:} Var lastObjSeen : Longint; + {out:} Var RepName : String; + Var RepType : Word; + Var RepId : LongInt; + Var RepFlag : Byte; + Var RepSecurity : Byte; + Var RepHasProperties: Boolean + ) :boolean; +{ This function scans the bindery and returns complete information about + a bindery object. } +Type TReq = record + length : word; + subfunction : byte; + last_obj_id : longint; {hi-lo} + search_obj_type : word; {hi-lo} + search_obj_name : string[48]; + end; + TRep= record + object_id : longint; {hi-lo} + object_type : word; {hi-lo} + object_name : array [1..48] of byte; + object_flag : byte; + security : byte; + properties : byte; + end; + TPreq=^Treq; + TPrep=^Trep; + +Var TempStr:string; + count : integer; +begin +with TPreq(GlobalReqBuf)^ +do begin + length := SizeOf(Treq)-2; + subfunction := $37; + last_obj_id := Lswap(lastObjseen); { force hi-lo } + search_obj_type:= swap(Word(SearchObjType)); { force hi-lo } + PstrCopy(Search_obj_name,SearchObjName,48); Search_obj_Name[48]:=#0; UpString(Search_obj_name); + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ +do begin + repFlag := object_flag; + repHasProperties := (properties>0); + repSecurity := security; + repType := swap(object_type); { force lo-hi } + repId := Lswap(object_id); { force lo-hi } + lastObjSeen := repId; + ZStrCopy(repName,Object_Name,48); + end; +scanBinderyObject:=(result=0); +{ Possible Resultcodes: + 96h server out of memory; EFh Invalid Name; FCh No Such Object; + FEh Server Bindery Locked; FFh Bindery failure } +end; + + +{F217/3D [2.15c+]} +Function ReadPropertyValue( objName:String; objType:Word; + propName:String; segmentNumber:Word; + Var propValue : Tproperty; + Var moreSegments: Boolean; + Var propFlags : Byte ):boolean; +{ Returns the value of a property associated with a Bindery object. } +Type Treq=record + len : word; + subfunction : byte; + _objType : word; { hi-lo } + _ObjName : string[48]; + _segNbr : byte; + _propName : string[15]; + end; + Trep = record + _propValue : Tproperty; {array [1..128] of byte} + _moreSegments : byte; + _propFlags : byte; + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN + With TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subfunction := $3d; + _objType:=swap(objType); { force hi-lo } + _segNbr:=segmentNumber; + PStrCopy(_ObjName,objName,48); _ObjName[48]:=#0; UpString(_ObjName); + PStrCopy(_PropName,propName,15); UpString(_propName); + end; +F2SystemCall($17,sizeof(Treq),sizeof(Trep),result); +if result=0 + then with TPrep(GlobalreplyBuf)^ + do begin + propValue:=_propValue; + moreSegments:=(_moreSegments>0); + propFlags:=_propFlags; + end; +ReadPropertyValue:=(result=0); +{ 96 server out of memory; EC no such segment; F0 wilcard not allowed; + f1 invalid bindery security; f9 no property read privileges; + fb no such property; fc no such object; FE Server Bindery Locked; + FF Bindery Failure. } +end; + + +{F217/36 [2.15c+] } +Function GetBinderyObjectName( object_Id:LongInt; + Var objName:String; Var objType:word ):boolean; +{ returns the type and name of an object, given its four BYTE-id. } +Type TReq =record + len:word; + subF:byte; + _objId:LongInt; { hi-lo } + end; + Trep=record + _objId:LongInt; { hi-lo } + _objType:word; { hi-lo } + _objName:array[1..48] of Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN +WITH TPreq(GlobalReqBuf)^ +do begin + len :=SizeOf(TReq)-2; + SubF:=$36; + _objId:=Lswap(object_Id); { force hi-lo } + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result); +IF result=0 + then with TPrep(GlobalReplyBuf)^ + do begin + ZstrCopy(objName,_objName,48); + objType:=swap(_objType); { force lo-hi } + end; +GetBinderyObjectName:=(result=0); +end; + + +{F217/35 [2.15c+] } +Function GetBinderyObjectID( objName:String; objType:word; + Var objID:Longint ):boolean; +{ returns the object ID of an object, given its type and name. } +Type Treq=record + len:word; + subF:Byte; + _objType:word; { hi-lo } + _objName:string[48]; + end; + TRep=record + _objId:LongInt; { hi-lo } + _objType:word; { hi-lo } + _objName:array[1..48] of char; + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN +WITH TPreq(GlobalReqBuf)^ +do begin + len :=SizeOf(TReq)-2; + SubF:=$35; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; + UpString(_objName); + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result); +IF result=0 + then with TPrep(GlobalReplyBuf)^ + do objID:=Lswap(_objId); { force lo-hi } +GetBinderyObjectID:=(result=0); +end; + + +{F217/46 [2.15c+]} +Function getBinderyAccessLevel(Var SecurityAccessLevel:byte; + Var objId:Longint ):boolean; +{ It returns the user's access level to the bindery. } +{ Often used as a quick way of determining the current users' object id } +{ use the BS_xxxx constants to determine the exact rights of the user } +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; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + subF:=$46; + len:=sizeOf(Treq)-2; + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result); +If result=0 + then with TPrep(GlobalReplyBuf)^ + do begin + SecurityAccessLevel:=accLevel; + objId:=Lswap(_objId); + end; +GetBinderyAccessLevel:=(result=0); +end; + + + +{F217/45 [2.15c+]} +Function OpenBindery:boolean; +{ This call must be used after the CloseBindery call. No other bindery + call will work while the bindery is closed. } +Type Treq=record + len:word; + subFunc:byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=1; + subFunc:=$45; + end; +F2SystemCall($17,sizeOf(Treq),0,result); +OpenBindery:=(result=0) +end; + + +{F217/44 [2.15c+]} +Function CloseBindery:boolean; +{ Closes the bindery files so they can be backed up. (Supervisor only) } +Type Treq=record + len:word; + subFunc:byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$44; + end; +F2SystemCall($17,sizeOf(Treq),0,result); +CloseBindery:=(result=0) +end; + + +{F217/32 [2.15c+] } +Function CreateBinderyObject(objName:string; objType:Word; + objFlaG, objSecurity :Byte ):boolean; +{ Creates an object in the bindery. + objName: name of the new object (47 chars) + objType: object type number (own type number or OT_xxx constant) + objFlag: identifies an object as static (0) or dynamic (1) + (dynamic objects are removed from the bindery when the server goes down) + objSecurity: high nibble: write privileges needed to modify this object + low nibble: read privileges needed to access this object + (default: $31 Supervisor write/Logged read) } +Type Treq=record + len :word; + subFunc :byte; + _objFlag :Byte; + _objSecurity :Byte; + _objType :word; { hi-lo } + _objName :string[48] + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$32; + _objFlag:=objFlag; + _objSecurity:=objSecurity; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + end; +F2SystemCall($17,sizeof(Treq),0,result); +CreateBinderyObject:=(result=0) +{ 96h server out of memory; EEh Object Already Exists; EFh Invalid Name + F1h invalid Bindery security; F5h no object create privileges + FEh Server Bindery Locked; FFh Bindery Failure } +end; + + + +{F217/33 [2.15c+] } +Function DeleteBinderyObject( objName:String; objType:Word ):boolean; +{ deletes a bindery object and all asociated properties. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :string[48]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$33; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#48; UpString(_objName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +DeleteBinderyObject:=(result=0) +{ 96h Server out of memory; EFh Invalid name; F0h wildcard not allowed; + F4h No object delete privileges; FCh no such object + FEh Server Bindery Locked; FFh bindery failure } +end; + + +{F217/34 [2.15c+]} +Function RenameBinderyObject( objName,NewObjName :string; objType :word ):boolean; +{ This function allows the (supervisor-equivalent) user to rename an object, + given its' type and old name. } +Type Treq=record + len :word; + subFunc :byte; + _objType :word; { hi-lo } + _objName :string[48]; + _NewObjName :string[48]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$34; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; Upstring(_objName); + PstrCopy(_NewObjName,NewObjName,48); _NewObjName[48]:=#0; UpString(_NewObjName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +RenameBinderyObject:=(result=0) +{ 96h Server out of memory; EFh Invalid name; F0h wildcard not allowed; + F3h No object rename privileges; FCh no such object + FEh Server Bindery Locked; FFh bindery failure } +end; + + + +{F217/43 [2.15c+]} +Function IsBinderyObjectInSet(objName:String; objType:Word; + propName, memberName:String; memberType:Word ):boolean; +{ Allows the programmer to check whether a bindery object is a member of a + set-property. Objectname( of Objecttype) is the object to be searched for, + PropName (attached to the object with name memberName (of memberType)) + is the property containing the set to be searched. + User must have read rights to the object and the property. + Ex: ('SUPERVISOR',OT_USER,'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP) } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + _memObjType :Word; { hi-lo } + _memName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$43; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PstrCopy(_propName,propName,15); UpString(_propName); + _memObjType:=swap(memberType); { force hi-lo } + PStrCopy(_memName,memberName,48); _memName[48]:=#0; UpString(_memName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +IsBinderyObjectInSet:=(result=0) +{ 96h Server out of memory; EA No Such member; EB Not Group Property + F0h wildcard not allowed; F9 No Property read privileges; + FCh no such object; FEh Server Bindery Locked; FFh bindery failure } +end; + + + +{F217/41 [2.15c+]} +Function AddBinderyObjectToSet(objName:String; objType:Word; + propName, memberName:String; memberType:Word ):boolean; +{ Adds a bindery object to a property set. + user must have write access to the set property. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + _memObjType :Word; { hi-lo } + _memName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$41; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PstrCopy(_propName,propName,15); UpString(_propName); + _memObjType:=swap(memberType); { force hi-lo } + PStrCopy(_memName,memberName,48); _memName[48]:=#0; UpString(_memName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +AddBinderyObjectToSet:=(result=0) +{ 96h Server out of memory; E9 Member already Exists; EB Not Group Property + F0h wildcard not allowed; F8 No Property write privileges; + FCh no such object; FEh Server Bindery Locked; FFh bindery failure } +end; + + +{F217/42 [2.0/2.1/3.x]} +Function DeleteBinderyObjectFromSet(objName:String; objType:Word; + propName, memberName:String; memberType:Word ):boolean; +{ Deltes a bindery object from a property set. + user must have write access to the set property. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + _memObjType :Word; { hi-lo } + _memName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$42; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PstrCopy(_propName,propName,15); UpString(_propName); + _memObjType:=swap(memberType); { force hi-lo } + PStrCopy(_memName,memberName,48); _memName[48]:=#0; UpString(_memName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +DeleteBinderyObjectFromSet:=(result=0) +{ 96h Server out of memory; EA No Such Member; EB Not Group Property + F0h wildcard not allowed; F8 No Property write privileges; FB No Such property; + FCh no such object; FEh Server Bindery Locked; FFh bindery failure } +end; + + +{F217/38 [2.15c+]} +Function ChangeBinderyObjectSecurity(objName :String; objType :Word; + NewObjSecurity :Byte ):boolean; +{ Changes the security of a Bindery object. This call is made successfully, + if the user is supervisor equivalent and the current security is unequal to + NetWare Read/ NetWare Write. } +Type Treq=record + len :word; + subFunc :byte; + _NobjSec :Byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$38; + _NobjSec:=NewObjSecurity; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +ChangeBinderyObjectSecurity:=(result=0) +{ Completion Codes: + 96 Server out of memory; F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure. } +end; + + + + +{F217/4B [3.x]} +FUNCTION ChangeEncrBinderyObjectPassword(ObjName: String; ObjType: Word; +{#d} oldPassWord,newPassword: String): Boolean; +{ Changes the password of a bindery object. + Old Password can be NULL. To log into a file server, an object must have a + PASSWORD property. User must have read and write access to the bindery object. } + FUNCTION ChangeEncrypted(ObjName : String; ObjType : Word; + oldEncrPW:TencryptionKey; + Var newPWdif:TencrPWdifference; + PWdifCheckSum:byte + ):boolean; + Type Treq=RECORD + BufLen : Word; + _func : Byte; + _oldPW : TencryptionKey; + _ObjType: Word; + _ObjNameLen : byte; + _Various: array [1..48+1+16] of byte; { ObjName, difCheksum, PWdif } + End; + TPreq=^Treq; + Begin + With TPreq(GlobalreqBuf)^ + do Begin + _func := $4B; + _oldPW:=oldEncrPW; + _ObjType := Swap(objType); + if objName[0]>#48 + then objName[0]:=#48; + move (objName[0],_objNameLen,ord(objName[0])+1); + _Various[_objNamelen+1]:=PWdifCheckSum; + move(newPWdif,_Various[_objNamelen+2],16); + BufLen:=29+_objNameLen; + F2SystemCall($17,buflen+2,0,result); + end; + ChangeEncrypted:=(result=0); + End; + +VAR + key : TencryptionKey; + ObjId:LongInt; + PWdif:TencrPWdifference; + PWdifChecksum:byte; + +Begin +UpString(oldPassword); +if oldPassword[0]>#127 + Then oldPassword[0]:=#127; +UpString(newPassword); +if newPassword[0]>#127 + Then newPassword[0]:=#127; +UpString(ObjName); + +IF GetEncryptionKey(key) + Then Begin + IF GetBinderyObjectId(objName,objType,ObjId) + Then Begin + EncryptPasswordDifference(objId, + OldPassword,NewPassword, + key, { i/o, out: EncrOldPW } + PWdif, { out, 16 bytes } + PWdifChecksum { out, 1 byte } + ); + ChangeEncrypted(ObjName, ObjType, key, PWdif, PWdifChecksum); + End; + End + Else ChangeBinderyObjectPassword(ObjName, ObjType, OldPassword, NewPassword); + +ChangeEncrBinderyObjectPassword:= (result=0); +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; FB No Such Property; + FC No Such Object; FE Server Bindery Locked; FF No Such Object *OR* + No Password Associated With Object *OR* Old Password Invalid. } +End; + + +{F217/40 [2.0/2.1/3.x] } +Function ChangeBinderyObjectPassword(objName:String; objType:Word; + oldPassWord,newPassWord:String ):boolean; +{ Changes the password of a bindery object. + Allow unencrypted passwords must be ON! + Old Password can be NULL. To log into a file server, an object must have a + PASSWORD property. User must have read and write access to the bindery object. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _oldPW :String[128]; { wow! a password of 128 chars! } + _newPW :String[128]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$40; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _ObjName[48]:=#0; UpString(_objName); + PStrCopy(_oldPW,oldPassWord,128); UpString(_oldPW); + PStrCopy(_newPW,newPassWord,128); UpString(_newPW); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +ChangeBinderyObjectPassword:=(result=0) +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; FB No Such Property; + FC No Such Object; FE Server Bindery Locked; FF No Such Object *OR* + No Password Associated With Object *OR* Old Password Invalid. } +end; + + + + +{F217/39 [2.15c+]} +Function CreateProperty( objName:String; objType:Word; + propertyName:String; propFlags,propSecurity:Byte ):boolean; +{ Creates a property to be associated with a bindery object. + property flags tell whether a property is dynamic or static and whether + the property is defined as static or dynamic. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propFlags:Byte; + _propSec :Byte; + _propName :String[15]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$39; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + _propFlags:=propFlags; + _propSec:=propSecurity; + PStrCopy(_propName,propertyName,15); UpString(_propName); + end; +F2SystemCall($17,sizeof(Treq),0,result); +CreateProperty:=(result=0) +{ Completion Codes: + 96 Server Out Of Memory; ED Property already exists; EF Invalid Name; + F0 Wildcard Not Allowed; F1 Invalid Bindery Security; F7 No Property Create Privileges; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + + +{F217/3A [2.15c+]} +Function DeleteProperty( objName:String; objType:Word; + propertyName:String ):boolean; +{ Deletes a property from a bindery object. + The property field may contain wildcards. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3A; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PStrCopy(_propName,propertyName,15); UpString(_propName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +DeleteProperty:=(result=0) +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + F6 No property delete privileges; FB No Such property; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + + +{F217/3C [2.15c+]} +Function ScanProperty( objName:String; objType:Word; searchPropName:String; + {i/o var:} Var SequenceNumber:LongInt; + { output:} Var propName:String; + Var propFlags:Byte; + Var propSecurity:Byte; + Var propHasValue:Boolean; + Var moreProperties:Boolean ):boolean; +{ Sequence number should be -1 the first time this call is made. + The call can be reiterated (by supplying the returned Seq.#) until + moreProperties=FALSE or nwBindry.Result=NO_SUCH_PROPERTY. + searchPropName may contain wildcards; + If propHasValue=TRUE, the value can be read by calling ReadPropertyValue; + moreProperties=TRUE if more properties exist for this object. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; {hi-lo} + _objName :String[48]; + _SeqNbr :LongInt; {hi-lo} + _propName :String[15]; + end; + Trep=record + _propName :array[1..16] of Byte; + _propFlags:Byte; + _propSec :Byte; + _SeqNbr :Longint; {hi-lo} + _propHasValue:Byte; + _moreProp :Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3C; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + _SeqNbr:=Lswap(SequenceNumber); { force hi-lo } + PstrCopy(_propName,searchPropName,15); UpString(_propName); + end; +F2SystemCall($17,sizeof(Treq),sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ +do begin + SequenceNumber:=Lswap(_SeqNbr); { force lo-hi } + ZStrCopy(propName,_propName,15); + propFlags:=_propFlags; + propSecurity:=_propSec; + propHasValue:=(_propHasValue>0); + moreProperties:=(_moreProp>0); + end; +ScanProperty:=(result=0) +{ Completion Codes: + 96 Server Out Of Memory; F1 Invalid Bindery Security; FB No Such property; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + + +{F217/3E [2.15c+]} +Function WritePropertyValue( objName:String; objType:Word; + propName:String; segmentNbr: Byte; propValue:Tproperty; + moreSegments:Boolean ):boolean; +{ Changes the value of a (NON-SET) property associated with a Bindery object.} +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; + _segNbr :Byte; + _EraseRemainingSeg:Byte; { FF=true 00=false } + _propName :String[15]; + _propValSeg :Tproperty; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3E; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + _segNbr:=segmentNbr; + if moreSegments + then _EraseRemainingSeg:=$00 + else _EraseRemainingSeg:=$FF; + PstrCopy(_propName,propName,15); UpString(_propName); + _propValSeg:=propValue; + end; +F2SystemCall($17,sizeOf(Treq),0,result); +WritePropertyValue:=(result=0) +{ Completion Codes: + 96 Server Out Of Memory; E8 Not Item Property; EC no such segment; + F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + F8 No property write privileges; FB No Such property; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + +{F217/3B [2.15c+] } +Function ChangePropertySecurity( objName:String; objType:Word; + propName:String; newPropSecurity:Byte ):boolean; +{ The user must have read and write access to the property to make this call. + The call can't assign a greater security level than the security level of + the caller. } +Type Treq=record + len:word; + subFunc:byte; + _objType:Word; { hi-lo } + _objName:String[48]; + _NewPropSec:Byte; + _PropName:String[15]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3B; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; Upstring(_objName); + _NewPropSec:=NewPropSecurity; + PstrCopy(_propName,propName,15); Upstring(_propName); + end; +F2SystemCall($17,sizeOf(Treq),0,result); +ChangePropertySecurity:=(result=0) +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + FB No Such property; FC No Such Object; FE Server Bindery Locked; + FF Bindery Failure } +end; + +{F217/49 [3.0+]} +Function IsStationAManager:boolean; +{ Fast way to detremine if: object ID of caller included in the MANAGERS + set property attached to the SUPERVISOR object. } +Type Treq=record + len:word; + subFunc:byte; + end; + Trep=record + unknown:byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$49; + end; +F2SystemCall($17,SizeOf(Treq),Sizeof(Trep),result); +{With TPrep(GlobalReplyBuf)^ + do begin + + end; } +IsStationAManager:=(result=0) +{ Completion codes: + 00 Successful (WS is a manager); + FF Not a manager } +end; + +{F217/4C [3.0+]} +Function GetRelationOfBinderyObject(ObjName:string;ObjType:word; + relationPropertyName:string; + {i/o} Var sequenceNbr:longint; + {out} Var NbrOfObjects:word; + Var Info:TobjIdArray ):boolean; +{ OBJ_SUPERVISORS GROUPS_I'M_IN SECURITY_EQUALS } +Type Treq=record + len :word; + subFunc :byte; + _SeqObjId :Longint; {hi-lo} + _ObjType :word; {hi-lo} + _ObjAndPropName:string; + end; + Trep=record + _NbrOfObj:Word; + _Info :TobjIdArray; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$4C; + _SeqObjId:=Lswap(SequenceNbr); + _ObjType:=swap(ObjType); + Upstring(ObjName);UpString(RelationPropertyName); + _ObjAndPropName:=ObjName; + move(RelationPropertyName[0], + _ObjAndPropName[ord(ObjName[0])+1], + ord(RelationPropertyName[0])+1); + len:=9+ord(ObjName[0])+ord(RelationPropertyName[0]); + F2SystemCall($17,len+2,Sizeof(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + NbrOfObjects:=swap(_NbrOfObj); + for t:= 1 to NbrOfObjects + do Info[t]:=Lswap(_Info[t]); + if NbrOfObjects=$20 + then SequenceNbr:=Info[$20] + else SequenceNbr:=-1; + end; +if result<>0 then SequenceNbr:=-1; +GetRelationOfBinderyObject:=(result=0) +end; + + + +{=======SECONDARY FUNCTIONS===================================================} + + + +Function IsShellLoaded:boolean; +Var mask:byte; + id:LongInt; +begin +{$IFNDEF MSDOS} +FillChar(nwintr.GlobalReplyBuf^,Sizeof(nwintr.TintrBuffer),#$0); +{ Only needed in protected mode, otherwise an invalid value is reported. + Doesn't harm a bit if you use it in other modes, though. } +{$ENDIF} +IsShellLoaded:=(nwBindry.getBinderyAccessLevel(mask,id) and (id<>0)); +end; + + +Function IsUserLoggedOn:boolean; +Var mask:byte; + id:LongInt; + objName:String; + objType:word; +begin +IsUserLoggedOn:=( nwBindry.getBinderyAccessLevel(mask,id) + and (id<>0) + and nwBindry.GetBinderyObjectName(id,objName,objType) + ) +end; + + +Function GetRealUserName(userObjName:string; Var realname:string):boolean; +Var propValue:Tproperty; + moreSeg:Boolean; + w,propFlag:Byte; +begin +If ReadPropertyValue(userObjName,OT_USER,'IDENTIFICATION',1,propValue,moreSeg,propFlag) + then ZstrCopy(RealName,PropValue,128) + else realname:=''; +GetRealUserName:=(result=0); +end; + +Function GetUserObjectID:LongInt; +Var mask:byte; + id:LongInt; +begin +if getBinderyAccessLevel(mask,id) + then GetUserObjectID:=id + else getUserObjectID:=-1; +{ -1 : look at nwBindry.result for error number } +end; + + +Function ExistsUser(userObjName:string):boolean; +Var ObjId:Longint; +begin +ExistsUser:=GetBinderyObjectId(userObjName,OT_USER,ObjId); +end; + +Function IsGroupMember( GroupName,UserObjName:String): Boolean; +begin +IsGroupMember:=IsBinderyObjectInSet(GroupName,OT_USER_GROUP,'GROUP_MEMBERS', + UserObjName,OT_USER); +end; + + + + +Function AddUserToGroup(userName,GroupName:String):boolean; +begin +{ first create the necessary properties. They may already exist. } + +CreateProperty(userName,OT_USER,'GROUPS_I''M_IN', + BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ); +IF (result<>$00) and (result<>$ED) { property already exists } +then begin AddUserToGroup:=false;exit end; { bindery failure / bad username} + +CreateProperty(userName,OT_USER,'SECURITY_EQUALS', + BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ); +IF (result<>$00) and (result<>$ED) { property already exists } +then begin AddUserToGroup:=false;exit end; + +{ The following construction seems a bit overdone, but it is needed to keep + the bindery consistent. A user is either fully added to a group OR + nothing happens, this way we ensure that a user is not 'patially added' + to a group. + If the user already is a member of the group, no error is returned. } +IF AddBinderyObjectToSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER) + then begin + IF AddBinderyObjectToSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + then begin + IF AddBinderyObjectToSet(userName,OT_USER,'SECURITY_EQUALS', + GroupName,OT_USER_GROUP) + then begin + AddUserToGroup:=true; + exit; + end + else begin { attempt to delete partially setup member } + DeleteBinderyObjectFromSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + DeleteBinderyObjectFromSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + end + end + else begin + DeleteBinderyObjectFromSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + end; + end; +if result=$E9 then result:=$00; { $E9: user already a member of group } +AddUserToGroup:=(result=0); +{ As all these called functions are in this unit, you can check nwBindry.result + for the errorcode. } +{ resultcodes: $FC user OR group object doesn't exist. } +end; + + + + +Function DeleteUserFromGroup(userName,GroupName:String):boolean; +begin +{ The following construction seems a bit overdone, but it is needed to keep + the bindery consistent. A user is either totally deleted from a group OR + nothing happens, this way we ensure that a user is not 'patially deleted' + from a group. + If the user was not a member of the group, no error is returned. } +IF DeleteBinderyObjectFromSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER) + then begin + IF DeleteBinderyObjectFromSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + then begin + IF DeleteBinderyObjectFromSet(userName,OT_USER,'SECURITY_EQUALS', + GroupName,OT_USER_GROUP) + then begin + DeleteUserFromGroup:=True; + exit; + end + else begin { attempt to repair partially deleted member } + AddBinderyObjectToSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + AddBinderyObjectToSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + end + end + else AddBinderyObjectToSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + end; +if result=$EA then result:=0; { $EA: user obj NOT a member of group } +DeleteUserFromGroup:=false; +{ As all these called functions are in this unit, you can check nwBindry.result + for the errorcode. } +{ Resultcodes: $FC user OR group object doesn't exist. } +end; + +Function ExistsFileServer(ServerName:string):Boolean; +{ You must be attached to at least one server before using this function. } +Var ObjId:Longint; +begin +UpString(ServerName); +ExistsFileServer:=GetBinderyObjectId(ServerName,OT_FILE_SERVER,ObjId); +end; + + + +end. { end of unit nwBindry } + diff --git a/NWTP/NWCONN.PAS b/NWTP/NWCONN.PAS new file mode 100644 index 0000000..41b9129 --- /dev/null +++ b/NWTP/NWCONN.PAS @@ -0,0 +1,1455 @@ +{$X+,B-,V-,S-} {essential compiler directives} + +UNIT nwConn; + +{ nwConn unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk } +{ Includes modifications to Attach/Detach by H. Jelonneck } + +INTERFACE + +{ Primary Functions: Interrupt: comments: + +Connection Services +------------------- + +* AttachToFileServer (F100) +* AttachToFileServerWithAddress (F100) +* DetachFromFileServer (F101) +. EnterLoginArea (F217/0A) +* GetConnectionInformation (F217/16) +* GetConnectionNumber (DC..) +* GetInternetAddress (F217/13) +* GetObjectConnectionNumbers (F217/15) +* GetWorkstationNodeAddress (EE..) +* LoginToFileserver (F217/14) UNencrypted +* LoginEncrToFileserver (F217/18) encrypted +* Logout (F219) +* LogoutFromFileServer (F102) + + Secondary Functions: + +* GetUserAtConnection +* GetObjectLoginControl +* GetObjectNodeControl +* ObjectCanLoginAt + +Workstation Services +-------------------- + +* EndOfJob (D6) to be rewritten to F218 +* GetConnectionID (EF04) +* GetConnectionIDtable (EF03) (1) +* GetDefaultConnectionID (F002) +* GetEndOfJobStatus (BB..) +* GetFileServerName (EF04) +* GetNetwareErrorMode (DD..) +* GetNetwareShellVersion (EA00) +* GetNumberOfLocalDrives (DB..) +* GetPreferredConnectionID (F001) +* GetPrimaryConnectionID (F005) +* GetShowDots (E908) +* GetWorkstationEnvironment (EAxx,xx>00) (2) +* SetEndOfJobStatus (BB..) +* SetNetwareErrorMode (DD..) +* SetPreferredConnectionID (F000) +* SetPrimaryConnectionID (F004) +* SetShowDots (E908) + + Secondary Functions: + +* GetEffectiveConnectionID (F001,F002,F005) +* IsConnectionIDinUse (EF03) + + +Not Implemented: +---------------- + +- GetStationsLoggedInformation (F217/05) (3) +- Login (F217/00) (4) +- MapUserToStationSet (F217/02) (5) + +Notes: -Only functions marked with a * have been tested; others might work. + -(1): This function returns the complete Connection ID table. The + partial function IsConnectionIDInUse has been moved to the + secondary function group. + -(2): This function is an extension to EA00 GetNetwareShellVersion. + A function that returns all returned information from the call + EAxx,xx>00 is sometimes referred to as GetWShardwareAndOS. + + -NOT implemented in this API: + (3): Replaced by F217/16 GetConnectionInformation. + (4): This function has been replaced by F217/14 LoginToFileServer. + (5): Replaced by F217/15 GetObjectConnectionNumbers. + + -NW 386 can support up to 250 connections, NW 286 Max 100. + -Type TconnectionList=array[1..250] of byte (Declared in unit nwMisc) + +} + +Uses nwIntr,nwMisc,nwBindry; + + +Const MaxServers=8; + +Type TServerNameTableEntry = Array [1..48] OF Char; + TServerNameTable = Array[1..MaxServers] OF TServerNameTableEntry; + + TConnectionIDTableEntry= + Record + SlotInUse : Byte; + OrderNumber : Byte; + ServerAddress : TinternetworkAddress; + ReceiveTimeOut : Word; + RouterAddress : TnodeAddress; + PacketSeqNbr : Byte; + ConnectionNumber : Byte; + ConnectionStatus : Byte; + MaxTimeOut : Word; + WConnectionNumber: Word; + MajorNWrev : Byte; + ServerFlags : Byte; + MinorNWrev : Byte; + END; + TConnectionIDTable = Array [1..MaxServers] OF TConnectionIDTableEntry; + + TloginControl=Record + AccountDisabled :boolean; + AccountExpirationDate :TNovTime; { dmy valid only } + + MinimumPasswordLength :byte; + PasswordControlFlag :byte; + DaysBetweenPasswordChanges:word; + PasswordExpirationDate :TnovTime; + LastLoginTime :TnovTime; {dmy, hms valid only } + GraceLoginsRemaining :Byte; + MaxGraceLoginsAllowed :byte; + BadLoginCount :byte; + AccountResetTime :TnovTime; {dmy, hms valid only } + LastIntruderAddress :TinterNetworkAddress; + + MaxConcurrentConnections :byte; + LoginTimes :array[1..42] of byte; + + DiskSpace :Longint; + end; + + TnodeControl=array[1..12] of record + net :TnetworkAddress; + node:TnodeAddress; + end; + +Var result:word; + +{BB.. [2.0/2.1/3.x]} +Function SetEndOfJobStatus( EndOfJobFlag: Boolean ):Boolean; +{ When this function is called with EndOfJobFlag=False and control is returned + to the root COMMAND.COM, COMMAND.COM will NOT perform an EOJ action. } + +{BB.. [2.0/2.1/3.x]} +Function GetEndOfJobStatus(Var EndOfJobFlag: Boolean ):Boolean; + +{F218 [2.15c+]} +FUNCTION EndOfJob(All : Boolean):boolean; +{ Forces an end of job } + +{E908 (shell 3.00+)} +Function SetShowDots( Show:Boolean):Boolean; + +{E908 (shell 3.00+)} +Function GetShowDots(Var Shown:Boolean):Boolean; + +{F219 [2.15c+]} +Function Logout:boolean; +{ Logout from all file servers, remains attached to Server, effective EOJ } + +{DB.. [2.0/2.1/3.x]} +Function GetNumberOfLocalDrives( Var drives:Byte ):Boolean; + +{DC.. [2.0/2.1/3.x]} +Function GetConnectionNumber(Var ConnectionNbr:byte):boolean; +{ Returns connection number of requesting WS } + +{DD.. [2.0/2.1/3.x]} +Function SetNetwareErrorMode( errMode:Byte):boolean; +{ Sets the shell's handling mode for dealing with netware errors. } + +{DD.. [2.0/2.1/3.x]} +Function GetNetwareErrorMode(Var errMode:Byte):boolean; + +{E3../0A [2.0/2.1/3.x]} +Function EnterLoginArea( LoginSubDirName:String; + numberOfLocalDrives:Byte ):boolean; +{ Changes the login directory. Used by boot-proms. } + +{F217/13 [2.15c+]} +Function GetInternetAddress( ConnNbr : byte; + var IntNetAddress:TinternetworkAddress):boolean; + +{F217/14 [2.15c+] UNENCRYPTED} +Function LoginToFileServer( objName:String; objType:word; + password : string ):boolean; + +{F217/18 [2.15c+] ENCRYPTED} +FUNCTION LoginEncrToFileServer(ObjName: String; ObjType: Word; + PassWord: String ): Boolean; + +{F217/15 [2.15c+]} +Function GetObjectConnectionNumbers( objName:String; objType:Word; + Var numberOfConnections: Byte; + Var connections: TconnectionList ):boolean; +{ returns a list of connectionnumbers where objects of the desired type and + name are logged in. } + +{F217/16 [2.15c+]} +Function GetConnectionInforMation (ConnectionNbr:byte; + Var objName:String; + Var objType:Word; + Var objId:LongInt; + Var LoginTime:TnovTime ):boolean; + +{EA00 [2.0/2.1/3.x]} +Function GetNetwareShellVersion( Var MajorVersion,MinorVersion, + RevisionLevel :Byte ):Boolean; +{ Returns information about a WS environment. Queries shell. } + +{EAxx,xx>00 [2.0/2.1/3.x]} +Function GetWorkstationEnvironment(Var OStype,OSversion, + HardwareType,ShortHWType:String):Boolean; + +{EE.. [2.0/2.1/3.x]} +FUNCTION GetWorkstationNodeAddress( var physicalNodeAddress: TNodeAddress ):boolean; +{ Get the physical address of the workstation (6 bytes hi-endian) } + + +{EF03 [2.0/2.1/3.x]} +Function GetConnectionIDTable( ConnectionID: Byte ; Var TableEntry: TConnectionIDTableEntry ):boolean; +{ Returns a copy of the entry in the shells' ConnectionID table corresponding + with the given ConnectionID. } + +{EF04 [2.0/2.1/3.x]} +Function GetConnectionID( serverName: String; Var ConnectionID: Byte):boolean; + + +{EF04 [2.0/2.1/3.x]} +Function GetFileServerName( ConnectionID : byte; var ServerName : string):boolean; +{ get name of file server. file server number must be in range [1..MaxServers] } + +{F000 [2.0/2.1/3.x]} +Function SetPreferredConnectionID( ConnectionID :byte ):boolean; + +{F001 [2.0/2.1/3.x]} +Function GetPreferredConnectionID(var connID : byte):boolean; + +{F002 [2.0/2.1/3.x]} +FUNCTION GetDefaultConnectionID(var connID :byte):boolean; + +{F004 [2.0/2.1/3.x]} +FUNCTION SetPrimaryConnectionID( primaryConnectionID :Byte ):boolean; + +{F005 [2.0/2.1/3.x]} +FUNCTION GetPrimaryConnectionID(var connID :byte ):boolean; + +{F100 [2.0+]} +Function AttachToFileServerWithAddress(ServerName:string; + ServerAddr:TinternetworkAddress; + Var ConnectionID:Byte):Boolean; + +{F100 [2.0/2.1/3.x] (also calls EF03,EF04)} +Function AttachToFileServer(ServerName : String; Var ConnectionID:Byte):Boolean; +{ Create an attachment between a server and a workstation. } + +{F101 [2.0/2.1/3.x]} +Function DetachFromFileServer( ConnectionID:byte ):boolean; +{ removes server from shell's server table. Relinquishes the + fileserver connection number and breaks the connection. } + +{F102 [2.0/2.1/3.x]} +Function LogoutFromFileServer(var ConnectionID: byte):boolean; +{logout from one file server} + +{***** secondary Functions, Result variable is not used *******************} + +{EF03 [2.0/2.1/3.x] secondary Function } +Function IsConnectionIDinUse( ConnectionID: Byte ):boolean; + +Function GetUserAtConnection( ConnectionNbr:byte; var username: string):boolean; +{This function provides a short method of obtaining just the USERID.} + +Function GetEffectiveConnectionID(Var connId:byte):boolean; +{What server are the requests currently sent to? } + +Function GetObjectLoginControl(ObjName:string; ObjType:word; + VAR LoginControlInfo:TloginControl):boolean; + +Function GetObjectNodeControl( ObjName:string; ObjType:word; + {i/o} Var seqNbr:integer; + {out} Var NodeControlInfo:TnodeControl):boolean; + +Function ObjectCanLoginAt(ObjName:String; ObjType:Word; + LoginTime:TnovTime ):Boolean; +{ -If the fields hour,min,sec and dayOfWeek are filled, the time + will be checked against the login timerestrictions. + -If the fields year,month,day are filled ( >0 ), the date + will be checked with the expiration date of the account and + with the Account disabled Flag. } + +IMPLEMENTATION{=============================================================} + +Type TPConnectionIDTPtr=^TConnectionIDTable; + TPServerNTPtr=^TServerNameTable; + +{F000 [2.0/2.1/3.x]} +Function SetPreferredConnectionID( ConnectionID :byte ):boolean; +{ The preferred server is the default server to which the request + packets are sent. + Calls are routed to the preferred server. (IF explicitly set!). + If the preferred server was not set then the requests are routed to + the server that is attached to the current drive. If the current + drive is a local drive then the requests will be sent to the primary + server (mostly the server the shell initially attached to.) } +var regs : TTregisters; +begin + regs.ax := $F000; + regs.dl := ConnectionID; { 1..MaxServers, 0 to clear } + RealModeIntr($21,regs); + result:=0; + SetPreferredConnectionID:=TRUE; +end; + +{F004 [2.0/2.1/3.x]} +FUNCTION SetPrimaryConnectionID( primaryConnectionID :Byte ):boolean; +var regs : TTregisters; +begin + regs.ax := $F004; + regs.dl := primaryConnectionID; { 1..MaxServers, or 0 to clear } + RealModeIntr($21,regs); + result:=0; + SetPrimaryConnectionID:=TRUE; +end; + +{F005 [2.0/2.1/3.x]} +FUNCTION GetPrimaryConnectionID(var connID :byte ):boolean; +{ returns connection number of the primary file server (1..MaxServers) } +var regs : TTregisters; +begin + regs.ax := $F005; + RealModeIntr($21,regs); + connID := regs.al; + if connId>MaxServers + then result:=$FF + else result:=$00; + GetPrimaryConnectionID:=(result=0); +end; + +{F002 [2.0/2.1/3.x]} +FUNCTION GetDefaultConnectionID(var connID :byte):boolean; +{ Returns the connection ID of the file server to which + the packets are currently being sent. } +var regs : TTregisters; +begin + regs.ax := $F002; + RealModeIntr($21,regs); + connID := regs.al; { 1..MaxServers } + if connId>MaxServers + then result:=$FF + else result:=$00; + GetDefaultConnectionID:=(result=0); +end; + +{F001 [2.0/2.1/3.x]} +Function GetPreferredConnectionID(var connID : byte):boolean; +var regs : TTregisters; +begin + regs.ax := $F001; + RealModeIntr($21,regs); + connID := regs.al; { 1..MaxServers, or 0 if the preferred server was not set } + { The preferred coneection is reset to 0 by an EOJ. } + if connId>MaxServers + then result:=$FF + else result:=$00; + GetPreferredConnectionID:=(result=0); +end; + + + +{EF04 [2.0/2.1/3.x]} +Function GetConnectionID( serverName: String; Var ConnectionID: Byte):boolean; +Type ptarr=^arr; + arr=Array[0..MaxServers*32] of Byte; +Var regs : TTregisters; + NameTable : Array [1..MaxServers*48] of Byte; + ServerNames: Array [1..MaxServers] of String; + t : Byte; +begin +UpString(ServerName); +regs.ax := $EF04; +RealModeIntr($21,regs); +{ get pointer to shell's server name table. } +move(nwPtr(regs.es, regs.si)^,NameTable,MaxServers*48); +For t := 0 to 7 + do ZstrCopy(ServerNames[t+1],NameTable[1+ t*48],48); + +t:=1; +While ((t<9) and (ServerNames[t]<>ServerName)) + do inc(t); +If t=9 + then Result:=$FC { invalid server name } + else begin + ConnectionID:=t; + { ServerName found. Is ConnectionID valid ? } + regs.ax:=$EF03; + RealModeIntr($21,regs); + IF (ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32] = $00 ) {= $FF ?? } + then begin + ConnectionID:=0; + result:=$FC { ConnectionID invalid => servername invalid } + end + else result:=$00; + end; +GetConnectionID:=(result=0); +end; + + +{EF04 [2.0/2.1/3.x]} +Function GetFileServerName( ConnectionID : Byte; Var ServerName : String):boolean; +{ Get the name of file server, associated with the ConnectionID. + The File server number must be in the range [1..MaxServers]. + The function will fail (result=$FF) if connID falls outside of this range. } +Type ptarr=^arr; + arr=Array[0..MaxServers*32] of Byte; +Var regs : TTregisters; + NameTable : Array [1..MaxServers*48] of Byte; + ServerNames: Array [1..MaxServers] of String; + t : Byte; +begin +regs.ax := $EF04; +RealModeIntr($21,regs); +{ Get pointer to shell's server name table. } +move(nwPtr(regs.es, regs.si)^,NameTable,MaxServers*48); +For t := 0 to 7 + do ZstrCopy(ServerNames[t+1],NameTable[1+ t*48],48); + +if ((ConnectionID<1) or (ConnectionID>MaxServers)) + then ServerName:='' + else ServerName := ServerNames[ConnectionID]; +IF ServerName='' + then result:=$FF + else begin { The name is valid, but is the ConnectionID valid ? } + regs.ax:=$EF03; + RealModeIntr($21,regs); + IF (ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32] = $00 ) {= $FF ?? } + then begin + result:=$FF; { ConnectionID invalid => servername invalid } + ServerName:=''; + end + else result:=$00; + end; +GetFileServerName:=(result=0); +end; + + +Function AttachToFileServerWithAddress(ServerName:string; + ServerAddr:TinternetworkAddress; + Var ConnectionID:Byte):Boolean; +{ Create an attachment between a server and a workstation. } +{ Does not Login the workstation. } +{ After attaching, and beFore logging in, you must set the preferred server + to the ConnectionID of the server. } +{ Will not report an error if you're already attached to + -or even logged on to- the target server. } +{ Attaches to the server whose address is supplied. The server name will + be placed in the server name tables, even if the servername is incorrect or + the supplied servername isn't associated with the supplied address. } +{ Based on the InsertServer Function in LOGON.PAS by Barry Nance, and + on Rose, p.262 } +Var ConnectionIDTPtr : TPConnectionIDTPtr; + ServerNTPtr : TPServerNTPtr; + NewServerSlot,i : Byte; + OldConnId : Byte; + ServIsAttached : Boolean; + AccessLevel : Byte; + ObjID : Longint; + + Regs:TTRegisters; + + NewServer:Boolean; + + Var cid:byte; + +BEGIN +{ If server known, take adress from shells' tables. + If server not known, try to read its' adress from a servers' bindery. + This will fail if you're not connected to at least one server. + Once an adress has been found, AttachToFileServerWithAdress is called. } + +ServerAddr.socket:=swap($0451); { swapped hi-lo} +UpString(ServerName); + +regs.ax:=$EF03; +RealModeIntr($21,regs); +ConnectionIDTPtr:=nwPtr(regs.es,regs.si); { Ptr to TConnectionIDTable } + +{ Determine whether the suplied server is already known/attached to } + +ConnectionID:=0; +REPEAT + inc(ConnectionID) +UNTIL (ConnectionID>MaxServers) + or ((ConnectionIDTPtr^[ConnectionID].SlotInUse>0) + and IsEqualNetworkAddress(ConnectionIDTPtr^[ConnectionID].ServerAddress,ServerAddr) + ); + +NewServer:=(ConnectionID>MaxServers); + +{ If the server is a new server, put it in the sorted ConnectionIDTable } +IF NewServer + then begin + { Determine free slot to insert new server } + NewServerSlot := 1; + WHILE (ConnectionIDTPtr^[NewServerSlot].SlotInUse <> $00) + AND (NewServerSlot <= MaxServers) + do inc(NewServerSlot); + IF NewServerSlot > MaxServers + then begin + Result:=$7C; + AttachToFileServerWithAddress := False; + exit; + end; + + With ConnectionIDTPtr^[NewServerSlot] + do begin + ServerAddress:=ServerAddr; + OrderNumber := 0; + For i := 1 TO MaxServers + do begin + IF (ConnectionIDTPtr^[i].SlotInUse <> $00) + and (ConnectionIDTPtr^[i].OrderNumber>=OrderNumber) + then OrderNumber:=ConnectionIDTPtr^[i].OrderNumber+1; + end; + SlotInUse := $FF; { Must be set to $FF before attaching } + end; + ConnectionID:=NewServerSlot; + end + else { NOT a new server.. } + IF (ConnectionIDTPtr^[ConnectionID].ConnectionNumber > 0) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionNumber < $FF) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionStatus = $FF) + then Begin { ServerIsKnown } + GetPreferredConnectionID (OldConnId); + SetPreferredConnectionID (ConnectionID); + ServIsAttached := GetBinderyAccessLevel (AccessLevel, ObjID); + SetPreferredConnectionID (OldConnID); + IF ServIsAttached { ServerIsAlreadyAttached / caller may even be looged on } + then begin + result:=0; + AttachToFileServerWithAddress := True; + exit; + end; + End; + +{ Create an attachment } +With Regs +do begin + AX := $F100; + DL := ConnectionID; + RealModeIntr($21,Regs); + Result := AL; + { F8 already attached to server; F9 No Free connection slots at server; + FA no more server slots; FE Server Bindery Locked; + FF No response from server } + end; + +IF NewServer + then begin + if Result<>$00 { F9/FA/FE/FF error at server/no response from server } + then Begin { Note that the combination of a 'new' server and err. F8 is impossible } + ConnectionIDTPtr^[NewServerSlot].SlotInUse:=$00; + { Invalid server, Free slot again } + end + else begin + { Valid server, sort ConnectionID table } + With ConnectionIDTPtr^[NewServerSlot] + do begin + SlotInUse:=$00; { temporarily set to 0, For sorting purposes } + OrderNumber := 1; + For i := 1 TO MaxServers + do begin + IF ConnectionIDTPtr^[i].SlotInUse <> $00 + then begin + IF IsLowerNetworkAddress(ConnectionIDTPtr^[i].ServerAddress, ServerAddress) + then inc(OrderNumber) + else inc(ConnectionIDTPtr^[i].OrderNumber) + end; + end; + SlotInUse:=$FF; + end; + { Put new servers' name in server Name Table } + regs.ax := $EF04; + RealModeIntr($21,regs); + ServerNTPtr:=nwPtr(regs.es, regs.si); { pointer to shell's server name table. } + FillChar(ServerNTPtr^[NewServerSlot],48,#0); + If ServerName[0]>#47 + then ServerName[0]:=#47; + Move(ServerName[1],ServerNTPtr^[NewServerSlot],Length (ServerName)); + end; + end; + +AttachToFileServerWithAddress:=(result=0); +{ Valid completion codes: + 7C Maximum number of attached servers exceeded. + F8 already attached to server; + F9 No Free connection slots at specified server; + FA no more server slots; + FF No response from server + FC No Free slots in shells' ConnectionID table; } +end; + + +Function AttachToFileServer(ServerName : String; Var ConnectionID:Byte):Boolean; +{ Create an attachment between a server and a workstation. } +{ !! you have to be attached to at least 1 server before calling this function. } +{ Does not Login the workstation. } +{ After attaching, and beFore logging in, you must set the preferred server + to the ConnectionID of the server. } +{ Will not report an error if you're already attached to + -or even logged on to- the target server. } +Var ConnectionIDTPtr : TPConnectionIDTPtr; + OldConnId : Byte; + ServIsAttached : Boolean; + AccessLevel : Byte; + ObjID : Longint; + + PropValue :Tproperty; + MoreSegments :boolean; + PropFlags :Byte; + + Regs:TTRegisters; + + ServAddr:TinternetworkAddress; +BEGIN +{ If server known, take adress from shells' tables. + If server not known, try to read its' address from a servers' bindery. + This will fail if you're not connected to at least one server. + Once an adress has been found, AttachToFileServerWithAdress is called. } +UpString(ServerName); + +regs.ax:=$EF03; +RealModeIntr($21,regs); +ConnectionIDTPtr:=nwPtr(regs.es,regs.si); { Ptr to TConnectionIDTable } + +{ Determine whether the suplied server is already known/attached to } +IF GetConnectionID(ServerName,ConnectionID) + then Begin + IF (ConnectionIDTPtr^[ConnectionID].ConnectionNumber > 0) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionNumber < $FF) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionStatus = $FF) + then Begin { ServerIsKnown } + GetPreferredConnectionID (OldConnId); + SetPreferredConnectionID (ConnectionID); + ServIsAttached := GetBinderyAccessLevel (AccessLevel, ObjID); + SetPreferredConnectionID (OldConnID); + result:=0; + IF ServIsAttached { ServerIsAlreadyAttached / caller may even be looged on } + then begin + AttachToFileServer := True; + exit; + end + else ServAddr:=ConnectionIDTPtr^[ConnectionID].ServerAddress; + end + End + Else begin + IF ReadPropertyValue(ServerName,OT_FILE_SERVER,'NET_ADDRESS',1,PropValue,moreSegments,propFlags) + then begin + result:=0; + Move(PropValue,ServAddr,SizeOf(TinternetworkAddress)); + end + else begin + Result:=$FC; + AttachToFileServer:=False; + exit; + end; + End; + +if result=0 + then AttachToFileServerWithAddress(ServerName,ServAddr,ConnectionID); + +AttachToFileServer:=(result=0); +{ Valid completion codes: + 7C Maximum number of attached servers exceeded. + 7D Bindery read error (The supplied server can't be located/doesn't exist) + F8 already attached to server; + F9 No Free connection slots at specified server; + FA no more server slots; + FE Server Bindery Locked; + FF No response from server + FC No Free slots in shells' ConnectionID table; } +END; + + +{F101 [2.0/2.1/3.x]} +Function DetachFromFileServer( ConnectionID:Byte ):boolean; +{ removes server from shell's server table. Relinquishes the + fileserver connection number and breaks the connection. + The function will fail (result=$FF) if connID falls outside of the range [1..MaxServers].} +Type ArrPtr=^Tarr; + Tarr=Array[0..MaxServers*48] of Byte; +Var regs : TTregisters; +begin +if (ConnectionID<1) or (ConnectionID>MaxServers) + then result:=$FF + else begin + regs.ax := $F101; + regs.dl := ConnectionID; { 1..MaxServers } + RealModeIntr($21,regs); + result := regs.al; + { returncodes: 00 successful; FF Connection Doesn't exist } + end; +DetachFromFileServer:=(result=0); +end; + + +{EF03 [2.0/2.1/3.x]} +Function GetConnectionIDTable( ConnectionID: Byte ; Var TableEntry: TConnectionIDTableEntry ):boolean; +{ Returns a copy of the entry in the shells' ConnectionID table corresponding + With the given ConnectionID. All fields are returned lo-hi, except Net and Node + addresses. + The function will fail (result=$FF) if connID falls outside of the range [1..MaxServers].} +Type ptarr=^tarr; + tarr=Array[0..MaxServers*32] of Byte; +Var regs:TTregisters; +begin +If ((ConnectionID<1) or (ConnectionID>MaxServers)) + then Result:=$FF + else begin + regs.ax:=$EF03; + RealModeIntr($21,regs); + move( ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32], TableEntry, 32 ); + With TableEntry + do begin + ServerAddress.socket:=swap(ServerAddress.socket); { Force lo-hi } + ReceiveTimeOut:=swap(ReceiveTimeOut); { Force lo-hi } + MaxTimeOut:=swap(MaxTimeOut); { Force lo-hi } + WconnectionNumber:=swap(WconnectionNumber); { force lo-hi } + end; + Result:=$00; + end; +GetConnectionIDTable:=(Result=0); +end; + + +{DC.. [2.0/2.1/3.x]} +Function GetConnectionNumber(Var ConnectionNbr:byte):boolean; +{ returns connection number of requesting WS (1..100) } +var regs:TTRegisters; +begin +regs.Ah:=$DC; +RealModeIntr($21,regs); +ConnectionNbr:=Regs.AL; { logical WS connection # } +{ cl= first digit of logical conn #, ch= second digit of conn# } +result:=0; +GetConnectionNumber:=true; +end; + + +{F217/16 [2.15c+]} +Function GetConnectionInformation (ConnectionNbr:byte; + Var objName:String; + Var objType:Word; + Var objId:LongInt; + Var LoginTime:TnovTime ):boolean; +Type TReq=Record + PacketLength : Word; + FunctionVal : Byte; + _ConnectionNo : Byte; + End; + Trep=Record + _objId :LongInt; { hi-lo } + _ObjType : word; { hi-lo } + _ObjName : Array [1..48] of Byte; + _LoginTime : TnovTime; + Reserved:word; + End; + TPreq=^Treq; + TPrep=^Trep; +Var i,x: Integer; +Begin +With TPreq(GlobalReqBuf)^ +Do Begin + PacketLength := 2; + FunctionVal := $16; + _ConnectionNo := ConnectionNbr; + End; +F2SystemCall($17,SizeOf(Treq),SizeOf(TRep),result); +If Result = 0 + Then Begin + With TPrep(GlobalReplyBuf)^ + Do Begin + ZstrCopy(ObjName,_objName,48); + ObjId:=Lswap(_objId); + ObjType:=swap(_objType); + logintime:=_logintime; + End; + End; +{ patch to have a NIL object return an error. } +if objName='' then result:=$FD; { no_such_connection } +GetConnectionInformation:=(result=0); +End { GetConnectInfo }; + + + +{F217/14 [2.15c+,unencrypted]} +Function LoginToFileServer( objName:String; objType:word; + password : string ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[47]; { asciiz? } + _objPassw:String[127]; { allowed to be '' } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$14; + _objType:=swap(objType); + PStrCopy(_objName,objName,47); _objName[47]:=#0; UpString(_objName); + PStrCopy(_objPassw,password,127); UpString(_objPassw); + end; +F2SystemCall($17,SizeOf(Treq),0,result); +LoginToFileServer:=(result=0) +end; + + +{F217/18 [3.x]} +FUNCTION LoginEncrToFileServer(ObjName: String; ObjType: Word; PassWord: String): Boolean; +{ assumes the current effective server = the server to login to. } + + + FUNCTION LoginEncrypted(ObjName : String; ObjType : Word; VAR key : TencryptionKey): Boolean; + Type Treq=RECORD + BufLen : Word; + _func : Byte; + _key : TencryptionKey; + _ObjType: Word; + _ObjName: String[48]; + End; + TPreq=^Treq; + Begin + With TPreq(GlobalReqBuf)^ + do Begin + _func := $18; + _key := key; + _ObjType := Swap(objType); + PstrCopy(_ObjName,ObjName,48); UpString(_ObjName); + if ObjName[0]<#48 + then _objName[0]:=objName[0] + else _objname[0]:=#48; + BufLen:=ord(_ObjName[0])+12; + End; + F2SystemCall($17,SizeOf(Treq),0,result); + LoginEncrypted:=(result=0); + End; + +VAR + key : TencryptionKey; + ObjId:LongInt; + +Begin +UpString(password); +if password[0]>#127 + Then password[0]:=#127; + +IF GetEncryptionKey(key) + Then Begin + IF GetBinderyObjectId(objName,objType,ObjId) + Then Begin + EncryptPassword(objId,password,key); + LoginEncrypted(ObjName, ObjType, key); + End; + End + Else LoginToFileServer(ObjName, ObjType, Password); + +LoginEncrToFileServer:= (result=0); +End; + + +{F219 [2.15c+]} +Function Logout:boolean; +{logout from all file servers, remains attached to Server, effective EOJ } +begin + F2SystemCall($19,0,0,result); + result:=$00; + Logout:=true; +end; + + +{F102 [2.0/2.1/3.x]} +Function LogoutFromFileServer(var ConnectionID: byte):boolean; +{logout from one file server} +var regs : TTregisters; +begin + regs.ah := $F1; + regs.al := $02; + regs.dl := ConnectionID; + RealModeIntr($21,regs); + result:=00; + LogoutFromFileServer:=True; +end; + +{EE.. [2.0/2.1/3.x]} +FUNCTION GetWorkstationNodeAddress( var physicalNodeAddress: TNodeAddress ):boolean; +{ Get the physical station address (6 bytes hi-endian) } +Var Regs :TTRegisters; +Begin + {Get the physical address from the Network Card} + Regs.Ah := $EE; + RealModeIntr($21,Regs); + result:=Regs.AL; + {nw node= CX BX AX hi-endian} + physicalNodeAddress[1]:=Regs.CH; + physicalNodeAddress[2]:=Regs.CL; + physicalNodeAddress[3]:=Regs.bh; + physicalNodeAddress[4]:=Regs.bl; + physicalNodeAddress[5]:=Regs.ah; + physicalNodeAddress[6]:=Regs.al; + result := 0; + GetWorkstationNodeAddress:=true; +End; + + +{F217/13 [2.15c+]} +Function GetInternetAddress( ConnNbr : byte; + Var IntNetAddress:TinterNetworkAddress + ):boolean; +Type TReq=record + length : word; + subfunction : byte; + connection : byte; + end; + TRep=record + network : LongInt; { array [1..4] of byte } { hi-lo } + node : array [1..6] of byte; { hi-lo } + socket : word; { array [1..2] of byte } { hi-lo } + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN +With TPreq(GlobalreqBuf)^ +do begin + length := 2; + subfunction := $13; + connection := ConnNbr; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(TRep),result); +if result = 0 +then With TPrep(GlobalreplyBuf)^ + do begin + move(network,IntNetAddress.net,4); {_is_ and stays hi-lo } + move(node,IntNetAddress.node,6); { _is_ and stays hi-lo } + IntNetAddress.socket:=swap(socket); { force lo-hi } + end; +GetInternetAddress:=(result=0); +end; + +{D6.. [2.0/2.1/3.x]} +FUNCTION EndOfJob(All : Boolean):boolean; +{ forces an end of job + If All is TRUE, then ends all jobs, otherwise ends a single job. + Ending a job unlocks and clears all locked or logged files and records. + It close all open network and local files and resets error and lock modes. + It also resets the workstation environment. } +Var NovRegs:TTRegisters; +BEGIN +with NovRegs +do begin + AH := $D6; + if All + then BX := $FFFF + else BX := $00; + end; +RealModeIntr($21,NovRegs); +Result:=$00; +EndOfJob:=True; +end; + +{$IFDEF NewCalls} + +{F218 [2.15c+]} +FUNCTION EndOfJob(All : Boolean):boolean; +{ forces an end of job + If All is TRUE, then ends all jobs, otherwise ends a single job. + Ending a job unlocks and clears all locked or logged files and records. + It close all open network and local files and resets error and lock modes. + It also resets the workstation environment. } +Type Treq=record + len:word; + _all:word; + end; + { ??? ERR: unclear how the req buffer should be... } + TPreq=^Treq; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + if All + then _all := $FFFF + else _all := $0000; + len:=2; + end; +F2SystemCall($18,2,0,result); +Result:=$00; +EndOfJob:=True; +end; + +{$ENDIF} + + +{F217/0A [2.0/2.1/3.x]} +Function EnterLoginArea( LoginSubDirName:String; + numberOfLocalDrives:Byte ):boolean; +{ Changes the login directory. Used by boot-proms. + LoginSubDirName contains the name of a sub directory under SYS:LOGIN + (e.g. 'V330' means login.exe is to be executed in directory SYS:LOGIN\V330)} +Type Treq=record + len:word; + subFunc:byte; + _numLocDr:Byte; + _subDirName:String[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$0A; + _numLocDr:=numberOfLocalDrives; + PstrCopy(_subDirName,LoginSubDirName,255); UpString(_subDirName); + end; +F2SystemCall($17,Sizeof(Treq),0,result); +EnterLoginArea:=(result=0) +end; + +{F217/15 [2.15c+]} +Function GetObjectConnectionNumbers( objName:String; objType:Word; + Var numberOfConnections: Byte; + Var connections: TconnectionList ):boolean; +{ returns a list of connectionnumbers where objects of the desired type and + name are logged in. + Tconnectionlist is defined as an array[1..100] of byte. Max connections for + Netware 286 = 100. Netware 386 allows more than 100 connections. + If you pass a bad Objectname or the object is not logged in, the errorcode + is NOT set to NO_SUCH_OBJECT ($FC), but GetObjectConnectionNumbers returns 0.} +Type Treq=record + len:word; + subFunc:byte; + _objType:Word; { hi-lo} + _objName:String[47]; + end; + Trep=record + _NbrOfConn:Byte; + _connList:TconnectionList + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$15; + PstrCopy(_objName,objName,47); _objname[47]:=#0; UpString(_objName); + _objType:=swap(objType); + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ +do begin + connections:=_connList; + NumberOfConnections:=_NbrOfConn; + end; +getObjectConnectionNumbers:=(result=0) +end; + + +{EA00 [2.0/2.1/3.x]} +Function GetNetwareShellVersion( Var MajorVersion,MinorVersion, + RevisionLevel :Byte ):Boolean; +{ Returns information about a WS environment. Queries shell. + See also: GetWorkstationEnvironment } + +Var regs:TTRegisters; + tmp1,tmp2:word; +Begin +With regs +do begin + AX:=$EA00; + GetGlobalBufferAddress(tmp1,tmp2,ES,DI); + { Set ES:DI to real-mode address of GlobalReplyBuffer } + { Returned value NOT used, but registers need a valid value anyway. } + RealModeIntr($21,regs); + MajorVersion:=BH; + MinorVersion:=BL; + { shell version>=3.00 : } + { CH = Shell Type. 0=conventional, 1= expanded, 2= extended } + RevisionLevel:=CL; { 1=A,2=B etc. } + end; +Result:=$00; +GetNetwareShellVersion:=True; +end; + +{EAxx,xx>00 [2.0/2.1/3.x] (shell version >=3.00) } +Function GetWorkstationEnvironment(Var OStype,OSversion, + HardwareType,ShortHWType:String):Boolean; +Type Treply=record + stringz4:array[1..4*32] of char; + end; + TPreply=^Treply; +Var regs:TTRegisters; + sNo,k:Byte; + tmp1,tmp2:word; +Begin +With regs +do begin + AX:=$EA01; + BX:=$00; + GetGlobalBufferAddress(tmp1,tmp2,ES,DI); + { set ES:DI to real-mode address of GlobalReplyBuffer } + RealModeIntr($21,regs); + end; +OStype:=''; +OSVersion:=''; +HardwareType:=''; +ShortHWtype:=''; +sNo:=0;k:=0; +With TPreply(GlobalReplyBuf)^ +do begin + while sNo<4 + do begin + inc(k); + while ((k<128) and (stringz4[k]<>#0)) + do begin + Case sNo of + 0:OStype:=OStype+stringz4[k]; + 1:OSversion:=OSversion+stringz4[k]; + 2:HardwareType:=HardwareType+stringz4[k]; + 3:ShortHWtype:=ShortHWtype+stringz4[k]; + end; {case} + inc(k); + end; + inc(Sno); + end; + end; +Result:=$00; +GetWorkstationEnvironment:=True; +end; + +{DD.. [2.0/2.1/3.x]} +Function SetNetwareErrorMode( errMode:Byte):boolean; +{ Sets the shell's handling mode for dealing with netware errors. + 0: default, INT 24 handler 'Abort, Retry, Fail'; + 1: a netware error number is returned in AL; + 2: the netware error number is translated to a DOS error number, + this number is returned. + An EOJ resets the errormode to 0. } +Var regs:TTregisters; +begin +Regs.AH:=$DD; +Regs.DL:=errMode; +RealModeIntr($21,Regs); +{ regs.al now contains previous error mode } +Result:=$00; +SetNetWareErrorMode:=True; +end; + +{DD.. [2.0/2.1/3.x]} +Function GetNetwareErrorMode(Var errMode:Byte):boolean; +Var regs:TTregisters; +begin +Regs.AH:=$DD; +Regs.DL:=0; +RealModeIntr($21,Regs); +{ regs.al now contains previous error mode } +errMode:=regs.al; +regs.ah:=$DD; +RealModeIntr($21,regs); { reset old error mode } +Result:=$00; +GetNetWareErrorMode:=True; +end; + + + +{BB.. [2.0/2.1/3.x]} +Function SetEndOfJobStatus( EndOfJobFlag: Boolean ):Boolean; +{ When this function is called with EndOfJobFlag=False and control is returned + to the root COMMAND.COM, COMMAND.COM will NOT perform an EOJ action. } +Var regs:TTRegisters; +begin +regs.AH:=$BB; +If EndOfJobFlag + then regs.AL:=$01 + else regs.AL:=$00; +RealModeIntr($21,Regs); +{ AL now contains previous EOJ Flag } +Result:=$00; +SetEndOfJobStatus:=True; +end; + +{BB.. [2.0/2.1/3.x]} +Function GetEndOfJobStatus(Var EndOfJobFlag: Boolean ):Boolean; +Var regs:TTRegisters; +begin +regs.AH:=$BB; +regs.al:=$00; +RealModeIntr($21,Regs); +{ AL now contains previous EOJ Flag } +EndOfJobFlag:=(regs.al<>0); +regs.ah:=$BB; +RealModeIntr($21,regs); { reset old eoj-status } +Result:=$00; +GetEndOfJobStatus:=True; +end; + +{E908 (shell 3.00+)} +Function SetShowDots( Show:Boolean):Boolean; +Var regs:TTregisters; +begin +regs.ax:=$E908; +if Show + then regs.bl:=$01 + else regs.bl:=$00; +RealModeIntr($21,Regs); +Result:=$00; +SetShowDots:=True; +end; + +{E908 (shell 3.00+)} +Function GetShowDots(Var Shown:Boolean):Boolean; +Var regs:TTregisters; +begin +regs.ax:=$E908; +RealModeIntr($21,Regs); +Shown:=(regs.bl<>0); +regs.ax:=$E908; +RealModeIntr($21,regs); {reset old 'show dots' parameter} +Result:=$00; +GetShowDots:=True; +end; + +{DB.. [2.0/2.1/3.x]} +Function GetNumberOfLocalDrives( Var drives:Byte ):Boolean; +Var regs:TTregisters; +begin +regs.ah:=$DB; +RealModeIntr($21,Regs); +drives:=Regs.AL; +Result:=$00; +GetNumberOfLocalDrives:=TRUE; +end; + + +{=======SECONDARY FUNCTIONS===================================================} + + +{EF03 [2.0/2.1/3.x] secondary Function } +Function IsConnectionIDinUse( ConnectionID: Byte ):boolean; +{ This function returns FALSE if connId isn't in the range [1..MaxServers] } +Type ptarr=^arr; + arr=Array[0..MaxServers*32] of Byte; +Var regs:TTregisters; +begin +If ((ConnectionID<1) or (ConnectionID>MaxServers)) + then IsConnectionIDInUse:=FALSE { NWTP04: TRUE } + else begin + regs.ax:=$EF03; + RealModeIntr($21,regs); + IsConnectionIDinUse:=(ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32] + <> $00 ) + end; +end; + +Function GetUserAtConnection( ConnectionNbr:byte; var username: string):boolean; +{This function provides a shorter method of obtaining just the USERID.} +var id:LongInt; + typ:word; + time:TnovTime; +begin + getUserAtConnection:=GetConnectionInformation(ConnectionNbr,username,typ,id,time); +end; + + +Function GetEffectiveConnectionID(Var connId:byte):boolean; +begin +if NOT (GetPreferredConnectionID(connId) and (connId<>0)) + then if NOT (GetDefaultConnectionID(ConnId) and (connId<>0)) + then GetPrimaryConnectionID(ConnId); +GetEffectiveConnectionID:=(result=$00); +end; + + +Function GetObjectLoginControl(ObjName:string; ObjType:word; + VAR LoginControlInfo:TloginControl):boolean; +{ Caller must have access to the bindery property LOGIN_CONTROL. + Default: you need to be supervisor-equivalent or the object the property + is associated with. (reading your 'own' information) + + PasswordcontrolFlag: + 00 User is allowed to change PW. + 01 User is NOT allowed to change PW. + 02 User is allowed to change PW, but the new password must be unique. + 03 User is NOT allowed to change PW, and a new password, to be changed + by the supervisor, must be unique. +} +Var LCpropVal:Tproperty; + lc:record + _AccExpDate :array[1..3] of byte; {yy mm dd} + _AccDisabled :boolean; + _PWexpDate :array[1..3] of byte; {yy mm dd} + _GraceLoginsRemaining:byte; + _DaysBetwPWchanges :word; {hi-lo} + _MaxGraceLogins :byte; + _minPWlen :byte; + _unknown1 :byte; {! = hi-byte of maxConcConn } + _MaxConcConn :byte; + _loginTimes :array[1..42] of byte; + _LastLoginTime :array[1..6] of byte; {yy mm dd hh mm ss} + _PWcontrol :byte; + _unknown2 :byte; { not used } + _MaxDiskSpace :Longint; { hi-lo } + _unknown3 :Byte; {! = hi-byte of bad login count } + _badLoginCount :byte; + _AccountResetTime :LongInt; { minutes since 1/1/1985 } + _lastIntruderAddress :TinterNetworkAddress; + end ABSOLUTE LCpropVal; + moreSegments:boolean; + propFlags:byte; + + Procedure Min2NovTime(m:Longint; Var time:TnovTime); + Const darr:array[1..12] of word=(0,31,59,90,120,151,181,212,243,273,304,334); + Var d,dr:word; + i,Lastleap:byte; + begin + d:=(m div 1440); + i:=0; + lastLeap:=84; + while d>((3+(i*4))*365)+31+28 + do begin + dec(d); + lastLeap:=85+3+(i*4); + inc(i); + end; + WITH time + do begin + year:=(d DIV 365)+85; + dr:=(d MOD 365); + month:=1; + while (month<12) and (dr>darr[month+1]) do inc(month); + day:=(dr-darr[month]); + if (day=28) and (month=2) and (lastLeap=year) + then inc(day); + dr:=(m mod 1440); + hour:=(dr div 60); + min:=(dr mod 60); + sec:=0; + end; + end; +begin +IF nwBindry.ReadPropertyValue(ObjName,ObjType,'LOGIN_CONTROL',1, + LCpropval,moreSegments,propFlags) + then begin + FillChar(LoginControlInfo,SizeOf(LoginControlInfo),#0); + With LoginControlInfo + do begin + AccountDisabled :=lc._AccDisabled; + move(lc._AccExpDate[1],AccountExpirationDate.year,3); + move(lc._PWexpDate[1],PasswordExpirationDate.year,3); + MinimumPasswordLength :=lc._minPWlen; + PasswordControlFlag :=lc._PWcontrol; + DaysBetweenPasswordChanges:=swap(lc._DaysBetwPWchanges); + Move(lc._lastLoginTime[1],LastLoginTime.year,6); + GraceLoginsRemaining :=lc._GraceLoginsRemaining; + MaxGraceLoginsAllowed :=lc._maxGraceLogins; + BadLoginCount :=lc._badLoginCount; + Min2NovTime(Lswap(lc._AccountResetTime),AccountResetTime); + LastIntruderAddress :=lc._LastIntruderAddress; + LastIntruderAddress.socket:=swap(LastIntruderAddress.socket); {force lo-hi} + MaxConcurrentConnections :=lc._MaxConcConn; + Move(lc._LoginTimes[1],LoginTimes[1],42); + + DiskSpace :=Lswap(lc._MaxDiskSpace); + end; + result:=$00; + end + else result:=nwBindry.result; +GetObjectLoginControl:=(result=0); +end; + +Function ObjectCanLoginAt(ObjName:String; ObjType:Word; + LoginTime:TnovTime ):Boolean; +{ Caller must have access to the bindery property LOGIN_CONTROL. + Default: you need to be supervisor-equivalent or the object the property + is associated with. (reading your 'own' information) + + -If one or more of the fields hour,min,sec,dayOfWeek contain a value >0, + the supplied time will be checked against the login timerestrictions. + (this means that checking '00:00 on sundays' is impossible) + -If one or more of the fields year,month,day contain a value >0 , the + date will be checked with the expiration date of the account and + with the Account disabled Flag. } +Var CanLog:Boolean; + Info:Tlogincontrol; + half_hrs:word; +begin +IF GetObjectLoginControl(ObjName,ObjType,Info) + then begin + if (logintime.month>0) and (loginTime.day>0) + then CanLog:=((NOT Info.AccountDisabled) and + IsLaterNovTime(Info.AccountExpirationDate,loginTime)) + else CanLog:=true; + if (logintime.hour>0) or (loginTime.min>0) + or (logintime.sec>0) or (logintime.DayOfWeek>0) + then begin + half_hrs:=(loginTime.DayOfWeek * 48)+(LoginTime.hour *2); + if LoginTime.min>=30 + then inc(half_hrs); + If half_hrs>=336 + then result:=$122 + else CanLog:=CanLog AND + ((Info.LoginTimes[(half_hrs DIV 8)+1] + AND (1 SHL (half_hrs MOD 8)) ) >0) + end; + end + else begin + CanLog:=(result=$FB); {no such property} + result:=0; + end; +ObjectCanLoginAt:=(result=0) and CanLog; +end; + +Function GetObjectNodeControl( ObjName:string; ObjType:word; + {i/o} Var seqNbr:integer; + {out} Var NodeControlInfo:TnodeControl):boolean; +Var NCpropVal:Tproperty; + moreSegments:boolean; + propFlags:byte; +begin +if seqNbr=$FBFB + then result:=$EC + else begin + if seqNbr<1 then seqNbr:=1; + IF nwBindry.ReadPropertyValue(ObjName,ObjType,'NODE_CONTROL',seqNbr, + NCpropval,moreSegments,propFlags) + then begin + Move(NCpropVal,NodeControlInfo,120); + if moreSegments + then inc(seqNbr) + else seqNbr:=Integer($FBFB); + end + else result:=nwBindry.result; + end; +GetObjectNodeControl:=(result=0); +{ $EC No more records (no such segment); + $FB No restrictions found (No such property) } +end; + + +end. { end of unit nwConn } + diff --git a/NWTP/NWFILE.PAS b/NWTP/NWFILE.PAS new file mode 100644 index 0000000..3f9bb4e --- /dev/null +++ b/NWTP/NWFILE.PAS @@ -0,0 +1,2999 @@ +{$X+,B-,V-} {essential compiler directives} + +Unit nwFile; + +{ nwFile unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk } + +INTERFACE +{ Primary Functions Interrupt: comments: + +Volume Management (Volume Tables) +--------------------------------- + +* ClearObjectVolRestriction (F216/22) (3) [aka ClearVolumeRestrictions/RemoveObjectDiskRestrictions] +* GetObjectVolRestriction (F216/29) (3) [aka GetObjDiskRestrictions/GetObjectDiskUsageAndRestrictions] +* GetVolumeName (F216/06) +* GetVolumeNameWithHandle (F216/15) [aka GetVolumeInfoWithHandle] +* GetVolumeNumber (F216/05) +* GetVolumeUsage (F216/2C) (3) [aka GetExtendedVolumeInformation] +* IsVolumeRemovable (F212) [aka GetVolumeInfoWithNumber] +* ScanVolForRestrictions (F216/20) (3) +* SetObjectVolRestriction (F216/21) (3) [aka SetVolumeRestrictions/SetObjectVolSpaceLimit + /AddUserDiskspaceRestriction] + +Directory Handles (Directory Handle Table/Drive tables) +------------------------------------------------------- + +* AllocPermanentDirHandle (F216/12) +* AllocTemporaryDirHandle (F216/13) +* DeallocateDirHandle (F216/14) +* DeleteFakeRootDirectory (E906) +* GetDirectoryHandle (E900) +* GetDriveConnectionId (EF02) +* GetDirectoryPath (F216/01) +* GetDriveFlag (EF01) (6) +* GetDriveHandle (EF00) (6) +* GetRelativeDriveDepth (E907) +* GetSearchDriveVector (E901) +* MapFakeRootDirectory (E905) +* SetDirectoryHandle (F216/00) +* SetDriveConnectionId (EF02) +* SetDriveFlag (EF01) +* SetDriveHandle (EF00) +* SetSearchDriveVector (E902) + + Secondary Functions + +* DeleteConnectionsDriveMappings +* DeleteDriveMapping +* GetEnvPath (BA..) +* IsSearchDrive (BA..) +* IsNetworkDrive (4409) +* MapDrive +* MapPermanentDrive +* MapSearchDrive +* SetEnvPath (BA..) + +Entries (directory/file management) +----------------------------------- + +* ChangeDirectory (3B..) (DOS) +* ConvertPathToDirEntryId (F217/F4) +* CreateDirectory (F216/0A) +* DeleteDirectory (F216/0B) +* EraseFiles (F244) +. FileServerFileCopy (F3..) + GetDirectoryInfo (F216/2D) (3) +* GetDirectoryEntry (F216/1F) (3) +. GetExtendedFileAttributes (B600) =F24E ??? +. GetFileAttributes (4300) (DOS) +* GetTrueEntryName (60..) (DOS) +* MapDirentryIdToPath (F217/F3) + MoveEntry (F216/2E) (3) dir and files +* PurgeSalvagableFile (F216/1D) (3) +* RecoverSalvagebleFile (F216/1C) (3) +* RenameDirectory (F216/0F) +* ScanDirectoryInformation (F216/02) +* ScanDirectoryEntry (F216/1E) (3) +* ScanFileInformation (F217/0F) + ScanFilePhysical (F216/28) (3) +* ScanSalvagableFiles (F216/1B) (3) +* SetEntry (F216/25) (3) dir and files +. SetExtendedFileAttributes (B601) =F24F +. SetFileAttributes (F246) [4301] +* SetFileInformation (F217/10) + +* ScanDirRestrictions (F216/23) (3) +* SetDirRestriction (F216/24) (3) + + Secondary functions: + + DeleteFile + GetFileHandle + IsFileShareable + FlagFileShareable + PurgeFiles (by dirHandle,fileMask) + SalvageFiles (by dirHandle,fileMask) + PurgeAllErasedFiles + + +Trustees/Max. Rights Mask +------------------------- + +* DeleteTrustee (F216/2B) (3) +* GetEffectiveRights (F216/2A) (3) +. ModifyMaximumRightsMask (F216/04) +. ScanBinderyObjectTrusteePaths (F217/47) +* ScanEntryForTrustees (F216/26) (3) +* SetTrustee (F216/27) (3) + + +Not Implemented: +---------------- + +- AddTrusteeToDirectory (F216/0D) (10) +- AllocSpecialDirHandle (F216/16) (2) +- DeleteTrusteeFromDirectory (F216/0E) (10) +- FileServerFileCopy (E6..) (8) +- GetEffectiveDirectoryRights (F216/03) (10) +- GetPathFromDirEntryID (F216/1A) (12) +- GetVolumeInformation (F217/E9) (1) +- GetVolumeInfoWithHandle (F216/15) (5) +- GetVolumeInfoWithNumber (F212) (4) [DA..] +- PurgeErasedFiles (F216/10) (8) +- PurgeAllErasedFiles (F217/CE) (8) +- RestoreDirectoryHandle (F216/18) (2) +- RestoreErasedFile (F216/11) (8) +- SaveDirectoryHandle (F216/17) (2) +- ScanDirectoryForTrustees (F216/0C) (9) +- SetDirectoryInformation (F216/19) (11) +- SetFileAttributes (E4..) (7) +- UpdateFileSize (E5..) (7) + + +Notes: (1) GetVolumeInformation. This call is NOT available in all 3.x versions. + (only with Nw 2.1 & 3.1x and CLIB.NLM dated before 11-11-92 ) + This call is not implemented here. Replaced by GetVolumeUsage. + (2) not available in (all versions of) NW 3.x. + (3) NW 3.x (and upwards) only. + (4) Replaced by GetVolumeUsage and IsVolumeRemovable. + (5) Replaced by GetVolumeUsage and GetVolumeNameWithHandle. + (6) Information can also be obtained by calling GetDirectoryHandle. + (DOS) 'Normal' DOS call, extended by NetWare shell. + (7) Not supported by Adv.NW 3.x. Not implemented here. + These are functions using FCB's. If another function with the same + name is listed here, that function performs the same action. + (8) Not supported by Adv.NW 3.x. Not implemented here. + These functions have been replaced with calls marked (3) + (9) Replaced by a newer version: ScanEntryForTrustees. + (10) Replaced by DeleteTrustee, GetEffectiveRights and SetTrustee. + (11) Replaced by SetEntry + (12) Replaced by MapDirEntryIDtoPath + + } + +Uses nwIntr,nwMisc,nwBindry,nwConn; + +Var Result:Word; + +Type TsearchDriveVector=array [1..17] of byte; + + +CONST + DRIVE_UNUSED = $00; + DRIVE_PERMANENT = $01; { Drive permanently assigned to fileserver directory } + DRIVE_TEMPORARY = $02; { Drive temporary assigned to FS dir. Released by EOJ } + DRIVE_NETWORK = $03; { Normal drive mapping } + DRIVE_LOCAL = $80; { Drive is local. ! By ORing with one of the above bits, + it can be reassigned to a FS directory.} + + {Name Space Type constants} + NS_DOS =0; + NS_MAC =1; + NS_NFS =2; + NS_FTAM =3; + NS_HPFS =4; + + { Attributes / Netware directory & file attributes } + A_NORMAL = $00; {file} + A_READ_ONLY = $01; {file} + A_HIDDEN = $02; {file/dir} + A_SYSTEM = $04; {file/dir} + A_EXECUTE_ONLY = $08; {file} + A_DIRECTORY = $10; {file} + A_NEEDS_ARCHIVED = $20; {file} + A_undocumented = $40; + A_SHAREABLE = $80; {file} + + A_LO_SEARCH = $0100; {file} + A_MID_SEARCH = $0200; {file} + A_HI_SEARCH = $0400; {file} + A_RESERVED = $0800; {file/dir} + A_TRANSACTIONAL = $1000; {file} + A_INDEXED = $2000; {file} + A_READ_AUDIT = $4000; {file} + A_WRITE_AUDIT = $8000; {file} + + A_PURGE = $010000; {file/dir} + A_RENAME_INHIBIT = $020000; {file/dir} + A_DELETE_INHIBIT = $040000; {file/dir} + A_COPY_INHIBIT = $080000; {file} + + { Trustee Attributes / directory access rights } + TA_NONE = $00; + TA_READ = $01; {R open/read} + TA_WRITE = $02; {W open/write} + TA_RESERVED = $04; { reserved, set to 0 } + TA_CREATE = $08; {C create files or dirs} + TA_DELETE = $10; {E delete files/dirs} + TA_ACCESS = $20; {A set /delete trustees} + TA_SEARCH = $40; {F directory can be searched/file is visible} + TA_MODIFY = $80; {M modify dir/file attributes} + TA_SUPERVISOR =$100; {S supervisor rights to file or directory } + + { Entry Modify flags / see SetEntry } + + EM_ENTRYNAME = $00000001; + EM_ATTRIBUTES = $00000002; + EM_CREATIONTIME = $0000000C; { date = $04, time = $08 } + EM_OWNERID = $00000010; + EM_ARCHIVETIME = $00000060; { date = $20, time = $40 } + EM_ARCHIVERID = $00000080; + EM_MODIFYTIME = $00000300; { date = $0100, time =$0200 } + EM_MODIFIERID = $00000400; + EM_LASTACCESSTIME = $00000800; { date = $0800 } + EM_RIGHTSMASK = $00001000; + EM_MAXDISKSPACE = $00002000; + +Type TvolUsage=record + totalBlocks, {static info} + freeBlocks, {dynamic} + purgableBlocks, {dynamic} + notYetPurgableBlocks, {dynamic} + totalDirEntries, {static} + availDirEntries, {dynamic} + Flags :LongInt; {dynamic} + SectorsPerBlock :byte; {static/number of 512 byte sectors per block} + volumeName :string[16];{static} + end; + + { used By ScanVolForRestrictions } + TobjVolRestr=array[1..64] of record + objId :LongInt; + MaxAllowedBlocks:LongInt; + end; + + +Type Tentry=record + EntryName :String[16]; + + NSType :byte; {namespace number} + DataForkSize :Longint; { =FileSize when NStype=0 (dos) } + {ResourceForkSize:Longint; (Mac data) =0 when NStype=0 (dos) } + FileSize :Longint; {FileSize=Resource+Data forksize } + + Attributes :Longint; + RightsMask :word; {(4)} + + CreationTime, + ArchiveTime, + ModifyTime, + LastAccessTime, + DeleteTime :TnovTime; {salvagable file only} + + OwnerId, + ArchiverId, + ModifierId, + DeletorId :Longint; {salvagable file only} + + end; + { Note: (4) When used with ScanDirectoryInfo, this field + contains the MaximumRightsMask. + Otherwise, the InheritedRightsMask } + +Type TdirRestrList=array[1..56] of record + Level:Byte; + MaxBlocks, + AvailableBlocks:Longint; + end; + {when MaxBlocks and Availableblocks are set to to $7FFFFFFF, + no restrictions are enforced -at this level-} + +Type TtrusteeInformation=record + NumberOfTrustees:Byte; + TrusteeID :array[1..20] of Longint; + TrusteeRights:array[1..20] of Word; + end; + +{-------------------- Volumes----------------------- } +{F216/05 [2.15c+]} +Function GetVolumeNumber( volumeName:String; Var volumeNumber:Byte ):boolean; +{ Returns the volume number of a given volume name } + +{F216/06 [2.15c+]} +Function GetVolumeName( volumeNumber:Byte; Var volumeName:String ):boolean; +{ Returns the volume name of a give volume number [0..31]. + If the volume is not mounted at the time of this call, a null-string is returned. } + +{F216/2C [2.15c+]} +Function GetVolumeUsage(volumeNumber:byte; Var VolUsage: TvolUsage):boolean; + +{F212 [2.15c+]} +Function IsVolumeRemovable( volumeNumber:Byte; + Var volIsRemoveable:Boolean):boolean; + +{F216/15 [2.15c+]} +Function GetVolumeNameWithHandle( dirHandle:Byte; + Var volumeName:String ):boolean; +{F216/29 [3.x]} +Function GetObjectVolRestriction(VolumeNumber:byte; objId:LongInt; + Var MaxAllowedBlocks,BlocksInUse:LongInt):boolean; + +{F216/21 [3.x]} +Function SetObjectVolRestriction(VolumeNumber:byte; objId, + MaxAllowedBlocks:LongInt):boolean; +{F216/22 [3.x]} +Function ClearObjectVolRestriction(VolumeNumber:byte; objId:LongInt):boolean; + + +{F216/20 [3.x]} +Function ScanVolForRestrictions(VolumeNumber:byte; + {i/o} Var sequenceNbr:LongInt; + {out} Var NbrOfObjects:byte; + Var ResultBuffer:TobjVolRestr):boolean; +{ 1st call: sequenceNbr=0, + after last call: sequenceNbr=0 again. } + +{-------------------- Directory Handles/ Drives -------------} + +{F216/01} +Function GetDirectoryPath(DirHandle:byte; Var PathName:string):boolean; + +{EF00 [2.0/2.1/3.x]} +Function GetDriveHandle( DriveNumber:Byte; Var DirHandle:Byte ):boolean; +{ The call returns a pointer to the shell's Drive Handle Table. (32 bytes) + (Drives A..Z and temporary drives [\]^_' ) + If a drive has been assigned a directory handle on the file server, + the handle can be found in the DHT at the position corresponding with the drive letter.} + +{EF00 [2.0/2.1/3.x]} +Function SetDriveHandle( DriveNumber:Byte; DirHandle:Byte ):boolean; + +{E900 [2.0/2.1/3.x]} +Function GetDirectoryHandle( DriveNumber:Byte; Var dirHandle,status:byte):Boolean; +{ Returns directory handle and status flags for a drive. } +{ Drivenumber = 0..31 (A..Z = 0..25) and temp drives (26..31) } + +{EF01 [2.0/2.1/3.x]} +Function GetDriveFlag( DriveNumber:Byte; Var DriveStatus:Byte ):Boolean; +{ This call returns a pointer to the shell's Drive Flag Table (32 Bytes) + Each entry indicates a drive's status (permanent,temporary,local,unassigned) + For further explanation see the DRIVE_xxx constants.} + +{EF01 [2.0/2.1/3.x]} +Function SetDriveFlag( DriveNumber:Byte; DriveStatus:Byte ):Boolean; + +{F216/14 [2.15c+]} +function DeallocateDirHandle(DirHandle : Byte) : Boolean; +{ This function deletes a directory handle } + + +{EF02 [2.0/2.1/3.x]} +Function GetDriveConnectionID( DriveNumber:Byte; Var connID:Byte):boolean; +{ returns the servernumber (1..8) associated with a drive. } + +{EF02 [2.0/2.1/3.x]} +Function SetDriveConnectionID( DriveNumber:Byte; connID:Byte):boolean; + +{F216/00 [2.15c+]} +Function SetDirectoryHandle( sourceDirHandle:Byte; sourceDirPath:String; + targetDirHandle:Byte ):boolean; +{ make handle 'targetHandle' point to the directory provided by + sourceHandle and/or sourceDirPath. } + +{F216/12 [2.15c+]} +FUNCTION AllocPermanentDirHandle( DriveNumber:Byte; + DirHandle : byte; DirPath : string ; + var NewDirHandle, EffectiveRights: byte ) :boolean; + +{F216/13 [2.15c+]} +function AllocTemporaryDirHandle( DriveNumber:byte; + DirHandle : Byte; DirPath : String; + var NewDirHandle,EffectiveRights : Byte) : Boolean; +{ Allocates a temporary directory handle, deleted automatically by EOJ. } + +{E901} +Function GetSearchDriveVector(Var vector:TsearchDriveVector):boolean; + +{E902 } +Function SetSearchDriveVector(vector:TsearchDriveVector):boolean; + +{E905 (shell 3.01+)} +Function MapFakeRootDirectory(DriveNumber:byte; DirPath:string):boolean; + +{E906 (shell 3.01+)} +Function DeleteFakeRootDirectory(DriveNumber:byte):boolean; + +{E907 (shell 3.01+)} +Function GetRelativeDriveDepth(DriveNumber:byte; Var depth:byte):boolean; + +{BA.. } +Function GetEnvPath(Var EnvPath:string):boolean; + +{BA.. } +Function SetEnvPath(EnvPath:string):boolean; + + +{secondary } +FUNCTION MapDrive(DriveNumber:byte; DirectoryPath:string; + Root, Permanent:boolean):boolean; + +{secondary } +FUNCTION MapPermanentDrive(DriveNumber:byte; DirectoryPath:string; + Root:boolean):boolean; + +{secondary} +Function MapSearchDrive(DriveNumber:byte; DirPath:string; + PathPosition:byte; + Insert,Root,Permanent:Boolean):boolean; + +{secondary} +Function DeleteDriveMapping(DriveNumber:Byte):boolean; + +{secondary} +Function DeleteConnectionsDriveMappings(ConnId:Byte):Boolean; + +{secondary} +Function IsSearchDrive(DriveNumber:byte):boolean; + +{4409 } +Function IsNetworkDrive(driveNumber:Byte):boolean; +{ isNetworkDrive is set to TRUE if the drive is a) a network drive, and + b) a legal drive letter was used. } + + +{------------------------- entries -----------------------------------------} + +{F217/0F [2.15c+]} +Function ScanFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + {i/o} VAR SequenceNbr:Integer; + {out} VAR fileInfo:Tentry):Boolean; + +{F217/F4 [3.0+]} +Function ConvertPathToDirEntryId(dirHandle:Byte; dirPath:string; + Var VolNbr :byte; + Var dirEntryID:LongInt):boolean; +{ aka ConvertPathToDirEntry / requires console rights } + +{F216/02} +Function ScanDirectoryInformation(dirHandle:byte; searchDirPath:string; + {i/o} Var sequenceNumber:word; + {out:} Var dirInfo:Tentry ):boolean; + +{F216/1F [2.15c+]} +Function GetDirectoryEntry(DirHandle:byte; + Var dirEntry:Tentry):boolean; + +{F216/1E [2.15c+]} +Function ScanDirectoryEntry(DirHandle:Byte; EntryName:string; SearchFlags:Longint; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; + +{F217/F3 [3.0+]} +Function MapDirEntryIdToPath(VolNbr:byte;DirEntryId:Longint; NStype:byte; + Var ExtPath:string):boolean; + +{F216/25 [2.15c+] } +Function SetEntry(DirHandle:Byte;EntryId:Longint;SearchFlags:Byte; + ModFlags:Longint; Entry:Tentry ):boolean; + +{F217/10 [2.15c+]} +Function SetFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + fileInfo:TEntry):boolean; + +{F216/1B [2.15c+]} +Function ScanSalvagableFiles(DirHandle:Byte; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; + +{F216/1D [3.0+]} +Function PurgeSalvagableFile(DirHandle:Byte; + EntryId:Longint; FileName:string):boolean; + +{F216/1C [3.0+] } +Function RecoverSalvagableFile(dirHandle:Byte; EntryId:Longint; + OldName,NewName:string):boolean; + +{F244 [2.1x/3.x]} +Function EraseFiles(dirHandle, searchAttrib:Byte; filePath:string ):boolean; + +{60.. (extended DOS call)} +Function GetTrueEntryName(DirPath:string; Var CanonicalPath:string):boolean; + + +{F216/0F [2.0/2.1/3.x]} +Function RenameDirectory( dirHandle:Byte; dirPath, newDirName :String):Boolean; + +{F216/0B [2.15c+]} +Function DeleteDirectory(DirHandle:Byte; DirPath:string):boolean; + +{F216/0A [2.15+]} +Function CreateDirectory(DirHandle:Byte; DirPath:string; MaxRightsMask:byte):boolean; + +{3B.. } +Function ChangeDirectory(DirPath:string):boolean; + + +{F216/24 [3.0+]} +Function SetDirRestriction(DirHandle:Byte; DiskSpaceLimit:Longint):boolean; + +{F216/23 [3.0+]} +Function ScanDirRestrictions(DirHandle:Byte; + Var NumberOfEntries:Byte; + Var RestrInfo:TdirRestrList):boolean; + +{--------------------------- Rights/trustees ---------------------------} + +{F216/27 [3.0+]} +Function SetTrustee(DirHandle:Byte;DirPath:string; + TrusteeObjectID:Longint; + RightsMask:Word ):boolean; + +{F216/2B [3.0+]} +Function DeleteTrustee(DirHandle:Byte;DirPath:String; + TrusteeObjectId:Longint):boolean; + +{F216/2A [3.0+]} +function GetEffectiveRights(DirHandle:Byte;DirPath:String; + var Rights:Word) : Boolean; + +{F216/04 [2.15c+]} +Function ModifyMaximumRightsMask(DirHandle:Byte;DirPath:string; + RevokeRightsMask,GrantRightsMask:Word):boolean; + + +{F217/47 [2.15c+]} +Function ScanBinderyObjectTrusteePaths(TrusteeObjectId:Longint; + VolumeNumber:Byte; + {i/o} Var SequenceNumber:word; + {out} Var AccessMask:Word; + Var Path:string ):boolean; + +{F216/26 [3.0+]} +Function ScanEntryForTrustees(DirHandle:Byte;DirPath:String; + {i/o} Var SequenceNumber:Byte; + {out} Var TrusteeInfo: TtrusteeInformation):boolean; + +IMPLEMENTATION{============================================================} + +{$IFDEF MSDOS} +uses dos; { file handles / 'normal' file attributes } +{$ENDIF} + +Type TintEntry=record { Unit internal Entry type } + { 0} _res1 :Longint; { low word = Dir Id of parent Dir } + { 4} _attrib :Longint; + { 8} _res2 :word; + { 10} _NStype :Byte; + { 11} _name :string[12]; + { 24} _creationTime :Longint; + { 28} _OwnerId :Longint; { hi-lo} + { 32} _ArchiveTime :Longint; + { 36} _ArchiverId :Longint; { hi-lo} + { 40} _modifyTime :Longint; + + { 44} _ModifierId :Longint; { files only } + { 48} _ForkSize :Longint; { files only } + { 52} _res3 :array[1..44] of byte; { Trustee obj IDs and Tr. rights } + { 96} _FileRightsMask:word; { files only } + { 98} _AccessDate :word; { files only } + + {100} _DirRightsMask :word; { directories only } + {102} _res4 :word; {Unique Dir ID, hi-lo} { directories only } + {104} _DeleteTime :Longint; { salvageable files only } + {108} _DeletorID :LongInt; { salvageable files only } + {112} _res5 :array[1..16] of byte; + {128} end; + +Procedure Convert2ExtEntry(Var Ie:TintEntry;Var Oe:Tentry); +begin +FillChar(Oe,Sizeof(Tentry),#$0); +with Ie,Oe + do begin + Attributes:=_Attrib; + NStype:=_NStype; + Entryname:=_name; + DosTime2NovTime(_CreationTime,CreationTime); + OwnerId:=Lswap(_OwnerId); {force lo-hi} + DosTime2NovTime(_ArchiveTime,ArchiveTime); + ArchiverId:=Lswap(_ArchiverID); {force lo-hi} + DosTime2NovTime(_ModifyTime,ModifyTime); + if (_attrib and $10)>0 { is entry a directory ? } + then begin + RightsMask:=_DirRightsMask; + end + else begin + ModifierId:=LSwap(_ModifierId); {force lo-hi} + DataForksize:=_Forksize; + if _NSType=0 + then FileSize:=_ForkSize; + RightsMask:=_FileRightsMask; + DosTime2NovTime(MakeLong(_accessDate,0),LastAccessTime); + DosTime2NovTime(_DeleteTime,DeleteTime); + DeletorId:=Lswap(_DeletorID); {force lo-hi} + end; + end; +end; + +Procedure Convert2IntEntry(Var Oe:TEntry;Var Ie:TIntEntry); +Var TempTime:Longint; +begin +FillChar(Ie,Sizeof(Tentry),#$0); +with Ie,Oe + do begin + _Attrib:=Attributes; + _NStype:=NStype; + _Name:=EntryName; + NovTime2DosTime(CreationTime,_CreationTime); + _OwnerId:=Lswap(OwnerId); {force hi-lo} + NovTime2DosTime(ArchiveTime,_ArchiveTime); + _ArchiverId:=Lswap(ArchiverId); {force hi-lo} + NovTime2DosTime(ModifyTime,_ModifyTime); + if (Attributes and $10)>0 { is entry a directory ? } + then begin + _DirRightsMask:=RightsMask; + end + else begin + _ModifierId:=Lswap(ModifierId); { force hi-lo } + _ForkSize:=DataForkSize; + _FileRightsMask:=RightsMask; + NovTime2DosTime(LastAccessTime,TempTime); + _AccessDate:=HiLong(TempTime); + NovTime2DosTime(DeleteTime,_DeleteTime); + _DeletorID:=Lswap(DeletorId); { force hi-lo } + end; + end; +end; + +Procedure ConvertPathToVolFormat(Var path:string); +{ reformat \\server\vol\path to VOL:PATH + server/vol:path to VOL:PATH } +Var pcolon,pslash:byte; +begin +if (Path[0]>#1) and (Path[1]='\') and (Path[2]='\') + then begin + delete(Path,1,2); + Path:=Path+'\'; + pslash:=pos('\',Path); + if pslash>0 + then begin + delete(Path,1,pslash); { remove servername from path } + pslash:=pos('\',Path); + if pslash>0 + then Path:=copy(Path,1,pslash-1)+':'+copy(Path,pslash+1,255); + end; + while Path[ord(Path[0])]='\' do dec(Path[0]); + end + else begin + pcolon:=pos(':',path); + if (path[0]>#3) and (pcolon>3) + then begin + pslash:=pos('/',path); + if (pslash=0) or (pslash>pcolon) + then pslash:=pos('\',path); + if (pslash>0) and (pslash#16 + then volumeName[0]:=#16; + volName:=volumeName; + if volname[ord(volName[0])]=':' + then dec(volName[0]); + len:=2+ord(volName[0]); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +volumenumber:=TPrep(GlobalReplyBuf)^.volNbr; +getVolumeNumber:=(result=0) +{resultcodes: + 00 success; 98h volume doesn't exist } +end; + + +{F216/15 [2.15c+]} +Function GetVolumeNameWithHandle( dirHandle:Byte; + Var volumeName:String ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _dirHandle :Byte; + end; + Trep=record + _sectPerBlock :Word; {hi-lo} + _TotalBlocks :Word; {hi-lo} + _availBlocks :Word; {hi-lo} { Use GetVolumeUsage for the other fields } + _TotalDirSlots:Word; {hi-lo} + _availDirSlots:Word; {hi-lo} + _volName :array[1..16] of byte; + _volRemoveable:Word; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$15; + _dirHandle:=dirHandle; + end; +F2SystemCall($16,Sizeof(Treq),SizeOf(Trep),result); +ZStrCopy(volumeName,TPrep(GlobalReplyBuf)^._volName,16); +if volumeName='' + then result:=$9B; { Invalid directory handle } +getVolumeNameWithHandle:=(result=0) +{ resultcodes: 00 success; $9B invalid directory handle } +end; + + +{F212 [2.15c+]} +Function IsVolumeRemovable( volumeNumber:Byte; + Var volIsRemoveable:Boolean):boolean; +{ stripped down version of the GetVolumeInfoWithNumber call } +Type Treq=Byte; + Trep=record + _sectPerBlock :Word; {hi-lo} + _TotalBlocks :Word; {hi-lo} + _availBlocks :Word; {hi-lo} + _TotalDirSlots :Word; {hi-lo} + _availDirSlots :Word; {hi-lo} + _volName :array[1..16] of byte; + _volRemoveable :Word; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +TPreq(GlobalReqBuf)^:=volumeNumber; +F2SystemCall($12,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + volIsRemoveable:=(_volRemoveable>0); + if _volName[1]=0 + then result:=$98; + end; +IsVolumeRemovable:=(result=0); +{ resultcodes: 00 success; 98h Invalid volume number / volume not mounted } +end; + +{F216/22 [3.x]} +Function ClearObjectVolRestriction(VolumeNumber:byte; objId:LongInt):boolean; +{ If the objId doesn't exist, no error is returned. } +Type Treq=record + len:word; + subFunc:byte; + _volNbr:byte; + _objId:LongInt; { hi-lo } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$22; + _volNbr:=VolumeNumber; + _objId:=Lswap(objId); { force hi-lo } + end; +F2SystemCall($16,SizeOf(Treq),0,result); +ClearObjectVolRestriction:=(result=0) +{ $8C No supervisor rights } +end; + +{F216/29 [3.x]} +Function GetObjectVolRestriction(VolumeNumber:byte; objId:LongInt; + Var MaxAllowedBlocks,BlocksInUse:LongInt):boolean; +{ If MaxAllowedBlocks is equal to $40000000 on return, there are no + disk restrictions for the object on this volume. } +{ You need not be logged in to use this call. } +Type Treq=record + len :word; + subFunc:byte; + _volNbr:byte; + _objId :Longint; {hi-lo} + end; + Trep=record + _MaxAllowedBlocks, + _BlocksInUse :Longint; + end; + TPreq=^Treq; + TPrep=^Trep; +Var objName:string; + objType:word; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len :=SizeOf(Treq)-2; + subFunc:=$29; + _volNbr:=VolumeNumber; + _objId :=Lswap(objId); {force hi-lo} + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + MaxAllowedBlocks:=_MaxAllowedBlocks; + BlocksInUse:=_BlocksInUse; + If BlocksInUse=0 + then if NOT nwBindry.GetBinderyObjectName(objId,objName,objType) + then result:=$FF; + end; +GetObjectVolRestriction:=(result=0) +{resultcodes: 00 success; $FF Invalid objectId } +end; + +{F216/20 [3.x]} +Function ScanVolForRestrictions(VolumeNumber:byte; + {i/o} Var sequenceNbr:LongInt; + {out} Var NbrOfObjects:byte; + Var ResultBuffer:TobjVolRestr):boolean; +{ 1st call: sequenceNbr=0, + // n-th call: sequenceNbr(n):=sequenceNbr(n-1)+NbrOfObjects + // (addition done by function itself) + + after last call: sequenceNbr=0 again. } +Type Treq=record + len:word; + subFunc:byte; + _volNbr:byte; + _seqNbr:LongInt; { lo-hi !} + end; + Trep=record + _NbrOfObjects:byte; + _buff :TobjVolRestr; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$20; + _volNbr:=VolumeNumber; + _seqNbr:=sequenceNbr; + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +if result=0 + then begin + With TPrep(GlobalReplyBuf)^ + do begin + NbrOfObjects:=_NbrOfObjects; + ResultBuffer:=_buff; + For t:=1 to NbrOfObjects + do ResultBuffer[t].objId:=Lswap(_buff[t].ObjId); + if _NbrOfObjects=0 + then result:=$FF + else sequenceNbr:=sequenceNbr+_NbrOfObjects; + end + end + else NbrOfObjects:=0; +ScanVolForRestrictions:=(result=0) +{ $98 VolumeNumber doesn't exist; + $FF No New restriction data (end of iteration) } +end; + +{F216/21 [3.x]} +Function SetObjectVolRestriction(VolumeNumber:byte; objId,MaxAllowedBlocks:LongInt):boolean; +{ If the objId doesn't exist, no error is returned. } +Type Treq=record + len :word; + subFunc:byte; + _volNbr:byte; + _objId :Longint; {hi-lo} + _maxBlocks:LongInt; {lo-hi !!} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$21; + _volNbr:=VolumeNumber; + _objId:=Lswap(objId); { force hi-lo } + _maxBlocks:=MaxAllowedBlocks; + end; +F2SystemCall($16,SizeOf(Treq),0,result); +SetObjectVolRestriction:=(result=0) +{ $8C No supervisor Rights } +end; + + +{--------------Dir handles/ drive mappings----------------------------------} + + +{BA.. } +Function GetEnvPath(Var EnvPath:string):boolean; {#d} +Type Tarr=array[1..2048] of byte; +Var regs:TTregisters; + penv:^Tarr; + i,envSize:word; + state:byte; +begin +regs.ah:=$BA; +RealModeIntr($21,regs); +envSize:=byte(nwPtr(regs.dx-1,3)^) SHL 4; +penv:=nwPtr(regs.dx,0); +i:=1; +state:=0; +while (i0) + do begin + EnvPath:=EnvPath+chr(penv^[i]); + inc(i); + end; +if i>envSize + then begin + result:=$301; + GetEnvPath:=false; + exit; + end; +result:=0; +GetEnvPath:=true; +{ 00 successful + 300 'Path' not found + 301 Path value could not be read } +end; + +{BA.. } +Function SetEnvPath(EnvPath:string):boolean; {#d} +Type Tarr=array[1..2048] of byte; +Var regs:TTregisters; + penv:^Tarr; + i,t,envSize:word; + state:byte; + pbegin,pend:word; + NewPathSize,OldPathSize:byte; + diff:integer; + sVector:TsearchDriveVector; + Vecind,p:byte; + dn:Byte; +begin +Upstring(EnvPath); +If pos('PATH=',envPath)=1 + then delete(EnvPath,1,5); +regs.ah:=$BA; +RealModeIntr($21,regs); +envSize:=word(nwPtr(regs.dx-1,3)^) SHL 4; +penv:=nwPtr(regs.dx,0); + +i:=1; +state:=0; +while (i0) + do inc(i); +if i>envSize + then begin + result:=$301; + SetEnvPath:=false; + exit; + end; +dec(i); +pend:=i; + +{ determine end of 'active' environment / marked by $00 00} +while (ienvSize + then begin + result:=$302; + SetEnvPath:=false; + exit; + end; + +diff:=NewPathSize-OldPathSize; +if diff>0 + then for t:=i downto pend + do penv^[t+diff]:=penv^[t]; +if diff<0 + then for t:=pend to i + do penv^[t+diff]:=penv^[t]; +Move(EnvPath[1],penv^[pbegin],NewPathSize); + +FillChar(Svector,SizeOf(TsearchDriveVector),#$FF); +VecInd:=1; +REPEAT +p:=pos(':',envPath); +if p>0 + then begin + dn:=ord(ord(envPath[p-1])-ord('A')); + p:=pos(';',envPath); + if p=0 + then envPath:='' + else delete(envPath,1,p); + IF IsNetworkDrive(dn) + then begin + Svector[VecInd]:=dn; + inc(VecInd) + end; + end; +UNTIL (p=0) or (VecInd=17); +SetSearchDriveVector(Svector); + +result:=0; +SetEnvPath:=true; +{ 00 successful + 300 'Path' not found + 301 Environment failure + 302 Environment overflow (new path too large) } +end; + + +{F216/01} +Function GetDirectoryPath(DirHandle:byte; Var PathName:string):boolean; +{ path includes volumename } +Type Treq=record + len :word; + subFunc:byte; + _dh :byte; + end; + Trep=record + DirPath:string[255]; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$01; + _dh:=DirHandle; + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +PathName:=TPrep(GlobalReplyBuf)^.DirPath; +GetDirectoryPath:=(result=0) +{ 00 Successful 9B Bad directory handle } +end; + +{EF02 [2.0/2.1/3.x]} +Function GetDriveConnectionID( DriveNumber:Byte; Var connID:Byte):boolean; +{ returns the servernumber (1..8) associated with a drive. } +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF02; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + connID:=Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]; + Result:=0; + end; +GetDriveConnectionID:=(Result=0); +end; + +{EF02 [2.0/2.1/3.x]} +Function SetDriveConnectionID( DriveNumber:Byte; connID:Byte):boolean; +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF02; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]:=connId; + Result:=0; + end; +SetDriveConnectionID:=(Result=0); +end; + + +{EF00 [2.0/2.1/3.x]} +Function GetDriveHandle( DriveNumber:Byte; Var DirHandle:Byte ):boolean; +{ The call returns a pointer to the shell's Drive Handle Table. (32 bytes) + (Drives A..Z and temporary drives [\]^_' ) + If a drive has been assigned a directory handle on the file server, + the handle can be found in the DHT at the position corresponding with the drive letter.} +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF00; +RealModeIntr($21,regs); +if DriveNumber>31 + then result:=$0105 + else begin + DirHandle:=Parr(nwPtr(Regs.Es,Regs.Si))^[DriveNumber]; + Result:=0; + end; +GetDriveHandle:=(Result=0); +end; + +{EF00 [2.0/2.1/3.x]} +Function SetDriveHandle( DriveNumber:Byte; DirHandle:Byte ):boolean; +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF00; +RealModeIntr($21,regs); +if DriveNumber>31 + then result:=$0105 + else begin + Parr(nwPtr(Regs.Es,Regs.Si))^[DriveNumber]:=DirHandle; + Result:=0; + end; +SetDriveHandle:=(Result=0); +end; + +{EF01 [2.0/2.1/3.x]} +Function GetDriveFlag( DriveNumber:Byte; Var DriveStatus:Byte ):Boolean; +{ This call returns a pointer to the shell's Drive Flag Table (32 Bytes) + Each entry indicates a drive's status (permanent,temporary,local,unassigned) + For further explanation see the DRIVE_xxx constants.} +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF01; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + DriveStatus:=Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]; + Result:=0; + end; +GetDriveFlag:=(Result=0); +end; + +{EF01 [2.0/2.1/3.x]} +Function SetDriveFlag( DriveNumber:Byte; DriveStatus:Byte ):Boolean; +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF01; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]:=DriveStatus; + Result:=0; + end; +SetDriveFlag:=(Result=0); +end; + + +{E900 [2.0/2.1/3.x]} +Function GetDirectoryHandle( DriveNumber:Byte; Var dirHandle,status:byte):Boolean; +{ Returns directory handle and status flags for a drive. } +{ Drivenumber = 0..31 (A..Z = 0..25) and temp drives (26..31) } +{ Status Byte + 7 6 5 4 3 2 1 0 + | | +-Permenant Directory Handle + | +----Temporary Directory Handle + +----------------------Mapped to a local drive } +{ in case of an invalid driveNumber, handle and status will be set to 0 } +Var Regs:TTRegisters; +begin +With Regs +do begin + AX:=$E900; + DX:=DriveNumber; + RealModeIntr($21,Regs); + { AH = Status Flags; + 01 mapped to a permanent dir handle; + 02 mapped to a temporary dir handle; + 80 local drive. } + dirHandle:=AL; + status:=AH; + If dirHandle=0 + then begin status:=0;Result:=$FF end {INVALID_DRIVE_NUMBER} + else Result:=0; + GetDirectoryHandle:=(Result=0) + end; +{ result: $00 success; $FF Invalid Drive Number } +end; + + +{F216/00 [2.15c+]} +Function SetDirectoryHandle( sourceDirHandle:Byte; sourceDirPath:String; + targetDirHandle:Byte ):boolean; +{ make handle 'targetHandle' point to the directory provided by + sourceHandle and/or sourceDirPath. ( "Volume:dir\subdir" ) } +Type Treq=record + len :word; + subFunc :byte; + _TargetDH :Byte; + _SourceDH :Byte; + _SourceDP :String[255] + end; + TPreq=^Treq; +Var p:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$00; + _TargetDH:=targetDirHandle; + _SourceDH:=SourceDirHandle; + if SourceDirHandle=0 + then ConvertPathToVolFormat(SourceDirPath); + _sourceDP:=sourceDirPath; + UpString(_sourceDP); + len:=4+ord(_SourceDP[0]); + F2SystemCall($16,len+2,0,result); + end; +SetDirectoryHandle:=(result=0) +{ resultcodes: + 00 Success; 98h Volume does not exist; + 9Bh Bad directory handle; 9Ch Invalid Path. } +end; + + +{F216/12 [2.15c+]} +FUNCTION AllocPermanentDirHandle( DriveNumber:Byte; + DirHandle : byte; DirPath : string ; + var NewDirHandle, EffectiveRights: byte ) :boolean; +{ Effective server must be the server involved, i.e. where the dir is stored } +Type Treq=record + len : word; + subf : byte; + _dirHandle : byte; + _driveLetter : char; + _DirectoryPath: String[255]; + end; + Trep=record + _newDirHandle : byte; + _EffectiveRights : byte; { e.r. mask } + end; + TPreq=^Treq; + TPrep=^Trep; +Var p:Byte; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + subf := $12; + _dirHandle := dirHandle; + _driveLetter := chr(DriveNumber+ord('A')); + if Dirhandle=0 + then ConvertPathToVolFormat(DirPath); + _DirectoryPath:=DirPath; + UpString(_DirectoryPath); + len:=4+ord(_DirectoryPath[0]); + F2SystemCall($16,len+2,sizeof(Trep),result); + end; +if result = 0 + then with TPrep(GlobalReplyBuf)^ + do begin + effectiveRights := _effectiveRights; + newDirHandle := _newDirHandle; + end; +AllocPermanentDirHandle:=(result=0); +{ $00 Successful $98 Volume doen't exist $9C Invalid path } +end; + + + + + +{F216/13 [2.15c+]} +function AllocTemporaryDirHandle( DriveNumber:byte; + DirHandle : Byte; DirPath : String; + var NewDirHandle,EffectiveRights : Byte) : Boolean; +{ Allocates a temporary directory handle, deleted automatically by EOJ. } +{ Effective server must be the server involved, i.e. where the dir is stored } +Type TReq=record + Len : Word; + SubF : Byte; + Handle : Byte; + Letter : Char; + _DirectoryPath : String; + end; + TRep=record + NewH : Byte; + Mask : Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Var p:Byte; +begin +with TPReq(GlobalReqBuf)^ + do begin + SubF := $13; + Handle := DirHandle; + Letter := chr(DriveNumber+ord('A')); + { Allocating handles requires paths to be in + the VOL:path format.. NOT canonical } + if handle=0 + then ConvertPathToVolFormat(DirPath); + _DirectoryPath:=DirPath; + UpString(_DirectoryPath); + Len:=4+length(_DirectoryPath); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +with TPrep(GlobalReplyBuf)^ + do begin + NewDirHandle := NewH; + EffectiveRights := Mask; + end; +AllocTemporaryDirHandle:=(result=0); +{ result: 00 success; 98h Volume doesn't exist; 9Ch Invalid Path } +end; + + +{F216/14 [2.15c+]} +function DeallocateDirHandle(DirHandle : Byte) : Boolean; +{ This function deletes a directory handle } +Type TReq=record + Len : Word; + SubF : Byte; + Handle : Byte; + end; + TPreq=^Treq; +begin +with TPReq(GlobalReqBuf)^ + do begin + Len := 2; + SubF := $14; + Handle:= DirHandle; + end; +F2SystemCall($16,Sizeof(Treq),0,result); +DeallocateDirHandle:=(result=0); +{ result: + 00h - Success; 9Bh - Bad directory handle } +end; + + +{E901 } +Function GetSearchDriveVector(Var vector:TsearchDriveVector):boolean; +Var regs:TTregisters; + tmp1,tmp2:word; +begin +regs.ax:=$E901; +GetGlobalBufferAddress(tmp1,tmp2,regs.ds,regs.dx); +{ DS:DX real-mode address of GlobalReplyBuffer } +RealModeIntr($21,regs); +result:=0; +Move(GlobalReplyBuf^,vector,sizeof(TsearchDriveVector)); +vector[17]:=$FF; +GetSearchDriveVector:=True; +end; + +{E902 } +Function SetSearchDriveVector(vector:TsearchDriveVector):boolean; +Var regs:TTregisters; + tmp1,tmp2:word; +begin +regs.ax:=$E902; +Move(vector,GlobalReqBuf^,sizeof(TsearchDriveVector)); +GetGlobalBufferAddress(regs.ds,regs.dx,tmp1,tmp2); +{ DS:DX real-mode address of GlobalRequestBuffer } +RealModeIntr($21,regs); +result:=0; +SetSearchDriveVector:=True; +end; + +Function IsSearchDrive(DriveNumber:byte):boolean; +Var pth:string; +begin +IsSearchDrive:=(getEnvPath(pth) + and (pos(chr(DriveNumber+ord('A'))+':',pth)>0)); +end; + + +{E905 (shell 3.00+)} +Function MapFakeRootDirectory(DriveNumber:byte; DirPath:string):boolean; +{ Dirpath may include server and volumename } +Var regs:TTregisters; + tmp1,tmp2:word; + PName:string; +begin +with regs + do begin + ax:=$E905; + bl:=driveNumber+1; { FF default, 0=A, 2= B etc. } + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { VLM patch for SERVER/VOL: and VOL: type paths } + if (DirPath[0]>#2) and (pos(':',DirPath)>2) + then GetTrueEntryName(DirPath,PName) + else PName:=DirPath; + Pname:=Pname+#0; + move(PName[1],GlobalReqBuf^,ord(PName[1])); + { DS:DX real-mode address of GlobalRequestBuffer holding new path } + RealModeIntr($21,regs); + if (flags and 1 {carry})>0 + then result:=al + else result:=0; + end; +MapFakeRootDirectory:=(result=0); +{ $00 Successful $03 Invalid path $0F Invalid Drive $11 Not same device } +end; + +{E906 (shell 3.00+)} +Function DeleteFakeRootDirectory(DriveNumber:byte):boolean; +Var regs:TTregisters; +begin +with regs + do begin + ax:=$E906; + bl:=DriveNumber+1; + RealModeIntr($21,regs); + result:=0; + end; +DeleteFakeRootDirectory:=(result=0); +end; + +{E907 (shell 3.00+)} +Function GetRelativeDriveDepth(DriveNumber:byte; Var depth:byte):boolean; +Var regs:TTregisters; +begin +with regs + do begin + ax:=$E907; + bl:=DriveNumber+1; + RealModeIntr($21,regs); + depth:=al; + if al<$FF + then result:=0 + else result:=$FF; { no fake root assigned } + end; +GetRelativeDriveDepth:=(result=0); +{ 00 Succesful $FF No fake root assigned } +end; + +{secondary} +Function DeleteDriveMapping(DriveNumber:Byte):boolean; +Var dirHandle,status:byte; + pth:string; + ch:char; + p:byte; + DDepth,Dflag:byte; +begin +{ if searchdrive, remove drive from searchtable and PATH environment string } +IF GetEnvPath(pth) + then begin + if pth[ord(pth[0])]<>';' + then pth:=pth+';'; + p:=pos(chr(DriveNumber+ord('A'))+':',pth); + if p>0 + then begin { it is a searchdrive, remove from path } + Repeat + ch:=pth[p]; + delete(pth,p,1); + UNTIL ch=';'; + SetEnvPath(pth); { also creates a new searchdriveVector } + end; + end; +IF (result=0) and GetDirectoryHandle(DriveNumber,dirHandle,status) + then begin + IF GetRelativeDriveDepth(DriveNumber,DDepth) { is it a fake root ? } + then DeleteFakeRootDirectory(DriveNumber); + GetDriveFlag(DriveNumber,Dflag); + SetDriveFlag(DriveNumber,(Dflag and $F0) or DRIVE_UNUSED); + SetDriveHandle(DriveNumber,0); + SetDriveConnectionId(DriveNumber,0); + DeallocateDirHandle(dirHandle); + end; +DeleteDriveMapping:=(result=0); +end; + + +{secondary } +FUNCTION MapPermanentDrive(DriveNumber:byte; DirectoryPath:string; + Root:boolean):boolean; +var pth : string; + DriveHandle: Byte; +begin +IF GetTrueEntryName(DirectoryPath,pth) + then begin + while pth[ord(pth[0])] IN ['\','.','*','?'] + do dec(pth[0]); + if pth[1]<>'\' + then result:=$104 { attempt to map network drive to local drive } + else begin + If GetDriveHandle(DriveNumber,DriveHandle) and (DriveHandle<>0) + then DeleteDriveMapping(DriveNumber); + + IF MapFakeRootDirectory(DriveNumber,pth) + then begin + if (not root) + then DeleteFakeRootDirectory(DriveNumber); + { does not delete the mapping itself, + only the fake root. } + end; + end; + end + else result:=$101; { direcory not locatable } +MapPermanentDrive:=(result=0); +end; + +{secondary} +FUNCTION MapDrive(DriveNumber:Byte; DirectoryPath:string; + Root, Permanent:boolean):boolean; +var rights : byte; + newHandle : byte; + HandlePth,pth,srvr,vol: string; + OldConnId,VolConnId:byte; + p:byte; + VolNbr:byte; + Dflag:byte; +begin +IF Permanent + then begin + MapDrive:=MapPermanentDrive(DriveNumber,DirectoryPath,Root); + exit; + end; +{ map temporary drive } +IF GetTrueEntryName(DirectoryPath,pth) + then begin + if pth[ord(pth[0])]<>'\' + then pth:=pth+'\'; + if pth[1]<>'\' + then result:=$104 { attempt to map network drive to local drive } + else begin + delete(pth,1,2); + p:=pos('\',pth); + if p=0 then result:=$106; + srvr:=copy(pth,1,p-1); + delete(pth,1,p); + p:=pos('\',pth); + if p=0 then result:=$105; { volume does not exist } + vol:=copy(pth,1,p-1); + delete(pth,1,p); + IF NOT GetConnectionId(srvr,VolConnId) + then result:=$106; { server does not exist } + end; + end + else result:=$101; { direcory not locatable } +if (result=0) + then begin + while pth[ord(pth[0])] IN ['\','.','*','?'] + do dec(pth[0]); + + { rebuild path: Alloc handle requires VOL:path format } + HandlePth:=vol+':\'+pth; + GetPreferredConnectionId(OldConnId); + SetPreferredConnectionId(VolConnId); + + { IF Permanent + then AllocPermanentDirHandle(DriveNumber,0,HandlePth, + newHandle,rights) + else} + AllocTemporaryDirHandle(DriveNumber,0,HandlePth, + newHandle,rights); + if (result=0) + then begin + GetDriveFlag(DriveNumber,Dflag); + {If Permanent + then SetDriveFlag(DriveNumber,(Dflag and $F0) or DRIVE_PERMANENT) + else} + SetDriveFlag(DriveNumber,(Dflag and $F0) or DRIVE_TEMPORARY); + SetDriveHandle(DriveNumber,newHandle); + SetDriveConnectionId(DriveNumber,VolConnId); + IF root + then MapFakeRootDirectory(DriveNumber,'\\'+srvr+'\'+vol+'\'+pth); + end; + SetPreferredConnectionId(OldConnId); + end; +MapDrive:=(result=0); +end; + + + +Function MapSearchDrive(DriveNumber:byte; DirPath:string; + PathPosition:byte; + Insert,Root,Permanent:Boolean):boolean; +Var pth:string; + p,scCount:byte; + ch:char; +begin +IF MapDrive(DriveNumber,DirPath,Root,Permanent) + then begin + GetEnvPath(pth); + if pth[ord(pth[0])]<>';' + then pth:=pth+';'; + scCount:=1;p:=1; + while (scCount=ord(pth[0])); + pth:=copy(pth,1,p-1)+chr(DriveNumber+ord('A')) + +':.;'+copy(pth,p,255); + end + else pth:=pth+chr(DriveNumber+ord('A'))+':.;'; + SetEnvPath(pth); + end; +MapSearchDrive:=(result=0); +end; + +{secondary} +Function DeleteConnectionsDriveMappings(ConnId:Byte):Boolean; +Var t,connId2,res:Byte; +begin +res:=$FF; +for t:=0 to 31 + do if GetDriveConnectionId(t,connId2) and (connId2=connId) + then begin + DeleteDriveMapping(t); + if result=0 + then res:=0; + end; +result:=res; +DeleteConnectionsDriveMappings:=(result=0); +{00 successful FF No mappings affected OR Invalid connectionId } +end; + + +{4409 / implemented as a secondary function } +Function IsNetworkDrive(driveNumber:Byte):boolean; +{ isNetworkDrive is set to TRUE if the drive is a) a network drive, and + b) a legal drive letter was used. } +Var regs:TTRegisters; +begin +With regs +do begin + AX:=$4409; + BL:=DriveNumber+1; + RealModeIntr($21,Regs); + IsNetworkDrive:=(DX and $1000)<>0 + end; +end; + + +{--======================-- Entries --===============================--} + + +{60.. (extended DOS call)} +Function GetTrueEntryName(DirPath:string; Var CanonicalPath:string):boolean; +{ SERVER/VOL:[\]Path -> \\SERVER\VOL\path + VOL:[\]Path -> \\effective_server_name\VOL\path + D:\ -> D:\. + +{ if a volumename is supplied without a servername, the name of the + effective server will be returned. } + +{ Format of returned string: + a) D:\path\file.ext or + b) \\servername\volumename\path\file.ext } + +LABEL skip; + +Var reply :array[1..128] of byte; + regs :TTregisters; + pcolon, + pslash :byte; + srvr, + volname:string[47]; + connId :Byte; +begin +{ ----- Pre processing } +if DirPath[0]>#2 + then begin + if ((DirPath[1]='\') and (DirPath[2]='\')) + then begin + CanonicalPath:=DirPath; + UpString(Canonicalpath); + goto skip + end; + pcolon:=pos(':',DirPath); + if (pcolon=2) and (DirPath[0]=#3) and (DirPath[3]='\') + then DirPath:=DirPath+'.'; + { fix known problem of netware: D:\. instead of D:\ } + if (pcolon=2) and (DirPath[0]=#2) + then DirPath:=DirPath+'.'; + { fix know problem of -among others- OS/2-dos: D:. instead of D: } + end; +pcolon:=pos(':',DirPath); +if pcolon>2 + then begin { format must be VOL:[\]path or SERVER/VOL:[\]Path } + pslash:=pos('/',DirPath); + if pslash=0 + then pslash:=$FF; + if (pslash#0) and (dirPath[1]='\') + then delete(DirPath,1,1); + DirPath:='\\'+srvr+'\'+volname+'\'+DirPath; + end; +if dirPath='' + then dirPath:='\'; +{ ----- actual call } +dirPath:=dirPath+#0; { zero terminate } +WITH regs + do begin + Move(dirPath[1],GlobalReqBuf^,ord(dirPath[0])); + GetGlobalBufferAddress(ds,si,es,di); + { DS:SI real mode pointer to GlobalRequestBuffer holding asciiz path ; + ES:DI real mode pointer to GlbalReplyBuffer } + ah:=$60; + RealModeIntr($21,regs); + Move(GlobalReplyBuf^,reply[1],128); + if (regs.flags and 1 {carry})>0 + then begin + result:=ax; + reply[1]:=0; + end + else result:=0; + end; +ZstrCopy(CanonicalPath,reply[1],128); +{ ----- post-processing -- strip \ and . } +skip: ; +While CanonicalPath[ord(CanonicalPath[0])] in ['\','.'] + do dec(CanonicalPath[0]); +GetTrueEntryName:=(result=0); +{ $00 successful + $02 Invalid component in directory path OR drive letter only + $03 Malformed path OR invalid drive letter } +end; + + + +{3B.. } +Function ChangeDirectory(DirPath:string):boolean; +{ does not change the default drive } +Var regs:TTregisters; + tmp1,tmp2:word; +begin +if DirPath[0]>#63 + then result:=$110 { length of path too long } + else begin + DirPath:=DirPath+#0; + with regs + do begin + ah:=$3b; + Move(DirPath[1],GlobalReqBuf^,ord(DirPath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real-mode pointer to GlobalRequestBuffer holding DirPath } + RealModeIntr($21,regs); + If (flags and 1 {carry})>0 + then result:=$111 { invalid pathname } + else result:=0; + end; + end; +ChangeDirectory:=(result=0); +end; + +{F216/0A [2.15+]} +Function CreateDirectory(DirHandle:Byte; DirPath:string; MaxRightsMask:byte):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + _MRM :byte; + _dirPath :string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ +do begin + subFunc:=$0A; + _dirHandle:=DirHandle; + _MRM:=MaxRightsMask; + _DirPath:=DirPath; + len:=4+ord(_dirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +CreateDirectory:=(result=0) +{ 00 successful 84 No create privileges 98 Volume doesn't exist + FF directory already exists } +end; + + +{F216/0B [2.15c+]} +Function DeleteDirectory(DirHandle:Byte; DirPath:string):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + unused :byte; + _DirPath :string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ +do begin + subFunc:=$0B; + _DirHandle:=DirHandle; + _DirPath:=DirPath; + unused:=0; + len:=4+ord(_DirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +DeleteDirectory:=(result=0) +{ 00 successful 8A No delete privileges + 98 Volume doesn't exist 9B Bad directory handle + 9C Invalid path 9F Directory in use + A0 Directory not empty } +end; + + +{F217/F4 [3.0+]} +Function ConvertPathToDirEntryId(dirHandle:Byte; dirPath:string; + Var VolNbr :byte; + Var dirEntryID:LongInt):boolean; +{ aka ConvertPathToDirEntry } +Type Treq=record + len :word; + subFunc :byte; + _dirHandle:byte; + _DirPath :string[255]; + end; + Trep=record + _volNbr:Byte; + _EntryId:Longint; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + subFunc:=$F4; + _dirHandle:=DirHandle; + _dirPath:=DirPath; + UpString(_DirPath); + If DirHandle=0 + then ConvertPathToVolFormat(_DirPath); + len:=3+ord(_DirPath[0]); + F2SystemCall($17,len+2,SizeOf(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ +do begin + VolNbr :=_volNbr; + dirEntryId:=_EntryId; + end; +ConvertPathToDirEntryId:=(result=0) +{ 00 Successful 9B Bad directory Handle + 9C Invalid Path C6 No console rights } +end; + +{F217/F3 [3.0+]} +Function MapDirEntryIdToPath(VolNbr:byte;DirEntryId:Longint; NStype:byte; + Var ExtPath:string):boolean; +{aka MapDirectoryNumberToPath } +{ Returns full path/ with nameSpace information; + Doesn't return server or volumename. } +Type Treq=record + len :word; + subFunc :byte; + _VolNbr :byte; + _EntryId:longint; {hi-lo} + _NameSp :byte; + end; + Trep=record + _path:array[1..255] of byte; {!! maximum: 512 bytes in path ! } + end; + TPreq=^Treq; + TPrep=^Trep; +Var TempPath:string; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$F3; + _VolNbr:=VolNbr; + _EntryId:=DirEntryId; + _NameSp:=NStype; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +if result=0 + then begin + With TPrep(GlobalReplyBuf)^ + do ZstrCopy(TempPath,_path,255); + { TempPath according to the 'new' Novell format; + translate into a 'DOS' style path } + NovPath2DOSPath(TempPath,ExtPath); { dir\subdir (no server or volume name) } + end; +MapDirentryIdtoPath:=(result=0) +{ 00 Successful C6 No console rights FF ? } +end; + + +{F216/02} +Function ScanDirectoryInformation(dirHandle:byte; searchDirPath:string; + {i/o} Var sequenceNumber:word; + {out:} Var dirInfo:Tentry ):boolean; +{ set sequenceNumber to 0 before the first call. + + If wildcards (* or ?) are included in the searchDirPath: + Iterate until a $9C error is returned. + + If you don't include a wildcard in the searchDirPath, only use + this call once. Do not iterate, the same entry will be returned + eternaly. + + } +Type Treq=record + len :word; + subFunc :byte; + _dirHandle :byte; + _subDirNumber:word; {hi-lo} + _dirPath :string[255] + end; + Trep=record + _subDirName :array[1..16] of byte; + _creationDate :word; + _creationTime :word; + _ownerObjId :LongInt; {hi-lo} + _maxRightsMask:word; + _SubDirNbr :word; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$02; + _dirHandle:=dirHandle; + _subDirNumber:=swap(sequenceNumber); { force hi-lo} + _dirPath:=searchDirPath; + UpString(_dirPath); + len:=5+ord(searchDirPath[0]); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + FillChar(dirInfo,SizeOf(Tentry),0); + ZstrCopy(dirInfo.EntryName,_SubDirName,16); + + DosTime2NovTime(MakeLong(swap(_CreationDate),swap(_CreationTime)), + dirInfo.creationTime); + dirInfo.ownerId:=Lswap(_ownerObjId); + dirInfo.RightsMask:=_maxRightsMask; + sequenceNumber:=swap(_SubDirNbr)+1; + end; +ScanDirectoryInformation:=(result=0) +{resultcodes: $00 success; $98 Volume does not exist; + $9B Bad directory Handle $9C Invalid Path } +end; + + +{F216/0F [2.0/2.1/3.x]} +Function RenameDirectory( dirHandle:Byte; dirPath, newDirName :String):Boolean; +{ The new directory name must be a regular (legal) directory name, + max 14 chars long. + The user must have Parental and Modify rights in the parent directory of + the directory to be renamed. } +Type Treq=record + len :word; + subFunc :byte; + _dirHandle :Byte; + _dirNames :Array[0..255+1+14] of byte; { _dirpath[0] is allowed to be 0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$0F; + _dirHandle:=dirHandle; + Upstring(dirPath); + UpString(newDirName); + Move(DirPath[0],_DirNames[0],ord(DirPath[0])+1); + Move(newDirName[0],_DirNames[1+_DirNames[0]],ord(newDirName[0])+1); + len:=4+ord(dirPath[0])+ord(newDirName[0]); + F2SystemCall($16,len+2,0,result); + end; +RenameDirectory:=(result=0) +{ Possible ResultCodes: + 8B No Rename Privileges; 9B Bad Directory Handle; + 9C Invalid Path; 9E Invalid (new) Dir Name. } +end; + + +{F216/1F [2.15c+]} +Function GetDirectoryEntry(DirHandle:byte; + Var dirEntry:Tentry):boolean; +Type Treq=record + len:word; + subFunc:byte; + _dirHandle:byte; + end; + Trep=record + _Entry :TintEntry; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$1F; + _dirHandle:=dirHandle; + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + Convert2ExtEntry(_entry,dirEntry); + end; +GetDirectoryEntry:=(result=0) +{ 00 successful 98 Volume doesn't exist + 9B Bad directory handle 9C Invalid path } +end; + + +{B601 [2.0+] } +function SetExtendedFileAttributes(FilePath:String; Attr:Byte) : Boolean; +{ See GetExtFAttr for meaning of Attr the Attribute + Function result code: + 00h Success; + FFh File not found; + FEh Access denied } +Var Novregs:TTRegisters; + tmp1,tmp2:word; +begin +with NovRegs +do begin + AX := $B601; + if FilePath[0]=#255 + then FilePath[255]:=#0 + else FilePath:=FilePath+#0; + Move(FilePath[1],GlobalReqBuf^,ord(FilePath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real mode pointer to GlobalRequestBuffer holding FilePath } + CL := Attr; + RealModeIntr($21,NovRegs); + IF (Flags AND 1 {carry})>0 + then Result:=AL + else Result:=$00; + Result := AL + end; +SetExtendedFileAttributes:=(Result=0); +end; + + + +{B600 [2.0+]} +function GetExtendedFileAttributes(FilePath:String; var Attributes:Byte) : Boolean; +{ Meaning of Attributes: + 7 6 5 4 3 2 1 0 + | | | | | | | + | | | | +---+---+------Search mode + | | | +----------------------transactional bit A_TRANSACTIONAL + | | +--------------------------Indexing bit A_INDEXED + | +------------------------------Read Audit bit A_READ_AUDIT + +----------------------------------Write Audit bit A_WRITE_AUDIT + } +Var NovRegs:TTRegisters; + tmp1,tmp2:word; +begin +with NovRegs +do begin + AX := $B600; + if FilePath[0]=#255 + then FilePath[255]:=#0 + else FilePath:=FilePath+#0; { null terminate string } + Move(FilePath[1],GlobalReqBuf^,ord(FilePath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real mode pointer to GlobalRequestBuffer hloding FilePath } + RealModeIntr($21,NovRegs); + IF (Flags and 1 {carry})>0 + then Result := AL + else Result:=$00; + Attributes := CL; + end; +GetExtendedFileAttributes:=(Result=0); +{ $8C caller lacks privileges + FEh not permitted to search directory + FFh file not found } +end; + + + + +{F3.. [2.x/3.x]} +Function FileServerFileCopy( sourceFileHandle, destFileHandle:word; + sourceFileOffset, destFileOffset:Longint; + numberOfBytesToCopy :Longint; + VAR numberOfBytesCopied :Longint ):boolean; +{Note: both source and destination must be on the same file server +SeeAlso: 3C..,3F..} +Type Treq=record + _sFH,_dFH :word; {lo-hi} {as returned by GetFileHandle.} + _sFoffs,_dfOffs:Longint; {lo-hi} + _NbrOfBytes :Longint; {lo-hi} + end; + TPreq=^Treq; +Var regs:TTRegisters; + tmp1,tmp2:word; +begin +with TPreq(GlobalReqBuf)^ + do begin + _sFH:=sourceFileHandle; + _dFH:=destFileHandle; + _sFoffs:=sourceFileOffset; + _dFoffs:=destFileOffset; + _NbrOfBytes:=numberOfBytesToCopy; + end; +with regs + do begin + AH:=$F3; + GetGlobalBufferAddress(es,di,tmp1,tmp2); + { ES:DI real mode pointer to GlobalRequestBuffer } + RealModeIntr($21,regs); + result:=AL; + end; +numberOfBytesCopied:=MakeLong(regs.cx,regs.dx); { ? swap those regs for correct byte order ? } +FileServerFileCopy:=(Result=0); +end; + +{level-0 function. See GetFileAttributes and SetFileAttributes } +Function DoFileAttributes(subf:byte;FilePath:string;VAR attr:byte):boolean; +Var regs:TTregisters; + tmp1,tmp2:word; +begin +with regs +do begin + AH:=$43; + AL:=subf; + if subf=$01 then CX:=attr; + if filePath[0]=#255 + then filePath[255]:=#0 + else filePath:=filePath+#0; + Move(FilePath[1],GlobalReqBuf^,ord(FilePath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real mode pointer to GlobalRequestBuffer holding FilePath } + RealModeIntr($21,regs); + IF ((Flags and 1 {Fcarry})<>0) + then result:=AL + else begin + result:=$00; + if subf=$00 then attr:=CX + end; + end; +DoFileAttributes:=(result=$00); +{ resultcodes: 00 success; 01 invalid function; + 03 path not found; 05 access denied. } +end; + +{4300 [1.x/2.x/3.x]} +Function GetFileAttributes(FilePath:string; Var attr:byte):boolean; +{ A_READ_ONLY,A_HIDDEN,A_SYSTEM and A_SHAREABLE only. } +begin +GetFileAttributes:=DoFileAttributes($00,FilePath,attr); +end; + +{4301 [1.x/2.x/3.x]} +Function SetFileAttributes(FilePath:string; attr:byte):boolean; +{ A_READ_ONLY,A_HIDDEN,A_SYSTEM and A_SHAREABLE only. } +Var _attr:byte; +begin +_attr:=attr; +SetFileAttributes:=DoFileAttributes($01,FilePath,_attr); +end; + + + +{F217/0F [2.15c+]} +Function ScanFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + {i/o} VAR SequenceNbr:Integer; + {out} VAR fileInfo:Tentry):Boolean; +{ To be called Iteratatively; initial value for seqNbr=-1 } +{ wildcards in filename allowed. + Iterate util an error $FF occurs } +Type Treq=record + len :word; + subFunc :byte; + _seqNbr :word; {hi-lo} + _dirHandle :byte; + _searchAttrib:Byte; + _filePath :string; + end; + Trep=record + _seqNbr :word; {hi-lo} + _fileName :array[1..14] of byte; + _Fattr, + _ExtFattr :Byte; + _Fsize :LongInt; {hi-lo} + _Crdate :word; {hi-lo} + _LastAccDate :word; {hi-lo} + _LastUpdDate, + _LastUpdTime :Word; + _ownerObjId :Longint; {hi-lo} + _LastArchDate, + _lastArchTime:Word; + _reserved :array[1..56] of byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + subFunc:=$0F; + _seqNbr:=swap(word(SequenceNbr)); { force hi-lo } + _dirHandle:=dirHandle; + _searchAttrib:=searchAttrib; + _filePath:=FilePath; + len:=6+ord(_filePath[0]); + F2SystemCall($17,len+2,SizeOf(Trep),result); + end; +with TPrep(GlobalReplyBuf)^ +do begin + FillChar(fileInfo,sizeOf(fileInfo),#0); + SequenceNbr:=Integer(swap(_seqNbr)); { force lo-hi } + ZstrCopy(fileInfo.EntryName,_filename,15); + fileInfo.Attributes:=(_ExtFattr SHL 8)+_Fattr; + fileInfo.filesize:=Lswap(_Fsize); { force lo-hi} + fileinfo.OwnerID:=Lswap(_ownerObjID); { force lo-hi} + DosTime2NovTime(MakeLong(swap(_CrDate),0),fileinfo.creationTime); + DosTime2NovTime(MakeLong(swap(_LastAccDate),0),fileinfo.lastAccessTime); + DosTime2NovTime(MakeLong(swap(_LastUpdDate),swap(_LastUpdTime)) + ,fileinfo.ModifyTime); + DosTime2NovTime(MakeLong(swap(_LastArchDate),swap(_lastArchTime)) + ,fileinfo.ArchiveTime); + end; +ScanFileInformation:=(result=0) +{ 89 No search privileges FF No more matching files } +end; + + +{F217/10 [2.15c+]} +Function SetFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + fileInfo:TEntry):boolean; +Type Treq=record + len :word; + subFunc :byte; + _Fattr, + _ExtFattr :Byte; + reserved1 :LongInt; {hi-lo} + _crDate :word; {hi-lo} + _lastAccDate :word; {hi-lo} + _lastUpdTime :Longint; + _ownerObjId :Longint; {hi-lo} + _lastArchTime:Longint; + reserved2 :array[1..56] of byte; + _dirHandle :Byte; + _searchAttr :byte; + _filePath :string; + end; + TPreq=^Treq; +Var DummyDate:Longint; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + subFunc:=$10; + _Fattr:=Lo(LowLong(fileInfo.Attributes)); + _ExtFattr:=Hi(LowLong(fileinfo.Attributes)); + _ownerObjId:=Lswap(fileinfo.OwnerId); {force hi-lo} + _dirHandle:=DirHandle; + _searchAttr:=SearchAttrib; + _filePath:=FilePath; + If Dirhandle=0 + then ConvertPathToVolFormat(_FilePath); + UpString(_filePath); + NovTime2DosTime(fileinfo.CreationTime,dummyDate); + _crDate:=HiLong(dummyDate); + NovTime2DosTime(fileinfo.LastAccessTime,dummyDate); + _lastAccDate:=HiLong(dummyDate); + NovTime2DosTime(fileinfo.ModifyTime,_lastUpdTime); + NovTime2DosTime(fileinfo.ArchiveTime,_lastArchTime); + len:=82+ord(_filepath[0]); + F2SystemCall($17,len+2,0,result); + end; +SetFileInformation:=(result=0); +{ result codes: 00 Success } +end; + + +{F244 [2.1x/3.x]} +Function EraseFiles(dirHandle, searchAttrib:Byte; filePath:string ):boolean; +{ marks files for deletion / in DOS parlance: delete file, file remains purgable } +Type Treq=record + _dirHandle:Byte; + _Sattr:Byte; + _filePath:string; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + _dirHandle:=dirHandle; + _Sattr:=searchAttrib; + _filePath:=filePath; + F2SystemCall($44,3+ord(_filepath[0]),0,result); + end; +EraseFiles:=(result=0); +{ resultcodes: 00 Success; 98h Volume doesn't exist; 9Bh bad directory handle; + 9Ch invalid path; FFh no files found error. } +end; + +{F216/1B [3.0+]} +Function ScanSalvagableFiles(DirHandle:Byte; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; +{ Iterate (with entryId set to -1 at first) until an error $FF occurs } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:Byte; + _EntryId :Longint; {low_word-hi_word & each word lo-hi } + end; + Trep=record + _EntryId :Longint; + _Entry :TintEntry; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$1B; + _DirHandle:=DirHandle; + _EntryId:=EntryId; + end; +F2SystemCall($16,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + EntryId:=_EntryId; {return next EntryId for iteration} + {low_word-hi_word & each word lo-hi } + Convert2ExtEntry(_Entry,Entry); + end; +ScanSalvagableFiles:=(result=0) +{ 98 Volume does not exist FF No more erased files } +end; + +{F216/1D [3.0+]} +Function PurgeSalvagableFile(DirHandle:Byte; + EntryId:Longint; FileName:string):boolean; +{ either supply an entryId and an empty filename, + or supply an entryId of -1 and a filename. Note that the filename + may not be unique: there may be more than one old deleted versions + of a filename. } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:Byte; + _EntryId :Longint; {low_word-hi_word & each word lo-hi } + _Name :string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$1D; + _DirHandle:=DirHandle; + _EntryId:=EntryId; + _Name:=FileName; + UpString(_name); + len:=7+ord(_Name[0]); + F2SystemCall($16,len+2,0,result); + end; +PurgeSalvagableFile:=(result=0) +end; + +{F216/1C [3.0+] } +Function RecoverSalvagableFile(dirHandle:Byte; EntryId:Longint; + OldName,NewName:string):boolean; +{ entryId may be set to -1 + OldName is the name of the file before it was deleted. + NewName is the name to be assigned to the recovered file } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle :Byte; + _EntryId :Longint; {low_word-hi_word & each word lo-hi } + _OldAndNewName:string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$1C; + _DirHandle:=DirHandle; + _EntryId:=EntryId; + UpString(OldName); + UpString(NewName); + _OldAndNewName:=OldName; + move(NewName[0],_OldAndNewName[ord(oldname[0])+1],ord(NewName[0])+1); + len:=8+ord(oldName[0])+ord(NewName[0]); + F2SystemCall($16,len+2,0,result); + end; +RecoverSalvagableFile:=(result=0) +{ 98 Volume does not exist FF No more erased files } +end; + + +{F216/24 [3.0+]} +Function SetDirRestriction(DirHandle:Byte; DiskSpaceLimit:Longint):boolean; +{ limit expressed in Blocks. set limit to 0 to lift limit. + use a negative number if limit should be equal to 0 } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:Byte; + _Limit :Longint; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$24; + _DirHandle:=DirHandle; + _Limit:=DiskSpaceLimit; + end; +F2SystemCall($16,SizeOf(Treq),0,result); +SetDirRestriction:=(result=0) +end; + + +{F216/23 [3.0+]} +Function ScanDirRestrictions(DirHandle:Byte; + Var NumberOfEntries:Byte; + Var RestrInfo:TdirRestrList):boolean; +Type Treq=record + len:word; + subFunc:byte; + _DirHandle:Byte; + end; + Trep=record + _Entries:Byte; + _Info:TdirRestrList; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$23; + _DirHandle:=DirHandle; + end; +F2SystemCall($16,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + NumberOfEntries:=_Entries; + RestrInfo:=_Info; + end; +ScanDirRestrictions:=(result=0) +end; + + +Procedure FixEntryNameFormat(Var s:string); +Var res:string; + p:byte; +begin +res:=''; +for p:=1 to ord(s[0]) + do begin + if s[p]='?' + then res:=res+#$FF+#$BF + else if s[p]='*' + then res:=res+#$FF+'*' + else res:=res+s[p] + end; +s:=res; +end; + + +{F216/1E [2.15c+]} +Function ScanDirectoryEntry(DirHandle:Byte; EntryName:string; SearchFlags:Longint; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle :Byte; + _SearchFlags:Byte; { standard: $16 for dirs / $06 for files } + _SeqNbr :Longint; { lo-hi , set to -1 initially } + _EntryName :string; + end; + + Trep=record { len = 84h = 132 dec. } + _EntryID :Longint; { lo-hi } + _Entry :TintEntry; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$1E; + _DirHandle:=DirHandle; + _SearchFlags:=SearchFlags; + _SeqNbr:=EntryId; + _EntryName:=EntryName;UpString(_EntryName); + FixEntryNameFormat(_EntryName); + len:=8+ord(_EntryName[0]); + F2SystemCall($16,len+2,Sizeof(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + EntryId:=_EntryId; {return next EntryId for iteration} + Convert2ExtEntry(_Entry,entry); + end; +ScanDirectoryEntry:=(result=0) +end; + +{F216/25 [2.15c+] } +Function SetEntry(DirHandle:Byte;EntryId:Longint;SearchFlags:Byte; + ModFlags:Longint; Entry:Tentry ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _dirHandle:Byte; + _SFlags :Byte; + _EntryId :Longint; {lo-hi} + _ModFlags :Longint; {lo-hi} + _Entry :TintEntry; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$25; + _dirHandle:=DirHandle; + _EntryId:=EntryId; + _ModFlags:=ModFlags; + Convert2IntEntry(Entry,_Entry); + end; +F2SystemCall($16,SizeOf(Treq),0,result); +SetEntry:=(result=0) +end; + +{------------------ Secondary Functions ----------------------------} + +Function IsFileShareable(Path : String):boolean; + +var F: File; + FAttr : Word; + +begin + { Assign(F, Path); + GetFAttr(F, FAttr); + result:=DOSerror; } + IsFileShareable:=(result=0) and ((FAttr and $80)>0) +end; + +function FlagFileShareable(Path : String) : Boolean; +{ when the file could NOT be made shareable, false is returned as the + function result, a doserror# is returned as the result code. } +var F : File; + Attr : Word; + ErrCode : word; + Share : Boolean; +begin +if NOT IsFileShareable(Path) { Share: is it sharable? } + then begin + Assign(F,Path); + {SetFAttr(F,Attr or A_SHAREABLE); OR existing atrib. with SHARE bit } + {Result := DOSError;} + end; +FlagFileShareable := (Result=0); +end; + + +Function GetFileHandle(Var f):word; +begin +{GetFileHandle:=filerec(f).handle;} +end; + +{------===================-- Trustee/Max. Rights masks --=================--} + + +{F216/27 [3.0+]} +Function SetTrustee(DirHandle:Byte;DirPath:string; + TrusteeObjectID:Longint; + RightsMask:Word ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + _ObjId :Longint; { hi-lo } + _Rights :Word; { lo-hi } + _DirPath :string; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$27; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _DirPath:=DirPath;UpString(_DirPath); + _ObjId:=Lswap(TrusteeObjectId); + _Rights:=RightsMask; + len:=9+ord(_DirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +SetTrustee:=(result=0) +{ Possible resultcodes: 8C No modify privileges; + 98 Volume doesn't exist; 9B Bad directory handle + 9C Invalid path; FC No such bindery object } +end; + + +{F216/2B [3.0+]} +Function DeleteTrustee(DirHandle:Byte;DirPath:String; + TrusteeObjectId:Longint):boolean; +{ If DirHandle equals 0, DirPath should be according to the + VOL:\path format. All other path formats will result in + an resultcode of 98h (No such volume) } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + _ObjId :Longint; { hi-lo } + _Unused :Byte; + _DirPath :string; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$2B; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _DirPath:=DirPath;UpString(_DirPath); + _ObjId:=Lswap(TrusteeObjectId); + _Unused:=0; + len:=8+ord(_DirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +DeleteTrustee:=(result=0); +{ Possible resultcodes: 98 Volume doesn't exist + 9B Bad directory handle; 9C Invalid path + FE no such trustee } +end; + + +{F216/2A [3.0+]} +function GetEffectiveRights(DirHandle:Byte;DirPath:String; + var Rights:Word) : Boolean; +{ returns the requesting workstation's effective directory rights } +Type Treq=record + Len : word; + SubF : Byte; + _DirHandle : Byte; + _DirName : String; + end; + TRep=record + _RightsMask : Word; + end; + TPreq=^Treq; + TPrep=^Trep; +begin +with TPreq(GlobalReqBuf)^ + do begin + SubF := $2A; + _DirHandle := DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _DirName := DirPath;UpString(_DirName); + Len := 3+ord(DirPath[0]); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +with TPrep(GlobalReplyBuf)^ + do Rights:=_RightsMask; +GetEffectiveRights:=(Result=0); +{ return byte + 00h - Success + 98h - Volume Does Not Exist + 9Bh - Bad Directory Handle } +end; + + +{F216/04 [2.15c+]} +Function ModifyMaximumRightsMask(DirHandle:Byte;DirPath:string; + RevokeRightsMask,GrantRightsMask:Word):boolean; +Type Treq=record + len:word; + subFunc:byte; + _DirHandle:Byte; + _GrantRM, + _RevokeRM:Byte; + _DirPath:String; + end; + Trep=record + _EffectiveRightsMask:Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=5+ord(DirPath[0]); + subFunc:=$04; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _GrantRM:=MapV3RightsToV2(GrantRightsMask); + _RevokeRM:=MapV3RightsToV2(RevokeRightsMask); + _DirPath:=DirPath; + F2SystemCall($16,len+2,Sizeof(Trep),result); + end; +{With TPrep(GlobalReplyBuf)^ + do begin + --- nothing is done with the returned value--- + end;} +ModifyMaximumRightsMask:=(result=0) +{ result codes: 8C No modify privileges; 98 Volume dosn't exist; + 9C Invalid path } +end; + + + +{F217/47 [2.15c+]} +Function ScanBinderyObjectTrusteePaths(TrusteeObjectId:Longint; + VolumeNumber:Byte; + {i/o} Var SequenceNumber:word; + {out} Var AccessMask:Word; + Var Path:string ):boolean; +{ You must be supervisor (-equivalent) or the TrusteeObject itself + to use this function. + Initially, sequencenumber should be set to 0. } +Type Treq=record + len :word; + subFunc:byte; + _VolNbr:Byte; + _SeqNbr:word; {hi-lo} + _ObjId :Longint; {hi-lo} + end; + Trep=record + _NextSeqNbr:Word; {hi-lo} + _ObjId :Longint; {hi-lo} + _AccMask :byte; + _Path :string; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$47; + _VolNbr:=VolumeNumber; + _SeqNbr:=swap(SequenceNumber); + _ObjId:=Lswap(TrusteeObjectId); + end; +F2SystemCall($17,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + SequenceNumber:=Lswap(_NextSeqNbr); + Accessmask:=_AccMask; {MapV2RightsToV3(_accMask);} + Path:=_Path; + end; +ScanBinderyObjectTrusteePaths:=(result=0) +{ resultcodes: + $96 Server out of memory; $F0 Wildcard not allowed; + $F1 Invalid bindery security; $FC No such object; + $FE Server bindery locked; $FF Bindery failure } +end; + +{F216/26 [3.0+]} +Function ScanEntryForTrustees(DirHandle:Byte;DirPath:String; + {i/o} Var SequenceNumber:Byte; + {out} Var TrusteeInfo: TtrusteeInformation):boolean; +{ Set SequenceNumber to 0 initially, + iterate until error $9C (no more trustees) is returned } +{ see GETTR in the XFILE archive for an example } +Type Treq=record + len:word; + subFunc:byte; + _DirHandle:Byte; + _SeqNbr:Byte; + _DirPath:String; + end; + Trep=record + _Info:TtrusteeInformation; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=4+ord(DirPath[0]); + subFunc:=$26; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _SeqNbr:=SequenceNumber; + _DirPath:=DirPath;UpString(_DirPath); + F2SystemCall($16,len+2,Sizeof(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + inc(SequenceNumber); + TrusteeInfo.NumberOfTrustees:=_Info.NumberOfTrustees; + for t:=1 to 20 + do begin + TrusteeInfo.TrusteeId[t]:=Lswap(_Info.TrusteeId[t]); + TrusteeInfo.TrusteeRights[t]:=_Info.TrusteeRights[t]; + end; + end; +ScanEntryForTrustees:=(result=0) +{ resultcodes: + $9C No more trustees } +end; + + + + +{F2 [2.15c+] +Function ( ):boolean; +Type Treq=record + len:word; + subFunc:byte; + + end; + Trep=record + + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$ + + end; +F2SystemCall($ ,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + + end; + :=(result=0) +end; } + +end. \ No newline at end of file diff --git a/NWTP/NWINTR.PAS b/NWTP/NWINTR.PAS new file mode 100644 index 0000000..8a5b037 --- /dev/null +++ b/NWTP/NWINTR.PAS @@ -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$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. + + diff --git a/NWTP/NWIPX.PAS b/NWTP/NWIPX.PAS new file mode 100644 index 0000000..8482ee5 --- /dev/null +++ b/NWTP/NWIPX.PAS @@ -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. diff --git a/NWTP/NWLOCK.PAS b/NWTP/NWLOCK.PAS new file mode 100644 index 0000000..33b6f98 --- /dev/null +++ b/NWTP/NWLOCK.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/NWMESS.PAS b/NWTP/NWMESS.PAS new file mode 100644 index 0000000..c2f50cb --- /dev/null +++ b/NWTP/NWMESS.PAS @@ -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} diff --git a/NWTP/NWMISC.PAS b/NWTP/NWMISC.PAS new file mode 100644 index 0000000..e98715a --- /dev/null +++ b/NWTP/NWMISC.PAS @@ -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:=' ' + 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. diff --git a/NWTP/NWQMS.PAS b/NWTP/NWQMS.PAS new file mode 100644 index 0000000..c2a2d25 --- /dev/null +++ b/NWTP/NWQMS.PAS @@ -0,0 +1,1149 @@ +{$X+,B-,V-} {essential compiler directives} + +UNIT nwQMS; + +{ nwQMS unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk } +{ Based in part on a unit containing queue services routines, written by + Erik van Heyningen in April 1994. } + +INTERFACE + +Uses nwMisc; + +{ Function: Interrupt: Comments: + + Queue Server Functions: + +. AbortServicingQueueJob (F217/73) (S) +. AttachQueueServerToQueue (F217/6F) (S) +. ChangeToClientRights (F217/74) (S) +. DetachQueueServerFromQueue (F217/70) (S) +. FinishServicingQueueJob (F217/72) (S) +. RestoreQueueServerRights (F217/75) (S) +. ServiceQueueJob (F217/71) (S) +. SetQueueServerStatus (F217/77) (S) + + Queue Operator Functions: + +. ChangeQueueJobPosition (F217/6E) (O) +* CreateQueue (F217/64) (SUP) +* DestroyQueue (F217/65) (SUP) +. SetQueueStatus (F217/67) (O) + + Queue User Functions: + +. CreateQueueJob (F217/68) (C) +. StartQueueJob (F217/69) (C) (1) + + Miscellaneous Queue Functions: + +. ChangeQueueJobEntry (F217/6D) (C-O) +* GetQueueJobList (F217/6B) (C-O) +* GetQueueJobsFileSize (F217/78) (C-O-S) +* ReadQueueStatus (F217/66) (C-O) +* ReadQueueJobEntry (F217/6C) (C-O-S) +. ReadQueueServerStatus (F217/76) (C-O) +* RemoveJobFromQueue (F217/6A) (C-O) + + +Notes: C : Function available to Clients (Queue Users); + S : Function available to Servers (Queue Servers); + O : Functions availaible to Operators (Queue Operators); + SUP: Functions available to Supervisors/Workgroup managers. + + (1): StartQueueJob is a.k.a. CloseFileAndStartQueueJob +} + +CONST { Queue status flag } + QS_ALL_OK = $00; + QS_CANT_ADD_JOBS = $01; { possibility to add jobs disabled by operator } + QS_SERVERS_CANT_ATTACH = $02; { attachment of servers to queue disabled by operator } + QS_CANT_SERVICE_JOBS = $04; { queue halted by operator } + { QS_XXXX constants can be ORed to form a QstatusFlag } + + QF_NONE = $00; + QF_AUTO_START = $08; + QF_SERVICE_RESTART = $10; + QF_ENTRY_OPEN = $20; + QF_USER_HOLD = $40; + QF_OPERATOR_HOLD = $80; + +CONST MaxQueueJobs = 250; + +Type TQueueStatus= RECORD + ObjectId : Longint; { Object id of queue } + Status : Byte; { status of queue QS_XXX } + NbrOfJobs : Byte; { Number of jobs in queue } + NbrOfServers : Byte; { Number of servers attached to queue } + ServerObjectIds : array[1..25] of Longint; + { List of Objects-ids of attached servers } + ServerConnNbrs : array[1..25] of Byte; + { List of attached server stations } + MaxNbrOfServers : Byte; { ??? } + end; + + TQueueServerStatus= Array[1..64] of Byte; + { undefined structure -as far as QMS is concerned-} + +Type TJobNumberList = Array[1..MaxQueueJobs] OF Word; + TQueueJobList = record + JobCount : Word; + JobNbrs : TJobNumberList; { List of jobs numbers by position in queue } + MaxJobs : Word; {????} { Maximum job numbers } + end; + + TJobFileHandle=Array[1..6] of Byte; + TQueueJobEntry =Record { Unit external Type } + ClientConnNbr : Byte; + ClientTaskNbr : Byte; + ClientObjectID : Longint; + JobEntryTime : TnovTime; + JobNumber : Word; + JobFileName : String[14]; + JobFileHandle : TjobFileHandle; + + TargetServerIDnumber : Longint; {2} + TargetExecutionTime : TnovTime; {2} + JobType : Word; {2} + JobControlFlags : Byte; {2} + JobDescription : String[50]; {2} + ClientRecordArea : Array[1..152] OF Byte; {2} + + JobPosition : Byte; {2/operators only} + + ServerConnNbr, {1} + ServerTaskNbr : Byte; {1} + ServerObjectID : Longint; {1} + End; + { 1: Filled by Queue server. As long as ServerTaskNbr=0, + queue entry is not being serviced. + 2: Can be changed by queue operators and/or the 'owner' of + the job after job has been placed in queue + } + +Var result:Word; + +{F217/64 {2.1x+} +Function CreateQueue(Qname :string; QobjectType:Word; + dirHandle :Byte; pathName :string; + VAR QobjID:Longint ):Boolean; +{ Creates an object of an object_queue_type in the bindery, checks that + all settings are valid before creating. Returns the object_id of the + created queue if creation was successfull. } + +{F217/65 [2.1x+]} +Function DestroyQueue(QobjID:Longint):Boolean; +{ Destroys the specified Queue; aborts all jobs in the queue; + associated files/directories are deleted; + queue object is removed from the bindery. } + + +{F217/76 [2.1x/3.x]} +Function ReadQueueStatus(QobjID:Longint; + Var Qstatus:TQueueStatus):Boolean; +{ Read the status of a queue. This information is changed by queueservers.} + +{F217/67 [2.1x+]} +Function SetQueueStatus(QobjId:Longint; NewQstatusFlag:Byte):Boolean; +{ Change the queue status flag. Use the QS_XXXX constants } + +{F217/6B} +FUNCTION GetQueueJobList( QueueObjId: Longint; + Var QJobList:TQueueJobList): Boolean; +{ You need to be either a Q_USER or a Q_OPERATOR } + +{F217/6C} +FUNCTION ReadQueueJobEntry( QObjId: Longint;JobNbr: Word; + VAR QJob: TQueueJobEntry): Boolean; +{ You need to be either a Q_USER, Q_OPERATOR or a Q_SERVER } + +{F217/6A} +FUNCTION RemoveJobFromQueue( QObjId: Longint; JobNbr: Word): Boolean; +{ You need to be Q_OPERATOR or the Q_USER who queued the job } + +{F217/69 [2.1x+]} +Function StartQueueJob(QobjId:Longint;JobNbr:Word):Boolean; + + +{F217/6E [2.1x+]} +Function ChangeQueueJobPosition(QobjId:Longint; JobNbr:Word; + NewJobPos:Byte ):Boolean; +{ Q_OPERATOR only } + + +{F217/6F [2.1x+]} +Function AttachQueueServerToQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } + + +{F217/70 [2.1x+]} +Function DetachQueueServerFromQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } + + +{F217/71 [2.1x+]} +Function ServiceQueueJob(QobjID:Longint; JobType:Word; + Var QjobEntry:TQueueJobEntry):Boolean; +{ Q_SERVERs only } + +{F217/72 [2.1x+]} +Function FinishServicingQueueJob(QobjId:Longint;JobNbr:Word; + Charge:Longint ):Boolean; +{ Q_SERVERs only } + +{F217/73 [2.1x+]} +Function AbortServicingQueueJob(QobjId:Longint; JobNbr:Word):Boolean; + +{F217/74 [2.1x+]} +Function ChangeToClientRights(QobjId:Longint;JobNbr:Word):Boolean; +{ Q_SERVERs servicing job only } + +{F217/75 [2.1x+]} +Function RestoreQueueServerRights:Boolean; +{ Q_SERVERs, servicing job and having previously called + ChangeToClientRights only } + +{F217/76 [2.1x+]} +Function ReadQueueServerStatus(QobjId :Longint; + QserverObjId :Longint; + QserverConnNbr:Byte; + Var Qstatus:TQueueServerStatus):Boolean; + + +{F217/77 [2.1x+]} +Function SetQueueServerStatus(QobjId:Longint; Qstatus:TqueueServerStatus):Boolean; + +{F217/78 [2.1x+]} +Function GetQueueJobsFileSize(QobjId:Longint; JobNbr:Word; + Var JobSize:Longint ):Boolean; + +{F217/68 [2.1x+]} +Function CreateQueueJob(QobjId:Longint; + {i/o} Var Qjob:TqueueJobEntry):Boolean; + +{F217/6D [2.1x+]} +Function ChangeQueueJobEntry(QobjId:Longint;Qjob:TQueueJobEntry):Boolean; + +IMPLEMENTATION {============================================================} + +Uses nwIntr; + +Type TIntJobStruct =Record { Unit internal Type } + _ClientConnNbr, + _ClientTaskNbr : Byte; + _ClientObjectID, {hi-lo} + _TargetServerIDnumber : Longint; {hi-lo} + _TargetExecutionTime, + _JobEntryTime : Array[1..6] OF Byte; { YMDHMS } + _JobNumber, {hi-lo} + _JobType : Word; {hi-lo} + _JobPosition, + _JobControlFlags : Byte; + _JobFileName : Array[1..14] OF CHAR; { ASCIIZ } + _JobFileHandle : TJobFileHandle; + _ServerConnNbr, + _ServerTaskNbr : Byte; + _ServerObjectID : Longint; {hi-lo} + _JobDescription : Array[1..50] OF CHAR; { ASCIIZ } + _ClientRecordArea : Array[1..152] OF Byte + End; + +Procedure ConvertQJE2ext(qje:TintJobStruct;VAR ext:TQueueJobEntry; + Unrestricted:Boolean); +{convert the internal QueueJobEntry type into the equivalent + unit external type } +begin +With qje,ext + do begin + ClientConnNbr:=_ClientConnNbr; + ClientTaskNbr:=_ClientTaskNbr; + ClientObjectId:=Lswap(_ClientObjectId); + Move(_JobEntryTime,JobEntryTime,6); JobEntryTime.DayOfWeek:=0; + { # fix year for year 2000+ ? } + JobNumber:=swap(_JobNumber); + ZstrCopy(JobFileName,_JobFileName,14); + JobFileHandle:=_JobFileHandle; + TargetServerIdNumber:=Lswap(_TargetServerIdNumber); + Move(_TargetExecutionTime,TargetExecutionTime,6); TargetExecutionTime.DayOfWeek:=0; + { # fix year for year 2000+ ? } + JobType:=swap(_JobType); + JobControlFlags:=_JobControlFlags; + IF UnRestricted + then begin + ZstrCopy(JobDescription,_JobDescription,50); + Move(_ClientRecordArea,ClientRecordArea,152); + end; + JobPosition:=_JobPosition; + ServerConnNbr:=_ServerConnNbr; + ServerTaskNbr:=_ServerTaskNbr; + ServerObjectId:=Lswap(_ServerObjectId); + end; +end; + +Procedure ConvertQJE2int(qje:TQueueJobEntry;VAR int:TintJobStruct); +{convert the external QueueJobEntry type into the equivalent + unit internal type } +Var s:string[50]; +begin +With qje,int + do begin + _ClientConnNbr:=ClientConnNbr; + _ClientTaskNbr:=ClientTaskNbr; + _ClientObjectId:=Lswap(ClientObjectId); + _TargetServerIdNumber:=Lswap(TargetServerIdNumber); + Move(TargetExecutionTime,_TargetExecutionTime,6); + { # fix year for year 2000+ ? } + Move(JobEntryTime,_JobEntryTime,6); + { # fix year for year 2000+ ? } + _JobNumber:=swap(JobNumber); + _JobType:=swap(JobType); + _JobPosition:=JobPosition; + _JobControlFlags:=JobControlFlags; + PStrCopy(s,JobFilename,14);Move(s[1],_JobFileName,14); + _JobFileHandle:=JobFileHandle; + _ServerConnNbr:=ServerConnNbr; + _ServerTaskNbr:=ServerTaskNbr; + _ServerObjectId:=Lswap(ServerObjectId); + PstrCopy(s,JobDescription,50);Move(s[1],_JobDescription,50); + Move(ClientRecordArea,_ClientRecordArea,152); + end; +end; + + +{--- Initial Functions, create and destroy Job Queue --------------------} + +{F217/64 {2.1x+} +Function CreateQueue(Qname :string; QobjectType:Word; + dirHandle :Byte; pathName :string; + VAR QobjID:Longint ):Boolean; +{ Creates an object of an object_queue_type in the bindery, checks that + all settings are valid before creating. Returns the object_id of the + created queue if creation was successfull. } +{ QobjectType= OT_PRINT_QUEUE, OT_JOB_QUEUE, + OT_ARCHIVE_QUEUE, own obj.type >$8000 } +{ You need supervisor-equivalent or workgroup-manager rights to perform + this action. } +{ To add (remove) Queue operators or + (dis-)allow Queue servers to attach to a queue or + (dis-)allow objects (users/groups) to use a queue, + use the AddBinderyObjectToSet and DeleteBinderyObjectFromSet functions + in the nwBindry unit with the property names Q_OPERATORS, Q_SERVERS + and Q_USERS respectively. } +Type Treq=record + len :Word; + subFunc :Byte; + _Qtype :Word; { hi-lo} + _QdivData :array[1..168] of Byte; + end; + Trep=record + _Qid:Longint; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Var i:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$64; + _Qtype:=swap(QobjectType); { force hi-lo } + i:=ord(Qname[0])+1; + UpString(Qname);Move(Qname[0],_QdivData[1],i); + + inc(i); + _QdivData[i]:=DirHandle; + + inc(i); + UpString(PathName); + Move(PathName[0],_QDivData[i],ord(PathName[0])+1); + + len:=3+i+ord(PathName[0]); + F2SystemCall($17,len+2,SizeOf(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + QobjID:=Lswap(_Qid); { force lo-hi } + end; +CreateQueue:=(result=0) +{ resultcodes: $00 Success ; $96 Server Out Of Memory; $99 Drectory Full; + $9B Bad Directory Handle; $9C Invalid Path; $ED Property Already Exists; + $EE Object Already Exists; $EF Invalid Name; $F0 Wildcard Not Allowed; + $F1 Invalid Bindery Security; $F5 No Object Create Privilege; + $F7 No Property Create Privilege; $FC No Such Object; + $FE Server Bindery Locked; $FF Bindery Failure. } +end; + +{F217/65 [2.1x+]} +Function DestroyQueue(QobjID:Longint):Boolean; +{ Destroys the specified Queue; aborts all jobs in the queue; + associated files/directories are deleted; + queue object is removed from the bindery. } +Type Treq=record + len:Word; + subFunc:Byte; + _QobjID:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$65; + _QobjID:=Lswap(QobjID); { force hi-lo } + end; +F2SystemCall($17,Sizeof(Treq),0,result); +DestroyQueue:=(result=0); +{ resultcodes: $00 Success ; $96 Server Out Of Memory; $9C Invalid Path; + $D0 Queue Error; $D1 No Queue; $FF Hardware Failure. } +end; + +{----------------Client or Diagnostic Functions-----------------------------} + +{F217/76 [2.1x/3.x]} +Function ReadQueueStatus(QobjID:Longint; + Var Qstatus:TQueueStatus):Boolean; +{ Read the status of a queue. This information is changed by queueservers.} +Type Treq=record + len :Word; + subFunc:Byte; + _QobjID:Longint; {hi-lo} + end; + Trep=record + _QobjID:Longint; {hi-lo} + _Qstatus:Byte; + _NbrOfJobs:Byte; + _NbrOfServers:Byte; {max.25} + _serverIDlist:array[1..25] of Longint; {hi-lo} + _ServerConnNbrs:array[1..25] of Byte; + _MaxNumberOfServers:Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$66; + _QobjID:=Lswap(QobjID); {force hi-lo} + end; +F2SystemCall($17,Sizeof(Treq),SizeOf(Trep),result); +With Qstatus, TPrep(GlobalReplyBuf)^ + do begin + ObjectId:=Lswap(_QobjId); + status:=_Qstatus; + NbrOfJobs:=_NbrOfJobs; + NbrOfServers:=_NbrOfServers; + + for t:=1 to NbrOfServers + do ServerObjectIDs[t]:=Lswap(_ServerIDlist[t]); + Move(_ServerConnNbrs,ServerConnNbrs,25); + MaxNbrOfServers:=_MaxNumberOfServers; + end; +ReadQueueStatus:=(result=0) +end; + +{F217/67 [2.1x+]} +Function SetQueueStatus(QobjId:Longint; NewQstatusFlag:Byte):Boolean; +{ Change the queue status flag. Use the QS_XXXX constants } +Type Treq=record + len:Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _Qstatus:Byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$67; + _QobjId:=Lswap(QobjId); + _Qstatus:=NewQStatusFlag; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +SetQueueStatus:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. +} +end; + + + +{F217/6B} +FUNCTION GetQueueJobList( QueueObjId: Longint; + Var QJobList:TQueueJobList): Boolean; +{ You need to be either a Q_USER or a Q_OPERATOR } +Type TReq=Record + BufLen : Word; + func : Byte; + _QueueObjId: Longint; {hi-lo} + end; + TRep=Record + _JobCount:Word; {max 250, hi-lo} + _JobBuf :TJobNumberList; {array, entries hi-lo} + _MaxJobs :Word; {hi-lo} + End; + TPrep=^Trep; + TPreq=^Treq; +Var i:Word; +Begin +With TPReq(GlobalReqBuf)^ + do Begin + func:= $6B; + _QueueObjId:= LSwap(QueueObjId); + BufLen:=5; + End; +F2SystemCall($17,Sizeof(Treq),SizeOf(Trep),result); +IF result = 0 + Then with QJobList, TPrep(GlobalReplyBuf)^ + do Begin + JobCount:= Swap(_JobCount); + IF (JobCount > MaxQueueJobs) + Then JobCount:= MaxQueueJobs; + FOR i:= 1 TO JobCount + DO JobNbrs[i]:= Swap(_JobBuf[i]); + MaxJobs:=swap(_MaxJobs); + End; +GetQueueJobList:= (result = 0); +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +End; + +{F217/6C} +FUNCTION ReadQueueJobEntry( QObjId: Longint;JobNbr: Word; + VAR QJob: TQueueJobEntry): Boolean; +{ You need to be either a Q_USER, Q_OPERATOR or a Q_SERVER } +Type TReq=Record + BufLen : Word; + func : Byte; + _QueueObjId: Longint; {hi-lo} + _JobNumber : Word {hi-lo} + End; + TRep=Record + buf : TintJobStruct; { Unit INTERNAL type. To be converted } + End; + TPreq=^Treq; + TPrep=^Trep; +Begin +With TPReq(GlobalReqBuf)^ + do Begin + Buflen:= 7; + func:= $6C; + _QueueObjId:= LSwap(QObjId); + _JobNumber:= Swap(JobNbr); + End; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +IF result= 0 + Then with TPrep(GlobalReplyBuf)^ + do Begin + ConvertQJE2ext(buf,QJob,True); + End; +ReadQueueJobEntry:= result = 0; +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $D5 No Queue Job; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +End; + +{F217/6A} +FUNCTION RemoveJobFromQueue( QObjId: Longint; JobNbr: Word): Boolean; +{ You need to be Q_OPERATOR or the Q_USER who queued the job } +Type TReq=Record + BufLen: Word; + func: Byte; + _QueueObjId: Longint; {hi-lo} + _JobNumber:Word {hi-lo} + End; + TPreq=^Treq; +Begin +With TPReq(GlobalReqBuf)^ + do Begin + Buflen:= 7; + func:= $6A; + _QueueObjId:= LSwap(QObjId); + _JobNumber:= Swap(JobNbr); + End; +F2SystemCall($17,SizeOf(Treq),0,result); +RemoveJobFromQueue:= result = 0; +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D6 No Job Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. } +End; + + +{F217/69 [2.1x+]} +Function StartQueueJob(QobjId:Longint;JobNbr:Word):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$69; + _QobjId:=Lswap(QobjID); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +StartQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D6 No Job Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/6E [2.1x+]} +Function ChangeQueueJobPosition(QobjId:Longint; JobNbr:Word; + NewJobPos:Byte ):Boolean; +{ Q_OPERATOR only } +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _JobNbr :Word; {hi-lo} + _NewJobPos:Byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$6E; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + _NewJobPos:=NewJobPos; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +ChangeQueueJobPosition:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D5 No Queue Job; + $D6 No Job Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/6F [2.1x+]} +Function AttachQueueServerToQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$6F; + _QobjId:=Lswap(QobjId); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +AttachQueueServerToQueue:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/70 [2.1x+]} +Function DetachQueueServerFromQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$70; + _QobjId:=Lswap(QobjId); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +DetachQueueServerFromQueue:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/71 [2.1x+]} +Function ServiceQueueJob(QobjID:Longint; JobType:Word; + Var QjobEntry:TQueueJobEntry):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _JobType:Word; {hi-lo} + end; + Trep=Record + _qje:TintJobStruct; { EXCEPT last two fields } + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$71; + _QobjId:=Lswap(QobjId); + _JobType:=swap(JobType); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep)-50-152,result); +With TPrep(GlobalReplyBuf)^ + do begin + ConvertQJE2Ext(_qje,QjobEntry,false); + FillChar(QjobEntry.JobDescription,50,#$0); + FillChar(QjobEntry.ClientRecordArea,152,#$0); + { Use the ReadQueueJobEntry function to get job's + descriptionstring and clientRecordArea. } + end; +ServiceQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D9 Connection not Queue Server; + $DA Queue Halted; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/72 [2.1x+]} +Function FinishServicingQueueJob(QobjId:Longint;JobNbr:Word; + Charge:Longint ):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + _Charge:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$72; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + _Charge:=Lswap(Charge); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +FinishServicingQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D6 No Job Rights; } +end; + +{F217/73 [2.1x+]} +Function AbortServicingQueueJob(QobjId:Longint; JobNbr:Word):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$73; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +AbortServicingQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D6 No Job Rights; + $D9 Connection not Queue Server; } +end; + +{F217/74 [2.1x+]} +Function ChangeToClientRights(QobjId:Longint;JobNbr:Word):Boolean; +{ Q_SERVERs servicing job only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$74; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +ChangeToClientRights:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D6 No Job Rights; + $D9 Connection not Queue Server; } +end; + +{F217/75 [2.1x+]} +Function RestoreQueueServerRights:Boolean; +{ Q_SERVERs, servicing job and having previously called + ChangeToClientRights only } +Type Treq=record + len :Word; + subFunc:Byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$75; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +RestoreQueueServerRights:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D9 Connection not Queue Server; + $DA Queue Halted; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/76 [2.1x+]} +Function ReadQueueServerStatus(QobjId :Longint; + QserverObjId :Longint; + QserverConnNbr:Byte; + Var Qstatus:TQueueServerStatus):Boolean; +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _QSobjId :Longint; {hi-lo} + _QSconnNbr:Byte; + end; + Trep=record + _Qstatus:TqueueServerStatus; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$76; + _QobjId:=Lswap(QobjId); + _QSobjId:=Lswap(QserverObjId); + _QSconnNbr:=QserverConnNbr; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + Move(_Qstatus,Qstatus,SizeOf(TQueueServerStatus)); + end; +ReadQueueServerStatus:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $F1 Invalid Bindery Security; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/77 [2.1x+]} +Function SetQueueServerStatus(QobjId:Longint; Qstatus:TqueueServerStatus):Boolean; +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _Qstatus:TQueueServerStatus; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$77; + _QobjId:=Lswap(QobjId); + Move(Qstatus,_Qstatus,Sizeof(TQueueServerStatus)); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +SetQueueServerStatus:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/78 [2.1x+]} +Function GetQueueJobsFileSize(QobjId:Longint; JobNbr:Word; + Var JobSize:Longint ):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + Trep=record + _QobjId :Longint; {hi-lo} + _JobNbr :Word; {hi-lo} + _JobSize:Longint; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$78; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + JobSize:=Lswap(_JobSize); + end; +GetQueueJobsFileSize:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/68 [2.1x+]} +Function CreateQueueJob(QobjId:Longint; + {i/o} Var Qjob:TqueueJobEntry):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _Qjob :TintJobStruct; + end; + Trep=record + _QjobR:TintJobStruct; { Except the last two fields ! } + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$68; + _QobjId:=Lswap(QobjId); + ConvertQJE2Int(Qjob,_Qjob); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep)-152-50,result); +With TPrep(GlobalReplyBuf)^ + do begin + ConvertQJE2Ext(_QjobR,Qjob,False); + { False => Last 2 fields remain unchanged } + end; +CreateQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $99 Directory Full; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $D4 Queue Full; + $DA Queue Halted; + $ED Property Already Exists; + $EF Invalid Name; + $F0 Wildcard Not Allowed; + $F1 Invalid Bindery Security; + $F7 No Property Create Privilege; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/6D [2.1x+]} +Function ChangeQueueJobEntry(QobjId:Longint;Qjob:TQueueJobEntry):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _Qjob :TintJobStruct; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$6D; + _QobjId:=Lswap(QobjId); + ConvertQJE2Int(Qjob,_Qjob); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +ChangeQueueJobEntry:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D5 No Queue Job; + $D7 Queue Servicing; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{$IFDEF Template} {--------------- Q unit function template ---------------} + +{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 + $96 Server Out Of Memory; + $99 Drectory Full; + $9B Bad Directory Handle; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $D4 Queue Full; + $D5 No Queue Job; + $D6 No Job Rights; + $D7 Queue Servicing; + $D9 Connection not Queue Server; + $DA Queue Halted; + $DB Max Queue Servers; + $ED Property Already Exists; + $EE Object Already Exists; + $EF Invalid Name; + $F0 Wildcard Not Allowed; + $F1 Invalid Bindery Security; + $F5 No Object Create Privilege; + $F7 No Property Create Privilege; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. +} +end; + +{$ENDIF} + +end. diff --git a/NWTP/NWSEMA.PAS b/NWTP/NWSEMA.PAS new file mode 100644 index 0000000..0128660 --- /dev/null +++ b/NWTP/NWSEMA.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/NWSERV.PAS b/NWTP/NWSERV.PAS new file mode 100644 index 0000000..db0ef45 --- /dev/null +++ b/NWTP/NWSERV.PAS @@ -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} \ No newline at end of file diff --git a/NWTP/NWSPX.PAS b/NWTP/NWSPX.PAS new file mode 100644 index 0000000..8939fcc --- /dev/null +++ b/NWTP/NWSPX.PAS @@ -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. diff --git a/NWTP/NWTP.FAQ b/NWTP/NWTP.FAQ new file mode 100644 index 0000000..38a5506 --- /dev/null +++ b/NWTP/NWTP.FAQ @@ -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(''); + 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. + diff --git a/NWTP/NWTP.TPH b/NWTP/NWTP.TPH new file mode 100644 index 0000000..df60de8 Binary files /dev/null and b/NWTP/NWTP.TPH differ diff --git a/NWTP/NWTP06.TXT b/NWTP/NWTP06.TXT new file mode 100644 index 0000000..81dee58 --- /dev/null +++ b/NWTP/NWTP06.TXT @@ -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. diff --git a/NWTP/README.1ST b/NWTP/README.1ST new file mode 100644 index 0000000..e65777d --- /dev/null +++ b/NWTP/README.1ST @@ -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 diff --git a/NWTP/README.EXE b/NWTP/README.EXE new file mode 100644 index 0000000..83397e4 Binary files /dev/null and b/NWTP/README.EXE differ diff --git a/NWTP/REL.TXT b/NWTP/REL.TXT new file mode 100644 index 0000000..76dfdf1 --- /dev/null +++ b/NWTP/REL.TXT @@ -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. diff --git a/NWTP/THELP.CFG b/NWTP/THELP.CFG new file mode 100644 index 0000000..0a59368 --- /dev/null +++ b/NWTP/THELP.CFG @@ -0,0 +1,3 @@ +/fC:\BP\BIN\TURBO.TPH +/fC:\BP\BIN\TVISION.TPH +/fC:\BP\BIN\NWTP.TPH diff --git a/NWTP/THELP.COM b/NWTP/THELP.COM new file mode 100644 index 0000000..e4f9ebc Binary files /dev/null and b/NWTP/THELP.COM differ diff --git a/NWTP/XACCT/ACCT.PAS b/NWTP/XACCT/ACCT.PAS new file mode 100644 index 0000000..01b2e90 --- /dev/null +++ b/NWTP/XACCT/ACCT.PAS @@ -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. diff --git a/NWTP/XACCT/TSTACCT.PAS b/NWTP/XACCT/TSTACCT.PAS new file mode 100644 index 0000000..af08452 --- /dev/null +++ b/NWTP/XACCT/TSTACCT.PAS @@ -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,'<>') + 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. \ No newline at end of file diff --git a/NWTP/XBINDRY/BACKBIN.PAS b/NWTP/XBINDRY/BACKBIN.PAS new file mode 100644 index 0000000..19c8442 --- /dev/null +++ b/NWTP/XBINDRY/BACKBIN.PAS @@ -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 to continue, 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. diff --git a/NWTP/XBINDRY/NEW.TXT b/NWTP/XBINDRY/NEW.TXT new file mode 100644 index 0000000..0da337e --- /dev/null +++ b/NWTP/XBINDRY/NEW.TXT @@ -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 À¨ 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) + diff --git a/NWTP/XBINDRY/NEW2.TXT b/NWTP/XBINDRY/NEW2.TXT new file mode 100644 index 0000000..5bce7d7 --- /dev/null +++ b/NWTP/XBINDRY/NEW2.TXT @@ -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 À¨ 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) + diff --git a/NWTP/XBINDRY/NONAME00.EXE b/NWTP/XBINDRY/NONAME00.EXE new file mode 100644 index 0000000..25fa4b3 Binary files /dev/null and b/NWTP/XBINDRY/NONAME00.EXE differ diff --git a/NWTP/XBINDRY/NWPN9401.TXT b/NWTP/XBINDRY/NWPN9401.TXT new file mode 100644 index 0000000..c381a25 --- /dev/null +++ b/NWTP/XBINDRY/NWPN9401.TXT @@ -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. + + diff --git a/NWTP/XBINDRY/OT_XXX b/NWTP/XBINDRY/OT_XXX new file mode 100644 index 0000000..8d615d8 --- /dev/null +++ b/NWTP/XBINDRY/OT_XXX @@ -0,0 +1,1212 @@ +# ----------------------------------------------------------------- +# OT_XXX: Known Server/Object types +# ----------------------------------------------------------------- + +0000 Unknown Novell Inc. # used as a reply on queries +0001 User Novell Inc. +0002 User Group Novell Inc. +0003 Print Queue Novell Inc. +0004 File Server Novell Inc. +0005 Job Server Novell Inc. +0006 Gateway Novell Inc. +0007 Print Server Novell Inc. +0008 Archive Queue Novell Inc. +0009 Archive Server Novell Inc. +000A Job Queue Novell Inc. +000B Adminsitration Novell Inc. +0021 SNA Gateway National Advanced Systems +0022 Sperry Corp. Computer Systems +0023 ACS2 KTA +0024 Remote Bridge Server Novell Inc. +0025 Data Language Corp +0026 Async Bridge Server ? Computer Logics +0027 TCP/IP Gateway ? Santa Clara Systems/ Racal Interlan ? +0028 X25 Bridge Point-Point Eicon Technology +0029 X25 Gateway Multi-Point Eicon Technology +002A Chi Corp +002B Compass Computing +002C Intel Corp. +002D Time Synchronization VAP Novell Inc. +002E Target Service Agent Novell Inc. +0045 DI3270 Gateway ? +0047 Advertising Print Server Novell Inc. +0048 TCP/IP Gateway Micom Interlan +0049 Business Records Corp +004A Paradata Computer Networks +004B Btrieve Server 5.0 Novell Inc. +004C Netware SQL VAP Novell Inc. +004D Xtree-Net Central Point Software +004E ICL Gateway (Novell to TCP/IP) Computer Communication Consult +004F Database Server Emerald Bay +0050 Btrieve VAP 4.11 Novell Inc. +0051 Lan Services +0052 Icm +0053 Print Queue User/ Mac Project ? Novell Inc. +0054 Value Added File System Novell Inc. +0055 Terminal Emulator Systems Analysis Inc +0056 Stocknet Broker Sap Type Novell Inc. +0057 Stocknet Exchanger Sap Type Novell Inc. +0058 Multi-Point X.25 Router Eicon Technology +0059 Lan Services +005A Business Records Corp +005B Business Records Corp +005C Business Records Corp +005D Business Records Corp +005E Business Records Corp +005F Business Records Corp +0060 Stocknet Broker - Static Novell Inc. +0061 Stocknet Queue Type Novell Inc. +0062 Stocknet Player Type Novell Inc. +0063 +0064 +0065 +0066 ArcServe 3.0 +0067 +0068 +0069 +006A +006B +006C +006D Stocknet Exchange - Static Novell Inc. +006E Nacs Netpro Inc +006F Rabbit Software Corp +0070 MIC SNA DFV Server Computerland +0071 Tape Drive Server Digi Data Corp +0072 Wancopy Utility Novell Inc. +0073 Novell Inc. +0074 Novell Inc. +0075 Netware Btrieve Novell Inc. +0076 Netware Sql Novell Inc. +0077 Novell Inc. +0078 Novell Inc. +0079 Novell Inc. +007A TES - Netware for VMS Novell Inc. +007B Mergent International +007C +007D +007E +007F +0080 +0081 +0082 +0083 +0084 +0085 +0086 +0087 +0088 +0089 +008A +008B +008C +008D Mail Server Mcgill University +008E Rational Data Systems +008F Queue Types Tate Associates Inc +0090 Tnet X.21 IDA Bridge British Telecom +0091 Tnet X.21 Bridge British Telecom +0092 Tape Backup Server Emerald Systems Corp +0093 Watcom Debugger Watcom +0094 Sila Com Software Novell Inc. +0095 Vms Router Control Interconnections +0096 Micro Data Base Systems +0097 Dart College Hill Systems +0098 Netware Access Server Novell Inc. +0099 Network Courier Microsoft Workgroup Canada +009A Named Pipes Server Novell Inc. +009B Job Server Dis Inc +009C Raylynn Knight +009D CQ3270 Lan Cq Computer Communications +009E Unix - Portable Netware Novell Inc. +009F Progress Database Progress Software Corp +00A0 Gupta SQL Base Server Gupta Technologies +00A1 Powerchute VAP/NLM American Power Conversion +00A2 Auditor Package Blue Lance Network Info Sys +00A3 Security Blue Lance Network Info Sys +00A4 Corel Optical Driver Product Corel Systems, Optical Div +00A5 Archive Server Gigatrend Inc +00A6 Menu Program R&s Data Systems +00A7 386 NLM Unisys - Camarillo +00A8 LAN 1 Router Atlanta Technologies +00A9 Object Type Corel Systems, Optical Div +00AA Object Type Corel Systems, Optical Div +00AC IDA Status Monitor Compaq Computer Corp +00AD Lanport Microtest Inc +0100 Peer Logic +0101 R21PX Crosstalk +0102 LANProtect Intel Corp. +0103 Sequelnet (DB server?) Oracle Corp +0104 Pillsbury Co +0105 Gateway To Unisys Marshfield Clinic +0106 Gateways To Unisys Marshfield Clinic +0107 RSPCX Server ('Rconsole') Novell Inc. +0108 Netware For VM & MVS Phaser Systems +0109 IRMA LAN gateway (VM/MVS) Phaser Systems +010A Netware For VM & MVS Phaser Systems +010B Netware For VM & MVS Phaser Systems +010C Net 3270 Mcgill University Computing Ct +010D Image Server File Net Corporation +010E RTK Owl Micro Systems +010F SAP Novell Inc. +0110 Artefact Network Support +0111 Test Server Novell Inc. +0112 Print Server Hewlett Packard +0113 Communication Server Novell Inc. +0114 Comm. Server Appl. (MUX) Novell Inc. +0115 Comm. Server Appl. (LSA) Novell Inc. +0116 Comm. Server Appl. (CM) Novell Inc. +0117 Comm. Server Appl. (SMA) Novell Inc. +0118 Comm. Server Appl. (DBA) Novell Inc. +0119 Comm. Server Appl. (NMA) Novell Inc. +011A Comm. Server Appl. (SSA) Novell Inc. +011B Comm. Server Appl. (Status) Novell Inc. +011C Saa Data Link Agent Novell Inc. +011D Communication Server Novell Inc. +011E Comm. Server Appl. (APPC) Novell Inc. +011F Communication Server Novell Inc. +0120 Communication Server Novell Inc. +0121 Communication Server Novell Inc. +0122 Communication Server Novell Inc. +0123 Communication Server Novell Inc. +0124 Communication Server Novell Inc. +0125 Communication Server Novell Inc. +0126 Comm. Server Appl. (Test/SAA ?) Novell Inc. +0127 Communication Server Novell Inc. +0128 Communication Server Novell Inc. +0129 Communication Server Novell Inc. +012A Comm. Server Appl. (Trace) Novell Inc. +012B Super Sna Agent Novell Inc. +012C Communication Server Novell Inc. +012D Communications Server Novell Inc. +012E Communications Server Novell Inc. +012F Communications Server Novell Inc. +0130 Comm. Server Appl. (Exec) Novell Inc. +0131 Image Server Wang Laboratories +0132 BT X.25 British Telecom +0133 NNS Domain Novell Inc. +0134 NNS Novell Inc. +0135 NNS Profile Novell Inc. +0136 NNS Novell Inc. +0137 NNS Queue Novell Inc. +0138 NNS Novell Inc. +0139 NNS Novell Inc. +013A NNS Novell Inc. +013B NNS Novell Inc. +013C NNS Novell Inc. +013D Securities Trading & Technolog +013E Securities Trading & Technolog +013F Network Designers Ltd +0140 Network Management System Accunetics +0141 Lufthansa +0142 Aladdin Knowledge Systems +0143 CDrom Server Online Computer Systems +0144 Netwise Inc +0145 Communication Processor Evergreen Systems +0146 XDB Database Server XDB Systems +0147 Piggyback Login Net_inc Micro Enhancement Inc +0148 Network Software Associates +0149 Advertising Remote Server Artefact Network Support +014A ID 5001 Weather Station Zenith Data Systems +014B Novell Inc. +014C Netfram Netware 386 Netframe +014D Netfram Netware 386 Netframe +014E Netfram Netware 386 Netframe +014F Netfram Netware 386 Netframe +0150 Maxiback - VAP Sysgen +0151 Dcs System Server Computer Concepts Corporation +0152 DCA IPX Communication Product Digital Communications Ass. +0153 DCA IPX Communication Product Digital Communications Ass. +0154 Forms Capability Rochester Telephone Corp +0155 Forms Capability Rochester Telephone Corp +0156 Forms Capability Rochester Telephone Corp +0157 Forms Capability Rochester Telephone Corp +0158 Forms Capability Rochester Telephone Corp +0159 Forms Capability Rochester Telephone Corp +015A Forms Capability Rochester Telephone Corp +015B Forms Capability Rochester Telephone Corp +015C Network Computing Inc (NCI) +015D Network Computing Inc (NCI) +015E Network Computing Inc (NCI) +015F Network Computing Inc (NCI) +0160 Network Computing Inc (NCI) +0161 Advertising Remote Server Artefact Network Support +0162 System 9 Hbf Group +0163 System 9 Hbf Group +0164 System 9 Hbf Group +0165 System 9 Hbf Group +0166 NW Management Novell Inc. +0167 Instantcom Communications Server Instant Information +0168 Pickit Communications Server Intel +0169 Peer Logic +016A Open Image For Netware Wang Laboratories +016B Open Image For Netware Wang Laboratories +016C Open Image For Netware Wang Laboratories +016D Open Image For Netware Wang Laboratories +016E Open Image For Netware Wang Laboratories +016F Luminar Optical Server Corel Systems Corp +0170 TXD Thomas Conrad Corp +0171 Lanfax Redirector Alcom Inc +0172 File Share Compaq Computer Corp +0173 File Share Compaq Computer Corp +0174 File Share/ SNMP Agent ? Compaq Computer Corp +0175 File Share Compaq Computer Corp +0176 File Share Compaq Computer Corp +0177 Lanware Horizon Technology Inc +0178 Lanware Horizon Technology Inc +0179 Lanware Horizon Technology Inc +017A Lanware Horizon Technology Inc +017B Lanware Horizon Technology Inc +017C Lanware Horizon Technology Inc +017D Lanware Horizon Technology Inc +017E Lanware Horizon Technology Inc +017F Lanware Horizon Technology Inc +0180 Lanware Network Management Inc +0188 Sysm/lan2 H&W Computer Systems +0189 Xtree Server Central Point Software +018E Pc Metro Crystal Point +018F Pc Metro Crystal Point +0190 Service Point Interpoint Software +0191 Service Point Interpoint Software +0192 Netway 2000 Tri Data Systems +0193 Netway SNA Tri Data Systems +0194 Maxway 500 Tri Data Systems +0195 TCP/IP Gateway Computervision Services +0196 Integrated Technologies Inc +0197 Share Master Storage Dimensions +0198 Zenith Data Systems +0199 Zenith Data Systems +019A Zenith Data Systems +019B Apt Net Remote Automated Programming Tech +019C Apt Net Remote Automated Programming Tech +019D Apt Net Remote Automated Programming Tech +019E Apt Net Remote Automated Programming Tech +019F Mailslots IBM +01A0 Terminal Gateway For Unisys Upstanding Systems +01A1 DB Server Lodgistix Inc +01A2 Lodgistix Inc +01A3 Gateway, C. Page, & Etc Server Teknos Systems +01A4 Gateway, C. Page, & Etc Server Teknos Systems +01A5 Gateway, C. Page, & Etc Server Teknos Systems +01A6 Gateway, C. Page, & Etc Server Teknos Systems +01A7 Gateway, C. Page, & Etc Server Teknos Systems +01A8 Gateway, C. Page, & Etc Server Teknos Systems +01A9 Gateway, C. Page, & Etc Server Teknos Systems +01AA Gateway, C. Page, & Etc Server Teknos Systems +01AB Gateway, C. Page, & Etc Server Teknos Systems +01AC Gateway, C. Page, & Etc Server Teknos Systems +01AD Menu Program R&s Data Systems +01AE Menu Program R&s Data Systems +01B0 Garp Gateway Net Research Pty Ltd +01B1 Licensing Restrictions Lan Support Group +01B2 Licensing Restrictions Lan Support Group +01B3 Media Touch Systems +01B4 Network Management Product NCR +01B5 Network Management Product NCR +01B6 Network Management Product NCR +01B7 Network Management Product NCR +01B8 Network Management Product NCR +01B9 Bonsai Technologies +01BA Biztech +01BB Bonsai Technologies +01BC Bonsai Technologies +01BD Bonsai Technologies +01BE Km Systems +01BF Connect Computer +01C0 La Cite Collegiale +01C1 J&l Information Systems +01C2 J&l Information Systems +01C3 J&l Information Systems +01C4 J&l Information Systems +01C5 J&l Information Systems +01C6 Distributed Application Folio Corporation +01C7 Microtest Inc +01C8 Madge Networks Ltd +01C9 Funk Software +01CA Funk Software +01CB Shiva Corp +01CC Shiva Corp +01CD Shiva Corp +01CE Shiva Corp +01CF E-Mail Queue C&D Data Services +01D0 E-Mail Server C&D Data Services +01D1 Lanlord Product Microcom Client Server Technol +01D2 Mark Hurst +01D3 Mark Hurst +01D5 Centers For Disease Control +01D6 On-Queue Task Queue Netplus Software Inc +01D7 On-Queue Task Server Netplus Software Inc +01D8 Castelle Inc +01D9 Castelle Inc +01DA LANPress Castelle Inc +01DB Castelle Inc +01DC Castelle Inc +01DD Castelle Inc +01DE Castelle Inc +01DF Castelle Inc +01E0 Castelle Inc +01E1 Castelle Inc +01E2 Area Code Look-Up Server Equinox Information Systems +01E3 Sorting Server Equinox Information Systems +01E4 Wall Data +01E6 X25 Automated Bridge Monitor Automated Interactions Div Of +01E7 Rational Data Systems +01E8 Rational Data Systems +01E9 Rational Data Systems +01EA Rational Data Systems +01EB Media Touch Systems +01EC Powergrid Network Daemon Cognos Inc +01ED Integralis Ltd +01EE Integralis Ltd +01EF Felsina Software +01F0 Legato Systems +01F1 Legato Systems +01F2 Legato Systems +01F3 Legato Systems +01F4 Legato Systems +01F5 Legato Systems +01F6 Andersen Consulting +01F8 Sytron Corp +01F9 Integralis Ltd/ Unibase BV +01FB Northeast Broadcast Consultant +01FC Extended Systems +01FD IBM +0200 NP/SQL Server Novell Inc. +0201 The Make Server Novell Inc. +0202 Generic Job Server Novell Inc. +0203 RMF2 Utility Novell Inc. +0204 Novell Inc. +0205 Novell Inc. +0206 Novell Inc. +0207 Novell Inc. +0208 Novell Inc. +0209 Novell Inc. +020A Novell Inc. +020B Novell Inc. +020C Novell Inc. +020D Novell Inc. +020E Novell Inc. +020F Novell Inc. +0210 Novell Inc. +0211 Novell Inc. +0212 Novell Inc. +0213 Novell Inc. +0214 Novell Inc. +0215 Novell Inc. +0216 +0217 +0218 +0219 +021A Messaging Server Novell Inc. +021D Home Router Novell Inc. +021E Netware Lontalk Gateway Novell Inc. +0220 +0222 Novell Inc. +0233 Network Management Agent (NMS) Novell Inc. +0234 Network Management Info Server Novell Inc. +0235 TIRPC Service Novell Inc. +0236 Novell Inc. +0237 IPX Discovery (NMS) Novell Inc. +0238 IP Discovery (NMS) Novell Inc. +0239 Netware Management (NMS) Novell Inc. +023A Netware Management (NMS) Novell Inc. +023B Broadcast Novell Inc. +023C Dos Target Service Agent Novell Inc. +023D SMS Workstation Name Object Novell Inc. +023E SMS Testing & Development Novell Inc. +023F SMS Testing & Development Novell Inc. +0240 Novell Inc. +0241 Novell Inc. +0242 Novell Inc. +0243 Novell MHS DS Gateway For Oce Novell Inc. +0244 Nds Gateway For Oce Novell Inc. +0245 Superlab File Distribution Server Novell Inc. +0246 Version Control Queue Novell Inc. +0247 Nvt Remote Login Over SPX Novell Inc. +0248 Queue Server For IBM PSf/2 Novell Inc. +0249 Remote monitor (NMS) Novell Inc. +024A Lat Transport Service Provider Novell Inc. +024B Lat Session Manager Novell Inc. +024C Lat Network From Netware Novell Inc. +024D Address Server Novell Inc. +025E Xapia Interface For NW 3.11 Novell Inc. +025F X.400 Protocol Access Module Novell Inc. +0260 Snads Protocol Access Module Novell Inc. +0261 Superlab Network Switch Server Novell Inc. +0262 Hub Services Novell Inc. +0263 Netware Management Agent Novell Inc. +0264 Global MHS Novell Inc. +0265 SNMP Novell Inc. +0266 Version Control Server Novell Inc. +0267 Application Rights Program Novell Inc. +0268 Novell Inc. +0269 Superlab Automation Server Novell Inc. +026A Console (NMS) Novell Inc. +026B Time Synchronization Server Novell Inc. +026D Advertising Job Server Novell Inc. +0272 Datalink Switching (DLSW) Novell Inc. +0277 Sap Server Type Novell Inc. +0278 Directory Server (NDS) Novell Inc. +0280 Novell Inc. +0281 Domain Application Services Novell Inc. +0282 Domain Application Services Novell Inc. +0283 Domain Application Services Novell Inc. +0284 Domain Application Services Novell Inc. +0285 Domain Application Services Novell Inc. +0286 Domain Application Services Novell Inc. +0287 Domain Application Services Novell Inc. +0288 Domain Application Services Novell Inc. +02FF Novell Inc. +0300 Firefox Communications Ltd +0301 Firefox Communications Ltd +0302 Gateway (Novell to IP) Firefox Communications Ltd ? +0303 Firefox Communications Ltd +0304 Firefox Communications Ltd +0305 Firefox Communications Ltd +0306 NPS (netware Print Services) Inter Connections Inc +0307 NPS Spool Client Inter Connections Inc +0308 HP NS Util Hewlett Packard +0309 Document Management Package Perfect Solutions Corporation +030A BBS Server Galacticomm Inc +030B Lucid Systems Pty Ltd +030C Laserjet/Quick Silver ? Hewlett Packard +030D Broadcast Operation Sup Dynatech Utah Scientific +030E Fault Tolerant Control Dynatech Utah Scientific +030F CD Rom Server Trantor System Ltd +0310 CD Rom Server Trantor System Ltd +0311 CD Rom Server Trantor System Ltd +0312 CD Rom Server Trantor System Ltd +0313 CD Rom Server Trantor System Ltd +0314 CD Rom Server Trantor System Ltd +0315 CD Rom Server Trantor System Ltd +0316 CD Rom Server Trantor System Ltd +0317 Batch Processor Computer Aided Business Sol +0318 +0319 +031A +0320 Gateway Attachmate Corporation +0321 Chicago Research & Trading +0322 Frye Computer Systems +0323 Wang Laboratories +0324 Wang Laboratories +0325 X.500 DSA Server Aac Systems +0326 Novell Remote ISDN Router Lanworks +0327 Bootware/MSD Lanworks +0328 Watcom +0329 Aetna Life & Casualty +032A Aetna Life & Casualty +032B Fax Server Digital Visions Corp +032C Voice Server Digital Visions Corp +032D Interprocess Exchange Server Digital Visions Corp +032E Application Server Nationsbank Appl Systems Supp +0330 SAS Share Server Sas Institute +0331 SAS Connect Sas Institute +0332 Archetype +0333 Archetype +0334 Aetna Life & Casualty +0335 Communications Server Multitech +0336 Communications Server Multitech +0337 Magee Enterprises Inc +0338 Magee Enterprises Inc +0339 Magee Enterprises Inc +033A Magee Enterprises Inc +033B Magee Enterprises Inc +033C Magee Enterprises Inc +033D Magee Enterprises Inc +033E Magee Enterprises Inc +033F Magee Enterprises Inc +0340 Magee Enterprises Inc +0341 Data Service To Workstation Chancery Software +0342 Microtest Inc +0343 Microtest Inc +0344 Microtest Inc +0345 Microtest Inc +0346 Microtest Inc +0347 Microtest Inc +0348 Microtest Inc +0349 Microtest Inc +034A Preferred Health Care Ltd +034B Preferred Health Care Ltd +034C Preferred Health Care Ltd +034D Preferred Health Care Ltd +034E Preferred Health Care Ltd +034F Preferred Health Care Ltd +0350 Preferred Health Care Ltd +0351 Preferred Health Care Ltd +0352 Fujitsu Ltd +0353 Fujitsu Ltd +0354 Fujitsu Ltd +0355 Arcada Software +0356 Lanovation +0357 Lanovation +0358 Cbis Inc +035A Mbac +035B Right-Hand-Man, E-Mail/scheduling Lan Aces Inc +035C Fax Server Transfax Corporation +035D Fax Print Server Transfax Corporation +035E Fax Merge Server Transfax Corporation +035F Network Management Server Transfax Corporation +0360 Funk Software +0362 Pseudo Peer-To-Peer Us Army Corps Of Engineers +0363 Print Server - Laser Jet Extended Systems +0364 Lan Times Japan DEMO Lan Times Japan, Softbank Corp +0365 Lan Times Japan DEMO: Queue Type Lan Times Japan, Softbank Corp +0366 Mgate - Communication Gateway Coefficient Systems Corp +0367 Excalibur Technologies Corp +0368 Excalibur Technologies Corp +0369 Excalibur Technologies Corp +036A Excalibur Technologies Corp +036B Aetna Life & Casualty +036C IPX Peer-To-Peer Sewell Development +036D Micro Integration +036E NLM Server Praxis +036F Avail Systems Corp +0372 Digital Equipment +0373 UPS Info NLM Brainstorm Engineering +0374 Shareware Communications Server Cherry Tree Software +0375 Enterprise ECS Intel Corp +0376 Enterprise Initialization Mode Intel Corp +0377 Comm. Serverr - NETBios IPX US Robotics Software +0378 NLM Advertising For UPS Info Brainstorm Engineering +0379 Fax Server Extended Systems +037A Fax Server Extended Systems +037B Fax Server Extended Systems +037C Fax Server Extended Systems +037D Gateway Management Wall Data +037E Powerchute Alert - Ups Monitoring American Power Conversion +037F Virusafe Notify Central Point Software +0380 Fax Server Optus Information Systems +0381 Transport Network Substrate (TNS) Oracle +0382 Lasermaster Printer Products Laser Master Corp +0383 Powerchute Administrative American Power Conversion +0384 Sequel Link Cl/S Middleware Techgnosis Inc +0385 Mail Systems Synectic Systems Ltd +0386 Hewlett Packard Bridges Hewlett Packard +0387 Hewlett Packard Hubs Hewlett Packard +0388 Workstn Peer-To-Peer Communication IBM +0389 Datanex Corporation +039A Hp Open Mail & Portable Netware Hewlett Packard +039B ?? Lotus notes on OS/2 Iris Associates +039C Communications Server Bindery Dator 3 Spol Sro +039D Communications Server SAP Dator 3 Spol Sro +039E Fax Server Ferrari Electronic Gmbh +039F Computervision Services +03A0 CD Server Jostens Learning Corp +03A1 Neumeier & Walch Systemtechnik +03A2 Hyprotech Ltd +03A3 Kyocera Corp, Yohaga Office +03A4 Kyocera Corp, Yohaga Office +03A5 Kyocera Corp, Yohaga Office +03A6 Kyocera Corp, Yohaga Office +03A7 Group (Pforzheim POA) Stadt Pforzheim POA +03A8 Queue (Pforzheim POA) Stadt Pforzheim POA +03A9 Server (pforzheim POA) Stadt Pforzheim POA +03AA Uds Motorola +03AB Uds Motorola +03AC Uds Motorola +03AD Uds Motorola +03AE Raima Corp +03AF Copy Protection Server Pace Software Systems Inc +03B0 TNA Communication Palindrome +03B1 Lan Controller For Netware Bus Technology +03B2 Network Designers +03B3 File Management Services Systems Axis Plc +03B4 Queue Management Services Systems Axis Plc +03B5 Iwi +03B6 Lantech Services +03B7 Antivirus NLM Certus +03B8 Modem Server Lansource Technologies +03B9 Global Info Appl. Exec. Funk Software +03BA Magix Database Server Advanced Software Technologies +03BB Performance Monitor Ameridata +03BC Netport Advertising Intel Pced +03BD Wan Connection Server Ideassociation +03BE Wicat Jostens Learning Corp +03BF Wicat Server Jostens Learning Corp +03C0 Oem Plotter Product Cal Comp +03C1 Oem Plotter Product Cal Comp +03C2 Oem Plotter Product Cal Comp +03C3 Oem Plotter Product Cal Comp +03C4 ArcServe 4.0 Cheyenne +03C7 Lan Spool 3.5 Intel +03C8 Network Management Madge Networks Ltd +03C9 Diatek Patient Mgmt Systems +03CA Point-Of-Sale Server Optical Mark Systems Ltd +03CB Software Access Control Server U Of Plymouth +03CC Axnetwar - Print Server Tidemark/COSTAR +03CF Database Engine Blue Lance Network Info Sys +03D0 Report Engine Blue Lance Network Info Sys +03D1 Job Server Blue Lance Network Info Sys +03D2 Blue Lance Network Info Sys +03D3 Blue Lance Network Info Sys +03D4 Visinet NLM Technology Dynamics Inc +03D5 Print Servers Lexmark International +03D6 Print Servers Lexmark International +03D7 Print Servers Lexmark International +03D8 Print Servers Lexmark International +03D9 Server Monitoring Program Trellis +03DA Multiple Services & Applications Think Systems Corp +03DB Multiple Services & Applications Think Systems Corp +03DC Multiple Services & Applications Think Systems Corp +03DD Server Performance Analisys Banyan Systems Inc +03DE Gupta SQL DB Server Gupta Technologies +03DF Remote Database Services Interactive Data +03E0 Object Store Server Object Design +03E1 Unixware Univel +03E2 Unixware Univel +03E3 Unixware Univel +03E4 Unixware Univel +03E5 Unixware Univel +03E6 Unixware Univel +03E7 Unixware Univel +03E8 Unixware Univel +03E9 Unixware Univel +03EA Unixware Univel +03EB Unixware Univel +03EC Unixware Univel +03ED Unixware Univel +03EE Unixware Univel +03EF Unixware Univel +03F0 Unixware Univel +03F1 First Call Thomson Financial +03F2 Access Rights Server Qm Consulting +03F3 Vital Signs/lan Server Blueline Software Inc +03F4 LAA Server Saber Software +03F5 Microsoft SQL Server Microsoft +03F6 Asynchronous Serial Communications Black Creek Integrated Systems +03F7 Asynchronous Serial Communications Black Creek Integrated Systems +03F8 Asynchronous Serial Communications Black Creek Integrated Systems +03F9 Asynchronous Serial Communications Black Creek Integrated Systems +03FA Watson - Communications Server Prodigy Services +03FB Netport Intel Pced +03FC Netport Intel Pced +03FD Netport Intel Pced +03FE Netport Intel Pced +03FF Modular Software Corporation +0400 Artefact Network Support +0401 Artefact Network Support +0402 Artefact Network Support +0403 Artefact Network Support +0404 Artefact Network Support +0405 Artefact Network Support +0406 Artefact Network Support +0407 Artefact Network Support +0408 Artefact Network Support +0409 Artefact Network Support +040A Image Application Laser Data +040B Image Application Laser Data +040C Image Application Laser Data +040D Image Application Laser Data +040E Image Application Laser Data +040F Image Application Laser Data +0410 Image Application Laser Data +0411 Image Application Laser Data +0412 Image Application Laser Data +0413 Image Application Laser Data +0414 Netsprint Digital Products Inc +0415 Remote Database Services Interactive Data +0416 Dealing Room Servers Teknos Systems Ltd +0417 Dealing Room Servers Teknos Systems Ltd +0418 Dealing Room Servers Teknos Systems Ltd +0419 Dealing Room Servers Teknos Systems Ltd +041A Dealing Room Servers Teknos Systems Ltd +041B Dealing Room Servers Teknos Systems Ltd +041C Dealing Room Servers Teknos Systems Ltd +041D Dealing Room Servers Teknos Systems Ltd +041E Dealing Room Servers Teknos Systems Ltd +041F Dealing Room Servers Teknos Systems Ltd +0420 Dealing Room Servers Teknos Systems Ltd +0421 Dealing Room Servers Teknos Systems Ltd +0422 Dealing Room Servers Teknos Systems Ltd +0423 Dealing Room Servers Teknos Systems Ltd +0424 Dealing Room Servers Teknos Systems Ltd +0425 Dealing Room Servers Teknos Systems Ltd +0426 Dealing Room Servers Teknos Systems Ltd +0427 Dealing Room Servers Teknos Systems Ltd +0428 Dealing Room Servers Teknos Systems Ltd +0429 Dealing Room Servers Teknos Systems Ltd +042A Full Text Retrieval Cl/S Db Impact Italiana Srl +042B Gateway Software Datev Eg +042C Gateway Software Datev Eg +042D Client-Server Driver For IPX/SPX Reference Point Software +042E Intrak Inc +042F Loader Casper Systems Inc +0430 Finder Casper Systems Inc +0432 Filemaker Pro Claris Corp +0433 Networking Hub Synoptics +0434 Network Terminal Emulator Ide Association +0435 Administration Server Mcgill University Fac Of Engin +0436 Network Dynamic Data Exchange Netlogic Inc +0437 Asynch Comm Svr US Robotics Software +0438 Back Up Product Corel Systems, Optical Div +0439 Back Up Product Corel Systems, Optical Div +043A Software Communications Tentera Computer Services +043B Enterprise In Maintenance Mode Intel +043C Connection Station Service Corollary Inc +043D Connection Station Service Corollary Inc +043E Connection Station Service Corollary Inc +043F Connection Station Service Corollary Inc +0440 Connection Station Service Corollary Inc +0441 Connection Station Service Corollary Inc +0442 Connection Station Service Corollary Inc +0443 Connection Station Service Corollary Inc +0444 SNA Gateway Microsoft +0445 Workstation Terminal Access Hsd Hardware Software Developm +0446 De International Ltd +0447 Distributive Cache Product Raima Corp +044C +044D IBM Host Gateway Idea Courier +044E Urban Science Applications +044F Common Communication Interface Computer Associates +0450 Communications Server SDD Scandinavian Airlines Data +0451 Tape Back-Up For NLM Applications Mountain Network Solutions Inc +0452 Tape Back-Up For NLM Applications Mountain Network Solutions Inc +0453 Tape Back-Up For NLM Applications Mountain Network Solutions Inc +0454 Tape Back-Up For NLM Applications Mountain Network Solutions Inc +0455 Tape Back-Up For NLM Applications Mountain Network Solutions Inc +0456 Tape Back-Up For NLM Applications Mountain Network Solutions Inc +0457 Canon Peripheral Server Canon Information Systems +0458 Netware Server Product Intel Corp +0459 Object Oriented Database System Ontos Inc +045A QMS Printer - Remote Configuration QMS +045B Client Server Monitoring Utility Dell Computer +045C Application Definitition Lanovation +045D Fax Server Ferrari Electronic Gmbh +045E Fax Server Ferrari Electronic Gmbh +045F Fax Server Ferrari Electronic Gmbh +0460 Fax Server Ferrari Electronic Gmbh +0461 Communications Gateway - OSI Eicon Technology +0462 Communications Gateway - SNA Eicon Technology +0463 Network Archive Server Palindrome +0464 Batchfiler Application Jovandi International Inc +0465 NLM On File Server Jovandi International Inc +0466 Time Synchronization Server Jovandi International Inc +0468 Telephone Answering System A&m Communications +046A Fax Server Extended Systems +046B Cadence Time Service Polygon Inc +046C Poly-Portal For Netware/ethernet Polygon Inc +046D Poly-Link Pc To Vax Networking Polygon Inc +046E LAT Service Polygon Inc +046F Automatic Tracking System Holten White Associates +0470 Measureservers And Measureclients Advantech Benelux Bv +0471 Disk Monitor Storage Deminsions +0472 Enterprise Network Services Banyan Systems Inc +0474 Sybase SQL Server Sybase Inc +0475 Sybase SQL Server Console Sybase Inc +0476 Sybase SQL Server Monitor Sybase Inc +0477 Sybase SQL Server Back-Up Sybase Inc +0478 Sybase Open Server Sybase Inc +0479 Sybase Open Server Console Sybase Inc +047A +047B +047C Remote Printer Console Peerless Group +047D Auto-On/off Control NLM Mitsubisi Denki Computer +047E Ascom Fax Server Ascom Telecommunication Ltd +047F Ascom Advertising Fax Server Ascom Telecommunication Ltd +0480 Ascom Fax Queue Ascom Telecommunication Ltd +0481 Job Server High Aspect Development +0482 Job Queue High Aspect Development +0483 Finance Think Systems Corp +0484 Forcasting Think Systems Corp +0485 Schema Think Systems Corp +0486 Fail Safe Analysis Think Systems Corp +0487 Think Systems Corp +0488 Cl/s communication CDC +0489 Store Name Of Special File Delta Information Systems +048A Calendar Management NLM Russell Information Sciences +048B Array Monitor Server Core International +048C Document Processing Server NLM Boss Logic Inc +048D Document Processing Server NLM Boss Logic Inc +048E Document Processing Server NLM Boss Logic Inc +048F Document Processing Server NLM Boss Logic Inc +0490 Power Product For File Server Brainstorm Engineering +0491 Netblazer Communication Server Telebit Corporation +0492 RTS Terminal Emulation Data Research & Applications +0493 RSCF Client-Server API Data Research & Applications +0494 Cd Networker Bindery Type Lotus +0495 Remote Back-Up Device Astora Software Inc +0496 SQL Server IPX/SPX Hidden Server Microsoft +0497 Database Lock Server High Aspect Development +0498 Meter Server Polymeter Response Ltd +0499 Lancorp Eoms Lancorp Pty Ltd +049A Bull HN SDM Lancorp Pty Ltd +049B Network Management Agent Eicon Technology +049C Icot Sna Gateway Icot Corp +049D Software NLM Interconections +049E Internet Gateway Metascybe Systems Ltd +049F Email & Calendaring Attachmate Canada +04A1 Automation Information Router Kurt Manufacturing +04A2 Xbase Record Engine Extended Systems +04A3 Remote Procedure Call System Fortunet Inc +04A4 Valuable Info Transmission Wave Systems Corporation +04A5 Remote Access Server Traveling Software +04A6 Program Metering Database Pilott Systems +04A7 LT Auditor 4.00 Plus Blue Lance Inc +04A8 Fujitsu Ltd +04A9 Fujitsu Ltd +04AA SAP Service Fujitsu Ltd +04AB SAP Service Fujitsu Ltd +04AC Calendar Server Campbell Services +04AE Led Server Inova Corporation +04B0 CDnet Server Meridian Data Inc +04B1 Policy Engine Emerald Systems +04B2 Policy Engine Emerald Systems +04B3 Policy Engine Emerald Systems +04B4 Policy Engine Emerald Systems +04B5 Policy Engine Emerald Systems +04B6 Policy Engine Emerald Systems +04B7 Lan Assist Plus Remote Control Microtest +04B8 Lan Assist Plus Remote Control Microtest +04B9 Lan Assist Plus Remote Control Microtest +04BA Lan Assist Plus Remote Control Microtest +04BB Map Assist Peer-To-Peer Microtest +04BC Map Assist Peer-To-Peer Microtest +04BD Map Assist Peer-To-Peer Microtest +04BE Map Assist Peer-To-Peer Microtest +04BF Jetnet Driver Jetstream Technology Ltd +04C0 Database Server NLM Lodestar Data Systems +04C1 Asynchronous Comm. Servers Us Robotics Software +04C2 Database Server Fair Com +04C3 Taurus Database Server Dci +04C4 Taurus Serial Server Dci +04C5 Casper Queue Casper Systems Inc +04C6 Casper Ghost Casper Systems Inc +04C7 Conefrencing Service Fujitsu Networks Industry +04C8 Mail System Queue Service Mitsubishi Electric Engineerin +04C9 Video Server Novell - Multi Media +04CA Message Express Product Horizon Strategies Inc +04CB Cd Rom Server Cbis Inc +04CC Cost Recovery Server Vincent Larsen +04CD Pc-Based Sna Gateway Ungermann Bass +04CF User Restrictions Val Laboratory Co Ltd +04D0 User Restrictions Val Laboratory Co Ltd +04D1 Sap Advertising On Print Server Nissin Electric Co Ltd +04D2 Ellipse Server Bachman Information Systems +04D3 Asynchronous Access Server Skyline Technology +04D4 Enterprise Description Object Hans Spatzier +04D5 Print Server Foresyte Technologies +04D7 Cubix Ql Server Cubix Corp +04D8 Cubix Ql Client Cubix Corp +04D9 Job Server Storage Dimensions +04DA Communication Server Firefox Communications Ltd +04DB Communication Server Firefox Communications Ltd +04DC Communication Server Firefox Communications Ltd +04DD Communication Server Firefox Communications Ltd +04DE Communication Server Firefox Communications Ltd +04DF Communication Server Firefox Communications Ltd +04E0 Communication Server Firefox Communications Ltd +04E1 Communication Server Firefox Communications Ltd +04E2 Communication Server Firefox Communications Ltd +04E3 Communication Server Firefox Communications Ltd +04E4 Communication Server Firefox Communications Ltd +04E5 Communication Server Firefox Communications Ltd +04E6 Communication Server Firefox Communications Ltd +04E7 Communication Server Firefox Communications Ltd +04E8 Communication Server Firefox Communications Ltd +04E9 Communication Server Firefox Communications Ltd +04EA Communication Server Firefox Communications Ltd +04EB Communication Server Firefox Communications Ltd +04EC Communication Server Firefox Communications Ltd +04ED Communication Server Firefox Communications Ltd +04EE Remote Access Server DCA +04EF Statistic Management Multitech +04F0 Statistic Management Multitech +04F1 Remote Control Software Multitech +04F2 Remote Control Software Multitech +04F3 Multitech +04F4 Netlynx Communication Server Andrew Corporation +04F5 Netlynx Communication Server Andrew Corporation +04F6 Netlynx Communication Server Andrew Corporation +04F7 Netlynx Communication Server Andrew Corporation +04F8 Netlynx Communication Server Andrew Corporation +04F9 Netlynx Communication Server Andrew Corporation +04FA Netlynx Communication Server Andrew Corporation +04FB Netlynx Communication Server Andrew Corporation +04FC Netlynx Communication Server Andrew Corporation +04FD Netlynx Communication Server Andrew Corporation +04FE Netlynx Communication Server Andrew Corporation +04FF Netlynx Communication Server Andrew Corporation +0500 Netlynx Communication Server Andrew Corporation +0501 Netlynx Communication Server Andrew Corporation +0502 Netlynx Communication Server Andrew Corporation +0503 Netlynx Communication Server Andrew Corporation +0504 Deskview X Quarterdeck Office Systems +0505 Print Server Add-On Intel Corp. +0506 Index Sequential Access NLM Infopoint Systems +0507 Associative Index Server Infopoint Systems +0508 Netscribe Server Meridian Data Corp +0509 Print Server For Remote Wkstn. Fuji Xerox Co Ltd +050A Netmagic Bindery Id Net Magic Systems Inc +050B Financial Market Information Srvr AT Financial +050C Network Modem Nanagram +050D Network Modem Nanagram +050E Document Management Service Imagery Software Inc +050F Image Management Service Imagery Software Inc +0510 Mass Storage Service Imagery Software Inc +0511 Database Server Tobit Software Gmbh +0512 Teli-Link Voice Server Computer & Communications Co +0513 Print Server Emulex Corporation +0514 1012 Hub Agent Asante Technologies +0515 1012 Hub Agent Asante Technologies +0516 1012 Hub Agent Asante Technologies +0517 1012 Hub Agent Asante Technologies +0518 1012 Hub Agent Asante Technologies +0519 1012 Hub Agent Asante Technologies +051A 1012 Hub Agent Asante Technologies +051B 1012 Hub Agent Asante Technologies +051C 1012 Hub Agent Asante Technologies +051D 1012 Hub Agent Asante Technologies +051E Network Modems Lansource Technologies +051F Application Programs University Of Plymouth +0520 Bloomberg Audio Server Bloomberg Lp +0521 Bloomberg Process Server Bloomberg Lp +0522 Net Modem Server Practical Peripherals Inc +0525 Agent For Hub Management Idea Courier +0526 Named Pipe Communications Service Symantec Peter Norton Group +0527 Print Server/remote Printer Pacific Data Products +0528 Print Server Seiko Epson Corp +0529 Interserver File Copying Bankers Trust Co +052A Fax & Voice Server Dca +052B Angora Enterprise Gateway Rabbit Software Corp +052C Remote Login Terminal Gordian +052D OS/2 Application Server Citrix Systems +052E Bloomberg Media Touch Systems +052F Microcom Remote Access Server Microcom Inc +0530 Remark Voice Server Simpact & Assoc Inc +0531 IPX Communication Server Symantec Peter Norton Group +0532 Access Server For Modem Sharing Bay Technical Associates +0533 Visa Gateway Hemko Systems Corp +0534 Device Location Via Remote Config Milan Technology Corp +0535 Device Location Via Remote Config Milan Technology Corp +0536 Device Location Via Remote Config Milan Technology Corp +0537 Device Location Via Remote Config Milan Technology Corp +0538 Device Location Via Remote Config Milan Technology Corp +0539 Device Location Via Remote Config Milan Technology Corp +053A Device Location Via Remote Config Milan Technology Corp +053B Device Location Via Remote Config Milan Technology Corp +053C Device Location Via Remote Config Milan Technology Corp +053D Device Location Via Remote Config Milan Technology Corp +053E Remoted SMS Server New Era Systems Services Ltd +053F Listener/netware Sterling Tefen Lab +0540 Listener/dos Sterling Tefen Lab +0541 Listener/windows Sterling Tefen Lab +0542 Listener/os2 Sterling Tefen Lab +0543 Listener/mac Sterling Tefen Lab +0544 Listener/unix Sterling Tefen Lab +0545 Techra Client/server Rdbms Kvatro As +0546 Docra Cl/Sr Doc Mgmt System Kvatro As +0547 Voice/fax Responding Machine System Sophia +0548 I4/ls Naming Service Gradient Technologies +0549 TNSI Network Utilities Toadally Network Systems Inc +054A RM3 Configuration Cayman Systems Inc +054B SNMP Configuration Cayman Systems Inc +054D Imagesolve Ofs Imagesolve International +054E District Communication Gateway Chancery Software Ltd +054F District Link Chancery Software Ltd +0550 EDM Client/Pc Computer Vision +0552 Security Object Bank Of New Zealand +0555 Printers, Plotters & Routers Seiko Instruments Inc +0556 Fax Services Oaz +0557 Fax Services Oaz +0558 Fax Services Oaz +0559 At&t Joint Venture Telephony Srvr Novell Inc. +055A At&t Joint Venture Telephony Srvr Novell Inc. +055B At&t Joint Venture Telephony Srvr Novell Inc. +055C At&t Joint Venture Telephony Srvr Novell Inc. +055D Hostview Utility Attachmate Corp +055E Print Server Lexmark International Inc +055F Print Server Lexmark International Inc +0560 Print Server Lexmark International Inc +0561 Print Server Lexmark International Inc +0562 Statistics Gathering Agent Netcraft Software Development +0563 Erl Database Server Silver Platter Information Ltd +0564 Erl Directory Server Silver Platter Information Ltd +0565 Newswire Notification Generation Technologies Corp +0566 Ziff Proprietary Services Ziff Information Services +0567 Time Server NLM Meinberg Funkuhren +0568 X-Base Database Server Extended Systems +0569 Advertising Media-Db Server Ravi Technologies Inc +056A Oem Remote Access For Ethernet Shiva Corp +056B Oem Remote Access For Tokenring Shiva Corp +056C Remote Access For Ethernet Shiva Corp +056D Remote Access For Tokenring Shiva Corp +056F Med Station Server Pyxis Corporation +0570 Telnet IPX Router Teletrol Systems Inc +0571 NLM Server Sr Associates/cybermedia +0572 Netmodem Server Practical Peripherals Inc +0573 Satellite Connections Ulf Zimmermann +0574 Lan/CD Server Logicraft +0576 Peer Communications Tool Intelec Systems Corporation +0577 Communication Server Norman Data Defanse Systems +0578 Modem Sharing Software Seg +0579 Hops Database Server Hops International +057A Datafile Access Handler Lms +057B Novus Gateway Product Firefox Communications +057C Lgs Interconections +057D Lgs-Pft Interconections +057E Lgs-Pps Interconections +057F Tn 3270 Gateway Bus Tech Inc +0580 Mcafee Virus Pattern Server Mcafee Associates +0581 Optical Server Optisys +0582 Proride X.500 Ldap Support Control Data Systems +0583 Net Trax Alarm Monitor Net X Corp +0584 Net Trax File Server Agent Net X Corp +0585 Net Trax Workstation Agent Net X Corp +0586 Net Trax Bridge Agent Net X Corp +0587 Team Office Product Icl Personal Systems Oy +0589 Hyperdesk Distribute Object Mgmt Hyperdesk +058A Hyperdesk Database Type Hyperdesk +058B TCP/superlat Host Print SAP Meridian Technology Corp +058C Ocs Safeserver Omnitech Corporate Solutions +058D Jukebox User Group Todd Enterprises Inc +058E Full Screen Login Confirm +058F Meeting Space Server World Benders Inc +0590 Lan Product Server Bmc Software Inc +0591 CBT Server First Class Systems +0592 Net Tune Service Hawknet Inc +0593 Print Server Ricoh Company Ltd +0594 Remote Printer Ricoh Company Ltd +0595 Slathp Status NLM Meridian Technology Corp +0597 IPX Named Pipes Communication Srvr Symantec Peter Norton Group +0598 Appmeter For Suites Funk Software +059C Serverlog Diamond Software Inc +05A0 Service Location Protocol Eicon Technology +05A1 Nms Icons Networth Inc +05A2 Nms Icons Networth Inc +05A3 Nms Icons Networth Inc +05A4 Nms Icons Networth Inc +05A5 Nms Icons Networth Inc +05A6 Nms Icons Networth Inc +05A7 Nms Icons Networth Inc +05A8 Nms Icons Networth Inc +05A9 Nms Icons Networth Inc +05AA Nms Icons Networth Inc +05AB Nms Icons Networth Inc +05AC Nms Icons Networth Inc +05AD Nms Icons Networth Inc +05AE Nms Icons Networth Inc +05AF Nms Icons Networth Inc +05B0 Nms Icons Networth Inc +05B1 Nms Icons Networth Inc +05B2 Nms Icons Networth Inc +05B3 Multi-System Manager - Netview Ibm - Research Triangle Park +05B4 Online Transaction Transp. Srvr Abg Technology/united Card Svc +05B6 Datastar NLM Apertus Technologies +05B7 DS_LCC - Logical Link Controller Apertus Technologies +05B8 Database Management Services Revelation Technologies +05B9 Distribution Services Discovery Ibm - Rome +05BA Managing Hardware Routers Compatible Systems Corp +05C0 Calendar Server Campbell Services Inc +05C1 Network Management Application Xircom +05C2 Network Management Application Xircom +05C3 Network Management Application Xircom +05C4 Network Management Application Xircom +05C5 Network Management Application Xircom +05C6 Network Management Application Xircom +05D9 Ethernet-Managed Stackable Hub Ibm - Research Triangle Park +05E4 Filenet Network Clearinghouse File Net +05E5 Hpcs Data-Based Products Tobit Software Gmbh +05E6 Ast SNMP Instrumented Server Ast Research Inc +05EB Office Extend Server Fransen King +05EC Windows Nt Named Pipe Server Optus Information Systems +05ED Gateway Server Fujitsu Ltd +05EE Bindery File Fujitsu Ltd +05EF Fax Workstation Object Sofnet Inc +05F2 Router Administration Server Livingston Enterprises +05F3 Cl/S Array Monitor Program Allodyne Inc +05F4 Evergreen Management Agent Goodall Software +05F5 Windows Bulletin Board System Pacer Software +05F8 Ups SNMP Monitor NLM Computer Site Technologies Inc +05FA Goodall Virtual Protocol Adaptor Goodall Software +0603 Time Card Server Advanced Management Solutions +0606 Image Server Address Look-Up Watermark Software +0607 Arts Rlogind Server American Real Time, Reuters Co +0608 Arts Generic Server American Real Time, Reuters Co +0609 Arts Ruupd - Are You Up Daemon American Real Time, Reuters Co +060A Money Center Data Server Knight Ridder Financial Inc +060C Axis Printer Server Axis Communications Ab +060D Unix Mail Server Felpausch +0610 Scsi Management Adaptec +0611 Stealth Event Capture Engine Intelligence Quotient Intl Ltd +0613 Universal Data Transporter Conseil Formation Et Developpe +0614 Communication Software (NLM) NEC - Nippon Electric Company +0615 Communication Software (NLM) NEC - Nippon Electric Company +0616 Fax Gateway Server Russell Consulting +061C Print Server Emulex Corporation +061D Print Server Emulex Corporation +061E Print Server Emulex Corporation +061F Print Server Emulex Corporation +0620 Print Server Emulex Corporation +0625 Setup Manager Access Control Maximized Software +062F Metering Program Secure Design +0636 Comet Terminal Server Goodall Software +0637 Comet File Server Goodall Software +073D Connect:direct NLM Server Sterling Software +073E Connect:direct NLM Server Sterling Software +073F Connect:direct NLM Server Sterling Software +0740 Connect:direct NLM Server Sterling Software +0741 Connect:direct NLM Server Sterling Software +0742 Connect:direct NLM Server Sterling Software +0743 Maxserv 3270 Maxserv +0744 Maxserv Price Maxserv +0745 Maxserv Mail Maxserv +0746 Maxserv Macs Maxserv +0747 Maxserv Reserved Maxserv +0748 Maxserv Reserved Maxserv +0749 Tasking IPX/lwsi Gateway Tasking Software Bv +074D NLM Applications Knx Ltd +074E NLM Applications Knx Ltd +074F NLM Applications Knx Ltd +0750 NLM Applications Knx Ltd +0753 STP Protocol Service Agent Digital Technologies +0754 Ind$file File Transfer Agentt Digital Technologies +0755 Kalpana Switches Kalpana +0756 Chat Server Microsoft +0757 Titanium Database Engine Micro Data Base Systems Inc +0758 Tcs Communication Server Micro Tempus Inc +0759 Pc Communication Partner Sap Fujitsu Ltd +075A Pc Communication Partner Sap Fujitsu Ltd +075B Pc Communication Partner Bindery Fujitsu Ltd +075C Dpc Server SAP Fujitsu Ltd +075D Dpc Server Bindery Fujitsu Ltd +075E Cam Host Tmd Consulting +075F Server Monitoring Application Softwork Gmbh +076A Alarm Manager NLM Conner Peripherals +076B Event Manager NLM Conner Peripherals +076D Desktop Management NLM Advanced Modular Solutions Inc +0770 Real-Time Integration Services Industrial Peer To Peer +0771 Landeep Server Monitor Deerfield Computer Solutions +0773 Hitecsoft Api Manager Hitecsoft Corp +0774 Hitecsoft Public Library Hitecsoft Corp +0775 Hitecsoft Phone Server Hitecsoft Corp +077B Advantage X-Base Server Extended Systems +077F Security Auditor Secure Design +0B29 Site Lock LAI +0C29 License Profile Integrity Software +0C2A Virus File List Integrity Software +0C2C Global License Sap Integrity Software +0C31 License Report Definition Integrity Software +2380 Site Lock (licensing?) +238C Meeting maker +4088 Chat Server (Shareware Pkg) +4808 Site Lock Server Brightworks +5555 Site Lock User +6F00 3270 Rabbit Gateway +7F82 Tapeware Agent +9620 License Profile Administrator Integrity Software + + +# Object types are reserveb by Novell 0000-7FFF +# 8000 - FFFE can be assigned dynamically +# Some products use static numbers within this range.. + +8002 NPxxx = Netport (other uses known) Intel +8707 Frye utilities Frye +8888 Quick NW mngmnt/ Wordperfect NW ? +9000 Netshield McAfee +9009 Pegasus Mail David Harris +B0EF Access Workstation Quality Netware Tools BV +E0F0 Castaway! / Qview printqueue ? +F11F Sitelock + +# FFFF is a special type: used to query all server/object types + +FFFF All Types Novell Inc. \ No newline at end of file diff --git a/NWTP/XBINDRY/SCANBIND.BAK b/NWTP/XBINDRY/SCANBIND.BAK new file mode 100644 index 0000000..ddce16d --- /dev/null +++ b/NWTP/XBINDRY/SCANBIND.BAK @@ -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(' *'); + 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(' '); + 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. diff --git a/NWTP/XBINDRY/SCANBIND.EXE b/NWTP/XBINDRY/SCANBIND.EXE new file mode 100644 index 0000000..e362396 Binary files /dev/null and b/NWTP/XBINDRY/SCANBIND.EXE differ diff --git a/NWTP/XBINDRY/SCANBIND.PAS b/NWTP/XBINDRY/SCANBIND.PAS new file mode 100644 index 0000000..e780874 --- /dev/null +++ b/NWTP/XBINDRY/SCANBIND.PAS @@ -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(' *'); + 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(' '); + 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. diff --git a/NWTP/XBINDRY/SUPEQ.PAS b/NWTP/XBINDRY/SUPEQ.PAS new file mode 100644 index 0000000..3a8467e --- /dev/null +++ b/NWTP/XBINDRY/SUPEQ.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XBINDRY/SWAPNAME.PAS b/NWTP/XBINDRY/SWAPNAME.PAS new file mode 100644 index 0000000..c6ba0b9 --- /dev/null +++ b/NWTP/XBINDRY/SWAPNAME.PAS @@ -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 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. diff --git a/NWTP/XBINDRY/TSTBIND.PAS b/NWTP/XBINDRY/TSTBIND.PAS new file mode 100644 index 0000000..ee1b9a8 --- /dev/null +++ b/NWTP/XBINDRY/TSTBIND.PAS @@ -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(' 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(' 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. \ No newline at end of file diff --git a/NWTP/XCONN/CEXPPW.PAS b/NWTP/XCONN/CEXPPW.PAS new file mode 100644 index 0000000..2830b17 --- /dev/null +++ b/NWTP/XCONN/CEXPPW.PAS @@ -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. diff --git a/NWTP/XCONN/CHKATT.PAS b/NWTP/XCONN/CHKATT.PAS new file mode 100644 index 0000000..058cb92 --- /dev/null +++ b/NWTP/XCONN/CHKATT.PAS @@ -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 '); + 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 exists... am I logged in as ? } +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. \ No newline at end of file diff --git a/NWTP/XCONN/DETACH.PAS b/NWTP/XCONN/DETACH.PAS new file mode 100644 index 0000000..7ba27e0 --- /dev/null +++ b/NWTP/XCONN/DETACH.PAS @@ -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. diff --git a/NWTP/XCONN/LOGCON.PAS b/NWTP/XCONN/LOGCON.PAS new file mode 100644 index 0000000..066ad52 --- /dev/null +++ b/NWTP/XCONN/LOGCON.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XCONN/LOGOUT.PAS b/NWTP/XCONN/LOGOUT.PAS new file mode 100644 index 0000000..c0731c1 --- /dev/null +++ b/NWTP/XCONN/LOGOUT.PAS @@ -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 (CurrSegment77) + 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. diff --git a/NWTP/XCONN/PWEXP.PAS b/NWTP/XCONN/PWEXP.PAS new file mode 100644 index 0000000..ea0f0c8 --- /dev/null +++ b/NWTP/XCONN/PWEXP.PAS @@ -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. diff --git a/NWTP/XCONN/TRCOPY.PAS b/NWTP/XCONN/TRCOPY.PAS new file mode 100644 index 0000000..1b49d17 --- /dev/null +++ b/NWTP/XCONN/TRCOPY.PAS @@ -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 '); + writeln; + writeln('Where is the name of a USER,'); + writeln('and the name of a user or group the time restrictions'); + writeln('are to be copied to. 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. \ No newline at end of file diff --git a/NWTP/XCONN/TSTCONN.PAS b/NWTP/XCONN/TSTCONN.PAS new file mode 100644 index 0000000..4eb4a6a --- /dev/null +++ b/NWTP/XCONN/TSTCONN.PAS @@ -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 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. diff --git a/NWTP/XCONN/TSTCONN2.PAS b/NWTP/XCONN/TSTCONN2.PAS new file mode 100644 index 0000000..95a171a --- /dev/null +++ b/NWTP/XCONN/TSTCONN2.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XCONN/TSTCONN3.PAS b/NWTP/XCONN/TSTCONN3.PAS new file mode 100644 index 0000000..76a3659 --- /dev/null +++ b/NWTP/XCONN/TSTCONN3.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XCONN/WHO.PAS b/NWTP/XCONN/WHO.PAS new file mode 100644 index 0000000..70f8b71 --- /dev/null +++ b/NWTP/XCONN/WHO.PAS @@ -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$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. + diff --git a/NWTP/XFILE/GETOFIL.PAS b/NWTP/XFILE/GETOFIL.PAS new file mode 100644 index 0000000..230960a --- /dev/null +++ b/NWTP/XFILE/GETOFIL.PAS @@ -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 '); + 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. diff --git a/NWTP/XFILE/LDIR.PAS b/NWTP/XFILE/LDIR.PAS new file mode 100644 index 0000000..36d3e48 --- /dev/null +++ b/NWTP/XFILE/LDIR.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XFILE/TSTDH.PAS b/NWTP/XFILE/TSTDH.PAS new file mode 100644 index 0000000..169860b --- /dev/null +++ b/NWTP/XFILE/TSTDH.PAS @@ -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(' 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(' 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. \ No newline at end of file diff --git a/NWTP/XFILE/TSTENT2.PAS b/NWTP/XFILE/TSTENT2.PAS new file mode 100644 index 0000000..241fc17 --- /dev/null +++ b/NWTP/XFILE/TSTENT2.PAS @@ -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(' 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(' 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(' 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(' 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. \ No newline at end of file diff --git a/NWTP/XFILE/TSTENTRY.PAS b/NWTP/XFILE/TSTENTRY.PAS new file mode 100644 index 0000000..9e87bd8 --- /dev/null +++ b/NWTP/XFILE/TSTENTRY.PAS @@ -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(' 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. \ No newline at end of file diff --git a/NWTP/XFILE/TSTTRUST.PAS b/NWTP/XFILE/TSTTRUST.PAS new file mode 100644 index 0000000..9ab618c --- /dev/null +++ b/NWTP/XFILE/TSTTRUST.PAS @@ -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. diff --git a/NWTP/XFILE/TSTVOL.PAS b/NWTP/XFILE/TSTVOL.PAS new file mode 100644 index 0000000..e4c3b0e --- /dev/null +++ b/NWTP/XFILE/TSTVOL.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XFILE/USPACE.PAS b/NWTP/XFILE/USPACE.PAS new file mode 100644 index 0000000..eb3f5a6 --- /dev/null +++ b/NWTP/XFILE/USPACE.PAS @@ -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. diff --git a/NWTP/XFILE/VOLSTAT.PAS b/NWTP/XFILE/VOLSTAT.PAS new file mode 100644 index 0000000..bcd8448 --- /dev/null +++ b/NWTP/XFILE/VOLSTAT.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/APPN9001.TXT b/NWTP/XIPX/APPN9001.TXT new file mode 100644 index 0000000..3be2307 --- /dev/null +++ b/NWTP/XIPX/APPN9001.TXT @@ -0,0 +1,1644 @@ +(Note: AppNotes September 1990) + +NetWare Communications Processes + + Paul Turner + Consultant + Systems Engineering Division + +Abstract: + +This AppNote provides a comprehensive explanation of the protocols and +algorithms that govern communications in the 286-based NetWare, NetWare +386, and Portable NetWare environments. Topics covered include routing +and connection control. + +Disclaimer + +Novell, Inc. makes no representations or warranties with respect to the +contents or use of these Application Notes (AppNotes) or any of the +third-party products discussed in the AppNotes. Novell reserves the right +to revise these AppNotes 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 AppNotes, 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 + +This AppNote is a preliminary excerpt from an upcoming Novell Systems +Engineering Division research report entitled "NetWare Internals and +Structure." It provides a technical description of the protocols that +make client-server communications possible on NetWare networks. The +information contained in this document will be most valuable to those +individuals designing, implementing or administrating large NetWare +internetworks. It will also be useful to individuals and organizations +developing applications specifically for NetWare. + +The document begins with an explanation of the packet structures defined +by each protocol. It then describes the algorithms followed by +workstations, routers and file servers when transmitting or receiving +packets. + +Protocols + +Most computer networks require that information transferred between two +nodes be broken up into blocks, called packets. This packetizing makes +the information more manageable for the sending and receiving nodes, and +any intermediate nodes (bridges or routers). In addition to the +information, or data, that is being transferred, each packet contains +control information used for error checking, addressing, and other +purposes. The protocols being used on the network define the content of +this control information. In most cases multiple protocols exist within a +packet; each protocol defines a different portion of the control +information for the packet and the control information for each protocol +serves a different purpose. When multiple protocols are used, the control +information for the highest level protocol is first placed around the +data, then the control information for each subsequent protocol in the +protocol stack is added to the beginning and/or end of the packet. This +is called envoloping. (See Fig. 1.) + +The enveloping pattern illustrated in Fig. 1 is common in the computer +communications industry but the tasks assigned to each protocol in the +packet differs for different vendor's implementations. In an effort to +standardize the definition of protocols-and therefore make the networking +implementations of different vendors interoperable-several standards +organizations have been formed by governments and corporations. One of +these, the International Standards Organization (ISO), has developed a +model, called the Open Systems Interconnection (OSI) model, that +specifies how protocols should be defined in the future. The OSI model +separates the functions required for effective computer communications +(such as error checking and addressing) into seven catagories, or layers. +These layers are the Application, Presentation, Session, Transport, +Network, Data-Link and Physical layers. + +: Example of Multiple Protocols in a Packet + + Having been defined prior to the finalization of the OSI model, the +protocols used by NetWare do not all correspond exactly to the OSI +model's definitions. NetWare uses a variety of protocols. Some of these +protocols were developed specifically for NetWare; some are used +throughout the networking industry. The protocols required for +communications between NetWare workstations and file servers are the +following: + +o Medium-access Protocols + +o Internetwork Packet Exchange (IPX) + +o Routing Information Protocol (RIP) + +o Service Advertising Protocol (SAP) + +o NetWare Core Protocol (NCP) + +Fig. 2 provides a relative mapping of the NetWare protocols-also called +the NetWare protocol stack-to the OSI model; in actuality, a direct +correlation to the layer boundaries of the two architectures does not +exist. The NetWare protocols follow the enveloping pattern shown in Fig. +1. More specifically, the upper level protocols (NCP, SAP, and RIP) are +enveloped by the IPX and IPX is subsequently enveloped by the medium- +access protocol header and trailer. + +: Mapping of NetWare Protocols to OSI Model + +Medium-Access Protocol Implementations + +A number of medium-access protocols have been defined, many of which are +used with NetWare. The focus within this document is on the +implementations of medium-access protocols, the most common of which are +802.5 Token-Ring, 802.3 Ethernet, Ethernet v2.0, and Arcnet. The 802.x +protocols have been defined by the Institute of Electrical and Electronic +Engineers (IEEE). Ethernet v2.0 was co-developed by Xerox and Digital +Equipment Corporation, and Arcnet was developed by Datapoint, Inc. These +medium-access protocol implementations are primarily concerned with the +transport of packets from one node to another on a single network +segment. + +Medium-access protocols provide bit-level error checking in the form of a +cyclic redundancy check (CRC). This CRC, which is appended to every +packet that is transmitted, assures that 99.9999 percent of the packets +successfully received will be free of corruption. In view of this level +of integrity, NetWare does not provide any additional bit-level error +checking within any of its upper-level protocols. (Note that bit-level +error checking checks to make sure that bits within a packet have not +been corrupted. The packet-level error checking discussed later checks +that complete packets are not lost.) + +Medium-access protocol implementations define the addressing that +distinguishes each node on a NetWare network. This addressing is +implemented within the hardware of each network interface card (NIC). To +move a packet to the proper node on a network, a medium-access control +(MAC) header is placed at the beginning of every packet. This header +contains source and destination node address fields to indicate where the +packet originated and where it is going. Each NIC checks the destination +address in the MAC header of each packet sent on the network segment is +is attached to. If the destination address matches the NIC's own address, +or if the packet is a broadcast packet intended for all nodes, the NIC +will copy the packet. + +Bit-level error checking and node addressing are provided by the majority +of medium-access protocol implementations. IBM's Token-Ring (802.5) +implementation defines a method of routing called source routing. Source +routing allows ring segments to be interconnected by bridges, allowing +administrators to segment network traffic. This requires that each +workstation maintain a table of routes to the nodes it is communicating +with. Furthermore, routing information must be included in the MAC header +of each packet it sends. This information instructs bridges how to +properly forward each packet to its destination. Source routing can be +used instead of or in conjunction with NetWare routing. + +Internetwork Packet Exchange (IPX) + +The IPX protocol was adopted by Novell from Xerox Network System's (XNS) +Internet Datagram Protocol. IPX is a datagram, connectionless protocol +that does not require an acknowledgment for each packet sent. This packet +acknowledgment, or connection control, must be provided by protocols +above IPX. IPX defines internetwork and intranode addressing schemes, +while relying on the network hardware for the definition of node +addressing. + +The network number assigned in NETGEN (NetWare 2.1x) is the basis of +IPX's internetwork addressing. Each network segment on a NetWare +internetwork must be assigned a unique network number. This network +number is used by routers to forward packets to their final destination +segment. + +The IPX intranode address comes in the form of socket numbers. Since +several processes are normally operating within a node, socket numbers +provide a sort of mail slot so that each process can distinguish itself +to IPX. As a process needs to communicate on the network, it requests +that a socket number be assigned to it. Any packets that IPX receives +that are addressed to that socket are passed on to the process. Hence, +socket numbers provide a quick method of routing packets within a node. + +Novell has reserved several socket numbers for specific purposes. These +are shown in Fig. 3. Since socket numbers are internal to each node, +several workstations can use the same socket number at one time without +any fear of confusion. All NCP requests from workstations must be +addressed to socket 451h. + +: Socket Numbers Used in The NetWare Environment + +The network, node, and socket addresses for the both the destination and +the source are held within the packet's IPX header. The IPX header is +placed after the MAC header and before the packet data. (Packet data is +usually the header of a higher-level protocol.) Fig. 4 illustrates the +structure of an IPX packet on an 802.3 network. + +: Structure of an IPX Packet + +Routing Information Protocol + +The Routing Information Protocol (RIP) facilitates the exchange of +routing information on a NetWare internetwork. Like IPX, the RIP was +derived from XNS. However, an extra field was added to the packet +structure to improve the decision criteria for selecting the fastest +route to a destination. This change prohibits the straight integration of +NetWare's RIP with other undeviating XNS implementations. + +The single packet structure defined by the RIP allows the following +exchanges of information: + +o Workstations locate the fastest route to a network number by + broadcasting a route request (represented by "Route Request" entry + on the TRACK ON screen). + +o Routers request routing information from other routers to update + their own internal tables by broadcasting a route request + (represented by "Route Request" entry on the TRACK ON screen). + +o Routers respond to route requests from workstations and other + routers. + +o Routers perform periodic broadcasts to make sure that all other + routers are aware of the internetwork configuration. + +o Routers perform broadcasts whenever they detect a change in the + internetwork configuration. + +The RIP packet structure is shown in Fig. 5. This structure is enveloped +within the data area of IPX. The Operation field indicates whether the +packet is a request or a response. A 1 in this field indicates a request +and a 2 indicates a response. The Operation field can be followed by one +or more (n) sets of information, each consisting of a network number and +the number of Hops and Ticks to that network number. A RIP packet can +contain a maximum of 50 sets of network number information. + +The term "Hops" refers to the number of routers that must be passed +through to reach a network number. A "tick" is roughly 1/18 of a second +(there are 18.21 Ticks in a second, to be precise). The number of Ticks +measures how much time the packet takes to reach a network number. The +number in this field is always at least one. The original XNS definition +of the RIP did not include the Number of Ticks field. The Ticks field was +added by the developers of NetWare so that the NetWare shell could +estimate how long it should wait for a response from a file server. (This +will be explained in the discussion of the shell's receive time-out.) +Also, if multiple routes exist to a network number, a router uses the +route with the shortest number of Ticks when forwarding packets to that +network number. + +If a RIP packet is a request for information, only the Network Number +field applies; the Hops and Ticks fields are essentially nulled out. A +response packet can be either a reply to a request from a router or +workstation or a periodic broadcast by a router. + +: RIP Packet Structure + +Service Advertising Protocol (SAP) + +The Service Advertising Protocol (SAP) allows service-providing nodes- +such as file servers, print servers, and gateway servers-to advertise +their services and addresses. The SAP makes the process of adding and +removing services on an internetwork dynamic. As servers are booted up, +they advertise their services using the SAP; when they are brought down, +they use the SAP to indicate that their services will no longer be +available. + +Through the SAP, clients on the network can determine what services are +available on the network and obtain the internetwork address of the nodes +(servers) where they can access those services. This is an important +function, since a workstation cannot initiate a session with a file +server without first having that server's address. + +A gateway server, for instance, will broadcast a SAP packet every 60 +seconds (the period defined for all servers advertising with the SAP) +onto the network segment it is connected to. The SAP agent in each router +on that segment copies the information contained in the SAP packet into +an internal table called the Server Information table. Because the SAP +agent in each router keeps up-to-date information on available servers, a +client wanting to locate the gateway server can access a nearby router +for the correct internetwork address. + +Like the RIP, the SAP uses IPX and the medium-access protocol for its +transport. Fig. 6 illustrates the SAP packet structure. The first field +defines the operation that the packet is performing. The packet can +perform five different operations: + +o A workstation request for the name and address of the nearest server + of a certain type (this is represented by a "Get Nearest Server" + entry on a TRACK ON screen.) + +o A general request, by a router, for the names and addresses of + either all the servers or all the servers of a certain type on the + internetwork ("Send All Server Info." on TRACK ON.) + +o A response to either a "Get Nearest Server" request ("Give Nearest + Server" entry on TRACK ON) or a general request + +o Periodic broadcasts by servers and routers + +o Changed server information broadcasts + +Following the Operation field are one or more sets of fields. Each set +includes a service type server name, network address, node address, +socket number and a number of Hop fields. If the packet contains +information about more than one server, it will contain more than one set +of fields (n sets of fields). Each SAP packet can contain information +about up to seven servers. + +: SAP Packet Structure + +NetWare Core Protocol + +The NetWare Core Protocol (NCP) makes interaction between clients and +file servers possible by defining two aspects of their interaction, +connection control and service request encoding. Because the creation and +handling of NCP packets is done by the NetWare shell or NetWare Requester +for OS/2, you do not need an in-depth understanding of the NCP,but you +should have some idea of what the protocol does. + +The NCP provides its own session control and packet-level error checking +instead of relying on other protocols for these functions. Consequently, +the modularity of the protocol stack is reduced but, in the long run, a +more efficient mechanism is attained. Fig. 7 shows the general structure +of an NCP packet. When a client establishes a session with a file server, +it is assigned a connection number. This connection number must be +included in all subsequent service requests that the client submits. The +connection number allows the file server to keep track of which clients +are making requests, for response and security purposes. + +: Structure of an NCP Packet + +Each NCP request packet submitted on a given connection must be assigned +a sequence number by the client. The first request following the +establishment of the connection is assigned the number 1; that number is +incremented by one for each subsequent request. When a file server +finishes processing a request, it places the sequence number for that +request in the response packet. Hence, the client can make sure that it +is receiving the correct responses for the requests that it submits. + +Each of the services available at a NetWare file server has been assigned +a number. When it needs to submit a request to a server, the shell or +requester places the number-as well as any additional information that +might be needed-in the service code field of the NCP packet. Depending on +the service being requested, the NCP might provide additional fields for +the shell to give specific instructions to the file server-such as which +part of a file to read. The file server might report any problems or +errors that might have occurred while processing the request in these +additional fields. + +Packet Delivery + +On a NetWare network, the successful delivery of a packet depends on the +proper addressing of the packet and the internetwork configuration +(whether it is a single segment network or series of segments +interconnected by repeaters, bridges and/or routers). The addressing of +the packet is handled in its medium-access protocol and IPX address +fields. To send a packet to another node, the sending node must know the +full internetwork address (network, node, and socket) of the node it +desires to send to (the destination node). (The process of obtaining +another node's address is explained in the section entitled "Establishing +a Connection.") Once the sending node has the destination node's address +it can proceed with addressing the packet. The way the MAC header of that +packet is addressed, however, depends on whether the sending and +destination nodes are separated by a router. + +In the event that the sending and destination node are on the same +network segment-that is, they both have the same IPX network address-the +sending node addresses the packet in the following way: The node address +of the destination node is placed in the MAC header destination address +field. The node address of the sending node is placed in the MAC header +source address field. The full internetwork address of the destination +node is placed in the IPX header destination address fields. The full +internetwork address of the sending node is placed in the IPX header +source address fields. + +Fig. 8 shows an example of two nodes that are connected to network number +AA. The sending node (node 01) sending a packet to node 02. The sending +node places node address 02 in the destination field and node address 01 +in the source field of the MAC. In the destination address fields of the +IPX header, the sending node places AA, 02 and 451 (the full internetwork +address of the receiving node). The sending node places its own +internetwork address of AA, 01 and 4003 in the source address fields of +the IPX header. + +: Transmission to Same Network Segment (No Routing Required) + +Network Interconnection Devices + +The addressing method depicted in Fig. 8 is used when the two nodes +reside on the same physical segment (or ring) or if they reside on +separate segments interconnected by repeaters or bridges. A repeater is a +Physical Layer (OSI model) device that amplifies the signal of one +segment onto one or more other segments. Repeaters are used to extend the +maximum possible distance between end nodes on a segment. They are +completely transparent to the sending and receiving nodes. + +A bridge is a Data-Link Layer device used to interconnect cable segments +locally or over wide area network links. Instead of simply amplifying a +signal as repeaters do, bridges retransmit packets received on one +segment onto another segment. Bridges are considered Data-Link Layer +devices because they examine the data-link (or MAC header) portion of +packets before retransmitting them onto other segments. There are two +predominant types of bridges, transparent bridges and source routing +bridges. + +Transparent bridges interconnect two or more segments. They examine the +MAC header source and destination fields of every packet transmitted on +their connected segments. From the source address fields of packets, +these bridges develop a table of the nodes that reside on (or are +accessible through) each of their connected segments. With this table of +information, a bridge can determine whether packets should be passed on +to other segments. + +Fig. 9 shows a transparent bridge connected to two separate segments. +After examining the packets transmitted on both segments it creates a +table that tracks which nodes exist on each segment. With this table, the +bridge can filter unnecessary traffic. For instance, if node 1 sends a +packet to node 5, the bridge will not retransmit that packet on its port +B. It will, however, retransmit packets sent from node 1 to node 7. Like +repeaters, transparent bridges-as their name implies-are transparent to +the sending and receiving nodes. + +: Example Transparent Bridge + +Routers + +Routers, like bridges, interconnect different network segments; however, +the operation of routers and bridges is quite different. Routers by +definition are network layer devices. (See Fig. 10.) In other words, +routers receive their instructions for forwarding a packet from one +segment to another from a network layer protocol. The network layer +protocol that routers use in the NetWare environment is IPX. NetWare- +compatible routers are available with NetWare or from third-party +manufacturers. The routers that come packaged with NetWare have actually +been misnamed bridges in the past. The NetWare routers include what has +been called the internal bridge within NetWare file servers and external +bridge installed at workstations. Novell has officially renamed these two +devices internal router and external router. + +NetWare-compatible routers may be configured to interconnect two or more +segments. Each of these segments, however, must be assigned a unique IPX +network number to distinguish it from other segments on the internetwork. +A segment's network number must be configured into each of the routers +connected to that segment. The network number serves as a common address +for each node connected to a segment. + +: OSI Representations of Network Devices + +Packet Routing + +When a node wants to send information to another node, it must first have +network address-as well as the node address-of the destination node. If +the two nodes have the same network number (reside on the same segment), +the sending node can simply send packets to the destination node using +method illustrated in Fig. 8. On the other hand, if the two nodes have +different network numbers (reside on different network segments), the +sending node must find a router on its own segment that can forward +packets to the destination node's network segment. To find this router, +the workstation broadcasts a RIP packet requesting the fastest route to +the destination node's network number (RIP requests are discussed in more +detail later in the section entitled "Establishing a Connection". This +RIP request is responded to by the router residing on the sending nodes +segment with the shortest path to the desired segment; in the response, +the router includes its node address. + +Once the sending node receives the router's node address, it is prepared +to send packets to the destination node. The sending node addresses these +packets in the following way: It places the destination node's +internetwork address (network, node and socket number) in the destination +address fields of the IPX header. Next the sending node places its own +internetwork address in the source address fields of the IPX header. Then +the sending node places the node address of the router-the one that +responded to the RIP request-in the destination address field of the MAC +header. The sending node places its own node address in the source +address field of the MAC header. (See Fig. 11.) + +: Packet Addressing Through a Router + + When a router receives a packet to be routed, it can take one of two +possible actions. If the packet is destined for a network number that the +router is directly connected to, the router will place the destination +node address from the IPX header in the destination address field of the +MAC header, place its own node address in the source address field of the +MAC header, and transmit the packet. (See Fig. 11.) + +If the router is not directly connected to the segment that the final +destination node resides on, however, it will send the packet to the next +router in the path to the destination node. To forward the packet to +another router, the router will place the node address of that other +router in the destination address field of the MAC header. The router +will place its own node address in the source address field of the MAC +header. The router leaves the IPX header as initially set by the sending +node and sends the packet. + +Routing Information Administration + +To forward packets by the best possible route, NetWare routers maintain a +Routing Information table that holds information about all the network +segments on the internetwork. Fig. 12 gives an example of a Routing +Information table (only the fields pertinent to this discussion have +been included). Each entry in the Routing Information table gives the +router forwarding information for a network segment. + +: Portion of Routing Information Table + +The first field contains the network numbers for segments that the router +is currently aware exist. The router simply matches the destination +network number in the packet's IPX header with an entry in this field to +get its forwarding instructions for the packet. The second field +indicates the number of routers that must be traversed to reach the +network segment. + +An estimate of the time necessary to reach the destination segment is +recorded in the third field. The initial time estimate for a segment is +the responsibility of the driver directly connected to it. This driver +reports this estimate to its router. This time estimate is used by the +router in its periodic broadcasts to indicate the time necessary to +deliver a packet to a node on that segment. The method that drivers use +for estimating the time delay on a segment depends on the segment type. +For local segments with more than 1 Mb/sec of bandwidth (Token-Ring, +Ethernet, Arcnet, and so on), the driver makes the assumption that +delivery time is one tick. For remote segments (T1, 64 kbps, X.25, and +asynchronous), the driver will periodically poll to determine the current +time delay. For instance, the delay for a T1 link normally ranges from +six to seven Ticks. If this delay changes, the driver will inform its +router. As information about the segment is passed along throughout the +network (by way of periodic broadcasts), routers will add any additional +delay that they impose to the initial time estimate for the segment. + +The NIC field of the Routing Information table records which NIC in the +router the network segment can be reached through. The Immediate Address +field contains the node address of the router that can forward packets to +each segment. If the segment is directly connected to the router, this +field will remain empty. The "Net Status" field indicates whether the +segment is directly connected to the router and whether the segment is +considered reliable. The final field is used to make sure that +information about the segment is current. + +For NetWare versions prior to 2.15c, the Routing Information table keeps +a list of all alternate routes for each network number in case the +primary shortest route to a network number goes down. In other words, if +the router can reach the segment through more than one of its NICs, it +will make a record of both routes. The fastest route, the one that +requires the least number of Ticks, will always be used as the primary +route. NetWare versions after 2.15c maintain alternate routes only if +these alternate routes require the same amount of Ticks to reach the +segment as the primary route. This reduces the size of the Routing +Information table. + +Routing Information Broadcasts + +On an internetwork, routers are constantly exchanging information with +each other to make sure that their Routing Information tables reflect up- +to-the-minute changes in the layout of the internetwork. To accomplish +this, routers transmit a series of broadcasts from the time they come up +until they are brought down. These broadcasts can be separated by the +time at which they occur: + +o Initial broadcast of directly connected network segments + +o Initial request to receive routing information from other routers + +o Periodic broadcasts (every 60 seconds) of current list of active + network numbers + +o Broadcast of change in internetwork configuration + +o Final broadcast when brought down + +Although the broadcasts occur at different times and, for the most part, +contain different information, they must follow two important rules. +First, each broadcast must be a local broadcast, addressed so that it +will not be immediately passed on, intact, by the routers that receive +it. This reduces the network traffic created by these information +exchanges. Second, routers must follow a "best information" algorithm +when providing information to other routers through a broadcast (since +the second broadcast listed above is a request for information, this rule +does not apply to it). + +Best Information Algorithm + +The purpose of routing information broadcasts is twofold: to allow a +router to share its current impression of the layout of internetwork with +other routers, and to inform the routers of an internetwork change so the +routers can update their tables. A router sends routing information +broadcasts to every network segment that it is directly connected to. The +first rule of the best information algorithm dictates that a router about +to broadcast to a particular network segment should not include any +information about other segments that it has received from the segment to +which the information is being sent. + +For example, if the router within server FS2 in Fig. 13 is going to +broadcast a routing information broadcast to network segment BB, it will +not include information that it received from FS1 about network segment +AA. If it did, someone on segment BB might erroneously conclude that +there are two paths to segment AA-one through FS1 and another through +FS2. + +: The Best Information Algorithm + +The best information algorithm also states that routers should not +include information about the network segment that they are sending +routing information broadcasts to. For example, FS2 would not include +information about BB in its broadcast onto BB. + +Taking these rules into account, the information that FS2 would broadcast +onto segment BB would be information about segments CC and DD. + +Initial and Periodic Broadcasts + +When a router is first brought up, it places the network numbers of its +directly connected segments into its Routing Information table. Then, +following the best information algorithm, the router sends a routing +information broadcast to inform the routers on its directly connected +segments of the segments that the router will be making available. The +router next broadcasts a request to each of its directly connected +segments for information about all other network segments that exist on +the internetwork. This request is responded to by all the routers (each +using the best information algorithm) on these directly connected +segments. The router places the information gleaned from these responses +in its Routing Information table. Fig. 14 illustrates this initial +sequence of broadcasts. + +: Sequence Used to Build and Maintain Routing Information Table + +Once the router has performed these initial broadcasts and updated its +Routing Information table, it is ready to accept routing requests and +route packets. In addition to routing packets, the routers will broadcast +all the information in their Routing Information table (except that +excluded by the best information algorithm) to each of their connected +network segments every 60 seconds. Routers perform these periodic +broadcasts to make sure that all routers on the internetwork remain +synchronized. + +Because of lower bandwidth of X.25 and asynchronous links, routers do not +perform 60 second broadcasts on these links-only initial broadcasts, +changed information broadcasts and final broadcasts are sent over these +links. + +Changed Information Broadcasts + +When a router receives information that causes it to change its Routing +Information table, the router will immediately pass that information on +to its other directly connected network segments except the segment that +the router received the information from. If a new network segment comes +up or an existing segment goes down, all the routers on the internetwork +will learn about the change in a short amount of time. + +The primary cause of a change in the internetwork's configuration are +file servers and external routers coming up or going down. If a router +needs to be brought down (using the DOWN command at the console) the +router will inform its directly connected segments of the fact before +discontinuing service. The router issues broadcasts (as always, using the +best information algorithm) that indicate that the network segments which +the router had made available will no longer be accessible through this +router. (See Fig. 15.) + +: Routers Inform Other Routers When Going Down + +The Process of Aging + +If a router goes down due to a hardware failure, power glitch, or power +outage, other routers will not be notified that a change has occurred. To +safeguard against this eventuality an "aging" mechanism has been built in +to NetWare routers. + +Routers maintain a timer for each entry in their Routing Information +table. Every time that information is received concerning the entry, the +timer is reset to zero. If the timer reaches three minutes, the router +assumes that the route to the network number is down and broadcasts that +fact to its other segments. Since this information is new or changed, the +routers that receive the information will pass it on immediately and the +change will quickly permeate the internetwork. + +Service Advertising + +Using the SAP, servers on a NetWare network can advertise their services +and addresses. The information that these servers broadcast is not +directly used by clients but instead collected by a SAP agent within each +NetWare router on the server's segment. The SAP agents store this +information in a Server Information table and, if they reside within a +server, in their server's bindery. The clients can then contact the +nearest SAP agent or file server for server information. + +The SAP broadcasts that servers perform are local broadcasts and, +therefore, only received by SAP agents on their connected segments. +Consequently, SAP agents periodically broadcast their server information +so that all SAP agents on the internetwork have information about all +servers that are active on the internetwork-this is the same broadcast +method used by routers to distribute and exchange network number (RIP) +information. + +Server Information Table + +The table that SAP agents use to store information received in SAP +broadcasts is called the Server Information table. If all SAP agents on +the internetwork are exchanging SAP information properly, each agent's +Server Information table should have information about all the servers on +the internetwork-thus providing clients with nearby access to the +addresses of all the servers on the internetwork. Fig. 16 illustrates +some of the more pertinent fields of the Server Information table. + +: Portion of a NetWare Router's Server Information Table + +The Server Address field contains the service's full address, including +network, node, and socket addresses. The Server Type field holds a number +designating what type of service the server provides. One server might +provide printing services as opposed to file services, for instance. The +server type designation used to assign numbers to the different services +that servers provide is part of a more generic scheme used in the bindery +to classify objects. Some of the more common object types are shown in +Fig. 17. + +: Object Types + +The Time Since Changed field is used for aging servers that have +unexpectedly gone down. The NIC that the information about the server was +received on is specified in the NIC Number field. + +The way that information within the Server Information table is stored +makes sequential access (send me information about all servers with +server type 4, for instance) possible but makes database access (send me +information about server NCS) very difficult. Therefore, the Server Name, +Server Address, Server Type and Hops to Server fields of the Server +Information table are periodically copied to file server's binderies by +internal SAP agents-SAP agents that reside within file servers. With this +information stored in file server binderies, any client that has a +connection with a NetWare file server can query the bindery for the +address of a specific server. + +Server Information Administration + +When a file server is first brought up, its internal SAP agent places the +name of the server in the agent's Server Information table. The SAP agent +then sends a SAP broadcasts onto each of its directly connected segments +to inform the SAP agents on those segments that a new server has become +available. (See Fig. 18.) + +: Sequence Used to Build and Maintain Server Information Table + +After performing its initial broadcasts, the SAP agent broadcasts a +request onto each of its directly connected segments for information +about other servers that exist on the internetwork. These requests are +responded to by all the SAP agents on these directly connected segments. +The SAP agent places the information received in these responses in its +Server Information table. Thereafter, the SAP agent performs broadcasts +about the servers that it is aware of every 60 seconds (except on +asynchronous and X.25 links). illustrates these initial and periodic +broadcasts. + +As with routing information broadcasts, all server information broadcasts +are local broadcasts and are subject to the best information algorithm. +Any changes in server information are passed on immediately to ensure +current information across the internetwork. The router applies the aging +process to its Server Information table entries in case any servers +become unavailable. Finally, if the router is brought down, it will +indicate to its directly connected segments that the servers the router +has been advertising will no longer be available. (See Fig. 19.) + +: FS2 Brought Down + +File Server Addressing + +Value-added servers, such as gateway and print servers, normally contain +only one network adapter and will use the address of that adapter as the +address they advertise in their periodic SAP broadcasts. NetWare file +servers, on the other hand, may contain multiple adapters. This requires +that they use some sort of convention for advertising the address of +their file services; the convention used for this addressing differs for +286- and 386-based servers. Within the 286-based environment, the file +services of a server are addressed with respect to its NIC A. This +convention guarantees consistency since every server will have at least +one network adapter installed. (See Fig. 20.) If you enter an SLIST +command, the address you see for 286-based servers is the network and +node address assigned to the server's NIC A. + +: Addressing of File Services on a 286-based NetWare File Server + +In the NetWare 386-based servers, an internal network has been added for +the addressing of internal services, as shown in Fig. 21. This different +method of addressing requires that an internal network number be assigned +when a NetWare 386-based file server is brought up. + +: Addressing of File Services in NetWare 386-based Server + +Fig. 22 displays an SLIST screen that contains 286- and 386-based +servers. The 386-based servers can be distinguished by their node address +of one. This node address is assigned to the file services on the +internal network number. The implementation of redundant cabling systems +with 286-based servers is discussed in a later section. + +: Example SLIST Listing + +Client-Server Interaction + +The NetWare shell facilitates client-server communications for DOS-based +workstations. In a typical client-server interaction, one station (the +client) requests services from another station (the server). Through the +shell, DOS-based applications can request file services (such as writing +to and reading from files) from NetWare file servers. At the workstation, +the shell, the user application, and the user together act as the client +requesting file services; the NetWare file server acts as the server +providing file services. + +The shell, then, is the liaison between the client (the user application) +and the server. The shell performs the tasks necessary to request file +services from a NetWare file server: for example, establishing a +connection with the file server, maintaining the connection, and +terminating the connection. + +The NetWare shell is a terminate-and-stay-resident (TSR) program called +NETx.COM (where x depends on the version of DOS being run). NETx.COM is +loaded into a NetWare workstation's memory when the workstation is +booted. Before you load the shell, however, you must load another TSR +called IPX.COM + +IPX.COM + +Novell's IPX protocol serves as the communications link with the NIC +installed in the workstation. At installation, a customized version of +IPX.COM is generated for each workstation by linking in a driver written +specifically for the NIC that resides in that workstation. Once IPX.COM +is loaded, any workstation programs, including the shell, can communicate +on the network through NetWare's IPX protocol. + +In addition to interfacing with the NIC, IPX.COM performs several +communication-related functions. For example, it manages the IPX sockets +used with the workstation. The shell and other applications access +IPX.COM to open and close IPX sockets. When the workstation receives an +IPX packet, IPX.COM checks which socket the packet is addressed to and +passes the packet to the program having that socket open. + +Finally, IPX.COM is responsible for determining the address of the +network segment to which the workstation is physically connected. The +workstation's network number, along with its node address, make up the +workstation's full internetwork address. + +IPX can determine the workstation's network number in one of two ways. In +the first method, IPX.COM watches for any RIP broadcasts sent on the +network. Since RIP packets are not forwarded to other network segments, +IPX knows that this type of broadcast originated on the segment to which +the workstation is directly connected. IPX simply reads the source +network address contained in the IPX header of a RIP broadcast to +determine the workstation's network number. + +IPX uses an alternate method if the shell requests a route to a network +number before IPX can determine the workstation's network number from a +RIP broadcast. In this case, IPX broadcasts a Get Local Target request, +which requests the fastest route to the destination network number +requested by the shell. Upon receiving a response, IPX.COM checks the +source network number in the IPX header of the response packet. This +source network number (the network number of the router that responded to +the Get Local Target request) is the workstation's network number. + +The NetWare Shell + +The shell (NETx.COM) acts as the interface between user applications and +NetWare file servers. As user applications make requests, the shell +determines whether the requests should be handled locally by DOS or sent +to a server on the network. If the shell determines that the request +should be sent to a network server, the shell formulates a request +packet, hands it to IPX.COM for transmission, and waits for a response. + +Prior to submitting any requests to a server, the shell must establish a +connection with that server. The shell can establish a connection to a +server in two ways: When the shell is first loaded at the workstation, it +logically attaches to the first server that responds (usually the server +nearest to the workstation). The LOGIN and ATTACH command line utilities, +when executed, also establish a server connection. + +To establish a connection, the workstation and the server must exchange +several packets: a packet requesting that a connection number be assigned +to the shell, and another proposing the maximum packet size that will be +allowed in the interaction between the file server and the shell. Before +sending these initial packets, the shell needs the address of the server +and a route to the server. + +Getting a Server's Address + +To get a server's address, the shell can use the SAP to broadcast a +request for the address of the nearest server-a Get Nearest Server +request. All routers on the workstation's network segment having +information about the nearest server respond to the Get Nearest Server +request. Each response contains the nearest server's name, its full +internetwork address, and the number of Hops required to reach the +server. (See Fig. 23.) + +: Getting the Address of the Nearest File Server + + When first loaded at a workstation, the shell issues a Get Nearest +Server request to establish an initial connection to a file server. If +the shell loses its connections with all file servers, it resorts to the +Get Nearest Server request method to re-establish a server connection. + +A second method the shell uses to get a server's address is to use the +NCP to access a file server's bindery. The bindery is a database within +NetWare file servers that contains information about many network +entities, including users, groups, and servers. + +Because the shell must already have a server connection before it can +access the server's bindery, the shell can use this second method only +after it has established an initial connection to a file server. The +LOGIN and ATTACH utilities use this method, as does the new "preferred +server" shell (version 3.01). These utilities allow the user to specify a +specific file server name, and then these utilities use that name to scan +the bindery for the server's address. + +Getting a Route to a Server + +Once the shell has the address of a server, it needs a route to that +address. The shell uses this route for all subsequent communications with +the server for the duration of the connection. + +To obtain a route, the shell submits a Get Local Target request to +IPX.COM. IPX first compares the network number of the desired server to +the workstation's network number. If these two numbers are the same, IPX +tells the shell to send requests directly to the server (without going +through an intermediate router). + +If the network number the shell submits and the workstation's network +number are not the same, IPX broadcasts a RIP request for the fastest +route to the submitted network number. Whichever router on the +workstation's network segment has the shortest route to the network will +respond to the request. More than one router might respond if several +routers have a route equal to the shortest route. IPX accepts only the +first router's response, discarding all others. + +IPX then returns to the shell the node address of the first router that +responded. The shell places the node address of this router in the MAC +header of a Create Connection request packet; it addresses the IPX header +of the request packet to the file server it wants to connect to. With the +packet addressed in this fashion, the router will receive the packet +first, check the IPX destination address, and forward the packet toward +the network number on which the file server resides. (See Fig. 24.) + +: Requesting the Fastest Route to an Address + +Establishing an Initial Connection + +To establish its connection to a file server, the shell uses a +combination of the SAP, the RIP, and the NCP. The sequence followed is +slightly different for the new "preferred server" shell (version 3.01) +than it is for previous shell versions. + +Fig. 25 shows the steps taken by pre-v3.01 shells to make a connection +with a file server. The first column represents the call or packet sent. +The second column lists the source, or sender, of the packet. The third +column lists the addressee of the packet. The final column indicates the +protocol used for the packet. + +: Initial Connection Sequence for NetWare Shells + +We have already seen how the first four steps work. In steps 1 and 2, the +shell obtains the address of the nearest server. Step 3 is IPX.COM's +request for the fastest route to the address that the shell received in +step 2. Step 4 is the response by all routers with the shortest route to +that segment. + +Steps 5 through 8 show the packets exchanged between the shell and the +server to establish the initial connection. Once this connection is made, +the shell moves to the background (terminates-and-stays-resident) and +returns the DOS prompt to the user. The user can then execute LOGIN.EXE +to log in to the connected server or to another server. + +The Preferred Server Shell + +The preferred server shell (v3.01 and above) features several additional +functions not offered by older versions of the shell. As its name +implies, the preferred server shell allows users to specify, either at +the command line or in the SHELL.CFG file, which server they would like +to connect with. Whether or not a preferred server is specified, the +preferred server shell goes through the same initial eight steps as the +old shells. + +If the server the shell connects to during the initial eight steps is not +the preferred server the user specified, the preferred server shell +performs several additional steps to establish a connection with the +specified server. (See Fig. 26.) + +For instance, if the workstation in Fig. 24 initially connects to FS1 and +the user specified FS3 as the preferred server, the shell will follow a +sequence similar to that shown in Fig. 25. As you can see in step 9, the +preferred server shell uses the bindery method of acquiring the server's +address. + +: Connection Sequence for the Preferred Server Shell + +Steps 11 and 12 of this preferred server sequence are not always +required. If the preferred server resides on the same network segment as +the workstation, the shell skips these two steps and sends the Create +Connection request directly to the server. The shell destroys the +connection with the initial server once it has successfully established +the connection with the preferred server. + +Another major difference between old shells and the preferred server +shell involves the receipt of Give Nearest Server responses. Older shells +accept the first Give Nearest Server response they receive and ignore all +subsequent responses. Preferred server shells accept the first response +also, but save the next four Give Nearest Server responses in case a +connection cannot be made to the first server. + +Servers respond to Get Nearest Server requests even if they have no free +connections. Consequently, older shells fail to establish a connection +(steps 5 and 6 of Fig. 25) if the first Give Nearest Server response they +receive is from a server with no free connections. The preferred server +shells, on the other hand, can refer to the next saved Give Nearest +Server response if the current attempt to establish a connection fails. + +LOGIN.EXE + +Users can run LOGIN.EXE at any time after they have established a +connection to a NetWare file server. LOGIN submits the user's name and +password to the file server for verification. It also establishes a new +server connection if the user specifies a file server in the LOGIN +command. + +If the server specified at the command line is not the one the shell is +already connected to, LOGIN follows the steps outlined in Fig. 27. Once +these steps are completed, LOGIN verifies the username and password. If +the server specified at the command line is located on the same segment +as the workstation, steps 3 and 4 are not necessary. + +: Additional Steps Performed by LOGIN.EXE + + ATTACH.EXE uses the same sequence as that described for LOGIN.EXE when +establishing connections to a file server. + +Connection Management + +Communication between any two workstations requires a certain amount of +responsibility on both sides to ensure that no information is lost. NICs +maintain error checking at the bit level in the NetWare environment. File +servers and workstation shells handle packet- and session-level error +checking; each maintains a table to handle this level of error checking. +The NCP governs the way that the connection control information is +exchanged. (It is a common misconception that SPX is used for packet +level error checking between workstations and servers; however, SPX is +only used for peer-to-peer interaction.) Every NCP packet submitted to a +NetWare file server by a client must have a connection number and +sequence number attached to it. The connection number is the number that +client was assigned by the file server when the connection was +established. The sequence number identifies each packet so that both the +server and the shell can determine when a packet is lost. + +The Shell's Connection Table + +NETx.COM (the shell) can support up to eight server connections +concurrently. NETx.COM maintains a connection table to track these +connections. (See Fig. 28.) Within each entry in this table, the shell +stores the name and full internetwork address of the server it is +connected to. If the shell is forwarding packets through an intermediate +router to the server, the node address of that router will be stored in +the Router's Node Address field. The shell's connection number and packet +sequence number are also in the table. The sequence number is set to zero +when the connection is first established and incremented with each new +request. + +: Portion of Shell's Connection Table + +The shell's connection table also maintains two time-outs. One time-out +is the maximum time that the shell will wait for a response from the +server before resending a request packet. This time-out is based on an +estimate of the time (in ticks) needed to deliver a packet to the server. +This time estimate is provided by the router in its Give Immediate +Address response. (If the workstation and the server are on the same +segment, this value is set to one tick.) The shell multiplies this +estimate by 16 and adds 10 ticks to the result to set its maximum time- +out for communications with that server. + +The Receive Time-Out is a dynamic time-out that is originally set to four +times the time estimate (received in the Give Local Target response) plus +10 ticks. + +Once initially set, the receive time-out adjusts up or down to adapt to +changing network conditions. The receive time-out is increased if the +shell issues a request to a server and does not receive a response within +its current receive time-out. The receive time-out is multiplied by one +and one-half when the first retry to the server is issued. It remains at +this new value for all subsequent retries on the request and for use on +the next request. If the next request requires a retry, the receive time- +out will be increased again. The receive time-out will continue to be +increased in this fashion until it reaches the maximum time-out. + +The shell decreases the receive time-out each time that the shell does +not have to issue a retry to a request. To decrease the receive time- +out, the shell takes the time necessary to receive a response to the last +request-the request that didn't require a retry-and multiplies that value +by two and adds 10 Ticks to it. The shell sets the new receive time-out +to the average of this calculated value and the current receive time- +out. + +The number of times that the shell will resend a request to a server is +determined by a number called the IPX Retry Count. If this count is +exceeded the shell will give up and present the user with a "Network +error on server xxxxx. Error xxxxx from network. Abort, Retry?" message. +A default for this retry count exists for all drivers. This default +differs from driver to driver but is generally between 20 and 40. The +"IPX RETRY COUNT = xx" option for the SHELL.CFG files allows the default +IPX retry count to be modified; however, some drivers will ignore this +entry in the configuration file and leave the retry count at their +default. + +The File Server Connection Table + +The file server connection table, shown in part in Fig. 29, allows the +server to keep information about each of the clients that it is +servicing. The address fields are used for addressing response packets +and for security purposes. When a packet arrives with a service request, +it contains the connection number assigned to the sender. The server +matches the packet's IPX source address (network, node, socket) with the +address registered for that connection number. If the addresses don't +match, the server regards the request as a security breach. + +: A Portion of the NetWare File Server's Connection Table + +The NIC Number and Intermediate Router's Address fields are used for +sending responses to clients. As a request packet is received, the +number of NIC that the request came in on is placed in the NIC Number +field-this number would be A, B, C, or D for NetWare v2.15c and earlier +versions, or the network number of the NIC for NetWare versions 3.0 and +above. If the packet was forwarded through one or more routers, the node +address of the last router is stored in the Intermediate Router's Address +field. Hence, when the request has been processed, the server does not +have to find a route to the client to send a response. The server places +the node address of the first router in the path to the client-from the +Intermediate Routers Address field-in the MAC header destination address +field and sends the packet through the NIC specified in the NIC number +field. Of course, it first places the client's and its own full network +address in the destination and source address fields of IPX header, +respectively. + +The Sequence Number field is used for packet-level error checking. The +Watchdog Count and Timer fields are used by the watchdog process, which +is discussed later. File servers also maintain a 100-byte reply buffer +for each of their connections. If a response to a client is less than 100 +bytes, the server will make a copy of the response in the buffer that +corresponds to that connection. If the client does not receive the +response and resends the request, the server will not have to reprocess +the request. + +Packet-Level Error Checking + +The bit-level error checking that network adapters provide detects the +corruption of individual bits within a packet. When an adapter finds that +part of a received packet is corrupted, it discards the entire packet. +Due to the driver's simple design, no mechanism exists within the driver +to request that the packet be resent or to inform the upper-layer +processes and applications that an error occurred. Therefore, the upper- +level sending process (shell or file server) must determine when a packet +has not reached its intended destination. + +In the NetWare environment, this packet-level error checking is the +responsibility of the shell. The NCP specifies that a workstation shell +can submit only one request to a server at a time. Furthermore, the +response that the server provides must fit in a single packet-the shell +should never request more than a packet's worth of information. Thus, to +guarantee that no packets have been lost, the shell only has to make sure +that it receives a completed response to each of its requests. + +Each request that a shell sends to a server has a sequence number +attached to it within the NCP header. The response that the server +returns is labeled with the same sequence number. Ultimately, the shell +is responsible for getting completed responses for each of the service +requests that it submits. If the shell does not receive a response to its +most recent request within the specified receive time-out, it will +resubmit the request. The shell continues to resubmit the request until +it receives a response or exceeds its IPX Retry count. + +Three conditions could cause a shell to time-out while waiting for a +response from a server. Fig. 30 illustrates a case in which the request +is lost in transit to the server. The workstation's timer eventually +expires and the shell resends the same request. The server receives the +second request, processes it, and sends back the response. + +: Request Lost in Transit to File Server + +In Fig. 31, the request is received by the server but the response is +lost in transit to the workstation. Once the workstation's timer reaches +its limit, the shell sends a second identical request to the server. + +When a server receives any request, it checks the request's sequence +number to see that it is one greater than the sequence number registered +in the server's connection table. If it is, the server increments that +number and processes the request as usual. However, if the two numbers +are the same, the server determines that the client, for whatever reason, +is resubmitting its last request. In some cases, the server will have a +copy of the last response. NetWare file servers maintain a 100-byte +response buffer for each of their connections. If the server is sending a +response that is less that 100 bytes in size, the server will make a copy +to that client's buffer-that is, the buffer corresponding to that +client's connection number. Since a large percentage of responses are +less that 100 bytes, a good chance exists that a server will have a copy +of the response when requests are resubmitted by clients. (This type of +response increments the Duplicate Replies Sent counter on the FCONSOLE +Statistics->LAN I/O Statistics screen.) On the other hand, if the request +was larger than 100 bytes, the server must reprocess the request and send +the response. (This type of response increments the Reexecuted Requests +counter in FCONSOLE.) + +If the response is still in transit to the workstation when the shell +times out and resubmits the request-that is, the shell receives the +completed response after resending the request-the server will send +another response, but the shell will ignore it. + +: Response Lost in Transit to Shell + +Sometimes a server may be too busy to respond within the shell's time- +out. The shell then resends the request. When the server receives this +second request, it sends a reply to the workstation stating that the +initial request was received successfully, but that the processing of it +has not yet been completed (This intermediate response increments the +Positive Acknowledgments Sent counter within the FCONSOLE Statistics->LAN +I/O Statistics screen.) When the shell receives this reply from the +server, it sets its time-out to zero and waits for the request. If the +shell's time-out expires again, it will send a third copy of the request +just in case the response was sent by the server but lost in transit. +This process will continue until the shell finally receives a completed +response. (See Fig. 32.) + +: File Server is Busy + +Connection-Level Error Checking + +The connection between a workstation and server can be lost due to a +power failure or a communications problem. Both file servers and +workstation shells are equipped to handle this eventuality. On the +workstation side, the connection is checked each time a request is made. +If the shell does not receive a response to a request after it retries a +certain number of times (the number dictated by the IPX Retry Count), the +shell assumes that a problem exists with the connection and displays a +message for the user. At this point, the user has the choice of ordering +the shell to resubmit the request again or to abort the operation +completely. + +If the operation is aborted the shell removes that connection from its +Connection table. If it does not have any other server connections, it +attempts to create a new connection with a server (using the initial +connection sequence outlined in Fig. 25). If this attempt is +unsuccessful, the shell informs the user with the following message: You +are not connected to any file servers. The shell will try to connect to a +file server whenever the current default drive is changed to an invalid +drive. . + +Connection-level error checking at a NetWare file server comes in the +form of address verification and periodic watchdog polling. When a file +server receives a request packet for a certain connection, it verifies +that the IPX source address within the request packet matches the address +recorded for that connection within its connection table. If the +addresses do not match, the server returns a response to the sender of +the request indicating that the connection number and address do not +match. + +The Watchdog Process + +When a workstation is turned off, regardless of whether the LOGOUT +command was issued, the station's connection remains occupied at the +server. To clear these unused connections, the server uses the watchdog +process to poll (send a query packet to) clients that the server hasn't +heard from for a period of five minutes. This five-minute period is +tracked for each connection in the Watchdog Timer field of the server's +Connection table. If the shell within the station that the server is +polling is still operational, it will respond to the query and the server +will reset its timer for that connection. + +However, if the workstation has been turned off or some communications +problem exists on the network, the server will not receive a response +from the shell. In this instance, the watchdog process resets the +connection's Watchdog Timer field to zero, but increments the Watchdog +Counter field by one. The next packet that the watchdog process sends to +the workstation will be sent a minute later. If the watchdog continues to +hear nothing from the workstation, it will send a packet every minute +until it has sent a total of 11 polling packets to that workstation. +Fig. 33 illustrates the timetable for a connection that does not answer +to a server's queries. The server will clear the workstation's connection +if no response to the last watchdog packet is received. (NetWare 386- +based servers provide a setable parameter that allows administrators to +monitor when workstations are logged out by the watchdog process. This +option is set with the following command: SET CONSOLE DISPLAY WATCHDOG +LOGOUTS = ON.) + +: Watchdog Timetable for a Connection that Does Not Respond + +Conclusions + +NetWare's client-server communications are governed by a series of +protocols. These protocols can be broken up by functionality: protocols +used for all communications (the medium access protocols and IPX), +administrative protocols (the RIP and SAP), protocols concerned with +connection control (the NCP and Watchdog) and, finally, the protocol with +defines the coding of service requests (the NCP). This document explains +the operation and interoperation of these protocols; however, it does not +attempt to apply this information to all possible network configurations +and environments. It is up to you to apply this information to your +specific network(s). + +Appendix A: Implementing Redundant Cabling + +In internetworks that contain 286-based NetWare file servers, +incorporating multiple paths to those file servers may result in +inefficient routing. Fig. 34 shows an example of a 286-based NetWare +internet work that contains redundant paths to two file servers. + +: Sample Redundant Path Configuration + +The problem with this sample network configuration involves the route +taken by workstations on segment BB to communicate with file server FS1. +Although the shortest route between the workstations on BB and FS1 is +through NIC B on FS1, there is a good chance that packets may pass +through FS2 onto AA and subsequently through NIC A of FS1. + +Since traversing through an intermediate NetWare router can cause up to +40 percent degradation in the performance of packet exchanges between a +workstation and a file server, the scenario illustrated in Fig. 35 is not +the most desirable. + +: Inefficient Path to FS1 + +Routing problems occur because of the file service addressing scheme used +for 286-based NetWare file servers, combined with the algorithm for +establishing a connection to a file server. + +File Service Addressing + +The file services of a NetWare file server are assigned a specific +address within the file server. With 286-based NetWare servers, file +services are addressed with respect to NIC A in the file server. In other +words, when the file server advertises its existence, it provides only +the network and node address assigned to its NIC A-a socket address is +also included but it is not specific to NIC A. a shows a logical +representation of the file service addressing within a 286-based NetWare +file server. + +: Addressing of File Services in NetWare File Servers + +With NetWare 386, the file services are addressed with respect to an +internal network number assigned when the server is booted up. NetWare +386 assigns the file services node address 1. (See Fig. 36b.) + +The Connection Algorithm + +The problem inherent to the addressing scheme used for 286-based NetWare +file servers arises when LOGIN, ATTACH or the preferred server shell +attempts to connect to a specific server. Fig. 37 illustrates the way +that the file services of both servers appear to the workstations. + +As we have seen, a workstation's Get Local Target request asks for the +fastest route to the network segment on which the file server is located +(segment AA for FS1.) Since the router in FS1 and the router in FS2 both +register the same distance to network segment AA (two Ticks), both will +respond to the Get Local Target request. + +: Logical Positioning of File Services + +If FS2 is the first to respond to the requests, the workstation assumes +that FS2 has the fastest route, and therefore sends the create connection +request packet through FS2. If FS2 is consistently faster than FS1 in +responding to Get Local Target requests, connections to FS1 will always +be established through FS2. + +Fig. 38 shows the entire sequence that the workstation goes through to +connect to FS1 if FS2 responds to a Get Local Target request first. In +this sequence, FS2 is assumed to be consistently faster than FS1 in +responding to Get Local Target requests. + +Since FS2 is always the first to respond, the shell initially connects to +FS2 (using the sequence shown in Fig. 25). After making this initial +connection, the shell returns the DOS prompt to the user. + +: Workstation Sequence For Get Local Target Figure 38 (Continued): +Workstation Sequence For Get Local Target + +The user can then enter the command "LOGIN FS1/" to log in to FS1 +(following the sequence outlined in Fig. 27). First, the shell queries +FS2's bindery for FS1's address. Next the workstation broadcasts a Get +Local Target request. The router for FS1 and the router for FS2 both +answer this request, but FS2's router responds first. Therefore, the +workstation assumes that FS2 must have the fastest route to network +segment AA and sends its connection request-and all subsequent packets +intended for FS1-through FS2. Since FS1 depends on the workstation to +find the fastest route between the, FS1 sends all responses through FS2. + +To avoid this inefficient routing scenario, you can connect workstations +on the same segment as a file server's NIC A when you have redundant +paths to the server. (See Fig. 39.) With the correct configuration, the +shell receives the address of FS1 from FS2's bindery and makes the Get +Local Target call to IPX. IPX determines that FS1 and the workstation are +on the same network segment and tells the shell to address packets +directly to FS1. + +: Correct Configuration of Redundant Paths with 286-based NetWare + +Note that the connection sequence followed for the pre-v3.01 shell and +LOGIN.EXE is the same as that followed by the preferred server shell. +Therefore, the scenario described above applies for the preferred server +shell when a preferred is specified by the user. + +Another Redundant Path Configuration + +Fig. 40 shows another possible configuration that incorporates redundant +paths with 286-based NetWare file servers. In this configuration, +workstations on network BB should have direct access to both FS1 and FS2. +Due to the 286-based NetWare addressing scheme, however, packets destined +for one file server might go through the other file server first. + +For instance, if a workstation on BB wants to log in to FS1 but initially +connects to FS2, it will query FS2's bindery for FS1's address. The +address returned will include network number AA. The workstation will +then issue a Get Local Target request for AA. If FS2 responds to this +request first, the workstation's communications with FS1 will go through +FS2. + +: Redundant Paths With 286-based NetWare File Server + +Unfortunately, there is no all-inclusive solution to the routing problems +possible with this configuration. However, the configuration shown in +Fig. 41 will keep unnecessary routing to a minimum. This configuration +places NIC A for server FS1 and NIC A for server FS2 on different +networks: FS1's NIC A is connected to AA; FS2's NIC A is connected to BB. +Furthermore, workstations that access FS1 the majority of the time are +connected to AA, while those that access FS2 most often are connected to +BB. This configuration guarantees workstations a direct path to the file +server that they access most frequently. + +: Keeping Routing To A Minimum + +Redundant Paths with NetWare 386 + +Thanks to the internal network addressing scheme used by NetWare 386- +based file servers, they avoid the redundant-path problems experienced by +286-based NetWare servers. To illustrate, suppose FS1 is a NetWare 386 +file server with an internal network address of CC. In this case, FS2 +registers two Hops to CC, while FS1 registers only one Hop to CC. + +When the shell obtains the address CC from FS2's bindery, only FS1 +responds to the Get Local Target request. FS2 does not answer the request +because it no longer has a route equal to the fastest route to network +segment CC. + +The algorithms the NetWare shell uses to connect to a file server are +relatively simple in design. The basic procedure is the same: get a +server's address, obtain a route to that address, and send a request to +establish a connection with the server. + +However, when you configure 286-based NetWare file servers in an +internetwork with redundant paths, the shell may inadvertently route +packets through an intermediate router, even though the workstation is +connected to the same network segment as the file server it wants to +communicate with. As a result, you must carefully design redundant-path +networks to avoid such routing inefficiencies. As a general rule, always +connect those workstations that will spend most of the time accessing a +certain server to the NIC A segment of that server. + +Appendix B: Internal Components of a File Server + +It is a common misconception that NIC A enjoys a higher priority within +the 286-based NetWare servers and that it is therefore somewhat faster +than the other NICs. However, NIC A must vie for access to routing and +file services as a peer of NICs B, C, and D. In fact, within 286-based +NetWare servers, the only difference between NIC A and its peers is that +the address of the server is tied to it. + +286-Based NetWare Communication Components + +To fully understand the part that NICs play within 286-based and NetWare +386 servers, it is necessary to look at the communications components +that make up a server. Fig. 42 gives a graphic representation of the +communication-related components of a 286-based server that contains two +NICs. + +: Internal Communication Components of a 286-based NetWare File Server + +Each NIC has a corresponding driver. These drivers can be logically +separated into a send portion that transmits packets through the NIC and +a receive portion that pulls packets off the NIC. The receive portion is +commonly called the driver interrupt service routine (ISR) since it is +executed each time the NIC generates a hardware interrupt. (In most +cases, a hardware interrupt from the NIC indicates that a packet has been +received.) When a packet is received, the ISR checks the length of the +packet to make sure that it is large enough to be a viable IPX packet but +not so large that it will not fit into the server's buffers. If the +packet does not pass this test, the driver simply discards it. If the +packet is viable, the driver attempts to place the packet in a buffer. + +A 286-based file server uses two sets of packet buffers: file service +process (FSP) buffers and communication buffers. The FSP buffers are +primarily used for processing service requests (NCP packets) and can +number between one and 10, depending on the configuration of the server. +These buffers reside within the DGroup memory segment of the server and +are subject to its limitations. (Due to the design of the Intel 80286 +processor, memory must be divided into 64KB segments. The DGroup segment +has been optimized in the NetWare operating system code to be the fastest +segment. It contains several components besides the FSP buffers which, +for larger server configurations, may limit the memory available for +these FSP buffers.) + +All FSP buffers are the same size; they are sized to handle the largest +packet that any of the server's NIC drivers can receive. For instance, +if the server contains an Ethernet driver able to handle 1,024-byte +packets and an Arcnet driver able to handle 512-byte packets, the buffers +will sized to handle 1,024-byte packets. + +The communication buffers act as overflow areas for packets being +received by the server. The number of buffers that exist ranges from 40 +(the default) to 250 for version 2.15c-this number is set within NETGEN +at installation. These communication buffers are also sized to handle the +largest receivable packet size. Both sets of buffers are set up as first +in, first out queues, or linked lists, where the first packets to be +received are placed at the front of the queue and all subsequent packets +placed in line after that. + +Without examining the contents of the received packet, the driver ISR +first attempts to place the packet in an FSP buffer. If the FSP buffers +are full, the ISR will try to place the packet in a communication buffer. +The packet is discarded if both sets of buffers are full. The assumption +is that the packet-level error checking implemented at the transport +layer (handled by the NCP, SPX, and so on.) will cause the sender to send +another packet later when the server is not so busy. Once the ISR has +placed the packet in a buffer or has discarded it, the ISR returns +control of the CPU to the server and waits for another packet to be +received by its NIC. The ISR for each NIC follows this same routine. Each +has equal access to the buffers and places received packets at the end of +the FSP or communication buffer queues. + +A routing process services the FSP and communication buffers. (This +process is technically referred to as the Mux process or polling +process.) The routing process periodically checks the contents of the +FSP and communication buffers. This process is responsible for routing +packets found within these buffers to their proper destination, whether +that be in or outside the server. Generally, five types of packets can be +found in the buffers: + +o Service requests for the file server (NCP packets addressed to the + server) + +o Packets that need to be routed to another network segment + +o RIP packets + +o SAP packets + +o Packets addressed to other processes internal to the file server, + such as a nondedicated DOS process or a value-added process (VAP) + +When the routing process examines a packet in one of its buffers, it +takes one of four actions: + +o If it finds a service request for the server, the routing process + will schedule an FSP to service the request. The routing process + will then go on to the next buffer. + +o If it finds a packet not addressed to the server, the routing + process will check its Routing Information table for the best route + to the destination and send the packet through the appropriate NIC. + In this capacity, the routing process acts as the internal router of + a file server. + +o If it finds a RIP or SAP packet the routing process will update its + Routing or Server Information table, respectively, if necessary. + However, if the packet is a RIP or SAP request (such as a Get + Nearest Server request) the routing process will get the appropriate + information from its tables and send a response. + +o If it finds a packet addressed to another process within the server + (the packet would be identified by the destination socket number in + the IPX header) the routing process will pass the packet on to that + process. + +The routing process first checks the FSP buffers, starting at the top of +the queue. Since file service requests to the server can only be +processed in the FSP buffers, the routing process must try to keep the +FSP buffers as free as possible for these types of packets. Since the NIC +driver ISRs indiscriminately place packets into whichever buffers are +free at the time, the routing process may have to shuffle packets back +and forth between the FSP and communication buffers. Before checking the +contents of the FSP buffers, the routing process checks into see if all +the buffers are full. If so, the routing process assumes that some NCP +requests may have overflowed to the communication buffers. Therefore, any +non-NCP packets that the routing process finds in the FSP buffers are +moved over to the communication buffers to make room in the FSP buffers +for all the NCP requests. If the FSP buffers are not full, the routing +process simply processes all of the packets where they are. + +Having completed the scheduling or movement of packets in the FSP +buffers, the routing process switches its attention to the communication +buffers. The routing process attempts to move any NCP request packets +that it finds over to the FSP buffers. It places these packets in a +separate queue within the communication buffers if the FSP buffers are +full. This queue is later checked by the FSP buffers as they finish +processing their current requests. Any packets that are not NCP requests +are routed or processed within the communication buffers by the routing +process. + +NetWare 386 + +The NetWare 386 servers follow the same communication mode as 286-based +servers, with the following exceptions: + +o NIC drivers may be used re-entrantly to handle one or more NICs, + therefore saving RAM. + +o Only one set of packet buffers exists within a NetWare 386 server + (this difference stems from the 32-bit addressing scheme used by 386 + processors.) + +o FSP buffers are taken from a pool as they are needed and are not + assigned to one specific buffer. The number of FSP buffers may + increase as the load on the server increases. + +o NetWare 386 servers contain an internal network number for server + addressing. + +Fig. 43 illustrates the structure of the NetWare 386 communications +environment. + +: Internal Communication Components of a NetWare 386 File Server + +Appendix C: RIP and SAP Bandwidth Requirements + +On large internetworks with several hundred servers, administrators +become concerned with the load that RIP and SAP broadcasts will place on +their network segments. Of course, these concerns can be appeased for +asynchronous and X.25 links since only changed server and routing +information is sent on these lines. On other segment types the traffic +caused by these broadcasts does not cause a sginificant load. The +requirements and some examples are shown in Fig. 44. As you can see, the +SAP broadcasts for an internetwork containing 250 servers account for +less than one percent of the total bandwidth (10Mb/s) of an Ethernet +segment. + +: Bandwidth Requirements for 60 Second Broadcasts + +Total traffic load of routing and server information broadcasts on any +given segment will be equal to broadcasting information about all the +network segments and servers that exist on the internetwork. For example, +on a T1 link between two NetWare routers, one router will broadcast +information about all of the network segments and servers that it is +making available to the other router (using the best information +algorithm). The other router will broadcast information about all the +segments and servers that it is making available to the first router. The +total of the two equals the total number of servers and segments that +reside on the internetwork. diff --git a/NWTP/XIPX/APPN9008.TXT b/NWTP/XIPX/APPN9008.TXT new file mode 100644 index 0000000..3e32002 --- /dev/null +++ b/NWTP/XIPX/APPN9008.TXT @@ -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 ******** + diff --git a/NWTP/XIPX/BLTS9401.TXT b/NWTP/XIPX/BLTS9401.TXT new file mode 100644 index 0000000..ba1181d --- /dev/null +++ b/NWTP/XIPX/BLTS9401.TXT @@ -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. diff --git a/NWTP/XIPX/CHKVEND.PAS b/NWTP/XIPX/CHKVEND.PAS new file mode 100644 index 0000000..df04f45 --- /dev/null +++ b/NWTP/XIPX/CHKVEND.PAS @@ -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(''); + 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. \ No newline at end of file diff --git a/NWTP/XIPX/FGET.PAS b/NWTP/XIPX/FGET.PAS new file mode 100644 index 0000000..de2ab20 --- /dev/null +++ b/NWTP/XIPX/FGET.PAS @@ -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.TransactionIDLastTransactionID); { 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 '); + 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. \ No newline at end of file diff --git a/NWTP/XIPX/FSEND.PAS b/NWTP/XIPX/FSEND.PAS new file mode 100644 index 0000000..c41283e --- /dev/null +++ b/NWTP/XIPX/FSEND.PAS @@ -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 '); + 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. \ No newline at end of file diff --git a/NWTP/XIPX/M1_PEP.PAS b/NWTP/XIPX/M1_PEP.PAS new file mode 100644 index 0000000..da61999 --- /dev/null +++ b/NWTP/XIPX/M1_PEP.PAS @@ -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 '); + 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. \ No newline at end of file diff --git a/NWTP/XIPX/M_PEP.PAS b/NWTP/XIPX/M_PEP.PAS new file mode 100644 index 0000000..eb7a481 --- /dev/null +++ b/NWTP/XIPX/M_PEP.PAS @@ -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 '); + 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. \ No newline at end of file diff --git a/NWTP/XIPX/NWPEP.PAS b/NWTP/XIPX/NWPEP.PAS new file mode 100644 index 0000000..e25b810 --- /dev/null +++ b/NWTP/XIPX/NWPEP.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/NWRIP.PAS b/NWTP/XIPX/NWRIP.PAS new file mode 100644 index 0000000..3c69215 --- /dev/null +++ b/NWTP/XIPX/NWRIP.PAS @@ -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. diff --git a/NWTP/XIPX/NWSAP.PAS b/NWTP/XIPX/NWSAP.PAS new file mode 100644 index 0000000..a6c322b --- /dev/null +++ b/NWTP/XIPX/NWSAP.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/R1_HELLO.PAS b/NWTP/XIPX/R1_HELLO.PAS new file mode 100644 index 0000000..ae26094 --- /dev/null +++ b/NWTP/XIPX/R1_HELLO.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/R2_HELLO.PAS b/NWTP/XIPX/R2_HELLO.PAS new file mode 100644 index 0000000..851daae --- /dev/null +++ b/NWTP/XIPX/R2_HELLO.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/R3_HELLO.PAS b/NWTP/XIPX/R3_HELLO.PAS new file mode 100644 index 0000000..974ebe2 --- /dev/null +++ b/NWTP/XIPX/R3_HELLO.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/R_HELLO.PAS b/NWTP/XIPX/R_HELLO.PAS new file mode 100644 index 0000000..5982c44 --- /dev/null +++ b/NWTP/XIPX/R_HELLO.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/S1_HELLO.PAS b/NWTP/XIPX/S1_HELLO.PAS new file mode 100644 index 0000000..eeb1c08 --- /dev/null +++ b/NWTP/XIPX/S1_HELLO.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/S1_PEP.PAS b/NWTP/XIPX/S1_PEP.PAS new file mode 100644 index 0000000..d75011b --- /dev/null +++ b/NWTP/XIPX/S1_PEP.PAS @@ -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.TransactionIDLastTransactionID); { 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. \ No newline at end of file diff --git a/NWTP/XIPX/SHWSAPS.PAS b/NWTP/XIPX/SHWSAPS.PAS new file mode 100644 index 0000000..b1aec3d --- /dev/null +++ b/NWTP/XIPX/SHWSAPS.PAS @@ -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. diff --git a/NWTP/XIPX/SKT_XXX b/NWTP/XIPX/SKT_XXX new file mode 100644 index 0000000..d9782e8 --- /dev/null +++ b/NWTP/XIPX/SKT_XXX @@ -0,0 +1,1881 @@ +# -------------------------------------------------------------------- +# SKT_XXX: IPX Socket numbers +# +# Compiled from various lists: Novell, RFC 1340 +# -------------------------------------------------------------------- + +# Sockets 0001-0BB8 have to be registered with the IEEE + +0001 Routing Information +0002 Echo Protocol +0003 Error handler + +# Sockets 0020-003F are considered 'experimental' + +0040 NW4 Time Synchronisztion Server Novell Inc. +0451 File Service Xerox +0452 Service Adverstising Protocol Xerox +0453 Routing Information Protocol Xerox +0455 NetBIOS +0456 Diagnostic Services +0457 ?? Server Serial Number check Novell Inc. + +# IEEE: dynamically assignable sockets 0BB9-FFFF +# Novell uses this range in the following manner: +# 0BB9-7FFF: dynamically assignable sockets +# 8000-FFFF: 'well known sockets', registered with Novell. + +4444 Sitelock Server Brightworks +4800 LANZ Agent +5555 Sitelock Client Brightworks + +# Novell 'Well known' sockets + +8000 National Advanced Systems +8001 National Advanced Systems +8002 National Advanced Systems +8003 Comm Driver Sperry Corp. Computer Systems +8004 KTA +8005 KTA +8006 KTA +8007 KTA +8008 Novell Inc. +8009 Sperry Term Emulator Turnbull Automations +800A Print Server Communication Horizons +800B Data Language Corp +800C Stats Socket Novell Inc. +800D UPS Novell Inc. +800E Performance Test Novell Inc. +800F Batram Santa Clara Systems +8010 Office Ware Century Analysis +8011 UPS Elgar Corp. +8012 UPS Elgar Corp. +8013 Chi Corp. +8014 Intel - American Fork +8015 Compass Computing +8016 Compass Computing +8017 Compass Computing +8018 Compass Computing +8019 Compass Computing +801A Compass Computing +801B Compass Computing +801C Compass Computing +801D Compass Computing +801E Compass Computing +801F Novell Inc. +8020 Novell Inc. +8021 Novell Inc. +8022 Novell Inc. +8023 Mcafee Associates +8024 Blue Lance Network Info Sys +8027 Gateway Communications Inc. +8028 Gateway Communications Inc. +8029 Gateway Communications Inc. +802A File Sharing Netline Inc. +802B File Sharing Netline Inc. +802C Intel +802D Intel +802E ICM +802F C-Tree Server Fair Com +8030 Micromind +8031 Micromind +8032 North Star Computers +8033 North Star Computers +8034 X.25 Gateway Rsj Software +8035 Sanyo Icon Inc. +8036 Data Access Corp. +8037 Apic's Stocknet Broker Novell Inc. +8038 Apic's Stocknet Broker Novell Inc. +8039 Net Management Novell - Austin +803A Beta Soft +803B Phaser Systems +803C Phaser Systems +803D Phaser Systems +803E Performance Group +803F Performance Group +8040 Horizon Technology Inc. +8041 Cd-Rom Server Meridian Data Corp. +8042 Nationwide Computer Services +8043 Comm Server Computer Language Research Inc. +8046 Netware VMS Novell Inc. +8047 3274 Controller Emulators Software Dynamics +8048 3274 Controller Emulators Software Dynamics +8049 3274 Controller Emulators Software Dynamics +804A 3274 Controller Emulators Software Dynamics +804B Mic Sna Dfv Server Computerland +804C Mic Sna Dfv Server Computerland +804D Database Server Migent Software Inc. +804E Switch Link Systems +804F +8050 Btrieve Server 5.0 ? +8051 +8052 +8053 +8054 +8055 E-Mail Chat Niche Co +8056 Money Transfer IPI Inc. +8057 E-Mail Chat Niche Co +8058 Btrieve Novell Inc. +8059 Btrieve Novell Inc. +805A SQL Novell Inc. +805B SQL Novell Inc. +805C Gameserver Novell Inc. +805D Gameserver Novell Inc. +805E Telebase Systems +805F Telebase Systems +8060 Print Server Novell Inc. +8061 T-Net, Lan Bridges British Telecom +8062 Wollongong Group +8063 Unix R Login Novell Inc. +8064 Micro Data Base Systems +8065 Micro Data Base Systems +8066 Norton Lambert Corp. +8067 Norton Lambert Corp. +8068 Norton Lambert Corp. +8069 Netware To HP Lan Gateway Hewlett Packard +806A Remote Pc Software ALM +806B Wancopy Utility Novell Inc. +806C Chat Program Digital Av Inc. +806D Pc Dex Mergent International +806E DART College Hill Systems +806F Netware Access Server Novell Inc. +8070 Network Courier Microsoft Workgroup Canada +8071 Pipes Peer Logic +8072 Wordperfect Corp. +8073 Progress Database & 4GL Progress Software Corp. +8074 Right Hand Man Futuresoft +8075 Right Hand Man Futuresoft +8076 Laser Disk Program University Of Wisconsin +8077 Fax Link & Vax Manager Optus Information Systems +8078 Fax Link & Vax Manager Optus Information Systems +8079 Telecommunications Van Auto Parts +807A Telecommunications Van Auto Parts +807B Telecommunications Van Auto Parts +807C Telecommunications Van Auto Parts +807D Telecommunications Van Auto Parts +807E R21px Crosstalk +807F Oracle Corp. +8080 Oracle Corp. +8081 Oracle Corp. +8082 Oracle Corp. +8083 Oracle Corp. +8084 Oracle Corp. +8085 Oracle Corp. +8086 Oracle Corp. +8087 Oracle Corp. +8088 Oracle Corp. +8089 Remote Pc Software ALM +808A +808B +808C +808D +808E +808F +8090 Pillsbury Corp. +8091 Pillsbury Corp. +8092 Pillsbury Corp. +8093 Pillsbury Corp. +8094 Pillsbury Corp. +8095 Pillsbury Corp. +8096 Pillsbury Corp. +8097 Pillsbury Corp. +8098 Pillsbury Corp. +8099 Pillsbury Corp. +809A Marshfield Clinic +809B Marshfield Clinic +809C Marshfield Clinic +809D Marshfield Clinic +809E Marshfield Clinic +809F Marshfield Clinic +80AF Dsi Dynapro Systems Inc. +80B0 Dsi Dynapro Systems Inc. +80B1 Dsi Dynapro Systems Inc. +80B2 Dsi Dynapro Systems Inc. +80B3 Dsi Dynapro Systems Inc. +80B4 Chicago Research & Trading +80B5 Streetwise Systems Inc. +80B6 Streetwise Systems Inc. +80B7 Fax Server Digital Visions Corp. +80B8 Voice Server Digital Visions Corp. +80B9 Digital Visions Corp. +80BA Netware Management Application Frye Computer Systems +80BB Major BBS Software Galacticomm Inc. +80BC Major BBS Software Galacticomm Inc. +80BD Major BBS Software Galacticomm Inc. +80BE Major BBS Software Galacticomm Inc. +80BF Major BBS Software Galacticomm Inc. +80C0 Major BBS Software Galacticomm Inc. +80C1 Major BBS Software Galacticomm Inc. +80C2 Major BBS Software Galacticomm Inc. +80C3 Chat Program/IPX Talk Felsina Software +80C4 IPX/SPX Comm Protocol Applications Magee Enterprises Inc. +80C5 Watcom +80C6 Newport Systems Solutions Inc. +80C7 Newport Systems Solutions Inc. +80C8 Newport Systems Solutions Inc. +80C9 Newport Systems Solutions Inc. +80CA Newport Systems Solutions Inc. +80CB Newport Systems Solutions Inc. +80CC Newport Systems Solutions Inc. +80CD Newport Systems Solutions Inc. +80CE Nova Focus Remote Pc Access Driggs Corp. +80CF Appl IPX/SPX Communications Magee Enterprises Inc. +80D0 Appl IPX/SPX Communications Magee Enterprises Inc. +80D1 Appl IPX/SPX Communications Magee Enterprises Inc. +80D2 Appl IPX/SPX Communications Magee Enterprises Inc. +80D3 Appl 1px/SPX Communications Magee Enterprises Inc. +80D5 Database Server Gupta Technologies +80D6 Database Server Gupta Technologies +80D7 Comm Servers/LAN p2p services US Robotics Software +80D8 Powerchute NLM American Power Conversion +80D9 Corel Driver Product Corel Systems, Optical Div +80DA Archive Server Gigatrend Inc. +80DB Gateway Product Atlanta Technologies +80DC Gateway Product Atlanta Technologies +80DD Office Organizer NLM Unisys +80DE Universal Network Systems +80DF Application Server Nationsbank Appl Systems Supp +80E1 Modular Software Corp. +80E2 Client Server Application Software Ag +80E4 Lanport Virtual Extension Of Ports Microtest Inc. +80E5 Work Station Peer-To-Peer Conveyant Systems Inc. +80E6 Deskview X - IPX Socket Interface Quarterdeck Office Systems +80E7 Deskview X - IPX Socket Interface Quarterdeck Office Systems +80E8 Deskview X - IPX Socket Interface Quarterdeck Office Systems +80E9 Deskview X - IPX Socket Interface Quarterdeck Office Systems +80EA Deskview X - IPX Socket Interface Quarterdeck Office Systems +80EB Deskview X - IPX Socket Interface Quarterdeck Office Systems +80EC Meridian Data Inc. +80ED Biztech +80EE Rational Data Systems +80EF Rational Data Systems +80F0 Rational Data Systems +80F1 Rational Data Systems +80F4 Garp Server Communication Net Research Pty Ltd +80F5 Network Management Product NCR +80F6 Network Management Product NCR +80F7 Network Management Product NCR +80F8 Network Management Product NCR +80F9 Network Management Product NCR +80FA Network Management Product NCR +80FB Professional Programming SVCs +80FC Professional Programming SVCs +80FD Peer Logic +80FE Wall Data +80FF Distributed Application Folio Corp. +8100 Marshfield Clinic +8101 Marshfield Clinic +8102 Marshfield Clinic +8103 Marshfield Clinic +8104 Netware 386 Server Novell Inc. +8105 Via +8106 Proteon +8107 Proteon +8108 Proteon +8109 Proteon +810A Proteon +810B Proteon +810C Proteon +810D Proteon +810E Proteon +810F Net 3270 Mcgill University Computing Ct +8110 Professional Productivity Corp. +8111 Tods Teletrak +8112 Lufthansa Lufthansa +8113 Lanport Microtest +8114 Lanport Microtest +8115 Lanport/Netport Microtest/Intel +8116 Lanport Microtest +8117 Lanport Microtest +8118 Lanport Microtest +8119 Lanport Microtest +811A Lanport Microtest +811B Lanport Microtest +811C Lanport Microtest +811D Image Server File Net Corp. +811E Print Server Novell Inc. +811F RTK Operating System Owl Micro Systems +8120 TXD Thomas Conrad Corp. +8121 Special Request Spectrafax +8122 Net Monitor Artefact Network Support +8123 Net Monitor Artefact Network Support +8124 Net Monitor Artefact Network Support +8125 Net Monitor Artefact Network Support +8126 Net Monitor Artefact Network Support +8127 Net Monitor Artefact Network Support +8128 Net Monitor Artefact Network Support +8129 Net Monitor Artefact Network Support +812A Net Monitor Artefact Network Support +812B Net Monitor Artefact Network Support +812C Net Monitor Artefact Network Support +812D Net Monitor Artefact Network Support +812E Test Server Novell Inc. +812F Test Server Novell Inc. +8130 Test Server Novell Inc. +8131 Test Server Novell Inc. +8132 Test Server Novell Inc. +8133 Test Server Novell Inc. +8134 Test Server Novell Inc. +8135 Test Server Novell Inc. +8136 Test Server Novell Inc. +8137 Test Server Novell Inc. +8138 Lansight Lan Systems +8139 Pc Chalkboard Intel - American Fork +813B Real Time Back-Up Emerald Systems +813C Network Management Pure Data Inc. +813D Srs Plus Novell Inc. +813E File Transfer AAC Systems +813F Image Server Wang Laboratories +8140 Image Server Wang Laboratories +8141 Image Server Wang Laboratories +8142 Image Server Wang Laboratories +8143 Network Designers Ltd +8144 Maynestream Arcada Software +8145 Maynestream Arcada Software +8146 Network Management System Accunetics +8147 Network Management System Accunetics +8148 Network Management System Accunetics +8149 Network Management System Accunetics +814A BR Computing +814B Automated Design Systems +814C BR Computing +814D BR Computing +814E BR Computing +814F BR Computing +8150 BR Computing +8151 BR Computing +8152 BR Computing +8153 BR Computing +8154 BR Computing +8155 BR Computing +8156 BR Computing +8157 BR Computing +8158 BR Computing +8159 BR Computing +815A BR Computing +815B BR Computing +815C BR Computing +815D BR Computing +815E BR Computing +815F BR Computing +8160 Printqlan Software Directions Inc. +8161 Printqlan Software Directions Inc. +8162 Printqlan Software Directions Inc. +8163 Printqlan Software Directions Inc. +8164 Printqlan Software Directions Inc. +8165 Printqlan Software Directions Inc. +8166 Printqlan Software Directions Inc. +8167 Printqlan Software Directions Inc. +8168 Printqlan Software Directions Inc. +8169 Printqlan Software Directions Inc. +816A Printqlan Software Directions Inc. +816B Printqlan Software Directions Inc. +816C Printqlan Software Directions Inc. +816D Printqlan Software Directions Inc. +816E Printqlan Software Directions Inc. +816F Printqlan Software Directions Inc. +8170 Cdrom Online Computer Systems +8171 Cdrom Online Computer Systems +8172 Bentley Systems +8173 Avalan +8174 Avalan +8175 Avalan +8176 Avalan +8177 Avalan +8178 Avalan +8179 Avalan +817A Avalan +817B Accounting APD Supernet +817C Acs Instant Information +817D Server Db Xdb Systems +817E Pipes Peer Logic +817F Pipes Peer Logic +8180 Netware Software Associates +8181 Peer-To-Peer Lodgistix Inc. +8182 Peer-To-Peer Lodgistix Inc. +8183 Peer-To-Peer Lodgistix Inc. +8184 Peer-To-Peer Lodgistix Inc. +8185 Peer-To-Peer Lodgistix Inc. +8186 Danware +8187 Danware +8188 Danware +8189 Danware +818A Danware +818B Netframe Nw 386 Netframe +818C Netframe Nw 386 Netframe +818D Netframe Nw 386 Netframe +818E Netframe Nw 386 Netframe +818F Maxiback Sysgen Inc. +8190 Maxiback Sysgen Inc. +8191 Maxiback Sysgen Inc. +8192 Maxiback Sysgen Inc. +8193 DCA IPX Comm Product Digital Communications Assoc +8194 DCA IPX Comm Product Digital Communications Assoc +8195 DCA IPX Comm Product Digital Communications Assoc +8196 Quickchart Healthware +8197 Quickchart Healthware +8198 Quickchart Healthware +8199 Quickchart Healthware +819A Universuty Of Otago +819B University Of Otago +819C Mini SQL Isicad +81A0 Dealing Room Systems Hovland Business Systems Ltd +81A1 Dealing Room Systems Hovland Business Systems Ltd +81A2 Dealing Room Systems Hovland Business Systems Ltd +81A3 Dealing Room Systems Hovland Business Systems Ltd +81A4 Dealing Room Systems Hovland Business Systems Ltd +81A5 Dealing Room Systems Hovland Business Systems Ltd +81A6 Dealing Room Systems Hovland Business Systems Ltd +81A7 Dealing Room Systems Hovland Business Systems Ltd +81A8 Dealing Room Systems Hovland Business Systems Ltd +81A9 Dealing Room Systems Hovland Business Systems Ltd +81AA Dealing Room Systems Hovland Business Systems Ltd +81AB Dealing Room Systems Hovland Business Systems Ltd +81AC Dealing Room Systems Hovland Business Systems Ltd +81AD Dealing Room Systems Hovland Business Systems Ltd +81AE Dealing Room Systems Hovland Business Systems Ltd +81AF Dealing Room Systems Hovland Business Systems Ltd +81B0 Dealing Room Systems Hovland Business Systems Ltd +81B1 Dealing Room Systems Hovland Business Systems Ltd +81B2 Dealing Room Systems Hovland Business Systems Ltd +81B3 Dealing Room Systems Hovland Business Systems Ltd +81B4 Dealing Room Systems Hovland Business Systems Ltd +81B5 Dealing Room Systems Hovland Business Systems Ltd +81B6 Dealing Room Systems Hovland Business Systems Ltd +81B7 Dealing Room Systems Hovland Business Systems Ltd +81B8 Dealing Room Systems Hovland Business Systems Ltd +81B9 Dealing Room Systems Hovland Business Systems Ltd +81BA Dealing Room Systems Hovland Business Systems Ltd +81BB Dealing Room Systems Hovland Business Systems Ltd +81BC Dealing Room Systems Hovland Business Systems Ltd +81BD Dealing Room Systems Hovland Business Systems Ltd +81BE Dealing Room Systems Hovland Business Systems Ltd +81BF Dealing Room Systems Hovland Business Systems Ltd +81C0 Dealing Room Systems Hovland Business Systems Ltd +81C1 Dealing Room Systems Hovland Business Systems Ltd +81C2 Dealing Room Systems Hovland Business Systems Ltd +81C3 Dealing Room Systems Hovland Business Systems Ltd +81C4 Dealing Room Systems Hovland Business Systems Ltd +81C5 Dealing Room Systems Hovland Business Systems Ltd +81C6 Dealing Room Systems Hovland Business Systems Ltd +81C7 Dealing Room Systems Hovland Business Systems Ltd +81C8 Dealing Room Systems Hovland Business Systems Ltd +81C9 Dealing Room Systems Hovland Business Systems Ltd +81CA Dealing Room Systems Hovland Business Systems Ltd +81CB Dealing Room Systems Hovland Business Systems Ltd +81CC Dealing Room Systems Hovland Business Systems Ltd +81CD Dealing Room Systems Hovland Business Systems Ltd +81CE Dealing Room Systems Hovland Business Systems Ltd +81CF Dealing Room Systems Hovland Business Systems Ltd +81D0 Dealing Room Systems Hovland Business Systems Ltd +81D1 Dealing Room Systems Hovland Business Systems Ltd +81D2 Dealing Room Systems Hovland Business Systems Ltd +81D3 Dealing Room Systems Hovland Business Systems Ltd +81D4 Dealing Room Systems Hovland Business Systems Ltd +81D5 Dealing Room Systems Hovland Business Systems Ltd +81D6 Dealing Room Systems Hovland Business Systems Ltd +81D7 Dealing Room Systems Hovland Business Systems Ltd +81D8 Dealing Room Systems Hovland Business Systems Ltd +81D9 Dealing Room Systems Hovland Business Systems Ltd +81DA Dealing Room Systems Hovland Business Systems Ltd +81DB Dealing Room Systems Hovland Business Systems Ltd +81DC Dealing Room Systems Hovland Business Systems Ltd +81DD Dealing Room Systems Hovland Business Systems Ltd +81DE Dealing Room Systems Hovland Business Systems Ltd +81DF Dealing Room Systems Hovland Business Systems Ltd +81E0 Dealing Room Systems Hovland Business Systems Ltd +81E1 Dealing Room Systems Hovland Business Systems Ltd +81E2 Dealing Room Systems Hovland Business Systems Ltd +81E3 Dealing Room Systems Hovland Business Systems Ltd +81E4 Dealing Room Systems Hovland Business Systems Ltd +81E5 Dealing Room Systems Hovland Business Systems Ltd +81E6 Dealing Room Systems Hovland Business Systems Ltd +81E7 Dealing Room Systems Hovland Business Systems Ltd +81E8 Dealing Room Systems Hovland Business Systems Ltd +81E9 Dealing Room Systems Hovland Business Systems Ltd +81EA Dealing Room Systems Hovland Business Systems Ltd +81EB Dealing Room Systems Hovland Business Systems Ltd +81EC Dealing Room Systems Hovland Business Systems Ltd +81ED Dealing Room Systems Hovland Business Systems Ltd +81EE Dealing Room Systems Hovland Business Systems Ltd +81EF Dealing Room Systems Hovland Business Systems Ltd +81F0 Dealing Room Systems Hovland Business Systems Ltd +81F1 Dealing Room Systems Hovland Business Systems Ltd +81F2 Dealing Room Systems Hovland Business Systems Ltd +81F3 Dealing Room Systems Hovland Business Systems Ltd +81F4 Dealing Room Systems Hovland Business Systems Ltd +81F5 Dealing Room Systems Hovland Business Systems Ltd +81F6 Dealing Room Systems Hovland Business Systems Ltd +81F7 Dealing Room Systems Hovland Business Systems Ltd +81F8 Dealing Room Systems Hovland Business Systems Ltd +81F9 Dealing Room Systems Hovland Business Systems Ltd +81FA Dealing Room Systems Hovland Business Systems Ltd +81FB Dealing Room Systems Hovland Business Systems Ltd +81FC Network Support Mgr PCI Ltd +81FD Network Support Mgr PCI Ltd +81FE Iwi +81FF Martello & Associates +8203 Network Computing Inc. (NCI) +8204 Network Computing Inc. (NCI) +8205 Network Computing Inc. (NCI) +8206 Network Computing Inc. (NCI) +8207 Network Computing Inc. (NCI) +8208 Network Computing Inc. (NCI) +8209 Network Computing Inc. (NCI) +820A Network Computing Inc. (NCI) +820B Network Computing Inc. (NCI) +820C Network Computing Inc. (NCI) +820D Data Voice Solutions Corp. +820E Id 5001 Weather Station Zenith Data Systems +820F Write Server Arc Calculon +8210 Write Server Quantum Consulting +8211 System 9 Hbf Group +8212 System 9 Hbf Group +8213 System 9 Hbf Group +8214 System 9 Hbf Group +8215 System 9 Hbf Group +8216 System 9 Hbf Group +8217 System 9 Hbf Group +8218 System 9 Hbf Group +8219 Argus Triticom +821A Argus Triticom +821B TCP/IP Gateway Computervision Services +821C Pickit (comm Server) Intel +821D Peer Logic +821E Peer Logic +821F Data Face Net Batch Computer Aided Business Sol +8220 Data Face Net Batch Computer Aided Business Sol +8221 Luminar Optical Server Corel Systems Corp. +8222 +8223 +8224 +8225 +8226 +8227 X-Bridge Advanced Policy Communications +8228 X-Bridge Advanced Policy Communications +8229 Flexcom Evergreen Systems +822A Flexcom Evergreen Systems +822B Flexcom Evergreen Systems +822C Flexcom Evergreen Systems +822D Flexcom Evergreen Systems +822E Gateways & Wkst Processor Teknos Systems +822F Gateways & Wkst Processor Teknos Systems +8230 Gateways & Wkst Processor Teknos Systems +8231 Gateways & Wkst Processor Teknos Systems +8232 Gateways & Wkst Processor Teknos Systems +8233 Gateways & Wkst Processor Teknos Systems +8234 Gateways & Wkst Processor Teknos Systems +8235 Gateways & Wkst Processor Teknos Systems +8236 Gateways & Wkst Processor Teknos Systems +8237 Gateways & Wkst Processor Teknos Systems +8238 Lanware Horizon Technology Inc. +8239 Lanware Horizon Technology Inc. +823A Lanware Horizon Technology Inc. +823B Lanware Horizon Technology Inc. +823C Lanware Horizon Technology Inc. +823D +823E Team 286 Iwi +823F Dbms Lock Manager Raima Corp. +8240 Dbms Lock Manager Raima Corp. +8241 Central Point Software +8242 Remote Computing Central Point Software +8243 Remote Computing Central Point Software +8244 Remote Computing Central Point Software +8245 Remote Computing Central Point Software +8246 Remote Computing Central Point Software +8247 Remote Computing Central Point Software +8248 Remote Computing Central Point Software +8249 Token Ring Rpl NCR +824A Token Ring Rpl NCR +824B Dealing Room Systems Hovland Business Systems Ltd +824C Dealing Room Systems Hovland Business Systems Ltd +824D Dealing Room Systems Hovland Business Systems Ltd +824E Dealing Room Systems Hovland Business Systems Ltd +824F Dealing Room Systems Hovland Business Systems Ltd +8250 Dealing Room Systems Hovland Business Systems Ltd +8251 Dealing Room Systems Hovland Business Systems Ltd +8252 Dealing Room Systems Hovland Business Systems Ltd +8253 Total Automation Systems Dynatech Utah Scientific +8254 Total Automation Systems Dynatech Utah Scientific +8255 Vantage Point Connect Computer +8256 Netarc Scheduler Emerald Systems +8257 Distributed Processing Brigham Young University +8258 Xtree Net Central Point Software +8259 Xtree Net Central Point Software +825A Sysm/lan2 H&w Computer Systems +825B Vantage Point Connect Computer +825C Vantage Point Connect Computer +825D Vantage Point Connect Computer +825E Time Out Nordra Inc. +825F Mulit-Processor Controller MBAC +8260 Mulit-Processor Controller MBAC +8261 Mulit-Processor Controller MBAC +8262 Mulit-Processor Controller MBAC +8263 Mulit-Processor Controller MBAC +8264 Time Out Nordra Inc. +8265 Ingres Database Ingres Corp. +8266 Easy Street Prem Finance Streetwise Systems Inc. +8267 Easy Street Prem Finance Streetwise Systems Inc. +8269 Apt Net Automated Programming Tech +826A Apt Net Automated Programming Tech +826B Apt Net Automated Programming Tech +826C Apt Net Automated Programming Tech +826D Total Automation Sys Ed Lutheran Social Services +826E Total Automation Sys Mc Lutheran Social Services +826F Total Automation Sys Ml Dynatech Utah Scientific +8270 Total Automation Sys - Adi Dynatech Utah Scientific +8271 Total Automation Sys - Fax Dynatech Utah Scientific +8272 Service Point Interpoint Software +8273 Service Point Interpoint Software +8274 Prodigy Gateway Computerease Software +8275 Prodigy Gateway Computerease Software +8276 Newsmanager VSS Inc. +8277 Newsmanager VSS Inc. +8278 Newsmanager VSS Inc. +827F Martello & Associates +8280 Mark Hurst +8281 Mark Hurst +8282 Mark Hurst +8283 Mark Hurst +8284 Barr gate/PC-Mainframe Comms Barr Systems Inc. +8285 Barr Gate/PC-Mainframe Comms Barr Systems Inc. +8286 Pure Data Research Ltd +8287 Voice Mail Plan Communications +8288 Centers For Disease Control +8289 RPC Calls Integrated Data Systems +828A Integrated Data Systems +828B Folio Corp. +828C Multitech +828D Multitech +828E Multitech +828F Multitech +8290 Multitech +8291 Bus Tech +8292 American Airlines Decision Tec +8293 Microcom Inc. +8294 Gateway Usa +8295 Gateway Usa +8296 Gateway Usa +8297 Gateway Usa +8298 Gateway Usa +8299 Gateway Usa +829A Computervision Services +829B Computervision Services +829C Computervision Services +829D Shiva Corp. +829E Shiva Corp. +829F Todd Weiss +82A0 Todd Weiss +82A1 Todd Weiss +82A2 Tape NLM Arcada Software +82A3 Lanlord Product Microcom Client Server Technol +82A4 Lanlord Product Microcom Client Server Technol +82A5 X25 Automated Bridge Monitor Microcom ?? +82A6 Microcom Inc. +82A7 Peer-To-Peer Communications Witness Systems +82A8 Micro Integration +82A9 Micro Integration +82AA IBM - Poughkeepsie +82AB IBM - Poughkeepsie +82AC IBM - Poughkeepsie +82AD IBM - Poughkeepsie +82AE IBM - Poughkeepsie +82AF IBM - Poughkeepsie +82B0 J&l Information Systems +82B1 J&l Information Systems +82B2 J&l Information Systems +82B3 J&l Information Systems +82B4 J&l Information Systems +82B5 J&l Information Systems +82B6 J&l Information Systems +82B7 J&l Information Systems +82B8 J&l Information Systems +82B9 J&l Information Systems +82BA J&l Information Systems +82BB J&l Information Systems +82BC J&l Information Systems +82BD J&l Information Systems +82BE J&l Information Systems +82BF J&l Information Systems +82C0 J&l Information Systems +82C1 J&l Information Systems +82C2 J&l Information Systems +82C3 J&l Information Systems +82C4 J&l Information Systems +82C5 J&l Information Systems +82C6 J&l Information Systems +82C7 J&l Information Systems +82C8 J&l Information Systems +82C9 J&l Information Systems +82CA J&l Information Systems +82CB J&l Information Systems +82CC J&l Information Systems +82CD J&l Information Systems +82CE J&l Information Systems +82CF J&l Information Systems +82D0 J&l Information Systems +82D1 J&l Information Systems +82D2 J&l Information Systems +82D3 J&l Information Systems +82D4 J&l Information Systems +82D5 J&l Information Systems +82D6 J&l Information Systems +82D7 J&l Information Systems +82D8 Legato Systems +82D9 Legato Systems +82DA Legato Systems +82DB Legato Systems +82DC Legato Systems +82DD Legato Systems +82DE Value Added Server Skyline Technology +82DF Value Added Server Skyline Technology +82E0 FCP For OS/2 Support Andersen Consulting +82E1 FCP For OS/2 Support Andersen Consulting +82E3 Sytron Corp. +82E4 American Airlines Decision Tec +82E5 Image Retrieval Inc. +82E6 Connect Computer +82E7 Connect Computer +82E8 Connect Computer +82E9 Connect Computer +82EA Connect Computer +82EB Connect Computer +82EC Connect Computer +82ED Connect Computer +82EE Connect Computer +82EF Connect Computer +82F0 Connect Computer +82F1 Connect Computer +82F2 Connect Computer +82F3 Connect Computer +82F4 Connect Computer +82F5 Connect Computer +82F6 Hello-1 (Client alive check) Joshin Denki Co Ltd J&p Div +82F7 Hello-1 (Client aluve check) Joshin Denki Co Ltd J&p Div +82F8 Hello-1 (Client alive check) Joshin Denki Co Ltd J&p Div +82F9 Hello-1 (Client alive check) Joshin Denki Co Ltd J&p Div +82FA Hello-1 (Client alive check) Joshin Denki Co Ltd J&p Div +82FD Netware Jukebox Corel Systems, Optical Div +82FE FCP For Windows Support Andersen Consulting +82FF FCP For Windows Support Andersen Consulting +8300 Smith Micro Software Inc. +8301 Smith Micro Software Inc. +8302 Smith Micro Software Inc. +8303 Smith Micro Software Inc. +8304 Smith Micro Software Inc. +8305 Smith Micro Software Inc. +8306 Smith Micro Software Inc. +8307 Smith Micro Software Inc. +8308 Smith Micro Software Inc. +8309 Smith Micro Software Inc. +830A Smith Micro Software Inc. +830B Smith Micro Software Inc. +830C Smith Micro Software Inc. +830D Smith Micro Software Inc. +830E Smith Micro Software Inc. +830F Smith Micro Software Inc. +8310 Smith Micro Software Inc. +8311 Smith Micro Software Inc. +8312 Smith Micro Software Inc. +8313 Smith Micro Software Inc. +8314 Smith Micro Software Inc. +8315 Smith Micro Software Inc. +8316 Smith Micro Software Inc. +8317 Smith Micro Software Inc. +8318 Smith Micro Software Inc. +8319 Smith Micro Software Inc. +831A Smith Micro Software Inc. +831B Smith Micro Software Inc. +831C Smith Micro Software Inc. +831D Smith Micro Software Inc. +831E Smith Micro Software Inc. +831F Smith Micro Software Inc. +8320 Smith Micro Software Inc. +8321 Smith Micro Software Inc. +8322 Smith Micro Software Inc. +8323 Smith Micro Software Inc. +8324 Smith Micro Software Inc. +8325 Smith Micro Software Inc. +8326 Smith Micro Software Inc. +8327 Smith Micro Software Inc. +8328 Smith Micro Software Inc. +8329 Smith Micro Software Inc. +832A Smith Micro Software Inc. +832B Smith Micro Software Inc. +832C Smith Micro Software Inc. +832D Smith Micro Software Inc. +832E Smith Micro Software Inc. +832F Smith Micro Software Inc. +8330 Smith Micro Software Inc. +8331 Smith Micro Software Inc. +8332 Smith Micro Software Inc. +8333 Smith Micro Software Inc. +8334 Smith Micro Software Inc. +8335 Smith Micro Software Inc. +8336 Smith Micro Software Inc. +8337 Smith Micro Software Inc. +8338 Smith Micro Software Inc. +8339 Smith Micro Software Inc. +833A Smith Micro Software Inc. +833B Smith Micro Software Inc. +833C Smith Micro Software Inc. +833D Smith Micro Software Inc. +833E Smith Micro Software Inc. +833F Smith Micro Software Inc. +8340 Smith Micro Software Inc. +8341 Smith Micro Software Inc. +8342 Smith Micro Software Inc. +8343 Smith Micro Software Inc. +8344 Smith Micro Software Inc. +8345 Smith Micro Software Inc. +8346 Smith Micro Software Inc. +8347 Smith Micro Software Inc. +8348 Smith Micro Software Inc. +8349 Smith Micro Software Inc. +834A Smith Micro Software Inc. +834B Smith Micro Software Inc. +834C Smith Micro Software Inc. +834D Smith Micro Software Inc. +834E Smith Micro Software Inc. +834F Smith Micro Software Inc. +8350 Power Grid Server Cognos Inc. +8351 Data Service To Workstation Chancery Software +8352 Transmitting Unisync +8353 Receiving Unisync +8354 Multicom Net Richard Cumming & Associates +8355 Multicom Net Richard Cumming & Associates +8356 Multicom Net Richard Cumming & Associates +8357 Cd Connections Cbis Inc. +8359 Riverview Systems +835A Total Automation Systems Dynatech Utah Scientific +835B Total Automation Systems Dynatech Utah Scientific +835C Itac Inc. +835D Asp Computer Products Inc. +835E Asp Computer Products Inc. +835F Asp Computer Products Inc. +8361 Fax Server Transfax Corp. +8362 Fax Print Server Transfax Corp. +8363 Fax Merge Server Transfax Corp. +8364 Network Management Server Transfax Corp. +8365 Funk Software +8366 Micro Integration +8367 Micro Integration +8368 Micro Integration +8369 Micro Integration +836A Micro Integration +836B Triple A Motor Club +836C Lan Times Japan, Softbank Corp. +836D Watchtower +836E SPX Client Server Comm Systems ProMicrorim +836F Norton Lambert Corp. +8370 Norton Lambert Corp. +8371 Norton Lambert Corp. +8372 Norton Lambert Corp. +8373 Norton Lambert Corp. +8374 Central Point Software +8375 Drivers Presoft Architects +8376 NLM For Remote Volume Mount Inteck Corp. +8377 NLM For Remote Volume Mount Inteck Corp. +8378 Symantec Peter Norton Group +8379 Symantec Peter Norton Group +837A Digital Equipment +837B CBS Facil. Assignment - Request Dynatech Utah Scientific +837C CBS Facilities Assignment - Reply Dynatech Utah Scientific +837D Multi-Protocol Router Inside IPX Research Machines Plc +837E Shareware Cherry Tree Software +837F Enterprise Ecs Intel Corp. +8380 Enterprise Mmt Intel Corp. +8381 Stock Ticker Broadcast Server Ncompass Development Intl +8382 Query Unique Users Us Robotics Software +8383 Cbs Ada Server Dynatech Utah Scientific +8384 Pace Software Systems Inc. +8385 Andersen Consulting +8386 Gateway Management Wall Data +8387 Gateway Management Wall Data +838B Powerchute Alert - Ups Monitoring American Power Conversion +838D Avail Systems Corp. +838E QA+ For Windows/remote Diagnostics Diagsoft Inc. +838F Powerchute Adminstrative Socket American Power Conversion +8390 Datamedic +8391 Corel Driver Corel Systems, Optical Div +8392 Lasermaster Printer Products Laser Master Corp. +8393 TFTP Trivial FTP Hewlett Packard +8394 FTP File Transfer Protocol Hewlett Packard +8395 Hewlett Packard +8396 Hewlett Packard +8397 Sita +8398 Sita +8399 Techgnosis Inc. +839A QA+ For Windows/remote Diagnostics Diagsoft Inc. +839B Mail Systems Synectic Systems Ltd +839C Mail Systems Synectic Systems Ltd +839D NLM/video Files On Novell Service Protocomm Corp. +839E Turnax Emulation Gateway Ide Corp. +839F Cnf 16000 Connection Station Corollary Inc. +83A0 Cnf 16000 Connection Station Corollary Inc. +83A1 Cnf 16000 Connection Station Corollary Inc. +83A2 Cnf 16000 Connection Station Corollary Inc. +83A3 Cnf 16000 Connection Station Corollary Inc. +83A4 Cnf 16000 Connection Station Corollary Inc. +83A5 Ws Peer-To-Peer Communicat IBM +83A6 Ws Peer-To-Peer Communicat IBM +83A7 Ws Peer-To-Peer Communicat IBM +83A8 Ws Peer-To-Peer Communicat IBM +83A9 Ws Peer-To-Peer Communicat IBM +83AA Ws Peer-To-Peer Communicat IBM +83AB Datanex Corp. +83AC Hp Open Mail & Portable Netware Hewlett Packard - Berkshire +83AD Communication/mail Server Software Dator 3 Spol Sro +83AE Communication/mail Server Software Dator 3 Spol Sro +83AF Communication/mail Server Software Dator 3 Spol Sro +83B0 Communication/mail Server Software Dator 3 Spol Sro +83B1 Power Management Server Elgar Corp. +83B2 Power Management Client Elgar Corp. +83B3 Network Peripherals - Print Server Canon Information Systems +83B4 Network Peripherals Canon Information Systems +83B5 Network Peripherals Canon Information Systems +83B6 Network Peripherals Canon Information Systems +83B7 Network Peripherals Canon Information Systems +83B8 Network Peripherals Canon Information Systems +83B9 Fax Server Ferrari Electronic GMbH +83BA Fax Server Ferrari Electronic GMbH +83BB Fax Server Ferrari Electronic GMbH +83BC Fax Server Ferrari Electronic GMbH +83BD SQL Cl/S Database Engine Sybase Inc. +83BE Printer Controller Board Dp Tek +83BF Printer Controller Board Dp Tek +83C0 Iwi +83C1 Lexmark International +83C2 Lexmark International +83C3 Lexmark International +83C4 Lexmark International +83C5 Lexmark International +83C6 Lexmark International +83C7 Okna Corp. +83C8 Okna Corp. +83C9 Okna Corp. +83CA Okna Corp. +83CB Okna Corp. +83CC Okna Corp. +83CD Development/communications Toolkit Michael Rich +83CE Reset Print Servers Motorola +83CF Network Designers +83D0 Remote Printer Socket Industrial Exotica +83D1 File Management Services Systems Axis Plc +83D2 Queue Management Services Systems Axis Plc +83D4 Lantech Services +83D5 Cc Mail Gateway 3.30/SPX Transport Cc Mail +83D6 Remote Control - Node-To-Node Dst - Distributed Systems Tech +83D7 Remote Control - Bank Of Modems Dst - Distributed Systems Tech +83D9 General Communication Forum Credit Lyonnais +83DA Database Engines Sybase Inc. +83DB Database Engines Sybase Inc. +83DC Database Engines Sybase Inc. +83DD Database Engines Sybase Inc. +83DE Database Engines Sybase Inc. +83DF Database Engines Sybase Inc. +83E0 Database Engines Sybase Inc. +83E1 Database Engines Sybase Inc. +83E2 Gateway Server Product Icc +83E3 Wan Connection Server Ideassociation +83E4 Lan Spool 3.5 Intel - American Fork +83E6 Remote Internal Hub Driver Intel Pced +83E7 Software Access Control Server U Of Plymouth +83E9 Communications System Unicables Sa +83EA Communications System Unicables Sa +83EB Communications System Unicables Sa +83EC Communications System Unicables Sa +83ED Communications System Unicables Sa +83EE Communications System Unicables Sa +83EF Communications System Unicables Sa +83F0 Communications System Unicables Sa +83F1 Communications System Unicables Sa +83F2 Communications System Unicables Sa +83F3 Communications System Unicables Sa +83F4 Communications System Unicables Sa +83F5 Communications System Unicables Sa +83F6 Communications System Unicables Sa +83F7 Communications System Unicables Sa +83F8 Communications System Unicables Sa +83F9 Communications System Unicables Sa +83FA Communications System Unicables Sa +83FB Communications System Unicables Sa +83FC Communications System Unicables Sa +83FD Communications System Unicables Sa +83FE Communications System Unicables Sa +83FF Communications System Unicables Sa +8400 Communications System Unicables Sa +8401 Communications System Unicables Sa +8402 Generic Server Greenbaum Associates +8403 Object-Store, DB Access Protocol Object Design +8404 Object-Store, DB Access Protocol Object Design +8405 Object-Store, Directory Protocol Object Design +8406 Object-Store, Directory Protocol Object Design +8407 Object-Store, Cache Coherence Prt Object Design +8408 Object-Store, Cache Coherence Prt Object Design +8409 Visinet NLM Technology Dynamics Inc. +840A WDAGR - Server Jostens Learning Corp. +840B Wkill Jostens Learning Corp. +840C Internet Lan Controller Bus Tech +840D Peer-To-Peer Communications M&m Mars Inc. +840E Peer-To-Peer Communications M&m Mars Inc. +840F Connection Manager Tbr International Corp. +8410 Connection Manager Tbr International Corp. +8411 Connection Manager Tbr International Corp. +8412 Connection Manager Tbr International Corp. +8413 Connection Manager Tbr International Corp. +8414 Connection Manager Tbr International Corp. +8415 For Proxy Host Funk Software +8416 Workstation 3-Lan Advanced Technical Solutions +8417 Server Performance Analisys Banyan Systems Inc. +8418 Server Performance Analisys Banyan Systems Inc. +8419 Server Performance Analisys Banyan Systems Inc. +841A Server Performance Analisys Banyan Systems Inc. +841B Server Performance Analisys Banyan Systems Inc. +841C Server Performance Analisys Banyan Systems Inc. +841D Remote Database Services Interactive Data +841E Remote Database Services Interactive Data +841F Envelope Printer For Network Thuridion Software Engineering +8420 Dacs Office Ii Docunet GMbH +8421 Terminal Emulator - Transmit Intelligent Micro Software Ltd +8422 Terminal Emulator - Receive Intelligent Micro Software Ltd +8423 Praxis +8424 Reflex Compliance Prodigy Services +8425 Reflex Compliance Prodigy Services +8426 Reflex Compliance Prodigy Services +8427 Reflex Compliance Prodigy Services +8428 Reflex Compliance Prodigy Services +8429 Reflex Compliance Prodigy Services +842A IPX Remote Control Function Networth Inc. +842B IPX Remote Control Function Networth Inc. +842C SPX Server-Client Communication At&t Jens Corp. +842D TSR Broadcasting Via IPX At&t Jens Corp. +842E Sita +842F Sita +8430 Instant Recall I Daytimer Technologies +8431 Application Server Fc1 Thomson Financial +8432 Application Server Fc2 Thomson Financial +8433 Application Server Fc3 Thomson Financial +8434 Application Server Fc3 Thomson Financial +8435 Envelope Manager Software Psi Associates +8436 Envelope Manager Software Psi Associates +8437 Envelope Manager Software Psi Associates +8438 Envelope Manager Software Psi Associates +8439 Laa Server Bindary Socket Saber Software +843A 440 IPX Communications Information Builders +843B Vital Signs/lan Server Blueline Software Inc. +843C Vital Signs/lan Server Blueline Software Inc. +843D Envelope Printer For Network Thuridion Software Engineering +843E OS2 Sequel Server IPX/SPX Support Microsoft +843F Asynchronous Serial Communications Black Creek Integrated Systems +8440 Asynchronous Serial Communications Black Creek Integrated Systems +8441 Asynchronous Serial Communications Black Creek Integrated Systems +8442 Asynchronous Serial Communications Black Creek Integrated Systems +8443 Communication Between Sages American Auto Matrix Inc. +8444 TV Broadcast Automation Status Utah Scientific +8445 TV Broadcast Automation Status Utah Scientific +8446 TV Broadcast Automation Status Utah Scientific +8447 Client-Server Version Of Cc Mail Cc Mail +8448 TV Broadcast Automation Status Utah Scientific +8449 Netsprint Digital Products Inc. +844A Workstation Remote Control California Federal +844B Full Text Retrieval Cl/S Impact Italiana Srl +844C Gateway IPX Icot +844D Gateway SPX Icot +844E Workstation IPX Icot +844F Workstation SPX Icot +8450 Network Services IPX Icot +8451 Network Services SPX Icot +8452 Network Logger IPX Icot +8453 Network Logger SPX Icot +8454 Gateway Software Datev Eg +8455 Gateway Software Datev Eg +8456 Novell Inc. +8457 Re:action Concentric Technologies +8458 Re:action Concentric Technologies +8459 Cad Server Isicad +845A Cad Server Isicad +845B ICL Portable Netware ICL +845C Locate Zenith Data Systems +845D BOML Zenith Data Systems +845E Rhotheos Zenith Data Systems +845F Chat Program Intel +8460 Mailslots IBM +8461 Mailslots IBM +8462 File Talk Mountain Network Solutions Inc. +8463 File Talk Mountain Network Solutions Inc. +8464 File Talk Mountain Network Solutions Inc. +8465 File Talk Mountain Network Solutions Inc. +8466 File Talk Mountain Network Solutions Inc. +8467 File Talk Mountain Network Solutions Inc. +8468 Microcom +8469 Microcom +846A Microcom +846B Microcom +846C Microcom +846D Microcom +846E Microcom +846F Microcom +8470 Microcom +8471 Microcom +8472 Microcom +8473 Microcom +8474 Microcom +8475 Microcom +8476 Microcom +8478 Document Mangement Package Perfect Solutions Corp. +8479 Litigation Support Gibson Ochsner & Adkins +847A Monotrex Prime Computer +847B Monotrex Prime Computer +847C Monotrex Prime Computer +847D Monotrex Prime Computer +847E Monotrex Prime Computer +847F Monotrex Prime Computer +8480 Monotrex Prime Computer +8481 Monotrex Prime Computer +8482 Monotrex Prime Computer +8483 Monotrex Prime Computer +8484 Litigation Support Gibson Ochsner & Adkins +8485 Litigation Support Gibson Ochsner & Adkins +8486 Litigation Suuport Gibson Ochsner & Adkins +8487 Argus/n Triticom +8488 Argus/n Triticom +8489 Argus/n Triticom +848A Channel Switcher Application Dynatech Utah Scientific +848B Channel Switcher Application Dynatech Utah Scientific +848C Channel Switcher Application Dynatech Utah Scientific +848D Channel Switcher Application Dynatech Utah Scientific +848E Channel Switcher Application Dynatech Utah Scientific +848F Channel Switcher Application Dynatech Utah Scientific +8490 Channel Switcher Application Dynatech Utah Scientific +8491 Channel Switcher Application Dynatech Utah Scientific +8492 Oxford Information Technology +8493 Gateway Integration Architect Morrisey Associates +8494 Bootware/msd Lanworks +8495 Workgroup Computing Tool Memorex Telex +8496 Workgroup Computing Tool Memorex Telex +8497 Workgroup Computing Tool Memorex Telex +8498 Workgroup Computing Tool Memorex Telex +8499 Workgroup Computing Tool Memorex Telex +849A Workgroup Computing Tool Memorex Telex +849B Workgroup Computing Tool Memorex Telex +84A0 IPX/SPX Sockets Artefact Network Support +84A1 IPX/SPX Sockets Artefact Network Support +84A2 IPX/SPX Sockets Artefact Network Support +84A3 IPX/SPX Sockets Artefact Network Support +84A4 IPX/SPX Sockets Artefact Network Support +84A5 IPX/SPX Sockets Artefact Network Support +84A6 IPX/SPX Sockets Artefact Network Support +84A7 IPX/SPX Sockets Artefact Network Support +84A8 IPX/SPX Sockets Artefact Network Support +84A9 IPX/SPX Sockets Artefact Network Support +84AA Client-Server Driver For IPX/SPX Reference Point Software +84AB Intrak Inc. +84AC Intrak Inc. +84AD Intrak Inc. +84AE Intrak Inc. +84AF Intrak Inc. +84B0 Intrak Inc. +84B1 Database Applications Digital Equipment - Nashua +84B2 Database Applications Digital Equipment - Nashua +84B3 Loader Socket Casper Systems Inc. +84B4 Finder Socket Casper Systems Inc. +84B5 Automated Control System Air Products & Chemicals +84B6 Automated Control System Air Products & Chemicals +84B7 Audit Trail Package Blue Lance Inc. +84B8 Sbackup Enhancement Product Sytron Corp. +84B9 Tape Backup Systems Colorado Memory Systems +84BA QA+ Attention Socket Diagsoft Inc. +84BB Administration Server Mcgill University Fac Of Engin +84BC Administration Server Mcgill University Fac Of Engin +84BD Workstation Communications Symantec Peter Norton Group +84BE Workstation Communications Symantec Peter Norton Group +84BF Network Dynamic Data Exchange Netlogic Inc. +84C0 Asynchronous Communications Server Us Robotics Software +84C1 Software Communications Server Tentera Computer Services +84C2 Forum Send Texas A&m University +84C3 Forum Receive Texas A&m University +84C4 Forum Control Texas A&m University +84C5 Remote Printer Configuration Newgen Systems Corp. +84C6 Audit Trail Package Blue Lance Inc. +84C7 Peer-To-Peer Communications Fujitsu Networks Industry +84C8 Sna Gateway Microsoft +84C9 Sna Gateway Microsoft +84CA Workstation Terminal Access Hsd Hardware Software Developm +84CB Sercomm +84CC De International Ltd +84CD Application Tracking System Automated Interactions Div Of +84CE IBM Host Gateway Idea Courier +84CF Credit Authorization Gateway Merchantec International +84D0 Graphical Hotel Management App Insure Inc. +84D1 Graphical Hotel Management App Insure Inc. +84D2 Network Back-Up Digital Equipment +84D3 Client Server Application Alcon Systems +84D4 Client Server Application Alcon Systems +84D5 Communications Server Sdd Scandinavian Airlines Data +84D6 Information Systems Product Prosoftia Ab +84D7 Information Systems Product Prosoftia Ab +84D8 Information Systems Product Prosoftia Ab +84D9 Information Systems Product Prosoftia Ab +84DA Information Systems Product Prosoftia Ab +84DB Information Systems Product Prosoftia Ab +84DC Information Systems Product Prosoftia Ab +84DD Information Systems Product Prosoftia Ab +84DE Information Systems Product Prosoftia Ab +84DF Information Systems Product Prosoftia Ab +84E0 Object Oriented Database System Ontos Inc. +84E1 Object Oriented Database System Ontos Inc. +84E2 Tape Back-Up For NLM Application Mountain Network Solutions Inc. +84E3 Tape Back-Up For NLM Application Mountain Network Solutions Inc. +84E4 Tape Back-Up For NLM Application Mountain Network Solutions Inc. +84E5 Tape Back-Up For NLM Application Mountain Network Solutions Inc. +84E6 Attachmate Corp. +84E7 Tape Back-Up For NLM Application Mountain Network Solutions Inc. +84E8 Tape Back-Up For NLM Application Mountain Network Solutions Inc. +84E9 Brmsg Network Mail Server Softbridge Inc. +84EA Client Server Monitoring Utility Dell Computer +84EB Synectics For Os/2 Version 2.0 Parallel Pcs Inc. +84EC Synectics For Os/2 Version 2.0 Parallel Pcs Inc. +84ED Information Systems Product Prosoftia Ab +84EE Information Systems Product Prosoftia Ab +84EF Information Systems Product Prosoftia Ab +84F0 Information Systems Product Prosoftia Ab +84F1 Information Systems Product Prosoftia Ab +84F2 Information Systems Product Prosoftia Ab +84F3 Information Systems Product Prosoftia Ab +84F4 Information Systems Product Prosoftia Ab +84F5 Information Systems Product Prosoftia Ab +84F6 Information Systems Product Prosoftia Ab +84F7 Information Systems Product Prosoftia Ab +84F8 Information Systems Product Prosoftia Ab +84F9 Information Systems Product Prosoftia Ab +84FA Information Systems Product Prosoftia Ab +84FB Netscribe Meridian Data Corp. +84FC Netscribe Meridian Data Corp. +84FD Netscribe Meridian Data Corp. +84FE Netscribe Meridian Data Corp. +84FF Fax Server Ferrari Electronic GMbH +8502 Fourth Shift Mfg Add-On Package Computer Aided Business Sol +8503 Computer Aided Business Sol +8504 Computer Aided Business Sol +8505 Computer Aided Business Sol +8506 Computer Aided Business Sol +8507 Computer Aided Business Sol +8508 Computer Aided Business Sol +8509 Computer Aided Business Sol +850A Modem-Sharing Software - Dos Lansource Technologies +850B Modem-Sharing Software - Windows Lansource Technologies +850C Telephone Answering System A&m Communications +850D File/IPX-Based RPC System +850E Network Disc Back-Up Software Fortunet Inc. +850F Archives & Museum Management Cactus Software +8510 Fax Server Extended Systems +8511 Teletext Service University Of Plymouth +8512 Network Error Log University Of Plymouth +8513 Measureservers And Measureclients Advantech Benelux Bv +8514 3270 Netware For SAA Emulator Forvus Research Inc. +8515 3270 Netware For SAA Emulator Forvus Research Inc. +8516 Data Collection (Ws) Network Security Systems +8517 Database Mgr (Ws) Network Security Systems +8518 Database Gateway Information Builders +8519 Fax Server Extended Systems +851A Remote Printer Console Peerless Group +851B Batchfiler Jovandi International Inc. +851C Time Synchronization Jovandi International Inc. +851D Fax Server Login Socket Ascom Telecommunication Ltd +851E Fax Server - Cas Request Socket Ascom Telecommunication Ltd +851F Fax Server - Workstation Utility Ascom Telecommunication Ltd +8520 Fax Server - Faxbios Requests Ascom Telecommunication Ltd +8521 Fax Server - Faxserver Ascom Telecommunication Ltd +8522 Dfdsm Data Facilities Data Storage IBM +8523 Relational Database Gupta Technologies +8524 Report Server Stats Central Point Software +8525 Report Server Stats Central Point Software +8526 Cl/S CDC Program Supprt +8529 Document Processing Server NLM Boss Logic Inc. +852A Document Processing Server NLM Boss Logic Inc. +852B Document Processing Server NLM Boss Logic Inc. +852C Document Processing Server NLM Boss Logic Inc. +852D Document Processing Server NLM Boss Logic Inc. +852E Document Processing Server NLM Boss Logic Inc. +852F Financial Markets Information Srvr At Financial +8530 Email Notification On Technology +8531 Netview Support Memorex Telex +8532 Lanlord Product Microcom Client Server Technol +8533 Rts Terminal Emulation Data Research & Applications +8534 Rscf Client-Server Api Data Research & Applications +8535 CD Networker IPX Version Lotus +8536 SQL Server IPX/SPX Hidden Server Microsoft +853D Database Lock Server High Aspect Development +853E Message Manager LanCo Pty Ltd +853F Object Manager LanCo Pty Ltd +8540 Object Agent LanCo Pty Ltd +8541 Request Manager LanCo Pty Ltd +8544 Workstation 4-Lan Advanced Technical Solutions +8548 Internet Gateway Metascybe Systems Ltd +8549 Intelligent Host Gateway American Airlines Decision Tec +854C Wireless Lan IBM +854D Multi-System Mgr IBM +854E Netprint Calling Channel Interlink Communications Ltd +854F Netprint Working Channel Interlink Communications Ltd +8550 Remote Session Distributed Systems Tech +8551 Remote Session Distributed Systems Tech +8552 Remote Session Distributed Systems Tech +8553 Remote Session Distributed Systems Tech +8554 Peer-To-Peer Communications Fujitsu Networks Industry +8555 Diagnostic Utility Fujitsu Networks Industry +8556 NLM Health Monitor Presoft Architects +8557 Crisler Mcgee Crisler Mckee Software Develop +8558 Crisler Mcgee Crisler Mckee Software Develop +8559 Workstation Communication Intel +855A Policy Engine Emerald Systems +855B Policy Engine Emerald Systems +855C Policy Engine Emerald Systems +855D Policy Engine Emerald Systems +855E Policy Engine Emerald Systems +855F Policy Engine Emerald Systems +8560 Stand-Alone Print Server Bay Technical Associates +8561 Service Distribution Us West Advanced Technologies +8562 Service Distribution Us West Advanced Technologies +8563 Service Distribution Us West Advanced Technologies +8564 Service Distribution Us West Advanced Technologies +8565 Service Distribution Us West Advanced Technologies +8566 Service Distribution Us West Advanced Technologies +8568 Mprst Peer-To-Peer Us Sprint +8569 Mprst Broadcast Us Sprint +856A Lan Assist Plus Remote Control Microtest +856B Lan Assist Plus Remote Control Microtest +856C Lan Assist Plus Remote Control Microtest +856D Lan Assist Plus Remote Control Microtest +856E Map Assist Peer-To-Peer Microtest +856F Map Assist Peer-To-Peer Microtest +8570 Map Assist Peer-To-Peer Microtest +8571 Map Assist Peer-To-Peer Microtest +8572 Asynchronous Comms Servers US Robotics Software +8573 Database Server Fair Com +8574 NLM-Based Database Engine Auto Graphics Inc. +8575 Tiger Quote Server Requests Joshua Group Ltd +8576 Tiger Quote Broadcast Joshua Group Ltd +8577 User Socket Casper Systems Inc. +8578 Ghost Socket Casper Systems Inc. +8579 Remote Procedure Protocol Fortunet Inc. +857A Eicon Interconnect Server Eicon Technology +857B Eicon Security Agent Eicon Technology +857C Cost Recovery Server Vincent Larsen +857D Cost Recovery Server Vincent Larsen +857E Pc-Based Sna Gateway Ungermann Bass +857F Print Server Nissin Electric Co Ltd +8580 Peer-To-Peer Messaging Hans Spatzier +8581 Banking Dealing Rooms Art & Science Ltd +8582 Banking Dealing Rooms Art & Science Ltd +8583 Banking Dealing Rooms Art & Science Ltd +8584 Banking Dealing Rooms Art & Science Ltd +858E Printing Client Utility Tokyo Denshi Sekkei Kk +8590 Network Workstation Control Western Pacific Technologies +8591 Teletext Server Tevescom +8592 Print Server Foresyte Technologies +8599 Wan Networks Prosoftia Ab +859A Wan Networks Prosoftia Ab +859B Wan Networks Prosoftia Ab +859C Wan Networks Prosoftia Ab +859D Wan Networks Prosoftia Ab +859E Wan Networks Prosoftia Ab +859F Wan Networks Prosoftia Ab +85A0 Wan Networks Prosoftia Ab +85A1 Wan Networks Prosoftia Ab +85A2 Wan Networks Prosoftia Ab +85A7 Database Server Softwright Systems +85A8 Change Control Product Occidental Petroleum SVCs Inc. +85A9 Change Control Product Occidental Petroleum SVCs Inc. +85AA Statistic Management Multitech +85AB Statistic Management Multitech +85AC Remote Control Software Multitech +85AD Remote Control Software Multitech +85AE Multitech +85AF Remote Access Server DCA +85B0 Windows-Based Fax System Iconographic Systems +85B1 Print Server Add-On Intel +85B2 AGV Controller Communications Control Engineering +85B3 Index Sequential Access NLM Infopoint Systems +85B4 Associative Index Server Infopoint Systems +85B5 Stressmagic Server Utility Net Magic Systems Inc. +85B6 Network Power Tools Net Magic Systems Inc. +85B7 Document Management SVC Imagery Software Inc. +85B8 Image Management SVC Imagery Software Inc. +85B9 Mass Storage SVC Imagery Software Inc. +85BA Citrix Application Server Citrix Systems +85BB Citrix Application Server Citrix Systems +85BC Klos Technologies Inc. +85BD Hospital Management Package Softwork GMbH +85BE Router Management Application Cisco Systems +85BF Network Modem Nanagram +85C0 Network Modem Nanagram +85C4 5250 Gateway Communications Micro Integration +85C5 Software Distribution Suite Centera Pty Ltd +85C6 Software Distribution Suite Centera Pty Ltd +85C7 Software Distribution Suite Centera Pty Ltd +85C8 Software Distribution Suite Centera Pty Ltd +85C9 Tobit !team - Remote Controlling Tobit Software GMbH +85CA Faxware 3.0 - API Communication Tobit Software GMbH +85CB Tobit Plz5 - Database Server Tobit Software GMbH +85CC Avl NLM Database Aetna Life & Casualty +85CD Lu6.2 Gateway Aetna Life & Casualty +85CF Teli-Link Voice Server Computer & Communications Co +85D0 Remote Download Software Asante Technologies +85D5 Lan Expanders & Data Transfer Gateway Communications Inc. +85D6 Calendar Server Campbell Services +85D7 CA Unicenter Computer Associates +85D8 CA Unicenter Computer Associates +85D9 CA Unicenter Computer Associates +85DA CA Unicenter Computer Associates +85DB CA Unicenter Computer Associates +85DC CA Unicenter Computer Associates +85DD Net Modem SPX Socket Practical Peripherals Inc. +85DE Net Modem IPX Socket Practical Peripherals Inc. +85DF Alert Server NLM Central Point Software +85E0 Message Router Central Point Software +85E1 Optical File Server Communications Pegasus Disk Technologies Inc. +85E2 Optical File Server Login/logout Pegasus Disk Technologies Inc. +85E5 Print Server Rasterops Printer Tech Div +85E6 Quark Express Quark Inc. +85E7 Security NLM Soft Solutions +85E8 Endpoint Mapper For Rpc Microsoft +85E9 Pc Anywhere/netware Lite Symantec Corp. +85EA Interserver File Copying Bankers Trust Co +85EB Connection Services Rabbit Software Corp. +85EC Discovery Services Rabbit Software Corp. +85ED Network Monitor Services Rabbit Software Corp. +85EE Ca-Datacom/pc Computer Associates +85EF Ca-Idms/pc Computer Associates +85F1 Industrial Control Automation Tele Denken +85F2 Print Server Ringdale Uk Ltd +85F3 Communications Server Csb Systems GMbH +85F6 Database Datagram Socket Lync Inc. +85F7 Netport Express Status Responder Intel +85F8 Cadence Time Sync. Polygon Inc. +85F9 Cadence Time Sync. Polygon Inc. +85FA Remote Virus Scanning Mcafee Associates +85FB Remote Memory Control Mcafee Associates +85FC Norton Back-Up Device Sharing Astora Software Inc. +85FD Sams:expert Sterling Tefen Lab +85FE Sams:control Sterling Tefen Lab +85FF Sams:vantage Sterling Tefen Lab +8600 Sams:save Sterling Tefen Lab +8601 Sams:dispatcher Sterling Tefen Lab +8602 Rendezvous IPX Greyhouse Technologies +8603 Rendezvous IPX Greyhouse Technologies +8604 Rendezvous SPX Greyhouse Technologies +8605 Rendezvous SPX Greyhouse Technologies +8606 Voice/fax Responding Machine System Sophia +8608 Share Mode Broadcast Addstor +8609 IPX Encapsulated Rm3 Packets Cayman Systems Inc. +860A Database Service Trifox Inc. +860B Imagesolve ofs Imagesolve International +860C Techra Kvatro As +860D Docra Kvatro As +860E Network Management Application Wandel & Goltermann +860F Network Management Application Wandel & Goltermann +8610 Network Management Application Wandel & Goltermann +8611 Network Management Application Wandel & Goltermann +8612 Network Management Application Wandel & Goltermann +8613 Network Management Application Wandel & Goltermann +8614 Connection Acceptance Socket Chancery Software Ltd +8615 Optidriver-Net Optisys +8616 Edm Client/pc Computer Vision +8617 Video Conferencing Lloyd Allan Corp. +8618 Printer Gateway/peer-To-Peer Comm. Adacom Group +861C Communications Utility Lexmark International Inc. +861D Communications Utility Lexmark International Inc. +861E Print Server Lexmark International Inc. +861F Print Server Lexmark International Inc. +8620 Phone System Control Dash Open Phone Systems +8621 Phone System Control Dash Open Phone Systems +8622 Phone System Control Dash Open Phone Systems +8623 Phone System Control Dash Open Phone Systems +8624 Oversight Agent Network Utilities Software Ltd +8625 Oversight Master Network Utilities Software Ltd +8626 Erl Database Server Silver Platter Information Ltd +8627 Erl Directory Server Silver Platter Information Ltd +8628 IPX Broadcast Intertech Imaging Corp. +8629 SPX Connect Intertech Imaging Corp. +862A Ziff Proprietary Services Ziff Information Services +862B Games Looking Glass +862C Lpt Ports Lexmark International Inc. +862D Lpt Ports Lexmark International Inc. +862E Lpt Ports Lexmark International Inc. +862F Lpt Ports Lexmark International Inc. +8630 Lpt Ports Lexmark International Inc. +8631 Lpt Ports Lexmark International Inc. +8632 Lpt Ports Lexmark International Inc. +8633 Lpt Ports Lexmark International Inc. +8634 Time Server Broadcast Socket Meinberg Funkuhren +8635 Acceleration Data Sable Technology Corp. +8636 Callpath IBM +8637 Callpath IBM +8638 Communication Integrator - SPX Covia Corp. +8639 Communication Integrator - IPX Covia Corp. +863B Information Mgmt Systems Intuitive Solutions +863C Information Mgmt Systems Intuitive Solutions +863D Information Mgmt Systems Intuitive Solutions +863E Information Mgmt Systems Intuitive Solutions +863F Arts Rlogin Application American Real Time, Reuters Co +8640 Arts Generic Server American Real Time, Reuters Co +8641 Netop Program Danware Data As +8642 Netop Program Danware Data As +8643 Netop Program Danware Data As +8644 Netop Program Danware Data As +8645 Netop Program Danware Data As +8646 Document Management System Sr Associates/cybermedia +8647 Security Check Mcafee Associates +8648 Newswire Notification Generation Technologies Corp. +8649 P-Net Gateway Proces Data Silkeborg Aps +864A Virtual Manufacturing Device Proces Data Silkeborg Aps +864B Sales Application Proxim Inc. +864C Broadcasts Remuera Corp. +864D Communications Remuera Corp. +864E Lan/cd Rom Server Logicraft +8650 Server Socket Knight Ridder Financial Inc. +8651 Ping Socket Knight Ridder Financial Inc. +8652 Broadcast Datagram Socket Knight Ridder Financial Inc. +8653 Empower Link Application Loader Network Security Systems +8654 Name Resolution Intelec Systems Corp. +8655 Message Line Norman Data Defanse Systems +8656 Client Message Line Norman Data Defanse Systems +8657 Cd Sharing On Novell Workstation Cross International Corp. +8658 Nettalk Lan Communications Swre Cross International Corp. +8659 Telephone Communications Software Cross International Corp. +865A Lan Chatting Cross International Corp. +865B Network Management Server Pole Position Software GMbH +865C Remote Access Socket #1 Traveling Software +865D Remote Access Socket #2 Traveling Software +865E Net Trax Administration Net X Corp. +865F Net Trax Agent Net X Corp. +8660 Net Trax Alarm Monitor Net X Corp. +8661 AO Client Icl Personal Systems Oy +8662 AO Server For Client Icl Personal Systems Oy +8663 AO Directory Server Icl Personal Systems Oy +8664 AO Server Alarmer Icl Personal Systems Oy +8665 AO Client Alarmer Icl Personal Systems Oy +8666 AO Lan Rts Icl Personal Systems Oy +8667 AO Remote Cmd Server Icl Personal Systems Oy +8668 AO Remote Cmd Client Icl Personal Systems Oy +8669 AO Dir Join Server Icl Personal Systems Oy +866A AO Storage Server For Client Icl Personal Systems Oy +866B Save Utiltiy/2 IBM +866C Save Utiltiy/librarian IBM +866D Save Utiltiy/curator IBM +866E Save Utiltiy/janitor IBM +866F Save Utiltiy/archives I IBM +8670 Save Utiltiy/archives Ii IBM +8671 Save Utiltiy/archives Iii IBM +8672 Save Utiltiy/archives Iv IBM +8673 Save Utiltiy/archives V IBM +8674 Save Utiltiy/archives Vi IBM +8675 Save Utiltiy/archives Vii IBM +8676 Save Utiltiy/archives Viii IBM +8677 Safeserver Omnitech Corp.orate Solutions +8678 Client NLM Communications Software Security Inc. +8679 NLM Server To Server Software Security Inc. +867A File Transfer Application Urs Zurbuchen +867B Sd Rom Jukebox Command Server Todd Enterprises Inc. +867C Courseware Server First Class Systems +867D UDP Over IPX Transmit Synoptics +867E UDP Over IPX Receive Synoptics +867F Realtime Voice Comm. Software Vocaltec Inc. +8681 Person To Person Product IBM +8682 Net Tune Hawknet Inc. +8683 Net Tune Hawknet Inc. +8684 Net Tune Hawknet Inc. +8685 Net Tune Hawknet Inc. +868A Access Control & License Mngmnt Dallas Semiconductor +868B Stand-Alone Print Server Sercomm +868C Cd-Vine Peer-To-Peer Comms Info Line +868D Ftp Central Point Software +868E Tftp Central Point Software +868F Boot Ps Central Point Software +8690 Boot Pc Central Point Software +8692 Client To Server Communication Nbs Systems Inc. +8693 Server To Server Communication Nbs Systems Inc. +8694 Notification Purposes Nbs Systems Inc. +8695 Future Expansion Nbs Systems Inc. +8696 Future Expansion Nbs Systems Inc. +8697 Sna Services Network Controls International +8698 Sna Services Network Controls International +869A Protocol IPX Ost-Ouest Standard Telematique +869B Protocol IPX Ost-Ouest Standard Telematique +869C Multi-Player Game - Doom ID Software +869D Network Management Hewlett Packard +869E Network Management Hewlett Packard +869F Distribution Services Discovery IBM +86A0 Document Management Package Soft Solutions +86A1 Document Management Package Soft Solutions +86A2 Document Management Package Soft Solutions +86A3 Document Management Package Soft Solutions +86A8 Central Monitoring System Talx Corp. +86A9 Central Monitoring System Talx Corp. +86AA Central Monitoring System Talx Corp. +86AB Central Monitoring System Talx Corp. +86AC Central Monitoring System Talx Corp. +86AD End Point Mapper Microsoft +86AE End Point Mapper Microsoft +86AF End Point Mapper Microsoft +86B0 Calendar Server Campbell Services Inc. +86BA Network Management Application Xircom +86BB Network Management Application Xircom +86BC Network Management Application Xircom +86BD Network Management Application Xircom +86BE Network Management Application Xircom +86BF Network Management Application Xircom +86CE Service Location Protocol Eicon Technology +86CF Twinscope For IPX Nippon System Kaihutsu +86D0 Major Bbs Software Galacticomm Inc. +86D1 Major Bbs Software Galacticomm Inc. +86D2 Major Bbs Software Galacticomm Inc. +86D3 Major Bbs Software Galacticomm Inc. +86D4 Major Bbs Software Galacticomm Inc. +86D5 Major Bbs Software Galacticomm Inc. +86D6 Major Bbs Software Galacticomm Inc. +86D7 Major Bbs Software Galacticomm Inc. +86D8 Major Bbs Software Galacticomm Inc. +86D9 Major Bbs Software Galacticomm Inc. +86DC Faxware 3.0 (c-Req) Tobit Software GMbH +86DD Faxware 3.0 (hs-Comm) Tobit Software GMbH +86DE Faxware 3.0 (tld) Tobit Software GMbH +86DF High Performance Comm Srv Tobit Software GMbH +86E0 High Performance Comm Srv Tobit Software GMbH +86E1 High Performance Comm Srv Tobit Software GMbH +86E2 High Performance Comm Srv Tobit Software GMbH +86E3 High Performance Comm Srv Tobit Software GMbH +86E4 High Performance Comm Srv Tobit Software GMbH +86E5 Electronic Spelling Book Tobit Software GMbH +86E6 Electronic Spelling Book Tobit Software GMbH +86E7 Electronic Spelling Book Tobit Software GMbH +86E8 Electronic Spelling Book Tobit Software GMbH +86F1 Office Extend Server Fransen King +86F2 Windows Nt Facsys Server Optus Information Systems +86F3 Windows Nt Facsys Server Optus Information Systems +86F4 Windows Nt Facsys Server Optus Information Systems +86F7 Keyfile Name Service Keyfile Corp. +86F8 Evergreen Management Agent Goodall Software +86F9 Evergreen Management Agent Goodall Software +86FA Evergreen Management Agent Goodall Software +86FB Evergreen Management Agent Goodall Software +86FC Evergreen Management Agent Goodall Software +86FD Evergreen Management Agent Goodall Software +86FE File Synchronizition Nomadic Systems +86FF Windows Bulletin Board System Pacer Software +8702 Lan Netview Management Utilities IBM +8703 Lan Netview Management Utilities IBM +8704 Lan Netview Management Utilities IBM +8705 Lan Netview Management Utilities IBM +8706 Lan Netview Management Utilities IBM +8707 Ethernet-Managed Stackable Hub IBM +8708 Document Management Package Soft Solutions +8709 Document Management Package Soft Solutions +870A Document Management Package Soft Solutions +870B Document Management Package Soft Solutions +870C Document Management Package Soft Solutions +870D Goodall Virtual Protocol Adaptor Goodall Software +870E Goodall Virtual Protocol Adaptor Goodall Software +870F Goodall Virtual Protocol Adaptor Goodall Software +8710 Goodall Virtual Protocol Adaptor Goodall Software +871D Pinnacle Relational Engine Vermont Database Corp. +871E Fault Tolerance Clone Star Software +8724 Unix Mail Server Felpausch +8727 Industiral Test & Handling Eq Q Corp. +8728 Industiral Test & Handling Eq Q Corp. +8729 Industiral Test & Handling Eq Q Corp. +872A Teli-Link Voice Server Computer & Communications Co +872B Secure Fax Client Socket Russell Consulting +8733 Bridge Router Menu Connection Networks Northwest Inc. +8734 Bridge Router Error Log Networks Northwest Inc. +8735 Image Server Connection Watermark Software +8737 Exsekey Interface Clover Informatica Snc +8738 Metering Program Secure Design +873C Comet Terminal Server Goodall Software +873D Comet Terminal Server Goodall Software +873E Comet Terminal Server Goodall Software +873F Comet Terminal Server Goodall Software +8740 Comet Terminal Server Goodall Software +8741 Comet Terminal Server Goodall Software +8742 Comet File Server Goodall Software +8743 Comet File Server Goodall Software +8744 Comet File Server Goodall Software +8745 Comet File Server Goodall Software +8746 Comet File Server Goodall Software +8747 Comet File Server Goodall Software +874A Maxserv Communications Maxserv +874B Maxserv Communications Maxserv +874C NCP Communication - Job Scheduler Simware +874E Trace Route 3com +874F Client Data Share Protocol At&t +875B Tvi Desktop Server Target Vision +875C Mastershow Target Vision +875D User-Access Server Tmd Consulting +875E TCP Gateway Tmd Consulting +875F Cam Server Tmd Consulting +8760 Cam Secure Database Tmd Consulting +8761 Cam Resource Manager Tmd Consulting +8762 Cam Back-Up Tmd Consulting +8763 Firefox NLMs And Client Software Firefox Communications Ltd +8764 Firefox NLMs And Client Software Firefox Communications Ltd +8765 Firefox NLMs And Client Software Firefox Communications Ltd +8766 Firefox NLMs And Client Software Firefox Communications Ltd +8767 Firefox NLMs And Client Software Firefox Communications Ltd +8768 Firefox NLMs And Client Software Firefox Communications Ltd +8769 Firefox NLMs And Client Software Firefox Communications Ltd +876A Firefox NLMs And Client Software Firefox Communications Ltd +876B Firefox NLMs And Client Software Firefox Communications Ltd +876C Firefox NLMs And Client Software Firefox Communications Ltd +876D Data Transactions Tenfore Research & Development +876E Flow Control Tenfore Research & Development +8770 Remote Control Product IBM +8771 Remote Control Product IBM +8772 Remote Control Product IBM +8773 Remote Control Product IBM +877C Hitecsoft Send Socket Hitecsoft Corp. +877D Hitecsoft Receive Socket Hitecsoft Corp. +877E Lan School For Windows Lan Fan Technologies +877F Remote Access Protocol For Desktop Intel - American Fork +8786 Daytimer Organizer Daytimer Technologies +8787 Video Server Corel Systems Corp. +8788 Lan Performance Mngmt Tool IPX/SPX Digital Equipment Corp. +8789 Lan Performance Mngmt Tool TCP Digital Equipment Corp. +878B Status Socket National Software Development +878C Production Socket National Software Development +878D A Non-Name-Pipe Server Team Development Corp. +9000 NP/SQL Server Novell Inc. +9001 Wide Area Router Novell Inc. +9002 Wide Area Router Novell Inc. +9003 Wide Area Router Novell Inc. +9004 Wide Area Router Novell Inc. +9005 Wide Area Router Novell Inc. +9006 Wide Area Router Novell Inc. +9007 Wide Area Router Novell Inc. +9008 Wide Area Router Novell Inc. +9009 Wide Area Router Novell Inc. +900A Wide Area Router Novell Inc. +900B Wide Area Router Novell Inc. +900C Wide Area Router Novell Inc. +900D 386 Profiler Novell Inc. +900E Portable Netware Internal Wat Novell Inc. +900F Smnp Over IPX Novell Inc. +9010 Smnp Over IPX Novell Inc. +9012 Software Distribution Phaser Systems +9013 Software Distribution Phaser Systems +9014 Software Distribution Phaser Systems +9015 Software Distribution Phaser Systems +9016 Software Distribution Phaser Systems +9017 Chat - Windows Novell Inc. +9019 Rpc Bind Novell Inc. +901A Rpc Bind Novell Inc. +901E Novell Inc. +901F Netware 'slurpy' Novell Inc. +9021 SPX Connection Novell Inc. +9022 Job Server Novell Inc. +9023 Netware 'slurpy' Novell Inc. +9024 Netware 'slurpy' Novell Inc. +9025 Netware 'slurpy' Novell Inc. +9026 Netware 'slurpy' Novell Inc. +9027 Novell Inc. +9028 Network Management Novell Inc. +9029 Novell Inc. +902A Novell Inc. +902B Novell Inc. +902C Network Management Client Info Novell Inc. +902D Novell Inc. +902E Dos Target Service Agent Novell Inc. +902F Novell Inc. +9030 Superlab Automation Server Novell Inc. +9031 Rpc Bind Novell Inc. +9032 IPX Biff Univel +9033 IPX Bootpc Univel +9034 IPX Bootps Univel +9035 IPX Chargen Univel +9036 IPX Daytime Univel +9037 IPX Discard Univel +9038 IPX Echo Univel +9039 IPX Eprc Univel +903A IPX Monitor Univel +903B IPX Name Univel +903C IPX Nameserver Univel +903D IPX Netstat Univel +903E IPX New-Rwho Univel +903F IPX Nfsd Univel +9040 IPX Ntp Univel +9041 IPX Qotd Univel +9042 IPX Rmonitor Univel +9043 IPX Route Univel +9044 IPX Syslog Univel +9045 IPX Systat Univel +9046 IPX Talk Univel +9047 IPX Time Univel +9048 IPX Who Univel +9049 IPX Whois Univel +904A SPX Apfs Univel +904B SPX Apts Univel +904C SPX Auth Univel +904D SPX Bftp Univel +904E SPX Chargen Univel +904F SPX Cmip-Agent Univel +9050 SPX Cmip-Manage Univel +9051 SPX Courier Univel +9052 SPX Csnet-Ns Univel +9053 SPX Daytime Univel +9054 SPX Discard Univel +9055 SPX Echo Univel +9056 SPX Exec Univel +9057 SPX Finger Univel +9058 SPX Ftp Univel +9059 SPX Ftp-Data Univel +905A SPX Hostnames Univel +905B SPX Ingreslock Univel +905C SPX Iso-Ip Univel +905D SPX Iso-Tp0 Univel +905E SPX Iso-Tsap Univel +905F SPX Link Univel +9060 SPX Listen Univel +9061 SPX Login Univel +9062 SPX Name Univel +9063 SPX Nameserver Univel +9064 SPX Netstat Univel +9065 SPX Nntp Univel +9066 SPX Ntp Univel +9067 SPX Pcserver Univel +9068 SPX Pop-2 Univel +9069 SPX Print-Srv Univel +906A SPX Printer Univel +906B SPX Qotd Univel +906C SPX Rje Univel +906D SPX Sftp Univel +906E SPX Shell Univel +906F SPX Smtp Univel +9070 SPX Supdup Univel +9071 SPX Systat Univel +9072 SPX Telnet Univel +9073 SPX Time Univel +9074 SPX Ttymon Univel +9075 SPX Uucp Univel +9076 SPX Uucp-Path Univel +9077 SPX Whois Univel +9078 SPX X400 Univel +9079 SPX X400-Snd Univel +907A SPX Xserver0 Univel +907B SMS Novell Inc. +907C SMS Novell Inc. +907D Queue Server For IBM PSf/2 Novell Inc. +907E IPX Socket For Btrieve Requester Novell Inc. +907F Netware For SAA Novell Inc. +9080 Address Server Novell Inc. +9081 Novell MHS DS Gateway For Oce Novell Inc. +9082 NDS Gateway For Oce Novell Inc. +9083 X.400 Protocol Access Module Novell Inc. +9084 Snads Protocol Access Module Novell Inc. +9085 Remote Program Spawning Novell Inc. +9086 IPX Ping Novell Inc. +9087 Enhanced NCP Communications Novell Inc. +9088 Roaming Client Support Novell Inc. +9089 Netware For SAA - Load Balancing Novell Inc. +9093 Monitor Socket Novell Inc. +9094 Datalink Switching (dlsw) Novell Inc. +9095 Remote Control Software Program Novell Inc. diff --git a/NWTP/XIPX/S_HELLO.PAS b/NWTP/XIPX/S_HELLO.PAS new file mode 100644 index 0000000..b2b02b4 --- /dev/null +++ b/NWTP/XIPX/S_HELLO.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XIPX/S_PEP.PAS b/NWTP/XIPX/S_PEP.PAS new file mode 100644 index 0000000..d2e1c70 --- /dev/null +++ b/NWTP/XIPX/S_PEP.PAS @@ -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. diff --git a/NWTP/XIPX/TSTRIP.PAS b/NWTP/XIPX/TSTRIP.PAS new file mode 100644 index 0000000..c6fb8c5 --- /dev/null +++ b/NWTP/XIPX/TSTRIP.PAS @@ -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. diff --git a/NWTP/XIPX/VEND_XXX b/NWTP/XIPX/VEND_XXX new file mode 100644 index 0000000..c89e082 --- /dev/null +++ b/NWTP/XIPX/VEND_XXX @@ -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) diff --git a/NWTP/XLOCK/TSTLRL.PAS b/NWTP/XLOCK/TSTLRL.PAS new file mode 100644 index 0000000..6598fbd --- /dev/null +++ b/NWTP/XLOCK/TSTLRL.PAS @@ -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. diff --git a/NWTP/XLOCK/TSTPFL.PAS b/NWTP/XLOCK/TSTPFL.PAS new file mode 100644 index 0000000..06cc711 --- /dev/null +++ b/NWTP/XLOCK/TSTPFL.PAS @@ -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. diff --git a/NWTP/XMESS/PMAIL.PAS b/NWTP/XMESS/PMAIL.PAS new file mode 100644 index 0000000..598901f --- /dev/null +++ b/NWTP/XMESS/PMAIL.PAS @@ -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. diff --git a/NWTP/XMESS/TSTMESS.PAS b/NWTP/XMESS/TSTMESS.PAS new file mode 100644 index 0000000..ddd35a5 --- /dev/null +++ b/NWTP/XMESS/TSTMESS.PAS @@ -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(' 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. \ No newline at end of file diff --git a/NWTP/XMESS/XPMAIL.PAS b/NWTP/XMESS/XPMAIL.PAS new file mode 100644 index 0000000..977bd05 --- /dev/null +++ b/NWTP/XMESS/XPMAIL.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XOTHER/PHONE.PAS b/NWTP/XOTHER/PHONE.PAS new file mode 100644 index 0000000..3515f12 --- /dev/null +++ b/NWTP/XOTHER/PHONE.PAS @@ -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 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 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 w2sec; + 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(''); +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. \ No newline at end of file diff --git a/NWTP/XOTHER/TVLM.PAS b/NWTP/XOTHER/TVLM.PAS new file mode 100644 index 0000000..c336dda --- /dev/null +++ b/NWTP/XOTHER/TVLM.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XQMS/QAVAIL.PAS b/NWTP/XQMS/QAVAIL.PAS new file mode 100644 index 0000000..5faaf61 --- /dev/null +++ b/NWTP/XQMS/QAVAIL.PAS @@ -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 '); + 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. + diff --git a/NWTP/XSEMA/SEMATEST.PAS b/NWTP/XSEMA/SEMATEST.PAS new file mode 100644 index 0000000..9095c7d --- /dev/null +++ b/NWTP/XSEMA/SEMATEST.PAS @@ -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. diff --git a/NWTP/XSEMA/TSTSEMA2.PAS b/NWTP/XSEMA/TSTSEMA2.PAS new file mode 100644 index 0000000..c38abf2 --- /dev/null +++ b/NWTP/XSEMA/TSTSEMA2.PAS @@ -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(' 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. + diff --git a/NWTP/XSERV/CLRCONN.PAS b/NWTP/XSERV/CLRCONN.PAS new file mode 100644 index 0000000..c36d4ae --- /dev/null +++ b/NWTP/XSERV/CLRCONN.PAS @@ -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. \ No newline at end of file diff --git a/NWTP/XSERV/LOGLOCK.PAS b/NWTP/XSERV/LOGLOCK.PAS new file mode 100644 index 0000000..0ffbf1b --- /dev/null +++ b/NWTP/XSERV/LOGLOCK.PAS @@ -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. diff --git a/NWTP/XSERV/TSTSERV.PAS b/NWTP/XSERV/TSTSERV.PAS new file mode 100644 index 0000000..800a6ee --- /dev/null +++ b/NWTP/XSERV/TSTSERV.PAS @@ -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) + '); +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) + '); +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. diff --git a/README b/README new file mode 100644 index 0000000..1a867a1 --- /dev/null +++ b/README @@ -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. diff --git a/SRC/COPYING b/SRC/COPYING new file mode 100644 index 0000000..76ce5a6 --- /dev/null +++ b/SRC/COPYING @@ -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. + + + Copyright (C) 19yy + + 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. + + , 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. diff --git a/SRC/DELUSER.DCU b/SRC/DELUSER.DCU new file mode 100644 index 0000000..39e84da Binary files /dev/null and b/SRC/DELUSER.DCU differ diff --git a/SRC/DELUSER.DFM b/SRC/DELUSER.DFM new file mode 100644 index 0000000..301a4d1 Binary files /dev/null and b/SRC/DELUSER.DFM differ diff --git a/SRC/DELUSER.PAS b/SRC/DELUSER.PAS new file mode 100644 index 0000000..0e35095 --- /dev/null +++ b/SRC/DELUSER.PAS @@ -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. diff --git a/SRC/EDUSER.DCU b/SRC/EDUSER.DCU new file mode 100644 index 0000000..3abf0cb Binary files /dev/null and b/SRC/EDUSER.DCU differ diff --git a/SRC/EDUSER.DFM b/SRC/EDUSER.DFM new file mode 100644 index 0000000..3dc6c52 Binary files /dev/null and b/SRC/EDUSER.DFM differ diff --git a/SRC/EDUSER.PAS b/SRC/EDUSER.PAS new file mode 100644 index 0000000..b3e8463 --- /dev/null +++ b/SRC/EDUSER.PAS @@ -0,0 +1,116 @@ +unit Eduser; + +interface + +uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, + StdCtrls, ExtCtrls, Dialogs; + +type + TBtnBottomDlg3 = class(TForm) + OKBtn: TBitBtn; + CancelBtn: TBitBtn; + Bevel1: TBevel; + Edit1: TEdit; + CheckBox1: TCheckBox; + Button1: TButton; + Label1: TLabel; + procedure FormShow(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure Button1Click(Sender: TObject); + private + { Private declarations } + public + UserNAme: String; + Int1: Integer; + { Public declarations } + end; + +var + BtnBottomDlg3: TBtnBottomDlg3; + +implementation + +{$R *.DFM} + +uses User, nwBindry, SysUtils, ChgPass2; + +function IsUserPrivileged(UserName:String): Boolean; +begin + IsUserPrivileged:=IsBinderyObjectInSet(UserName, OT_USER, 'SECURITY_EQUALS', + 'SUPERVISOR', OT_USER); +end; + +procedure TBtnBottomDlg3.FormShow(Sender: TObject); +begin + UserName:=''; Int1:=1; + While BtnBottomDlg.ListBox1.Items[BtnBottomDlg.ListBox1.ItemIndex][Int1]<>',' do + begin + UserName:=UserName+BtnBottomDlg.ListBox1.Items[BtnBottomDlg.ListBox1.ItemIndex][Int1]; + Int1:=Int1+1; + end; + Edit1.Text:=BtnBottomDlg.GetUnixUser(UserName); + Caption:='Editing User '+UserName; + CheckBox1.Checked:=((IsUserPrivileged(UserName)) or (UserName='SUPERVISOR')); + CheckBox1.Enabled:=(UserName<>'SUPERVISOR'); + Button1.Enabled:=(UserName<>'SUPERVISOR'); +end; + +function GetNewPass: String; +begin + PassWordDlg.ShowModal; + GetNewPAss:=PasswordDlg.Password.Text; +end; + + +procedure TBtnBottomDlg3.OKBtnClick(Sender: TObject); +var SX: Integer; + MyPThing: TProperty; + +begin + For SX:=1 to 128 do MyPThing[SX]:=0; + StrPCopy(Addr(MyPThing), Edit1.Text); + WritePropertyValue(UserName, OT_USER, 'UNIX_USER', 1, MyPThing, False); + if UserName<>'SUPERVISOR' then + begin + DeleteProperty(UserName, OT_USER, 'SECURITY_EQUALS'); + CreateProperty(Edit1.Text, OT_USER, 'SECURITY_EQUALS', BF_SET, $31); + if CheckBox1.Checked then AddBinderyObjectToSet(Edit1.Text, OT_USER, + 'SECURITY_EQUALS','SUPERVISOR', OT_USER) + else AddBinderyObjectToSet(Edit1.Text, OT_USER,'SECURITY_EQUALS','EVERYONE', OT_USER_GROUP); + end; + MessageDlg('Changes to user will take effect next time they login.', mtInformation, [mbOK], 0); + Close; +end; + +procedure TBtnBottomDlg3.Button1Click(Sender: TObject); +var Successish: Boolean; + Int3: Integer; + Prop1: TProperty; +begin + Successish:=DeleteBinderyObject(UserName, OT_USER); + if Successish=TRUE then + begin + if CreateBinderyObject(UserName, OT_USER, 0, $31)=FALSE then Successish:=False + else begin + CreateProperty(UserNAme, OT_USER, 'UNIX_USER', 0, $30); + CreateProperty(UserName, OT_USER, 'SECURITY_EQUALS', BF_SET, $31); + CreateProperty(UserName, OT_USER, 'GROUPS_I''M_IN', BF_SET, $32); + For Int3:=1 to 128 do Prop1[Int3]:=0; + StrPCopy(Addr(Prop1), Edit1.Text); + WritePropertyValue(UserName, OT_USER, 'UNIX_USER', 1, Prop1, False); + {Security} + if CheckBox1.Checked then AddBinderyObjectToSet(UserName, OT_USER, + 'SECURITY_EQUALS','SUPERVISOR', OT_USER) + else AddBinderyObjectToSet(UserName, OT_USER,'SECURITY_EQUALS','EVERYONE', OT_USER_GROUP); + {Groups} + AddBinderyObjectToSet(UserName, OT_USER, 'GROUPS_I''M_IN','EVERYONE', OT_USER_GROUP); + {Set Password} + if ChangeEncrBinderyObjectPassword(Username, OT_USER, '', GetNewPass)=FALSE then + MessageDlg('There was an error setting the password. The password is empty!', mtwarning, [mbOK], 0); + end; + end; + if Successish=FALSE then MessageDlg('Failed. Sorry.', mtError, [mbOK], 0) else + MessageDlg('Password Changed.', mtError, [mbOK], 0); +end; + +end. diff --git a/SRC/MYADMIN.DPR b/SRC/MYADMIN.DPR new file mode 100644 index 0000000..8b124d6 --- /dev/null +++ b/SRC/MYADMIN.DPR @@ -0,0 +1,35 @@ +program Myadmin; + +uses + Forms, + Startfrm in 'STARTFRM.PAS' {Form1}, + nwBindry in 'UNITS\NWBINDRY.PAS', + NWintr in 'UNITS\NWINTR.PAS', + NWMISC in 'UNITS\NWMISC.PAS', + nwConn in 'UNITS\NWCONN.PAS', + nwServ in 'UNITS\NWSERV.PAS', + User in 'USER.PAS' {BtnBottomDlg}, + Deluser in 'DELUSER.PAS' {BtnRightDlg}, + Passform in '\DELPHI\IMAGES\ICONS\PASSFORM.PAS' {BtnBottomDlg1}, + Adduser in '\DELPHI\IMAGES\BUTTONS\ADDUSER.PAS' {BtnBottomDlg2}, + Eduser in 'EDUSER.PAS' {BtnBottomDlg3}, + Svrutil in 'SVRUTIL.PAS' {BtnRightDlg1}, + nwMess in 'UNITS\NWMESS.PAS', + Sendmsg in 'UNITS\SENDMSG.PAS' {BtnBottomDlg4}, + Chgpass2 in 'UNITS\CHGPASS2.PAS' {PasswordDlg}; + +{$R *.RES} + +begin + Application.Title := 'NWE Admin 0.1'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TBtnBottomDlg, BtnBottomDlg); + Application.CreateForm(TBtnRightDlg, BtnRightDlg); + Application.CreateForm(TBtnBottomDlg1, BtnBottomDlg1); + Application.CreateForm(TBtnBottomDlg2, BtnBottomDlg2); + Application.CreateForm(TBtnBottomDlg3, BtnBottomDlg3); + Application.CreateForm(TBtnRightDlg1, BtnRightDlg1); + Application.CreateForm(TBtnBottomDlg4, BtnBottomDlg4); + Application.CreateForm(TPasswordDlg, PasswordDlg); + Application.Run; +end. diff --git a/SRC/MYADMIN.EXE b/SRC/MYADMIN.EXE new file mode 100644 index 0000000..5f9ec39 Binary files /dev/null and b/SRC/MYADMIN.EXE differ diff --git a/SRC/MYADMIN.OPT b/SRC/MYADMIN.OPT new file mode 100644 index 0000000..6284864 --- /dev/null +++ b/SRC/MYADMIN.OPT @@ -0,0 +1,34 @@ +[Compiler] +A=1 +B=0 +D=1 +F=0 +I=1 +K=1 +L=1 +P=1 +Q=0 +R=0 +S=1 +T=0 +U=1 +V=1 +W=0 +X=1 +Y=1 + +[Linker] +MapFile=0 +LinkBuffer=0 +DebugInfo=0 +OptimizeExe=1 +StackSize=16384 +HeapSize=8192 + +[Directories] +OutputDir= +SearchPath= +Conditionals= + +[Parameters] +RunParams= diff --git a/SRC/MYADMIN.RES b/SRC/MYADMIN.RES new file mode 100644 index 0000000..c3cc46d Binary files /dev/null and b/SRC/MYADMIN.RES differ diff --git a/SRC/README.TXT b/SRC/README.TXT new file mode 100644 index 0000000..2e1b4bd --- /dev/null +++ b/SRC/README.TXT @@ -0,0 +1,51 @@ +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. + +Hi Folks! I'm James Jeffrey Thanks for trying my software and I hope +you like it. + +This software is in a very eaarly state, the interface is fairly self +explanatory (I HOPE ;-) ) So I will let you work it out! + +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. + + +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. + +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. \ No newline at end of file diff --git a/SRC/STARTFRM.DCU b/SRC/STARTFRM.DCU new file mode 100644 index 0000000..0452945 Binary files /dev/null and b/SRC/STARTFRM.DCU differ diff --git a/SRC/STARTFRM.DFM b/SRC/STARTFRM.DFM new file mode 100644 index 0000000..8bedf62 Binary files /dev/null and b/SRC/STARTFRM.DFM differ diff --git a/SRC/STARTFRM.PAS b/SRC/STARTFRM.PAS new file mode 100644 index 0000000..2e30203 --- /dev/null +++ b/SRC/STARTFRM.PAS @@ -0,0 +1,145 @@ +unit Startfrm; + +interface + +uses + SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, + Forms, Dialogs, NwBindry, NWConn, NWServ, StdCtrls, User, Buttons, + ExtCtrls, PassForm, SvrUTil; + +type + TForm1 = class(TForm) + + Label1: TLabel; + SpeedButton1: TSpeedButton; + SpeedButton2: TSpeedButton; + SpeedButton3: TSpeedButton; + SpeedButton4: TSpeedButton; + Panel1: TPanel; + Panel2: TPanel; + Image1: TImage; + procedure FormCreate(Sender: TObject); + procedure Label1Click(Sender: TObject); + procedure SpeedButton4Click(Sender: TObject); + procedure SpeedButton2Click(Sender: TObject); + procedure SpeedButton1Click(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure AppActivate(Sender: TObject); + procedure FormPaint(Sender: TObject); + procedure SpeedButton3Click(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { Private declarations } + public + FirstTime: Boolean; + { Public declarations } + end; + +var + Form1: TForm1; + UzerID: String; +implementation + +{$R *.DFM} + + + +procedure TForm1.AppActivate(Sender: TObject); +begin + if FirstTime=FALSE then + begin + FirstTime:=True; + + end; + FormActivate(Sender); +end; + + +procedure TForm1.FormCreate(Sender: TObject); +var Lvl, ID: Byte; + UserName: String; + OwnID: Longint; +begin + Application.OnActivate:=AppActivate; +end; + +procedure TForm1.Label1Click(Sender: TObject); +begin + BtnBottomDlg.ShowModal; +end; + +procedure TForm1.SpeedButton4Click(Sender: TObject); +begin + Close; +end; + +procedure TForm1.SpeedButton2Click(Sender: TObject); +begin + BtnBottomDlg.ShowModal; +end; + +procedure TForm1.SpeedButton1Click(Sender: TObject); +var IDz: Byte; +begin + {Password Util} + UzerID:=''; + GetPrimaryConnectionID(IDz); + if GetUserAtConnection(IDz,UzerID)=TRUE then + begin + if BtnBottomDlg1.ShowModal=mrOK then + begin + if VerifyEncrBinderyObjectPassword(UzerID, OT_USER, BtnBottomDlg1.Edit1.Text)=FALSE + then MessageDlg('Could not verify password!', mtError, [mbOK], 0) + else begin + {Change Password} + if BtnBottomDlg1.Edit2.Text=BtnBottomDlg1.Edit3.Text then + begin + if ChangeEncrBinderyObjectPassword(UzerID, OT_USER, BtnBottomDlg1.Edit1.Text, BtnBottomDlg1.Edit2.Text)=FALSE + then MessageDlg('Could not Change Password', mtError, [mbOK], 0) else + MessageDlg('Password Changed', mtInformation, [mbOK], 0); + end else MessageDlg('New Passwords don''t match!', mtError, [mbOK], 0); + end + end + end else MessageDlg('Could not fetch User Name!', mtError, [mbOK], 0); +end; + +procedure TForm1.FormActivate(Sender: TObject); +var ID, Lvl: Byte; + OwnID: Longint; + UserIDB, UserName: String; +begin + UserIDB:=''; + SpeedButton3.Enabled:=CheckConsolePrivileges; + GetBinderyAccessLevel(Lvl, OwnID); + SpeedButton2.Enabled:=(Lvl=$33); + GetPrimaryConnectionID(ID); + GetUserAtConnection(ID,UserIDB); + Panel2.Caption:=UserIDB; + UserNAme:=''; + GetFileServerName(ID,UserName); + if UserName='' then + begin + UserName:='No Server!'; + SpeedButton1.Enabled:=False; + end else SpeedButton1.Enabled:=True; + Panel1.Caption:=UserName; + +end; + +procedure TForm1.FormPaint(Sender: TObject); +begin + FormActivate(Self); +end; + +procedure TForm1.SpeedButton3Click(Sender: TObject); +begin + BtnRightDlg1.ShowModal; +end; + +procedure TForm1.FormShow(Sender: TObject); +begin + MessageDlg('Welcome to NWE Administrator by James Jeffrey. Please read README for licence/warning etc. info.', + mtInformation, [mbOK], 0); +end; + +end. diff --git a/SRC/SVRUTIL.DCU b/SRC/SVRUTIL.DCU new file mode 100644 index 0000000..35f2e14 Binary files /dev/null and b/SRC/SVRUTIL.DCU differ diff --git a/SRC/SVRUTIL.DFM b/SRC/SVRUTIL.DFM new file mode 100644 index 0000000..dd96f8b Binary files /dev/null and b/SRC/SVRUTIL.DFM differ diff --git a/SRC/SVRUTIL.PAS b/SRC/SVRUTIL.PAS new file mode 100644 index 0000000..5f38ff8 --- /dev/null +++ b/SRC/SVRUTIL.PAS @@ -0,0 +1,69 @@ +unit Svrutil; + +interface + +uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, + StdCtrls; + +type + TBtnRightDlg1 = class(TForm) + OKBtn: TBitBtn; + CancelBtn: TBitBtn; + GroupBox1: TGroupBox; + RadioButton1: TRadioButton; + RadioButton2: TRadioButton; + RadioButton3: TRadioButton; + procedure OKBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + BtnRightDlg1: TBtnRightDlg1; + +implementation + +Uses StartFrm, NWServ, Dialogs, sendMsg; + +{$R *.DFM} + +procedure TBtnRightDlg1.OKBtnClick(Sender: TObject); +var CheckMe: Boolean; +begin + if RadioButton1.Checked=TRUE then + begin + if DownFileServer(FALSE)=FALSE then + if MessageDlg('Server reports open files, force server down?', + mtConfirmation, [mbYes, mbNo], 0)=mrYES then DownFileServer(TRUE); + end; + if RadioButton2.Checked then + begin + BtnBottomDlg4.ShowModal; + end; + if RadioButton3.Checked then + begin + {Enable / Disable Logins} + if GetFileServerLoginStatus(CheckME)=FALSE then MessageDLg('Can''t talk to server', mtWarning, [mbOK], 0) + else begin + if CheckMe=FALSE then + begin + EnableFileServerLogin; + MessageDlg('Login Enabled', mtInformation, [mbOK], 0); + end else + begin + DisableFileServerLogin; + MessageDlg('Login Diabled', mtInformation, [mbOK], 0); + end; + end; + end; +end; + +procedure TBtnRightDlg1.FormShow(Sender: TObject); +begin + Caption:='Do what to '+ Form1.Panel1.Caption + '?'; +end; + +end. diff --git a/SRC/UNITS/CHGPASS2.DCU b/SRC/UNITS/CHGPASS2.DCU new file mode 100644 index 0000000..4cf187c Binary files /dev/null and b/SRC/UNITS/CHGPASS2.DCU differ diff --git a/SRC/UNITS/CHGPASS2.DFM b/SRC/UNITS/CHGPASS2.DFM new file mode 100644 index 0000000..466536b Binary files /dev/null and b/SRC/UNITS/CHGPASS2.DFM differ diff --git a/SRC/UNITS/CHGPASS2.PAS b/SRC/UNITS/CHGPASS2.PAS new file mode 100644 index 0000000..5a6962d --- /dev/null +++ b/SRC/UNITS/CHGPASS2.PAS @@ -0,0 +1,27 @@ +unit Chgpass2; + +interface + +uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls, + Buttons; + +type + TPasswordDlg = class(TForm) + Label1: TLabel; + Password: TEdit; + OKBtn: TBitBtn; + private + { Private declarations } + public + { Public declarations } + end; + +var + PasswordDlg: TPasswordDlg; + +implementation + +{$R *.DFM} + +end. + diff --git a/SRC/UNITS/NWACCT.PAS b/SRC/UNITS/NWACCT.PAS new file mode 100644 index 0000000..e6ad4ce --- /dev/null +++ b/SRC/UNITS/NWACCT.PAS @@ -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. \ No newline at end of file diff --git a/SRC/UNITS/NWBINDRY.DCU b/SRC/UNITS/NWBINDRY.DCU new file mode 100644 index 0000000..7450502 Binary files /dev/null and b/SRC/UNITS/NWBINDRY.DCU differ diff --git a/SRC/UNITS/NWBINDRY.PAS b/SRC/UNITS/NWBINDRY.PAS new file mode 100644 index 0000000..ab4a2d4 --- /dev/null +++ b/SRC/UNITS/NWBINDRY.PAS @@ -0,0 +1,1442 @@ +{$X+,B-,V-,S-} {essential compiler directives} + +UNIT nwBindry; + +{ nwBindry unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk } + +INTERFACE + +USES nwIntr,nwMisc; + +{ Primary Functions: Interrupt: comments: + +* AddBinderyObjectToSet (F217/41) +* ChangeBinderyObjectPassword (F217/40) Unencrypted Passwords. +* ChangeEncrBinderyObjectPassword (F217/4B) Encrypted Passwords. +* ChangeBinderyObjectSecurity (F217/38) +* ChangePropertySecurity (F217/3B) +* CloseBindery (F217/44) +* CreateBinderyObject (F217/32) +* CreateProperty (F217/39) +* DeleteBinderyObject (F217/33) +* DeleteBinderyObjectFromSet (F217/42) +* DeleteProperty (F217/3A) +* GetBinderyAccessLevel (F217/46) +* GetBinderyObjectID (F217/35) +* GetBinderyObjectName (F217/36) +* GetEncryptionKey (F217/17) (1) +* GetRelationOfBinderyObject (F217/4C) +* IsBinderyObjectInSet (F217/43) +* IsStationAManager (F217/49) +* OpenBindery (F217/45) +* ReadPropertyValue (F217/3D) +* RenameBinderyObject (F217/34) +* ScanBinderyObject (F217/37) +* ScanProperty (F217/3C) +* VerifyBinderyObjectPassword (F217/3F) Unencrypted Passwords. +* VerifyEncrBinderyObjectPassword (F217/4A) Encrypted passwords +* WritePropertyValue (F217/3E) + + Secondary Functions: + +* IsShellLoaded +* IsUserLoggedOn +* ExistsUser +* ExistsFileServer +* GetRealUserName +* IsGroupMember +* AddUserToGroup +* DeleteUserFromGroup + +Not implemented: + +- ChangePassword (F217/01) (2) +- GetMemberSetMofGroupG (F217/09) (3) +- GetStationsRootMask (E3../06) (4) +- MapNumberToGroupName (F217/08) (5) +- MapNumberToObject (F217/04) (6) +- MapObjectToNumber (F217/03) (7) + +Notes: -Names of Objects & Properties (and Passwords) are converted to + uppercase by the above functions. + -Functions marked with a '*' are tested (with 3.1x) and found correct. + (See example programs in XBIND.ZIP, e.g. SCANBIND,TSTBIND,BACKBIN). + -(1): Called by other functions, e.g. ChangeEncrBinderObjectPassword, + VerifyEncrBinderyObjectPassword, LoginEncrToFileserver. + (2): This call has been replaced by F217/40 ChangeBinderyObjectPassword. + (3): replaced by F217/37 ScanBinderyObject and F217/3D ReadPropertyValue. + (4): -obsolete call- + (5,6): Replaced by F217/36 GetBinderyObjectName. + (7): Replaced by F217/35 GetBinderyObjectID. +} + +CONST + { known object types: (see the file OT_XXX for a full list)} + OT_WILD = Word(-1); + OT_UNKNOWN = 0; + OT_USER = 1; + OT_USER_GROUP = 2; + OT_PRINT_QUEUE = 3; + OT_FILE_SERVER = 4; + OT_JOB_SERVER = 5; + OT_GATEWAY = 6; + OT_PRINT_SERVER = 7; + OT_ARCHIVE_QUEUE = 8; + OT_ARCHIVE_SERVER = 9; + OT_JOB_QUEUE = $0A; + OT_ADMINISTRATION = $0B; + OT_ADVERTISING_PRINTSERVER = $47; + OT_NETWARE_ACCESS_SERVER = $98; + OT_NAMED_PIPES_SERVER = $9A; + OT_RSPCX_SERVER = $0107; { # Rconsole/FileServer, Sckt. 0451h, 8140h } + + { bindery security: } + BS_ANY_READ = $00; + BS_LOGGED_READ = $01; + BS_OBJECT_READ = $02; + BS_SUPER_READ = $03; + BS_BINDERY_READ = $04; + + BS_ANY_WRITE = $00; + BS_LOGGED_WRITE = $10; + BS_OBJECT_WRITE = $20; + BS_SUPER_WRITE = $30; + BS_BINDERY_WRITE = $40; + +{property & object objFlag/propFlags Constants:} + BF_ITEM = $00; + BF_SET = $02; + BF_DYN_PROP = $10; {1} + BF_STAT_PROP = $00; {1} + { or BF_ITEM/SET with BF_xx_PROP to obtain propFlags } + BF_STAT_OBJ = $00; {1} + BF_DYN_OBJ = $01; {1} + +{ Note 1: not available in the NW interface for C } + + +Type Tproperty=Array[1..128] of Byte; + + TobjIdArray=array[1..$20] of Longint; + +Var result1:word; + +{F217/32 [2.15c+] } +Function CreateBinderyObject(objName:string; objType:Word; + objFlaG, objSecurity :Byte ):boolean; +{ Creates an object in the bindery. } + +{F217/33 [2.15c+] } +Function DeleteBinderyObject( objName:String; objType:Word ):boolean; +{ deletes a bindery object and all asociated properties. } + +{F217/34 [2.15c+]} +Function RenameBinderyObject( objName,NewObjName :string; objType :word ):boolean; +{ This function allows the (supervisor-equivalent) user to rename an object, + given its' type and old name. } + +{F217/35 [2.15c+] } +Function GetBinderyObjectID( objName:String; objType:word; + Var objID:Longint ):boolean; +{ returns the object ID of an object, given its type and name. } + +{F217/36 [2.15c+] } +Function GetBinderyObjectName( object_Id:LongInt; + Var objName:String; Var objType:word ):boolean; +{ returns the type and name of an object, given its four BYTE-id. } + +{F217/37 [2.15c+]} +Function ScanBinderyObject( SearchObjName: String; + SearchObjType: Word; + {i/o:} Var lastObjSeen : Longint; + {out:} Var RepName : String; + Var RepType : Word; + Var RepId : LongInt; + Var RepFlag : Byte; + Var RepSecurity : Byte; + Var RepHasProperties: Boolean + ) :boolean; +{ This function scans the bindery and returns complete information about + one or more bindery object(s). It can be called iteratively. } + +{F217/38 [2.15c+]} +Function ChangeBinderyObjectSecurity(objName :String; objType :Word; + NewObjSecurity :Byte ):boolean; +{ Changes the security of a Bindery object. } + +{F217/39 [2.15c+]} +Function CreateProperty( objName:String; objType:Word; + propertyName:String; propFlags,propSecurity:Byte ):boolean; +{ Creates a property to be associated with a bindery object. } + +{F217/3A [2.15c+]} +Function DeleteProperty( objName:String; objType:Word; + propertyName:String ):boolean; +{ Deletes a property from a bindery object. } + +{F217/3B [2.15c+] } +Function ChangePropertySecurity( objName:String; objType:Word; + propName:String; newPropSecurity:Byte ):boolean; +{ The call can't assign a greater access security level for the property + than the security level of the caller. } + +{F217/3C [2.15c+]} +Function ScanProperty( objName:String; objType:Word; searchPropName:String; + {i/o var:} Var SequenceNumber:LongInt; + { output:} Var propName:String; + Var propFlags:Byte; + Var propSecurity:Byte; + Var propHasValue:Boolean; + Var moreProperties:Boolean ):boolean; +{ return information about one or more properties. } + +{F217/3D [2.15c+]} +Function ReadPropertyValue( objName:String; objType:Word; + propName:String; segmentNumber:Word; + Var propValue : Tproperty; + Var moreSegments: Boolean; + Var propFlags : Byte ):boolean; +{ Returns the value of a property associated with a Bindery object. } + +{F217/3E [2.15c+]} +Function WritePropertyValue( objName:String; objType:Word; + propName:String; segmentNbr: Byte; propValue:Tproperty; + moreSegments:Boolean ):boolean; +{ Changes the value of a (NON-SET) property associated with a Bindery object. } + +{F217/3F [2.15c+]} +FUNCTION VerifyBinderyObjectPassword + ( objName:string; objType:Word; password:string):boolean; +{ Verifies the accuracy of a password for a bindery object. (UNencrypted version) } + +{F217/4A [2.15c+]} +FUNCTION VerifyEncrBinderyObjectPassword + ( objName:string; objType:Word; password:string):boolean; +{ Verifies the accuracy of a password for a bindery object. (ENcrypted version) } + +{F217/ [2.15c+] } +Function ChangeEncrBinderyObjectPassword(objName:String; objType:Word; + oldPassWord,newPassWord:String ):boolean; +{ Changes the password of a bindery object. (UNencrypted version) } + +{F217/40 [2.0/2.1/3.x] } +Function ChangeBinderyObjectPassword(objName:String; objType:Word; + oldPassWord,newPassWord:String ):boolean; +{ Changes the password of a bindery object. (UNencrypted version) } + +{F217/41 [2.15c+]} +Function AddBinderyObjectToSet(objName:String; objType:Word;propName, + memberName:String; memberType:Word ):boolean; +{ Adds a bindery object (member) to a property set. } + +{F217/42 [2.15c+]} +Function DeleteBinderyObjectFromSet(objName:String; objType:Word;propName, + memberName:String; memberType:Word ):boolean; +{ Deletes a (member) bindery object from a property set. } + +{F217/43 [2.15c+]} +Function IsBinderyObjectInSet(objName:String; objType:Word;propName, + memberName:String; memberType:Word ):boolean; +{ Allows the programmer to check whether a bindery object is a member of a + set-property. } + +{F217/44 [2.15c+]} +Function CloseBindery:boolean; +{ Closes the bindery files so they can be backed up. (Supervisor only) } + +{F217/45 [2.15c+]} +Function OpenBindery:boolean; +{ This call must be used after the CloseBindery call. No other bindery + call will work while the bindery is closed. } + +{F217/46 [2.15c+] } +Function getBinderyAccessLevel( {out:} Var SecurityAccesslevel:byte; + Var ObjId:Longint ): Boolean; +{ It returns the user's access level to the bindery. } + +{F217/17 [3.x]} +FUNCTION GetEncryptionKey(VAR key : TencryptionKey): Boolean; +{ Used by calls using encrypted passwords to query the target fileserver + for an encryption key. } + + +{F217/49 [2.15c+]} +Function IsStationAManager:boolean; +{ Is station a workgroup manager ? } + + +{F217/4C [2.15c+]} +Function GetRelationOfBinderyObject(ObjName:string;ObjType:word; + relationPropertyName:string; + {i/o} Var sequenceNbr:longint; + {out} Var NbrOfObjects:word; + Var Info:TobjIdArray ):boolean; + +{************************** secondary functions: ****************************} + +Function IsShellLoaded:boolean; +Function IsUserLoggedOn:boolean; +Function ExistsUser(userObjName:string):boolean; +Function GetRealUserName(userObjname:string; Var realname:string):boolean; +Function IsGroupMember(GroupName,UserObjName:String): Boolean; +Function AddUserToGroup(userName,GroupName:String):boolean; +Function DeleteUserFromGroup(userName,GroupName:String):boolean; +Function ExistsFileServer(ServerName:string):Boolean; + +IMPLEMENTATION{=============================================================} + + +{F217/17 [3.x]} +FUNCTION GetEncryptionKey(VAR key : TencryptionKey): Boolean; +Type Treq=RECORD + len : WORD; + func: BYTE; + END; + TPreq=^Treq; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + len := 1; + func := $17; + end; +F2SystemCall($17,sizeof(Treq),SizeOf(TencryptionKey),result1); +Move(GlobalReplyBuf^,key,SizeOf(key)); +GetEncryptionKey:=(result1=0); +END; + + +{F217/3F [2.15c+]} +FUNCTION VerifyBinderyObjectPassword + ( objName:string;objType:Word; password : string):boolean; +{ Verifies the accuracy of a password for a bindery object. } +{ Passwords need to be converted to upper case, NULL if there is no password. } +Type TReq=record + buffer_length : Word; + subfunction : byte; + obj_type : word; { hi-lo } + _ObjectName : string[48]; + _PassWord : string[127]; + end; + TPreq=^Treq; +begin +With TPreq(GlobalReqBuf)^ +do begin + buffer_length := SizeOf(Treq)-2; + subfunction :=$3F; + obj_type:=swap(objType); { force hi-lo } + UpString(objName); + UpString(password); + PStrCopy(_ObjectName,objName,48); _ObjectName[48]:=#0; UpString(_ObjectName); + PStrCopy(_PassWord,password,127); Upstring(_PassWord); + end; +F2SystemCall($17,sizeof(Treq),0,result1); +VerifyBinderyObjectPassword:=(result1=0); +{ possible result1codes: +$00 0 verification of object_name/password combination +$96 150 Sever out of memory +$C5 197 account disabled due to intrusion lockout +$D6 214 unencrypted password calls not allowed on this v3+ server +$F0 240 Wildcard not allowed +$FB 251 no such property +$FC 252 no such object_name on this server +$FE 254 Server Bindery Locked +$FF 255 Bindery failure (No such object or bad password) } +end; + + +{F217/4A [3.x]} +FUNCTION VerifyEncrBinderyObjectPassword(ObjName: String; ObjType: Word; PassWord: String): Boolean; + + FUNCTION VerifyEncrypted(ObjName : String; ObjType : Word; VAR key : TencryptionKey): Boolean; + Type TReq=RECORD + BufLen : Word; + _func : Byte; + _key : TencryptionKey; + _ObjType: Word; + _ObjName: String[48]; + End; + TPreq=^Treq; + Begin + With TPreq(GlobalReqBuf)^ + do Begin + _func := $4A; + _key := key; + _ObjType := Swap(objType); + PstrCopy(_ObjName,ObjName,48); UpString(_ObjName); + if ObjName[0]<#48 + then _objName[0]:=objName[0] + else _objname[0]:=#48; + BufLen:=ord(_ObjName[0])+12; + End; + F2SystemCall($17,sizeof(Treq),0,result1); + VerifyEncrypted:=(result1=0); + End; + +VAR + key : TencryptionKey; + ObjId:LongInt; + _pw:string; + +Begin +UpString(password); +_pw:=password; +if _pw[0]>#127 Then _pw[0]:=#127; + +IF GetEncryptionKey(key) + Then Begin + + IF GetBinderyObjectId(objName,objType,ObjId) + Then Begin + EncryptPassword(objId,_pw,key); + VerifyEncrypted(ObjName, ObjType, key); + End; + End + Else VerifyBinderyObjectPassword(ObjName, ObjType, Password); + +VerifyEncrBinderyObjectPassword := (result1=0); +End; + + +{F217/37 [2.15c+]} +Function ScanBinderyObject( SearchObjName: String; + SearchObjType: Word; + {i/o:} Var lastObjSeen : Longint; + {out:} Var RepName : String; + Var RepType : Word; + Var RepId : LongInt; + Var RepFlag : Byte; + Var RepSecurity : Byte; + Var RepHasProperties: Boolean + ) :boolean; +{ This function scans the bindery and returns complete information about + a bindery object. } +Type TReq = record + length : word; + subfunction : byte; + last_obj_id : longint; {hi-lo} + search_obj_type : word; {hi-lo} + search_obj_name : string[48]; + end; + TRep= record + object_id : longint; {hi-lo} + object_type : word; {hi-lo} + object_name : array [1..48] of byte; + object_flag : byte; + security : byte; + properties : byte; + end; + TPreq=^Treq; + TPrep=^Trep; + +Var TempStr:string; + count : integer; +begin +with TPreq(GlobalReqBuf)^ +do begin + length := SizeOf(Treq)-2; + subfunction := $37; + last_obj_id := Lswap(lastObjseen); { force hi-lo } + search_obj_type:= swap(Word(SearchObjType)); { force hi-lo } + PstrCopy(Search_obj_name,SearchObjName,48); Search_obj_Name[48]:=#0; UpString(Search_obj_name); + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result1); +With TPrep(GlobalReplyBuf)^ +do begin + repFlag := object_flag; + repHasProperties := (properties>0); + repSecurity := security; + repType := swap(object_type); { force lo-hi } + repId := Lswap(object_id); { force lo-hi } + lastObjSeen := repId; + ZStrCopy(repName,Object_Name,48); + end; +scanBinderyObject:=(result1=0); +{ Possible result1codes: + 96h server out of memory; EFh Invalid Name; FCh No Such Object; + FEh Server Bindery Locked; FFh Bindery failure } +end; + + +{F217/3D [2.15c+]} +Function ReadPropertyValue( objName:String; objType:Word; + propName:String; segmentNumber:Word; + Var propValue : Tproperty; + Var moreSegments: Boolean; + Var propFlags : Byte ):boolean; +{ Returns the value of a property associated with a Bindery object. } +Type Treq=record + len : word; + subfunction : byte; + _objType : word; { hi-lo } + _ObjName : string[48]; + _segNbr : byte; + _propName : string[15]; + end; + Trep = record + _propValue : Tproperty; {array [1..128] of byte} + _moreSegments : byte; + _propFlags : byte; + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN + With TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subfunction := $3d; + _objType:=swap(objType); { force hi-lo } + _segNbr:=segmentNumber; + PStrCopy(_ObjName,objName,48); _ObjName[48]:=#0; UpString(_ObjName); + PStrCopy(_PropName,propName,15); UpString(_propName); + end; +F2SystemCall($17,sizeof(Treq),sizeof(Trep),result1); +if result1=0 + then with TPrep(GlobalreplyBuf)^ + do begin + propValue:=_propValue; + moreSegments:=(_moreSegments>0); + propFlags:=_propFlags; + end; +ReadPropertyValue:=(result1=0); +{ 96 server out of memory; EC no such segment; F0 wilcard not allowed; + f1 invalid bindery security; f9 no property read privileges; + fb no such property; fc no such object; FE Server Bindery Locked; + FF Bindery Failure. } +end; + + +{F217/36 [2.15c+] } +Function GetBinderyObjectName( object_Id:LongInt; + Var objName:String; Var objType:word ):boolean; +{ returns the type and name of an object, given its four BYTE-id. } +Type TReq =record + len:word; + subF:byte; + _objId:LongInt; { hi-lo } + end; + Trep=record + _objId:LongInt; { hi-lo } + _objType:word; { hi-lo } + _objName:array[1..48] of Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN +WITH TPreq(GlobalReqBuf)^ +do begin + len :=SizeOf(TReq)-2; + SubF:=$36; + _objId:=Lswap(object_Id); { force hi-lo } + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result1); +IF result1=0 + then with TPrep(GlobalReplyBuf)^ + do begin + ZstrCopy(objName,_objName,48); + objType:=swap(_objType); { force lo-hi } + end; +GetBinderyObjectName:=(result1=0); +end; + + +{F217/35 [2.15c+] } +Function GetBinderyObjectID( objName:String; objType:word; + Var objID:Longint ):boolean; +{ returns the object ID of an object, given its type and name. } +Type Treq=record + len:word; + subF:Byte; + _objType:word; { hi-lo } + _objName:string[48]; + end; + TRep=record + _objId:LongInt; { hi-lo } + _objType:word; { hi-lo } + _objName:array[1..48] of char; + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN +WITH TPreq(GlobalReqBuf)^ +do begin + len :=SizeOf(TReq)-2; + SubF:=$35; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; + UpString(_objName); + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result1); +IF result1=0 + then with TPrep(GlobalReplyBuf)^ + do objID:=Lswap(_objId); { force lo-hi } +GetBinderyObjectID:=(result1=0); +end; + + +{F217/46 [2.15c+]} +Function getBinderyAccessLevel(Var SecurityAccessLevel:byte; + Var objId:Longint ):boolean; +{ It returns the user's access level to the bindery. } +{ Often used as a quick way of determining the current users' object id } +{ use the BS_xxxx constants to determine the exact rights of the user } +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; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + subF:=$46; + len:=sizeOf(Treq)-2; + end; +F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result1); +If result1=0 + then with TPrep(GlobalReplyBuf)^ + do begin + SecurityAccessLevel:=accLevel; + objId:=Lswap(_objId); + end; +GetBinderyAccessLevel:=(result1=0); +end; + + + +{F217/45 [2.15c+]} +Function OpenBindery:boolean; +{ This call must be used after the CloseBindery call. No other bindery + call will work while the bindery is closed. } +Type Treq=record + len:word; + subFunc:byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=1; + subFunc:=$45; + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +OpenBindery:=(result1=0) +end; + + +{F217/44 [2.15c+]} +Function CloseBindery:boolean; +{ Closes the bindery files so they can be backed up. (Supervisor only) } +Type Treq=record + len:word; + subFunc:byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$44; + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +CloseBindery:=(result1=0) +end; + + +{F217/32 [2.15c+] } +Function CreateBinderyObject(objName:string; objType:Word; + objFlaG, objSecurity :Byte ):boolean; +{ Creates an object in the bindery. + objName: name of the new object (47 chars) + objType: object type number (own type number or OT_xxx constant) + objFlag: identifies an object as static (0) or dynamic (1) + (dynamic objects are removed from the bindery when the server goes down) + objSecurity: high nibble: write privileges needed to modify this object + low nibble: read privileges needed to access this object + (default: $31 Supervisor write/Logged read) } +Type Treq=record + len :word; + subFunc :byte; + _objFlag :Byte; + _objSecurity :Byte; + _objType :word; { hi-lo } + _objName :string[48] + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$32; + _objFlag:=objFlag; + _objSecurity:=objSecurity; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + end; +F2SystemCall($17,sizeof(Treq),0,result1); +CreateBinderyObject:=(result1=0) +{ 96h server out of memory; EEh Object Already Exists; EFh Invalid Name + F1h invalid Bindery security; F5h no object create privileges + FEh Server Bindery Locked; FFh Bindery Failure } +end; + + + +{F217/33 [2.15c+] } +Function DeleteBinderyObject( objName:String; objType:Word ):boolean; +{ deletes a bindery object and all asociated properties. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :string[48]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$33; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#48; UpString(_objName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +DeleteBinderyObject:=(result1=0) +{ 96h Server out of memory; EFh Invalid name; F0h wildcard not allowed; + F4h No object delete privileges; FCh no such object + FEh Server Bindery Locked; FFh bindery failure } +end; + + +{F217/34 [2.15c+]} +Function RenameBinderyObject( objName,NewObjName :string; objType :word ):boolean; +{ This function allows the (supervisor-equivalent) user to rename an object, + given its' type and old name. } +Type Treq=record + len :word; + subFunc :byte; + _objType :word; { hi-lo } + _objName :string[48]; + _NewObjName :string[48]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$34; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; Upstring(_objName); + PstrCopy(_NewObjName,NewObjName,48); _NewObjName[48]:=#0; UpString(_NewObjName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +RenameBinderyObject:=(result1=0) +{ 96h Server out of memory; EFh Invalid name; F0h wildcard not allowed; + F3h No object rename privileges; FCh no such object + FEh Server Bindery Locked; FFh bindery failure } +end; + + + +{F217/43 [2.15c+]} +Function IsBinderyObjectInSet(objName:String; objType:Word; + propName, memberName:String; memberType:Word ):boolean; +{ Allows the programmer to check whether a bindery object is a member of a + set-property. Objectname( of Objecttype) is the object to be searched for, + PropName (attached to the object with name memberName (of memberType)) + is the property containing the set to be searched. + User must have read rights to the object and the property. + Ex: ('SUPERVISOR',OT_USER,'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP) } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + _memObjType :Word; { hi-lo } + _memName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$43; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PstrCopy(_propName,propName,15); UpString(_propName); + _memObjType:=swap(memberType); { force hi-lo } + PStrCopy(_memName,memberName,48); _memName[48]:=#0; UpString(_memName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +IsBinderyObjectInSet:=(result1=0) +{ 96h Server out of memory; EA No Such member; EB Not Group Property + F0h wildcard not allowed; F9 No Property read privileges; + FCh no such object; FEh Server Bindery Locked; FFh bindery failure } +end; + + + +{F217/41 [2.15c+]} +Function AddBinderyObjectToSet(objName:String; objType:Word; + propName, memberName:String; memberType:Word ):boolean; +{ Adds a bindery object to a property set. + user must have write access to the set property. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + _memObjType :Word; { hi-lo } + _memName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$41; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PstrCopy(_propName,propName,15); UpString(_propName); + _memObjType:=swap(memberType); { force hi-lo } + PStrCopy(_memName,memberName,48); _memName[48]:=#0; UpString(_memName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +AddBinderyObjectToSet:=(result1=0) +{ 96h Server out of memory; E9 Member already Exists; EB Not Group Property + F0h wildcard not allowed; F8 No Property write privileges; + FCh no such object; FEh Server Bindery Locked; FFh bindery failure } +end; + + +{F217/42 [2.0/2.1/3.x]} +Function DeleteBinderyObjectFromSet(objName:String; objType:Word; + propName, memberName:String; memberType:Word ):boolean; +{ Deltes a bindery object from a property set. + user must have write access to the set property. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + _memObjType :Word; { hi-lo } + _memName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$42; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PstrCopy(_propName,propName,15); UpString(_propName); + _memObjType:=swap(memberType); { force hi-lo } + PStrCopy(_memName,memberName,48); _memName[48]:=#0; UpString(_memName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +DeleteBinderyObjectFromSet:=(result1=0) +{ 96h Server out of memory; EA No Such Member; EB Not Group Property + F0h wildcard not allowed; F8 No Property write privileges; FB No Such property; + FCh no such object; FEh Server Bindery Locked; FFh bindery failure } +end; + + +{F217/38 [2.15c+]} +Function ChangeBinderyObjectSecurity(objName :String; objType :Word; + NewObjSecurity :Byte ):boolean; +{ Changes the security of a Bindery object. This call is made successfully, + if the user is supervisor equivalent and the current security is unequal to + NetWare Read/ NetWare Write. } +Type Treq=record + len :word; + subFunc :byte; + _NobjSec :Byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$38; + _NobjSec:=NewObjSecurity; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +ChangeBinderyObjectSecurity:=(result1=0) +{ Completion Codes: + 96 Server out of memory; F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure. } +end; + + + + +{F217/4B [3.x]} +FUNCTION ChangeEncrBinderyObjectPassword(ObjName: String; ObjType: Word; +{#d} oldPassWord,newPassword: String): Boolean; +{ Changes the password of a bindery object. + Old Password can be NULL. To log into a file server, an object must have a + PASSWORD property. User must have read and write access to the bindery object. } + FUNCTION ChangeEncrypted(ObjName : String; ObjType : Word; + oldEncrPW:TencryptionKey; + Var newPWdif:TencrPWdifference; + PWdifCheckSum:byte + ):boolean; + Type Treq=RECORD + BufLen : Word; + _func : Byte; + _oldPW : TencryptionKey; + _ObjType: Word; + _ObjNameLen : byte; + _Various: array [1..48+1+16] of byte; { ObjName, difCheksum, PWdif } + End; + TPreq=^Treq; + Begin + With TPreq(GlobalreqBuf)^ + do Begin + _func := $4B; + _oldPW:=oldEncrPW; + _ObjType := Swap(objType); + if objName[0]>#48 + then objName[0]:=#48; + move (objName[0],_objNameLen,ord(objName[0])+1); + _Various[_objNamelen+1]:=PWdifCheckSum; + move(newPWdif,_Various[_objNamelen+2],16); + BufLen:=29+_objNameLen; + F2SystemCall($17,buflen+2,0,result1); + end; + ChangeEncrypted:=(result1=0); + End; + +VAR + key : TencryptionKey; + ObjId:LongInt; + PWdif:TencrPWdifference; + PWdifChecksum:byte; + +Begin +UpString(oldPassword); +if oldPassword[0]>#127 + Then oldPassword[0]:=#127; +UpString(newPassword); +if newPassword[0]>#127 + Then newPassword[0]:=#127; +UpString(ObjName); + +IF GetEncryptionKey(key) + Then Begin + IF GetBinderyObjectId(objName,objType,ObjId) + Then Begin + EncryptPasswordDifference(objId, + OldPassword,NewPassword, + key, { i/o, out: EncrOldPW } + PWdif, { out, 16 bytes } + PWdifChecksum { out, 1 byte } + ); + ChangeEncrypted(ObjName, ObjType, key, PWdif, PWdifChecksum); + End; + End + Else ChangeBinderyObjectPassword(ObjName, ObjType, OldPassword, NewPassword); + +ChangeEncrBinderyObjectPassword:= (result1=0); +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; FB No Such Property; + FC No Such Object; FE Server Bindery Locked; FF No Such Object *OR* + No Password Associated With Object *OR* Old Password Invalid. } +End; + + +{F217/40 [2.0/2.1/3.x] } +Function ChangeBinderyObjectPassword(objName:String; objType:Word; + oldPassWord,newPassWord:String ):boolean; +{ Changes the password of a bindery object. + Allow unencrypted passwords must be ON! + Old Password can be NULL. To log into a file server, an object must have a + PASSWORD property. User must have read and write access to the bindery object. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _oldPW :String[128]; { wow! a password of 128 chars! } + _newPW :String[128]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$40; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _ObjName[48]:=#0; UpString(_objName); + PStrCopy(_oldPW,oldPassWord,128); UpString(_oldPW); + PStrCopy(_newPW,newPassWord,128); UpString(_newPW); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +ChangeBinderyObjectPassword:=(result1=0) +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; FB No Such Property; + FC No Such Object; FE Server Bindery Locked; FF No Such Object *OR* + No Password Associated With Object *OR* Old Password Invalid. } +end; + + + + +{F217/39 [2.15c+]} +Function CreateProperty( objName:String; objType:Word; + propertyName:String; propFlags,propSecurity:Byte ):boolean; +{ Creates a property to be associated with a bindery object. + property flags tell whether a property is dynamic or static and whether + the property is defined as static or dynamic. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propFlags:Byte; + _propSec :Byte; + _propName :String[15]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$39; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + _propFlags:=propFlags; + _propSec:=propSecurity; + PStrCopy(_propName,propertyName,15); UpString(_propName); + end; +F2SystemCall($17,sizeof(Treq),0,result1); +CreateProperty:=(result1=0) +{ Completion Codes: + 96 Server Out Of Memory; ED Property already exists; EF Invalid Name; + F0 Wildcard Not Allowed; F1 Invalid Bindery Security; F7 No Property Create Privileges; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + + +{F217/3A [2.15c+]} +Function DeleteProperty( objName:String; objType:Word; + propertyName:String ):boolean; +{ Deletes a property from a bindery object. + The property field may contain wildcards. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; { [48]=#0 } + _propName :String[15]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3A; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + PStrCopy(_propName,propertyName,15); UpString(_propName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +DeleteProperty:=(result1=0) +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + F6 No property delete privileges; FB No Such property; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + + +{F217/3C [2.15c+]} +Function ScanProperty( objName:String; objType:Word; searchPropName:String; + {i/o var:} Var SequenceNumber:LongInt; + { output:} Var propName:String; + Var propFlags:Byte; + Var propSecurity:Byte; + Var propHasValue:Boolean; + Var moreProperties:Boolean ):boolean; +{ Sequence number should be -1 the first time this call is made. + The call can be reiterated (by supplying the returned Seq.#) until + moreProperties=FALSE or nwBindry.result1=NO_SUCH_PROPERTY. + searchPropName may contain wildcards; + If propHasValue=TRUE, the value can be read by calling ReadPropertyValue; + moreProperties=TRUE if more properties exist for this object. } +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; {hi-lo} + _objName :String[48]; + _SeqNbr :LongInt; {hi-lo} + _propName :String[15]; + end; + Trep=record + _propName :array[1..16] of Byte; + _propFlags:Byte; + _propSec :Byte; + _SeqNbr :Longint; {hi-lo} + _propHasValue:Byte; + _moreProp :Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3C; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + _SeqNbr:=Lswap(SequenceNumber); { force hi-lo } + PstrCopy(_propName,searchPropName,15); UpString(_propName); + end; +F2SystemCall($17,sizeof(Treq),sizeof(Trep),result1); +With TPrep(GlobalReplyBuf)^ +do begin + SequenceNumber:=Lswap(_SeqNbr); { force lo-hi } + ZStrCopy(propName,_propName,15); + propFlags:=_propFlags; + propSecurity:=_propSec; + propHasValue:=(_propHasValue>0); + moreProperties:=(_moreProp>0); + end; +ScanProperty:=(result1=0) +{ Completion Codes: + 96 Server Out Of Memory; F1 Invalid Bindery Security; FB No Such property; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + + +{F217/3E [2.15c+]} +Function WritePropertyValue( objName:String; objType:Word; + propName:String; segmentNbr: Byte; propValue:Tproperty; + moreSegments:Boolean ):boolean; +{ Changes the value of a (NON-SET) property associated with a Bindery object.} +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[48]; + _segNbr :Byte; + _EraseRemainingSeg:Byte; { FF=true 00=false } + _propName :String[15]; + _propValSeg :Tproperty; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3E; + _objType:=swap(objType); { force hi-lo } + PStrCopy(_objName,objName,48); _objName[48]:=#0; UpString(_objName); + _segNbr:=segmentNbr; + if moreSegments + then _EraseRemainingSeg:=$00 + else _EraseRemainingSeg:=$FF; + PstrCopy(_propName,propName,15); UpString(_propName); + _propValSeg:=propValue; + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +WritePropertyValue:=(result1=0) +{ Completion Codes: + 96 Server Out Of Memory; E8 Not Item Property; EC no such segment; + F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + F8 No property write privileges; FB No Such property; + FC No Such Object; FE Server Bindery Locked; FF Bindery Failure } +end; + +{F217/3B [2.15c+] } +Function ChangePropertySecurity( objName:String; objType:Word; + propName:String; newPropSecurity:Byte ):boolean; +{ The user must have read and write access to the property to make this call. + The call can't assign a greater security level than the security level of + the caller. } +Type Treq=record + len:word; + subFunc:byte; + _objType:Word; { hi-lo } + _objName:String[48]; + _NewPropSec:Byte; + _PropName:String[15]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$3B; + _objType:=swap(objType); { force hi-lo } + PstrCopy(_objName,objName,48); _objName[48]:=#0; Upstring(_objName); + _NewPropSec:=NewPropSecurity; + PstrCopy(_propName,propName,15); Upstring(_propName); + end; +F2SystemCall($17,sizeOf(Treq),0,result1); +ChangePropertySecurity:=(result1=0) +{ Completion Codes: + 96 Server Out Of Memory; F0 Wildcard Not Allowed; F1 Invalid Bindery Security; + FB No Such property; FC No Such Object; FE Server Bindery Locked; + FF Bindery Failure } +end; + +{F217/49 [3.0+]} +Function IsStationAManager:boolean; +{ Fast way to detremine if: object ID of caller included in the MANAGERS + set property attached to the SUPERVISOR object. } +Type Treq=record + len:word; + subFunc:byte; + end; + Trep=record + unknown:byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$49; + end; +F2SystemCall($17,SizeOf(Treq),Sizeof(Trep),result1); +{With TPrep(GlobalReplyBuf)^ + do begin + + end; } +IsStationAManager:=(result1=0) +{ Completion codes: + 00 Successful (WS is a manager); + FF Not a manager } +end; + +{F217/4C [3.0+]} +Function GetRelationOfBinderyObject(ObjName:string;ObjType:word; + relationPropertyName:string; + {i/o} Var sequenceNbr:longint; + {out} Var NbrOfObjects:word; + Var Info:TobjIdArray ):boolean; +{ OBJ_SUPERVISORS GROUPS_I'M_IN SECURITY_EQUALS } +Type Treq=record + len :word; + subFunc :byte; + _SeqObjId :Longint; {hi-lo} + _ObjType :word; {hi-lo} + _ObjAndPropName:string; + end; + Trep=record + _NbrOfObj:Word; + _Info :TobjIdArray; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$4C; + _SeqObjId:=Lswap(SequenceNbr); + _ObjType:=swap(ObjType); + Upstring(ObjName);UpString(RelationPropertyName); + _ObjAndPropName:=ObjName; + move(RelationPropertyName[0], + _ObjAndPropName[ord(ObjName[0])+1], + ord(RelationPropertyName[0])+1); + len:=9+ord(ObjName[0])+ord(RelationPropertyName[0]); + F2SystemCall($17,len+2,Sizeof(Trep),result1); + end; +With TPrep(GlobalReplyBuf)^ + do begin + NbrOfObjects:=swap(_NbrOfObj); + for t:= 1 to NbrOfObjects + do Info[t]:=Lswap(_Info[t]); + if NbrOfObjects=$20 + then SequenceNbr:=Info[$20] + else SequenceNbr:=-1; + end; +if result1<>0 then SequenceNbr:=-1; +GetRelationOfBinderyObject:=(result1=0) +end; + + + +{=======SECONDARY FUNCTIONS===================================================} + + + +Function IsShellLoaded:boolean; +Var mask:byte; + id:LongInt; +begin +{$IFNDEF MSDOS} +FillChar(nwintr.GlobalReplyBuf^,Sizeof(nwintr.TintrBuffer),#$0); +{ Only needed in protected mode, otherwise an invalid value is reported. + Doesn't harm a bit if you use it in other modes, though. } +{$ENDIF} +IsShellLoaded:=(nwBindry.getBinderyAccessLevel(mask,id) and (id<>0)); +end; + + +Function IsUserLoggedOn:boolean; +Var mask:byte; + id:LongInt; + objName:String; + objType:word; +begin +IsUserLoggedOn:=( nwBindry.getBinderyAccessLevel(mask,id) + and (id<>0) + and nwBindry.GetBinderyObjectName(id,objName,objType) + ) +end; + + +Function GetRealUserName(userObjName:string; Var realname:string):boolean; +Var propValue:Tproperty; + moreSeg:Boolean; + w,propFlag:Byte; +begin +If ReadPropertyValue(userObjName,OT_USER,'IDENTIFICATION',1,propValue,moreSeg,propFlag) + then ZstrCopy(RealName,PropValue,128) + else realname:=''; +GetRealUserName:=(result1=0); +end; + +Function GetUserObjectID:LongInt; +Var mask:byte; + id:LongInt; +begin +if getBinderyAccessLevel(mask,id) + then GetUserObjectID:=id + else getUserObjectID:=-1; +{ -1 : look at nwBindry.result1 for error number } +end; + + +Function ExistsUser(userObjName:string):boolean; +Var ObjId:Longint; +begin +ExistsUser:=GetBinderyObjectId(userObjName,OT_USER,ObjId); +end; + +Function IsGroupMember( GroupName,UserObjName:String): Boolean; +begin +IsGroupMember:=IsBinderyObjectInSet(GroupName,OT_USER_GROUP,'GROUP_MEMBERS', + UserObjName,OT_USER); +end; + + + + +Function AddUserToGroup(userName,GroupName:String):boolean; +begin +{ first create the necessary properties. They may already exist. } + +CreateProperty(userName,OT_USER,'GROUPS_I''M_IN', + BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ); +IF (result1<>$00) and (result1<>$ED) { property already exists } +then begin AddUserToGroup:=false;exit end; { bindery failure / bad username} + +CreateProperty(userName,OT_USER,'SECURITY_EQUALS', + BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ); +IF (result1<>$00) and (result1<>$ED) { property already exists } +then begin AddUserToGroup:=false;exit end; + +{ The following construction seems a bit overdone, but it is needed to keep + the bindery consistent. A user is either fully added to a group OR + nothing happens, this way we ensure that a user is not 'patially added' + to a group. + If the user already is a member of the group, no error is returned. } +IF AddBinderyObjectToSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER) + then begin + IF AddBinderyObjectToSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + then begin + IF AddBinderyObjectToSet(userName,OT_USER,'SECURITY_EQUALS', + GroupName,OT_USER_GROUP) + then begin + AddUserToGroup:=true; + exit; + end + else begin { attempt to delete partially setup member } + DeleteBinderyObjectFromSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + DeleteBinderyObjectFromSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + end + end + else begin + DeleteBinderyObjectFromSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + end; + end; +if result1=$E9 then result1:=$00; { $E9: user already a member of group } +AddUserToGroup:=(result1=0); +{ As all these called functions are in this unit, you can check nwBindry.result1 + for the errorcode. } +{ result1codes: $FC user OR group object doesn't exist. } +end; + + + + +Function DeleteUserFromGroup(userName,GroupName:String):boolean; +begin +{ The following construction seems a bit overdone, but it is needed to keep + the bindery consistent. A user is either totally deleted from a group OR + nothing happens, this way we ensure that a user is not 'patially deleted' + from a group. + If the user was not a member of the group, no error is returned. } +IF DeleteBinderyObjectFromSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER) + then begin + IF DeleteBinderyObjectFromSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + then begin + IF DeleteBinderyObjectFromSet(userName,OT_USER,'SECURITY_EQUALS', + GroupName,OT_USER_GROUP) + then begin + DeleteUserFromGroup:=True; + exit; + end + else begin { attempt to repair partially deleted member } + AddBinderyObjectToSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + AddBinderyObjectToSet(userName,OT_USER,'GROUPS_I''M_IN', + GroupName,OT_USER_GROUP) + end + end + else AddBinderyObjectToSet(Groupname,OT_USER_GROUP,'GROUP_MEMBERS', + userName,OT_USER); + end; +if result1=$EA then result1:=0; { $EA: user obj NOT a member of group } +DeleteUserFromGroup:=false; +{ As all these called functions are in this unit, you can check nwBindry.result1 + for the errorcode. } +{ result1codes: $FC user OR group object doesn't exist. } +end; + +Function ExistsFileServer(ServerName:string):Boolean; +{ You must be attached to at least one server before using this function. } +Var ObjId:Longint; +begin +UpString(ServerName); +ExistsFileServer:=GetBinderyObjectId(ServerName,OT_FILE_SERVER,ObjId); +end; + + + +end. { end of unit nwBindry } + diff --git a/SRC/UNITS/NWCONN.DCU b/SRC/UNITS/NWCONN.DCU new file mode 100644 index 0000000..69497bf Binary files /dev/null and b/SRC/UNITS/NWCONN.DCU differ diff --git a/SRC/UNITS/NWCONN.PAS b/SRC/UNITS/NWCONN.PAS new file mode 100644 index 0000000..be01679 --- /dev/null +++ b/SRC/UNITS/NWCONN.PAS @@ -0,0 +1,1455 @@ +{$X+,B-,V-,S-} {essential compiler directives} + +UNIT nwConn; + +{ nwConn unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk } +{ Includes modifications to Attach/Detach by H. Jelonneck } + +INTERFACE + +{ Primary Functions: Interrupt: comments: + +Connection Services +------------------- + +* AttachToFileServer (F100) +* AttachToFileServerWithAddress (F100) +* DetachFromFileServer (F101) +. EnterLoginArea (F217/0A) +* GetConnectionInformation (F217/16) +* GetConnectionNumber (DC..) +* GetInternetAddress (F217/13) +* GetObjectConnectionNumbers (F217/15) +* GetWorkstationNodeAddress (EE..) +* LoginToFileserver (F217/14) UNencrypted +* LoginEncrToFileserver (F217/18) encrypted +* Logout (F219) +* LogoutFromFileServer (F102) + + Secondary Functions: + +* GetUserAtConnection +* GetObjectLoginControl +* GetObjectNodeControl +* ObjectCanLoginAt + +Workstation Services +-------------------- + +* EndOfJob (D6) to be rewritten to F218 +* GetConnectionID (EF04) +* GetConnectionIDtable (EF03) (1) +* GetDefaultConnectionID (F002) +* GetEndOfJobStatus (BB..) +* GetFileServerName (EF04) +* GetNetwareErrorMode (DD..) +* GetNetwareShellVersion (EA00) +* GetNumberOfLocalDrives (DB..) +* GetPreferredConnectionID (F001) +* GetPrimaryConnectionID (F005) +* GetShowDots (E908) +* GetWorkstationEnvironment (EAxx,xx>00) (2) +* SetEndOfJobStatus (BB..) +* SetNetwareErrorMode (DD..) +* SetPreferredConnectionID (F000) +* SetPrimaryConnectionID (F004) +* SetShowDots (E908) + + Secondary Functions: + +* GetEffectiveConnectionID (F001,F002,F005) +* IsConnectionIDinUse (EF03) + + +Not Implemented: +---------------- + +- GetStationsLoggedInformation (F217/05) (3) +- Login (F217/00) (4) +- MapUserToStationSet (F217/02) (5) + +Notes: -Only functions marked with a * have been tested; others might work. + -(1): This function returns the complete Connection ID table. The + partial function IsConnectionIDInUse has been moved to the + secondary function group. + -(2): This function is an extension to EA00 GetNetwareShellVersion. + A function that returns all returned information from the call + EAxx,xx>00 is sometimes referred to as GetWShardwareAndOS. + + -NOT implemented in this API: + (3): Replaced by F217/16 GetConnectionInformation. + (4): This function has been replaced by F217/14 LoginToFileServer. + (5): Replaced by F217/15 GetObjectConnectionNumbers. + + -NW 386 can support up to 250 connections, NW 286 Max 100. + -Type TconnectionList=array[1..250] of byte (Declared in unit nwMisc) + +} + +Uses nwIntr,nwMisc,nwBindry; + + +Const MaxServers=8; + +Type TServerNameTableEntry = Array [1..48] OF Char; + TServerNameTable = Array[1..MaxServers] OF TServerNameTableEntry; + + TConnectionIDTableEntry= + Record + SlotInUse : Byte; + OrderNumber : Byte; + ServerAddress : TinternetworkAddress; + ReceiveTimeOut : Word; + RouterAddress : TnodeAddress; + PacketSeqNbr : Byte; + ConnectionNumber : Byte; + ConnectionStatus : Byte; + MaxTimeOut : Word; + WConnectionNumber: Word; + MajorNWrev : Byte; + ServerFlags : Byte; + MinorNWrev : Byte; + END; + TConnectionIDTable = Array [1..MaxServers] OF TConnectionIDTableEntry; + + TloginControl=Record + AccountDisabled :boolean; + AccountExpirationDate :TNovTime; { dmy valid only } + + MinimumPasswordLength :byte; + PasswordControlFlag :byte; + DaysBetweenPasswordChanges:word; + PasswordExpirationDate :TnovTime; + LastLoginTime :TnovTime; {dmy, hms valid only } + GraceLoginsRemaining :Byte; + MaxGraceLoginsAllowed :byte; + BadLoginCount :byte; + AccountResetTime :TnovTime; {dmy, hms valid only } + LastIntruderAddress :TinterNetworkAddress; + + MaxConcurrentConnections :byte; + LoginTimes :array[1..42] of byte; + + DiskSpace :Longint; + end; + + TnodeControl=array[1..12] of record + net :TnetworkAddress; + node:TnodeAddress; + end; + +Var result1:word; + +{BB.. [2.0/2.1/3.x]} +Function SetEndOfJobStatus( EndOfJobFlag: Boolean ):Boolean; +{ When this function is called with EndOfJobFlag=False and control is returned + to the root COMMAND.COM, COMMAND.COM will NOT perform an EOJ action. } + +{BB.. [2.0/2.1/3.x]} +Function GetEndOfJobStatus(Var EndOfJobFlag: Boolean ):Boolean; + +{F218 [2.15c+]} +FUNCTION EndOfJob(All : Boolean):boolean; +{ Forces an end of job } + +{E908 (shell 3.00+)} +Function SetShowDots( Show:Boolean):Boolean; + +{E908 (shell 3.00+)} +Function GetShowDots(Var Shown:Boolean):Boolean; + +{F219 [2.15c+]} +Function Logout:boolean; +{ Logout from all file servers, remains attached to Server, effective EOJ } + +{DB.. [2.0/2.1/3.x]} +Function GetNumberOfLocalDrives( Var drives:Byte ):Boolean; + +{DC.. [2.0/2.1/3.x]} +Function GetConnectionNumber(Var ConnectionNbr:byte):boolean; +{ Returns connection number of requesting WS } + +{DD.. [2.0/2.1/3.x]} +Function SetNetwareErrorMode( errMode:Byte):boolean; +{ Sets the shell's handling mode for dealing with netware errors. } + +{DD.. [2.0/2.1/3.x]} +Function GetNetwareErrorMode(Var errMode:Byte):boolean; + +{E3../0A [2.0/2.1/3.x]} +Function EnterLoginArea( LoginSubDirName:String; + numberOfLocalDrives:Byte ):boolean; +{ Changes the login directory. Used by boot-proms. } + +{F217/13 [2.15c+]} +Function GetInternetAddress( ConnNbr : byte; + var IntNetAddress:TinternetworkAddress):boolean; + +{F217/14 [2.15c+] UNENCRYPTED} +Function LoginToFileServer( objName:String; objType:word; + password : string ):boolean; + +{F217/18 [2.15c+] ENCRYPTED} +FUNCTION LoginEncrToFileServer(ObjName: String; ObjType: Word; + PassWord: String ): Boolean; + +{F217/15 [2.15c+]} +Function GetObjectConnectionNumbers( objName:String; objType:Word; + Var numberOfConnections: Byte; + Var connections: TconnectionList ):boolean; +{ returns a list of connectionnumbers where objects of the desired type and + name are logged in. } + +{F217/16 [2.15c+]} +Function GetConnectionInforMation (ConnectionNbr:byte; + Var objName:String; + Var objType:Word; + Var objId:LongInt; + Var LoginTime:TnovTime ):boolean; + +{EA00 [2.0/2.1/3.x]} +Function GetNetwareShellVersion( Var MajorVersion,MinorVersion, + RevisionLevel :Byte ):Boolean; +{ Returns information about a WS environment. Queries shell. } + +{EAxx,xx>00 [2.0/2.1/3.x]} +Function GetWorkstationEnvironment(Var OStype,OSversion, + HardwareType,ShortHWType:String):Boolean; + +{EE.. [2.0/2.1/3.x]} +FUNCTION GetWorkstationNodeAddress( var physicalNodeAddress: TNodeAddress ):boolean; +{ Get the physical address of the workstation (6 bytes hi-endian) } + + +{EF03 [2.0/2.1/3.x]} +Function GetConnectionIDTable( ConnectionID: Byte ; Var TableEntry: TConnectionIDTableEntry ):boolean; +{ Returns a copy of the entry in the shells' ConnectionID table corresponding + with the given ConnectionID. } + +{EF04 [2.0/2.1/3.x]} +Function GetConnectionID( serverName: String; Var ConnectionID: Byte):boolean; + + +{EF04 [2.0/2.1/3.x]} +Function GetFileServerName( ConnectionID : byte; var ServerName : string):boolean; +{ get name of file server. file server number must be in range [1..MaxServers] } + +{F000 [2.0/2.1/3.x]} +Function SetPreferredConnectionID( ConnectionID :byte ):boolean; + +{F001 [2.0/2.1/3.x]} +Function GetPreferredConnectionID(var connID : byte):boolean; + +{F002 [2.0/2.1/3.x]} +FUNCTION GetDefaultConnectionID(var connID :byte):boolean; + +{F004 [2.0/2.1/3.x]} +FUNCTION SetPrimaryConnectionID( primaryConnectionID :Byte ):boolean; + +{F005 [2.0/2.1/3.x]} +FUNCTION GetPrimaryConnectionID(var connID :byte ):boolean; + +{F100 [2.0+]} +Function AttachToFileServerWithAddress(ServerName:string; + ServerAddr:TinternetworkAddress; + Var ConnectionID:Byte):Boolean; + +{F100 [2.0/2.1/3.x] (also calls EF03,EF04)} +Function AttachToFileServer(ServerName : String; Var ConnectionID:Byte):Boolean; +{ Create an attachment between a server and a workstation. } + +{F101 [2.0/2.1/3.x]} +Function DetachFromFileServer( ConnectionID:byte ):boolean; +{ removes server from shell's server table. Relinquishes the + fileserver connection number and breaks the connection. } + +{F102 [2.0/2.1/3.x]} +Function LogoutFromFileServer(var ConnectionID: byte):boolean; +{logout from one file server} + +{***** secondary Functions, result1 variable is not used *******************} + +{EF03 [2.0/2.1/3.x] secondary Function } +Function IsConnectionIDinUse( ConnectionID: Byte ):boolean; + +Function GetUserAtConnection( ConnectionNbr:byte; var username: string):boolean; +{This function provides a short method of obtaining just the USERID.} + +Function GetEffectiveConnectionID(Var connId:byte):boolean; +{What server are the requests currently sent to? } + +Function GetObjectLoginControl(ObjName:string; ObjType:word; + VAR LoginControlInfo:TloginControl):boolean; + +Function GetObjectNodeControl( ObjName:string; ObjType:word; + {i/o} Var seqNbr:integer; + {out} Var NodeControlInfo:TnodeControl):boolean; + +Function ObjectCanLoginAt(ObjName:String; ObjType:Word; + LoginTime:TnovTime ):Boolean; +{ -If the fields hour,min,sec and dayOfWeek are filled, the time + will be checked against the login timerestrictions. + -If the fields year,month,day are filled ( >0 ), the date + will be checked with the expiration date of the account and + with the Account disabled Flag. } + +IMPLEMENTATION{=============================================================} + +Type TPConnectionIDTPtr=^TConnectionIDTable; + TPServerNTPtr=^TServerNameTable; + +{F000 [2.0/2.1/3.x]} +Function SetPreferredConnectionID( ConnectionID :byte ):boolean; +{ The preferred server is the default server to which the request + packets are sent. + Calls are routed to the preferred server. (IF explicitly set!). + If the preferred server was not set then the requests are routed to + the server that is attached to the current drive. If the current + drive is a local drive then the requests will be sent to the primary + server (mostly the server the shell initially attached to.) } +var regs : TTregisters; +begin + regs.ax := $F000; + regs.dl := ConnectionID; { 1..MaxServers, 0 to clear } + RealModeIntr($21,regs); + result1:=0; + SetPreferredConnectionID:=TRUE; +end; + +{F004 [2.0/2.1/3.x]} +FUNCTION SetPrimaryConnectionID( primaryConnectionID :Byte ):boolean; +var regs : TTregisters; +begin + regs.ax := $F004; + regs.dl := primaryConnectionID; { 1..MaxServers, or 0 to clear } + RealModeIntr($21,regs); + result1:=0; + SetPrimaryConnectionID:=TRUE; +end; + +{F005 [2.0/2.1/3.x]} +FUNCTION GetPrimaryConnectionID(var connID :byte ):boolean; +{ returns connection number of the primary file server (1..MaxServers) } +var regs : TTregisters; +begin + regs.ax := $F005; + RealModeIntr($21,regs); + connID := regs.al; + if connId>MaxServers + then result1:=$FF + else result1:=$00; + GetPrimaryConnectionID:=(result1=0); +end; + +{F002 [2.0/2.1/3.x]} +FUNCTION GetDefaultConnectionID(var connID :byte):boolean; +{ Returns the connection ID of the file server to which + the packets are currently being sent. } +var regs : TTregisters; +begin + regs.ax := $F002; + RealModeIntr($21,regs); + connID := regs.al; { 1..MaxServers } + if connId>MaxServers + then result1:=$FF + else result1:=$00; + GetDefaultConnectionID:=(result1=0); +end; + +{F001 [2.0/2.1/3.x]} +Function GetPreferredConnectionID(var connID : byte):boolean; +var regs : TTregisters; +begin + regs.ax := $F001; + RealModeIntr($21,regs); + connID := regs.al; { 1..MaxServers, or 0 if the preferred server was not set } + { The preferred coneection is reset to 0 by an EOJ. } + if connId>MaxServers + then result1:=$FF + else result1:=$00; + GetPreferredConnectionID:=(result1=0); +end; + + + +{EF04 [2.0/2.1/3.x]} +Function GetConnectionID( serverName: String; Var ConnectionID: Byte):boolean; +Type ptarr=^arr; + arr=Array[0..MaxServers*32] of Byte; +Var regs : TTregisters; + NameTable : Array [1..MaxServers*48] of Byte; + ServerNames: Array [1..MaxServers] of String; + t : Byte; +begin +UpString(ServerName); +regs.ax := $EF04; +RealModeIntr($21,regs); +{ get pointer to shell's server name table. } +move(nwPtr(regs.es, regs.si)^,NameTable,MaxServers*48); +For t := 0 to 7 + do ZstrCopy(ServerNames[t+1],NameTable[1+ t*48],48); + +t:=1; +While ((t<9) and (ServerNames[t]<>ServerName)) + do inc(t); +If t=9 + then result1:=$FC { invalid server name } + else begin + ConnectionID:=t; + { ServerName found. Is ConnectionID valid ? } + regs.ax:=$EF03; + RealModeIntr($21,regs); + IF (ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32] = $00 ) {= $FF ?? } + then begin + ConnectionID:=0; + result1:=$FC { ConnectionID invalid => servername invalid } + end + else result1:=$00; + end; +GetConnectionID:=(result1=0); +end; + + +{EF04 [2.0/2.1/3.x]} +Function GetFileServerName( ConnectionID : Byte; Var ServerName : String):boolean; +{ Get the name of file server, associated with the ConnectionID. + The File server number must be in the range [1..MaxServers]. + The function will fail (result1=$FF) if connID falls outside of this range. } +Type ptarr=^arr; + arr=Array[0..MaxServers*32] of Byte; +Var regs : TTregisters; + NameTable : Array [1..MaxServers*48] of Byte; + ServerNames: Array [1..MaxServers] of String; + t : Byte; +begin +regs.ax := $EF04; +RealModeIntr($21,regs); +{ Get pointer to shell's server name table. } +move(nwPtr(regs.es, regs.si)^,NameTable,MaxServers*48); +For t := 0 to 7 + do ZstrCopy(ServerNames[t+1],NameTable[1+ t*48],48); + +if ((ConnectionID<1) or (ConnectionID>MaxServers)) + then ServerName:='' + else ServerName := ServerNames[ConnectionID]; +IF ServerName='' + then result1:=$FF + else begin { The name is valid, but is the ConnectionID valid ? } + regs.ax:=$EF03; + RealModeIntr($21,regs); + IF (ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32] = $00 ) {= $FF ?? } + then begin + result1:=$FF; { ConnectionID invalid => servername invalid } + ServerName:=''; + end + else result1:=$00; + end; +GetFileServerName:=(result1=0); +end; + + +Function AttachToFileServerWithAddress(ServerName:string; + ServerAddr:TinternetworkAddress; + Var ConnectionID:Byte):Boolean; +{ Create an attachment between a server and a workstation. } +{ Does not Login the workstation. } +{ After attaching, and beFore logging in, you must set the preferred server + to the ConnectionID of the server. } +{ Will not report an error if you're already attached to + -or even logged on to- the target server. } +{ Attaches to the server whose address is supplied. The server name will + be placed in the server name tables, even if the servername is incorrect or + the supplied servername isn't associated with the supplied address. } +{ Based on the InsertServer Function in LOGON.PAS by Barry Nance, and + on Rose, p.262 } +Var ConnectionIDTPtr : TPConnectionIDTPtr; + ServerNTPtr : TPServerNTPtr; + NewServerSlot,i : Byte; + OldConnId : Byte; + ServIsAttached : Boolean; + AccessLevel : Byte; + ObjID : Longint; + + Regs:TTRegisters; + + NewServer:Boolean; + + Var cid:byte; + +BEGIN +{ If server known, take adress from shells' tables. + If server not known, try to read its' adress from a servers' bindery. + This will fail if you're not connected to at least one server. + Once an adress has been found, AttachToFileServerWithAdress is called. } + +ServerAddr.socket:=swap($0451); { swapped hi-lo} +UpString(ServerName); + +regs.ax:=$EF03; +RealModeIntr($21,regs); +ConnectionIDTPtr:=nwPtr(regs.es,regs.si); { Ptr to TConnectionIDTable } + +{ Determine whether the suplied server is already known/attached to } + +ConnectionID:=0; +REPEAT + inc(ConnectionID) +UNTIL (ConnectionID>MaxServers) + or ((ConnectionIDTPtr^[ConnectionID].SlotInUse>0) + and IsEqualNetworkAddress(ConnectionIDTPtr^[ConnectionID].ServerAddress,ServerAddr) + ); + +NewServer:=(ConnectionID>MaxServers); + +{ If the server is a new server, put it in the sorted ConnectionIDTable } +IF NewServer + then begin + { Determine free slot to insert new server } + NewServerSlot := 1; + WHILE (ConnectionIDTPtr^[NewServerSlot].SlotInUse <> $00) + AND (NewServerSlot <= MaxServers) + do inc(NewServerSlot); + IF NewServerSlot > MaxServers + then begin + result1:=$7C; + AttachToFileServerWithAddress := False; + exit; + end; + + With ConnectionIDTPtr^[NewServerSlot] + do begin + ServerAddress:=ServerAddr; + OrderNumber := 0; + For i := 1 TO MaxServers + do begin + IF (ConnectionIDTPtr^[i].SlotInUse <> $00) + and (ConnectionIDTPtr^[i].OrderNumber>=OrderNumber) + then OrderNumber:=ConnectionIDTPtr^[i].OrderNumber+1; + end; + SlotInUse := $FF; { Must be set to $FF before attaching } + end; + ConnectionID:=NewServerSlot; + end + else { NOT a new server.. } + IF (ConnectionIDTPtr^[ConnectionID].ConnectionNumber > 0) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionNumber < $FF) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionStatus = $FF) + then Begin { ServerIsKnown } + GetPreferredConnectionID (OldConnId); + SetPreferredConnectionID (ConnectionID); + ServIsAttached := GetBinderyAccessLevel (AccessLevel, ObjID); + SetPreferredConnectionID (OldConnID); + IF ServIsAttached { ServerIsAlreadyAttached / caller may even be looged on } + then begin + result1:=0; + AttachToFileServerWithAddress := True; + exit; + end; + End; + +{ Create an attachment } +With Regs +do begin + AX := $F100; + DL := ConnectionID; + RealModeIntr($21,Regs); + result1 := AL; + { F8 already attached to server; F9 No Free connection slots at server; + FA no more server slots; FE Server Bindery Locked; + FF No response from server } + end; + +IF NewServer + then begin + if result1<>$00 { F9/FA/FE/FF error at server/no response from server } + then Begin { Note that the combination of a 'new' server and err. F8 is impossible } + ConnectionIDTPtr^[NewServerSlot].SlotInUse:=$00; + { Invalid server, Free slot again } + end + else begin + { Valid server, sort ConnectionID table } + With ConnectionIDTPtr^[NewServerSlot] + do begin + SlotInUse:=$00; { temporarily set to 0, For sorting purposes } + OrderNumber := 1; + For i := 1 TO MaxServers + do begin + IF ConnectionIDTPtr^[i].SlotInUse <> $00 + then begin + IF IsLowerNetworkAddress(ConnectionIDTPtr^[i].ServerAddress, ServerAddress) + then inc(OrderNumber) + else inc(ConnectionIDTPtr^[i].OrderNumber) + end; + end; + SlotInUse:=$FF; + end; + { Put new servers' name in server Name Table } + regs.ax := $EF04; + RealModeIntr($21,regs); + ServerNTPtr:=nwPtr(regs.es, regs.si); { pointer to shell's server name table. } + FillChar(ServerNTPtr^[NewServerSlot],48,#0); + If ServerName[0]>#47 + then ServerName[0]:=#47; + Move(ServerName[1],ServerNTPtr^[NewServerSlot],Length (ServerName)); + end; + end; + +AttachToFileServerWithAddress:=(result1=0); +{ Valid completion codes: + 7C Maximum number of attached servers exceeded. + F8 already attached to server; + F9 No Free connection slots at specified server; + FA no more server slots; + FF No response from server + FC No Free slots in shells' ConnectionID table; } +end; + + +Function AttachToFileServer(ServerName : String; Var ConnectionID:Byte):Boolean; +{ Create an attachment between a server and a workstation. } +{ !! you have to be attached to at least 1 server before calling this function. } +{ Does not Login the workstation. } +{ After attaching, and beFore logging in, you must set the preferred server + to the ConnectionID of the server. } +{ Will not report an error if you're already attached to + -or even logged on to- the target server. } +Var ConnectionIDTPtr : TPConnectionIDTPtr; + OldConnId : Byte; + ServIsAttached : Boolean; + AccessLevel : Byte; + ObjID : Longint; + + PropValue :Tproperty; + MoreSegments :boolean; + PropFlags :Byte; + + Regs:TTRegisters; + + ServAddr:TinternetworkAddress; +BEGIN +{ If server known, take adress from shells' tables. + If server not known, try to read its' address from a servers' bindery. + This will fail if you're not connected to at least one server. + Once an adress has been found, AttachToFileServerWithAdress is called. } +UpString(ServerName); + +regs.ax:=$EF03; +RealModeIntr($21,regs); +ConnectionIDTPtr:=nwPtr(regs.es,regs.si); { Ptr to TConnectionIDTable } + +{ Determine whether the suplied server is already known/attached to } +IF GetConnectionID(ServerName,ConnectionID) + then Begin + IF (ConnectionIDTPtr^[ConnectionID].ConnectionNumber > 0) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionNumber < $FF) + AND (ConnectionIDTPtr^[ConnectionID].ConnectionStatus = $FF) + then Begin { ServerIsKnown } + GetPreferredConnectionID (OldConnId); + SetPreferredConnectionID (ConnectionID); + ServIsAttached := GetBinderyAccessLevel (AccessLevel, ObjID); + SetPreferredConnectionID (OldConnID); + result1:=0; + IF ServIsAttached { ServerIsAlreadyAttached / caller may even be looged on } + then begin + AttachToFileServer := True; + exit; + end + else ServAddr:=ConnectionIDTPtr^[ConnectionID].ServerAddress; + end + End + Else begin + IF ReadPropertyValue(ServerName,OT_FILE_SERVER,'NET_ADDRESS',1,PropValue,moreSegments,propFlags) + then begin + result1:=0; + Move(PropValue,ServAddr,SizeOf(TinternetworkAddress)); + end + else begin + result1:=$FC; + AttachToFileServer:=False; + exit; + end; + End; + +if result1=0 + then AttachToFileServerWithAddress(ServerName,ServAddr,ConnectionID); + +AttachToFileServer:=(result1=0); +{ Valid completion codes: + 7C Maximum number of attached servers exceeded. + 7D Bindery read error (The supplied server can't be located/doesn't exist) + F8 already attached to server; + F9 No Free connection slots at specified server; + FA no more server slots; + FE Server Bindery Locked; + FF No response from server + FC No Free slots in shells' ConnectionID table; } +END; + + +{F101 [2.0/2.1/3.x]} +Function DetachFromFileServer( ConnectionID:Byte ):boolean; +{ removes server from shell's server table. Relinquishes the + fileserver connection number and breaks the connection. + The function will fail (result1=$FF) if connID falls outside of the range [1..MaxServers].} +Type ArrPtr=^Tarr; + Tarr=Array[0..MaxServers*48] of Byte; +Var regs : TTregisters; +begin +if (ConnectionID<1) or (ConnectionID>MaxServers) + then result1:=$FF + else begin + regs.ax := $F101; + regs.dl := ConnectionID; { 1..MaxServers } + RealModeIntr($21,regs); + result1 := regs.al; + { returncodes: 00 successful; FF Connection Doesn't exist } + end; +DetachFromFileServer:=(result1=0); +end; + + +{EF03 [2.0/2.1/3.x]} +Function GetConnectionIDTable( ConnectionID: Byte ; Var TableEntry: TConnectionIDTableEntry ):boolean; +{ Returns a copy of the entry in the shells' ConnectionID table corresponding + With the given ConnectionID. All fields are returned lo-hi, except Net and Node + addresses. + The function will fail (result1=$FF) if connID falls outside of the range [1..MaxServers].} +Type ptarr=^tarr; + tarr=Array[0..MaxServers*32] of Byte; +Var regs:TTregisters; +begin +If ((ConnectionID<1) or (ConnectionID>MaxServers)) + then result1:=$FF + else begin + regs.ax:=$EF03; + RealModeIntr($21,regs); + move( ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32], TableEntry, 32 ); + With TableEntry + do begin + ServerAddress.socket:=swap(ServerAddress.socket); { Force lo-hi } + ReceiveTimeOut:=swap(ReceiveTimeOut); { Force lo-hi } + MaxTimeOut:=swap(MaxTimeOut); { Force lo-hi } + WconnectionNumber:=swap(WconnectionNumber); { force lo-hi } + end; + result1:=$00; + end; +GetConnectionIDTable:=(result1=0); +end; + + +{DC.. [2.0/2.1/3.x]} +Function GetConnectionNumber(Var ConnectionNbr:byte):boolean; +{ returns connection number of requesting WS (1..100) } +var regs:TTRegisters; +begin +regs.Ah:=$DC; +RealModeIntr($21,regs); +ConnectionNbr:=Regs.AL; { logical WS connection # } +{ cl= first digit of logical conn #, ch= second digit of conn# } +result1:=0; +GetConnectionNumber:=true; +end; + + +{F217/16 [2.15c+]} +Function GetConnectionInformation (ConnectionNbr:byte; + Var objName:String; + Var objType:Word; + Var objId:LongInt; + Var LoginTime:TnovTime ):boolean; +Type TReq=Record + PacketLength : Word; + FunctionVal : Byte; + _ConnectionNo : Byte; + End; + Trep=Record + _objId :LongInt; { hi-lo } + _ObjType : word; { hi-lo } + _ObjName : Array [1..48] of Byte; + _LoginTime : TnovTime; + Reserved:word; + End; + TPreq=^Treq; + TPrep=^Trep; +Var i,x: Integer; +Begin +With TPreq(GlobalReqBuf)^ +Do Begin + PacketLength := 2; + FunctionVal := $16; + _ConnectionNo := ConnectionNbr; + End; +F2SystemCall($17,SizeOf(Treq),SizeOf(TRep),result1); +If result1 = 0 + Then Begin + With TPrep(GlobalReplyBuf)^ + Do Begin + ZstrCopy(ObjName,_objName,48); + ObjId:=Lswap(_objId); + ObjType:=swap(_objType); + logintime:=_logintime; + End; + End; +{ patch to have a NIL object return an error. } +if objName='' then result1:=$FD; { no_such_connection } +GetConnectionInformation:=(result1=0); +End { GetConnectInfo }; + + + +{F217/14 [2.15c+,unencrypted]} +Function LoginToFileServer( objName:String; objType:word; + password : string ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _objType :Word; { hi-lo } + _objName :String[47]; { asciiz? } + _objPassw:String[127]; { allowed to be '' } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$14; + _objType:=swap(objType); + PStrCopy(_objName,objName,47); _objName[47]:=#0; UpString(_objName); + PStrCopy(_objPassw,password,127); UpString(_objPassw); + end; +F2SystemCall($17,SizeOf(Treq),0,result1); +LoginToFileServer:=(result1=0) +end; + + +{F217/18 [3.x]} +FUNCTION LoginEncrToFileServer(ObjName: String; ObjType: Word; PassWord: String): Boolean; +{ assumes the current effective server = the server to login to. } + + + FUNCTION LoginEncrypted(ObjName : String; ObjType : Word; VAR key : TencryptionKey): Boolean; + Type Treq=RECORD + BufLen : Word; + _func : Byte; + _key : TencryptionKey; + _ObjType: Word; + _ObjName: String[48]; + End; + TPreq=^Treq; + Begin + With TPreq(GlobalReqBuf)^ + do Begin + _func := $18; + _key := key; + _ObjType := Swap(objType); + PstrCopy(_ObjName,ObjName,48); UpString(_ObjName); + if ObjName[0]<#48 + then _objName[0]:=objName[0] + else _objname[0]:=#48; + BufLen:=ord(_ObjName[0])+12; + End; + F2SystemCall($17,SizeOf(Treq),0,result1); + LoginEncrypted:=(result1=0); + End; + +VAR + key : TencryptionKey; + ObjId:LongInt; + +Begin +UpString(password); +if password[0]>#127 + Then password[0]:=#127; + +IF GetEncryptionKey(key) + Then Begin + IF GetBinderyObjectId(objName,objType,ObjId) + Then Begin + EncryptPassword(objId,password,key); + LoginEncrypted(ObjName, ObjType, key); + End; + End + Else LoginToFileServer(ObjName, ObjType, Password); + +LoginEncrToFileServer:= (result1=0); +End; + + +{F219 [2.15c+]} +Function Logout:boolean; +{logout from all file servers, remains attached to Server, effective EOJ } +begin + F2SystemCall($19,0,0,result1); + result1:=$00; + Logout:=true; +end; + + +{F102 [2.0/2.1/3.x]} +Function LogoutFromFileServer(var ConnectionID: byte):boolean; +{logout from one file server} +var regs : TTregisters; +begin + regs.ah := $F1; + regs.al := $02; + regs.dl := ConnectionID; + RealModeIntr($21,regs); + result1:=00; + LogoutFromFileServer:=True; +end; + +{EE.. [2.0/2.1/3.x]} +FUNCTION GetWorkstationNodeAddress( var physicalNodeAddress: TNodeAddress ):boolean; +{ Get the physical station address (6 bytes hi-endian) } +Var Regs :TTRegisters; +Begin + {Get the physical address from the Network Card} + Regs.Ah := $EE; + RealModeIntr($21,Regs); + result1:=Regs.AL; + {nw node= CX BX AX hi-endian} + physicalNodeAddress[1]:=Regs.CH; + physicalNodeAddress[2]:=Regs.CL; + physicalNodeAddress[3]:=Regs.bh; + physicalNodeAddress[4]:=Regs.bl; + physicalNodeAddress[5]:=Regs.ah; + physicalNodeAddress[6]:=Regs.al; + result1 := 0; + GetWorkstationNodeAddress:=true; +End; + + +{F217/13 [2.15c+]} +Function GetInternetAddress( ConnNbr : byte; + Var IntNetAddress:TinterNetworkAddress + ):boolean; +Type TReq=record + length : word; + subfunction : byte; + connection : byte; + end; + TRep=record + network : LongInt; { array [1..4] of byte } { hi-lo } + node : array [1..6] of byte; { hi-lo } + socket : word; { array [1..2] of byte } { hi-lo } + end; + TPreq=^Treq; + TPrep=^Trep; +BEGIN +With TPreq(GlobalreqBuf)^ +do begin + length := 2; + subfunction := $13; + connection := ConnNbr; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(TRep),result1); +if result1 = 0 +then With TPrep(GlobalreplyBuf)^ + do begin + move(network,IntNetAddress.net,4); {_is_ and stays hi-lo } + move(node,IntNetAddress.node,6); { _is_ and stays hi-lo } + IntNetAddress.socket:=swap(socket); { force lo-hi } + end; +GetInternetAddress:=(result1=0); +end; + +{D6.. [2.0/2.1/3.x]} +FUNCTION EndOfJob(All : Boolean):boolean; +{ forces an end of job + If All is TRUE, then ends all jobs, otherwise ends a single job. + Ending a job unlocks and clears all locked or logged files and records. + It close all open network and local files and resets error and lock modes. + It also resets the workstation environment. } +Var NovRegs:TTRegisters; +BEGIN +with NovRegs +do begin + AH := $D6; + if All + then BX := $FFFF + else BX := $00; + end; +RealModeIntr($21,NovRegs); +result1:=$00; +EndOfJob:=True; +end; + +{$IFDEF NewCalls} + +{F218 [2.15c+]} +FUNCTION EndOfJob(All : Boolean):boolean; +{ forces an end of job + If All is TRUE, then ends all jobs, otherwise ends a single job. + Ending a job unlocks and clears all locked or logged files and records. + It close all open network and local files and resets error and lock modes. + It also resets the workstation environment. } +Type Treq=record + len:word; + _all:word; + end; + { ??? ERR: unclear how the req buffer should be... } + TPreq=^Treq; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + if All + then _all := $FFFF + else _all := $0000; + len:=2; + end; +F2SystemCall($18,2,0,result1); +result1:=$00; +EndOfJob:=True; +end; + +{$ENDIF} + + +{F217/0A [2.0/2.1/3.x]} +Function EnterLoginArea( LoginSubDirName:String; + numberOfLocalDrives:Byte ):boolean; +{ Changes the login directory. Used by boot-proms. + LoginSubDirName contains the name of a sub directory under SYS:LOGIN + (e.g. 'V330' means login.exe is to be executed in directory SYS:LOGIN\V330)} +Type Treq=record + len:word; + subFunc:byte; + _numLocDr:Byte; + _subDirName:String[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$0A; + _numLocDr:=numberOfLocalDrives; + PstrCopy(_subDirName,LoginSubDirName,255); UpString(_subDirName); + end; +F2SystemCall($17,Sizeof(Treq),0,result1); +EnterLoginArea:=(result1=0) +end; + +{F217/15 [2.15c+]} +Function GetObjectConnectionNumbers( objName:String; objType:Word; + Var numberOfConnections: Byte; + Var connections: TconnectionList ):boolean; +{ returns a list of connectionnumbers where objects of the desired type and + name are logged in. + Tconnectionlist is defined as an array[1..100] of byte. Max connections for + Netware 286 = 100. Netware 386 allows more than 100 connections. + If you pass a bad Objectname or the object is not logged in, the errorcode + is NOT set to NO_SUCH_OBJECT ($FC), but GetObjectConnectionNumbers returns 0.} +Type Treq=record + len:word; + subFunc:byte; + _objType:Word; { hi-lo} + _objName:String[47]; + end; + Trep=record + _NbrOfConn:Byte; + _connList:TconnectionList + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + len:=SizeOf(Treq)-2; + subFunc:=$15; + PstrCopy(_objName,objName,47); _objname[47]:=#0; UpString(_objName); + _objType:=swap(objType); + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result1); +With TPrep(GlobalReplyBuf)^ +do begin + connections:=_connList; + NumberOfConnections:=_NbrOfConn; + end; +getObjectConnectionNumbers:=(result1=0) +end; + + +{EA00 [2.0/2.1/3.x]} +Function GetNetwareShellVersion( Var MajorVersion,MinorVersion, + RevisionLevel :Byte ):Boolean; +{ Returns information about a WS environment. Queries shell. + See also: GetWorkstationEnvironment } + +Var regs:TTRegisters; + tmp1,tmp2:word; +Begin +With regs +do begin + AX:=$EA00; + GetGlobalBufferAddress(tmp1,tmp2,ES,DI); + { Set ES:DI to real-mode address of GlobalReplyBuffer } + { Returned value NOT used, but registers need a valid value anyway. } + RealModeIntr($21,regs); + MajorVersion:=BH; + MinorVersion:=BL; + { shell version>=3.00 : } + { CH = Shell Type. 0=conventional, 1= expanded, 2= extended } + RevisionLevel:=CL; { 1=A,2=B etc. } + end; +result1:=$00; +GetNetwareShellVersion:=True; +end; + +{EAxx,xx>00 [2.0/2.1/3.x] (shell version >=3.00) } +Function GetWorkstationEnvironment(Var OStype,OSversion, + HardwareType,ShortHWType:String):Boolean; +Type Treply=record + stringz4:array[1..4*32] of char; + end; + TPreply=^Treply; +Var regs:TTRegisters; + sNo,k:Byte; + tmp1,tmp2:word; +Begin +With regs +do begin + AX:=$EA01; + BX:=$00; + GetGlobalBufferAddress(tmp1,tmp2,ES,DI); + { set ES:DI to real-mode address of GlobalReplyBuffer } + RealModeIntr($21,regs); + end; +OStype:=''; +OSVersion:=''; +HardwareType:=''; +ShortHWtype:=''; +sNo:=0;k:=0; +With TPreply(GlobalReplyBuf)^ +do begin + while sNo<4 + do begin + inc(k); + while ((k<128) and (stringz4[k]<>#0)) + do begin + Case sNo of + 0:OStype:=OStype+stringz4[k]; + 1:OSversion:=OSversion+stringz4[k]; + 2:HardwareType:=HardwareType+stringz4[k]; + 3:ShortHWtype:=ShortHWtype+stringz4[k]; + end; {case} + inc(k); + end; + inc(Sno); + end; + end; +result1:=$00; +GetWorkstationEnvironment:=True; +end; + +{DD.. [2.0/2.1/3.x]} +Function SetNetwareErrorMode( errMode:Byte):boolean; +{ Sets the shell's handling mode for dealing with netware errors. + 0: default, INT 24 handler 'Abort, Retry, Fail'; + 1: a netware error number is returned in AL; + 2: the netware error number is translated to a DOS error number, + this number is returned. + An EOJ resets the errormode to 0. } +Var regs:TTregisters; +begin +Regs.AH:=$DD; +Regs.DL:=errMode; +RealModeIntr($21,Regs); +{ regs.al now contains previous error mode } +result1:=$00; +SetNetWareErrorMode:=True; +end; + +{DD.. [2.0/2.1/3.x]} +Function GetNetwareErrorMode(Var errMode:Byte):boolean; +Var regs:TTregisters; +begin +Regs.AH:=$DD; +Regs.DL:=0; +RealModeIntr($21,Regs); +{ regs.al now contains previous error mode } +errMode:=regs.al; +regs.ah:=$DD; +RealModeIntr($21,regs); { reset old error mode } +result1:=$00; +GetNetWareErrorMode:=True; +end; + + + +{BB.. [2.0/2.1/3.x]} +Function SetEndOfJobStatus( EndOfJobFlag: Boolean ):Boolean; +{ When this function is called with EndOfJobFlag=False and control is returned + to the root COMMAND.COM, COMMAND.COM will NOT perform an EOJ action. } +Var regs:TTRegisters; +begin +regs.AH:=$BB; +If EndOfJobFlag + then regs.AL:=$01 + else regs.AL:=$00; +RealModeIntr($21,Regs); +{ AL now contains previous EOJ Flag } +result1:=$00; +SetEndOfJobStatus:=True; +end; + +{BB.. [2.0/2.1/3.x]} +Function GetEndOfJobStatus(Var EndOfJobFlag: Boolean ):Boolean; +Var regs:TTRegisters; +begin +regs.AH:=$BB; +regs.al:=$00; +RealModeIntr($21,Regs); +{ AL now contains previous EOJ Flag } +EndOfJobFlag:=(regs.al<>0); +regs.ah:=$BB; +RealModeIntr($21,regs); { reset old eoj-status } +result1:=$00; +GetEndOfJobStatus:=True; +end; + +{E908 (shell 3.00+)} +Function SetShowDots( Show:Boolean):Boolean; +Var regs:TTregisters; +begin +regs.ax:=$E908; +if Show + then regs.bl:=$01 + else regs.bl:=$00; +RealModeIntr($21,Regs); +result1:=$00; +SetShowDots:=True; +end; + +{E908 (shell 3.00+)} +Function GetShowDots(Var Shown:Boolean):Boolean; +Var regs:TTregisters; +begin +regs.ax:=$E908; +RealModeIntr($21,Regs); +Shown:=(regs.bl<>0); +regs.ax:=$E908; +RealModeIntr($21,regs); {reset old 'show dots' parameter} +result1:=$00; +GetShowDots:=True; +end; + +{DB.. [2.0/2.1/3.x]} +Function GetNumberOfLocalDrives( Var drives:Byte ):Boolean; +Var regs:TTregisters; +begin +regs.ah:=$DB; +RealModeIntr($21,Regs); +drives:=Regs.AL; +result1:=$00; +GetNumberOfLocalDrives:=TRUE; +end; + + +{=======SECONDARY FUNCTIONS===================================================} + + +{EF03 [2.0/2.1/3.x] secondary Function } +Function IsConnectionIDinUse( ConnectionID: Byte ):boolean; +{ This function returns FALSE if connId isn't in the range [1..MaxServers] } +Type ptarr=^arr; + arr=Array[0..MaxServers*32] of Byte; +Var regs:TTregisters; +begin +If ((ConnectionID<1) or (ConnectionID>MaxServers)) + then IsConnectionIDInUse:=FALSE { NWTP04: TRUE } + else begin + regs.ax:=$EF03; + RealModeIntr($21,regs); + IsConnectionIDinUse:=(ptarr(nwPtr(regs.es,regs.si))^[(ConnectionID-1)*32] + <> $00 ) + end; +end; + +Function GetUserAtConnection( ConnectionNbr:byte; var username: string):boolean; +{This function provides a shorter method of obtaining just the USERID.} +var id:LongInt; + typ:word; + time:TnovTime; +begin + getUserAtConnection:=GetConnectionInformation(ConnectionNbr,username,typ,id,time); +end; + + +Function GetEffectiveConnectionID(Var connId:byte):boolean; +begin +if NOT (GetPreferredConnectionID(connId) and (connId<>0)) + then if NOT (GetDefaultConnectionID(ConnId) and (connId<>0)) + then GetPrimaryConnectionID(ConnId); +GetEffectiveConnectionID:=(result1=$00); +end; + + +Function GetObjectLoginControl(ObjName:string; ObjType:word; + VAR LoginControlInfo:TloginControl):boolean; +{ Caller must have access to the bindery property LOGIN_CONTROL. + Default: you need to be supervisor-equivalent or the object the property + is associated with. (reading your 'own' information) + + PasswordcontrolFlag: + 00 User is allowed to change PW. + 01 User is NOT allowed to change PW. + 02 User is allowed to change PW, but the new password must be unique. + 03 User is NOT allowed to change PW, and a new password, to be changed + by the supervisor, must be unique. +} +Var LCpropVal:Tproperty; + lc:record + _AccExpDate :array[1..3] of byte; {yy mm dd} + _AccDisabled :boolean; + _PWexpDate :array[1..3] of byte; {yy mm dd} + _GraceLoginsRemaining:byte; + _DaysBetwPWchanges :word; {hi-lo} + _MaxGraceLogins :byte; + _minPWlen :byte; + _unknown1 :byte; {! = hi-byte of maxConcConn } + _MaxConcConn :byte; + _loginTimes :array[1..42] of byte; + _LastLoginTime :array[1..6] of byte; {yy mm dd hh mm ss} + _PWcontrol :byte; + _unknown2 :byte; { not used } + _MaxDiskSpace :Longint; { hi-lo } + _unknown3 :Byte; {! = hi-byte of bad login count } + _badLoginCount :byte; + _AccountResetTime :LongInt; { minutes since 1/1/1985 } + _lastIntruderAddress :TinterNetworkAddress; + end ABSOLUTE LCpropVal; + moreSegments:boolean; + propFlags:byte; + + Procedure Min2NovTime(m:Longint; Var time:TnovTime); + Const darr:array[1..12] of word=(0,31,59,90,120,151,181,212,243,273,304,334); + Var d,dr:word; + i,Lastleap:byte; + begin + d:=(m div 1440); + i:=0; + lastLeap:=84; + while d>((3+(i*4))*365)+31+28 + do begin + dec(d); + lastLeap:=85+3+(i*4); + inc(i); + end; + WITH time + do begin + year:=(d DIV 365)+85; + dr:=(d MOD 365); + month:=1; + while (month<12) and (dr>darr[month+1]) do inc(month); + day:=(dr-darr[month]); + if (day=28) and (month=2) and (lastLeap=year) + then inc(day); + dr:=(m mod 1440); + hour:=(dr div 60); + min:=(dr mod 60); + sec:=0; + end; + end; +begin +IF nwBindry.ReadPropertyValue(ObjName,ObjType,'LOGIN_CONTROL',1, + LCpropval,moreSegments,propFlags) + then begin + FillChar(LoginControlInfo,SizeOf(LoginControlInfo),#0); + With LoginControlInfo + do begin + AccountDisabled :=lc._AccDisabled; + move(lc._AccExpDate[1],AccountExpirationDate.year,3); + move(lc._PWexpDate[1],PasswordExpirationDate.year,3); + MinimumPasswordLength :=lc._minPWlen; + PasswordControlFlag :=lc._PWcontrol; + DaysBetweenPasswordChanges:=swap(lc._DaysBetwPWchanges); + Move(lc._lastLoginTime[1],LastLoginTime.year,6); + GraceLoginsRemaining :=lc._GraceLoginsRemaining; + MaxGraceLoginsAllowed :=lc._maxGraceLogins; + BadLoginCount :=lc._badLoginCount; + Min2NovTime(Lswap(lc._AccountResetTime),AccountResetTime); + LastIntruderAddress :=lc._LastIntruderAddress; + LastIntruderAddress.socket:=swap(LastIntruderAddress.socket); {force lo-hi} + MaxConcurrentConnections :=lc._MaxConcConn; + Move(lc._LoginTimes[1],LoginTimes[1],42); + + DiskSpace :=Lswap(lc._MaxDiskSpace); + end; + result1:=$00; + end + else result1:=nwBindry.result1; +GetObjectLoginControl:=(result1=0); +end; + +Function ObjectCanLoginAt(ObjName:String; ObjType:Word; + LoginTime:TnovTime ):Boolean; +{ Caller must have access to the bindery property LOGIN_CONTROL. + Default: you need to be supervisor-equivalent or the object the property + is associated with. (reading your 'own' information) + + -If one or more of the fields hour,min,sec,dayOfWeek contain a value >0, + the supplied time will be checked against the login timerestrictions. + (this means that checking '00:00 on sundays' is impossible) + -If one or more of the fields year,month,day contain a value >0 , the + date will be checked with the expiration date of the account and + with the Account disabled Flag. } +Var CanLog:Boolean; + Info:Tlogincontrol; + half_hrs:word; +begin +IF GetObjectLoginControl(ObjName,ObjType,Info) + then begin + if (logintime.month>0) and (loginTime.day>0) + then CanLog:=((NOT Info.AccountDisabled) and + IsLaterNovTime(Info.AccountExpirationDate,loginTime)) + else CanLog:=true; + if (logintime.hour>0) or (loginTime.min>0) + or (logintime.sec>0) or (logintime.DayOfWeek>0) + then begin + half_hrs:=(loginTime.DayOfWeek * 48)+(LoginTime.hour *2); + if LoginTime.min>=30 + then inc(half_hrs); + If half_hrs>=336 + then result1:=$122 + else CanLog:=CanLog AND + ((Info.LoginTimes[(half_hrs DIV 8)+1] + AND (1 SHL (half_hrs MOD 8)) ) >0) + end; + end + else begin + CanLog:=(result1=$FB); {no such property} + result1:=0; + end; +ObjectCanLoginAt:=(result1=0) and CanLog; +end; + +Function GetObjectNodeControl( ObjName:string; ObjType:word; + {i/o} Var seqNbr:integer; + {out} Var NodeControlInfo:TnodeControl):boolean; +Var NCpropVal:Tproperty; + moreSegments:boolean; + propFlags:byte; +begin +if seqNbr=$FBFB + then result1:=$EC + else begin + if seqNbr<1 then seqNbr:=1; + IF nwBindry.ReadPropertyValue(ObjName,ObjType,'NODE_CONTROL',seqNbr, + NCpropval,moreSegments,propFlags) + then begin + Move(NCpropVal,NodeControlInfo,120); + if moreSegments + then inc(seqNbr) + else seqNbr:=Integer($FBFB); + end + else result1:=nwBindry.result1; + end; +GetObjectNodeControl:=(result1=0); +{ $EC No more records (no such segment); + $FB No restrictions found (No such property) } +end; + + +end. { end of unit nwConn } + diff --git a/SRC/UNITS/NWFILE.PAS b/SRC/UNITS/NWFILE.PAS new file mode 100644 index 0000000..3f9bb4e --- /dev/null +++ b/SRC/UNITS/NWFILE.PAS @@ -0,0 +1,2999 @@ +{$X+,B-,V-} {essential compiler directives} + +Unit nwFile; + +{ nwFile unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk } + +INTERFACE +{ Primary Functions Interrupt: comments: + +Volume Management (Volume Tables) +--------------------------------- + +* ClearObjectVolRestriction (F216/22) (3) [aka ClearVolumeRestrictions/RemoveObjectDiskRestrictions] +* GetObjectVolRestriction (F216/29) (3) [aka GetObjDiskRestrictions/GetObjectDiskUsageAndRestrictions] +* GetVolumeName (F216/06) +* GetVolumeNameWithHandle (F216/15) [aka GetVolumeInfoWithHandle] +* GetVolumeNumber (F216/05) +* GetVolumeUsage (F216/2C) (3) [aka GetExtendedVolumeInformation] +* IsVolumeRemovable (F212) [aka GetVolumeInfoWithNumber] +* ScanVolForRestrictions (F216/20) (3) +* SetObjectVolRestriction (F216/21) (3) [aka SetVolumeRestrictions/SetObjectVolSpaceLimit + /AddUserDiskspaceRestriction] + +Directory Handles (Directory Handle Table/Drive tables) +------------------------------------------------------- + +* AllocPermanentDirHandle (F216/12) +* AllocTemporaryDirHandle (F216/13) +* DeallocateDirHandle (F216/14) +* DeleteFakeRootDirectory (E906) +* GetDirectoryHandle (E900) +* GetDriveConnectionId (EF02) +* GetDirectoryPath (F216/01) +* GetDriveFlag (EF01) (6) +* GetDriveHandle (EF00) (6) +* GetRelativeDriveDepth (E907) +* GetSearchDriveVector (E901) +* MapFakeRootDirectory (E905) +* SetDirectoryHandle (F216/00) +* SetDriveConnectionId (EF02) +* SetDriveFlag (EF01) +* SetDriveHandle (EF00) +* SetSearchDriveVector (E902) + + Secondary Functions + +* DeleteConnectionsDriveMappings +* DeleteDriveMapping +* GetEnvPath (BA..) +* IsSearchDrive (BA..) +* IsNetworkDrive (4409) +* MapDrive +* MapPermanentDrive +* MapSearchDrive +* SetEnvPath (BA..) + +Entries (directory/file management) +----------------------------------- + +* ChangeDirectory (3B..) (DOS) +* ConvertPathToDirEntryId (F217/F4) +* CreateDirectory (F216/0A) +* DeleteDirectory (F216/0B) +* EraseFiles (F244) +. FileServerFileCopy (F3..) + GetDirectoryInfo (F216/2D) (3) +* GetDirectoryEntry (F216/1F) (3) +. GetExtendedFileAttributes (B600) =F24E ??? +. GetFileAttributes (4300) (DOS) +* GetTrueEntryName (60..) (DOS) +* MapDirentryIdToPath (F217/F3) + MoveEntry (F216/2E) (3) dir and files +* PurgeSalvagableFile (F216/1D) (3) +* RecoverSalvagebleFile (F216/1C) (3) +* RenameDirectory (F216/0F) +* ScanDirectoryInformation (F216/02) +* ScanDirectoryEntry (F216/1E) (3) +* ScanFileInformation (F217/0F) + ScanFilePhysical (F216/28) (3) +* ScanSalvagableFiles (F216/1B) (3) +* SetEntry (F216/25) (3) dir and files +. SetExtendedFileAttributes (B601) =F24F +. SetFileAttributes (F246) [4301] +* SetFileInformation (F217/10) + +* ScanDirRestrictions (F216/23) (3) +* SetDirRestriction (F216/24) (3) + + Secondary functions: + + DeleteFile + GetFileHandle + IsFileShareable + FlagFileShareable + PurgeFiles (by dirHandle,fileMask) + SalvageFiles (by dirHandle,fileMask) + PurgeAllErasedFiles + + +Trustees/Max. Rights Mask +------------------------- + +* DeleteTrustee (F216/2B) (3) +* GetEffectiveRights (F216/2A) (3) +. ModifyMaximumRightsMask (F216/04) +. ScanBinderyObjectTrusteePaths (F217/47) +* ScanEntryForTrustees (F216/26) (3) +* SetTrustee (F216/27) (3) + + +Not Implemented: +---------------- + +- AddTrusteeToDirectory (F216/0D) (10) +- AllocSpecialDirHandle (F216/16) (2) +- DeleteTrusteeFromDirectory (F216/0E) (10) +- FileServerFileCopy (E6..) (8) +- GetEffectiveDirectoryRights (F216/03) (10) +- GetPathFromDirEntryID (F216/1A) (12) +- GetVolumeInformation (F217/E9) (1) +- GetVolumeInfoWithHandle (F216/15) (5) +- GetVolumeInfoWithNumber (F212) (4) [DA..] +- PurgeErasedFiles (F216/10) (8) +- PurgeAllErasedFiles (F217/CE) (8) +- RestoreDirectoryHandle (F216/18) (2) +- RestoreErasedFile (F216/11) (8) +- SaveDirectoryHandle (F216/17) (2) +- ScanDirectoryForTrustees (F216/0C) (9) +- SetDirectoryInformation (F216/19) (11) +- SetFileAttributes (E4..) (7) +- UpdateFileSize (E5..) (7) + + +Notes: (1) GetVolumeInformation. This call is NOT available in all 3.x versions. + (only with Nw 2.1 & 3.1x and CLIB.NLM dated before 11-11-92 ) + This call is not implemented here. Replaced by GetVolumeUsage. + (2) not available in (all versions of) NW 3.x. + (3) NW 3.x (and upwards) only. + (4) Replaced by GetVolumeUsage and IsVolumeRemovable. + (5) Replaced by GetVolumeUsage and GetVolumeNameWithHandle. + (6) Information can also be obtained by calling GetDirectoryHandle. + (DOS) 'Normal' DOS call, extended by NetWare shell. + (7) Not supported by Adv.NW 3.x. Not implemented here. + These are functions using FCB's. If another function with the same + name is listed here, that function performs the same action. + (8) Not supported by Adv.NW 3.x. Not implemented here. + These functions have been replaced with calls marked (3) + (9) Replaced by a newer version: ScanEntryForTrustees. + (10) Replaced by DeleteTrustee, GetEffectiveRights and SetTrustee. + (11) Replaced by SetEntry + (12) Replaced by MapDirEntryIDtoPath + + } + +Uses nwIntr,nwMisc,nwBindry,nwConn; + +Var Result:Word; + +Type TsearchDriveVector=array [1..17] of byte; + + +CONST + DRIVE_UNUSED = $00; + DRIVE_PERMANENT = $01; { Drive permanently assigned to fileserver directory } + DRIVE_TEMPORARY = $02; { Drive temporary assigned to FS dir. Released by EOJ } + DRIVE_NETWORK = $03; { Normal drive mapping } + DRIVE_LOCAL = $80; { Drive is local. ! By ORing with one of the above bits, + it can be reassigned to a FS directory.} + + {Name Space Type constants} + NS_DOS =0; + NS_MAC =1; + NS_NFS =2; + NS_FTAM =3; + NS_HPFS =4; + + { Attributes / Netware directory & file attributes } + A_NORMAL = $00; {file} + A_READ_ONLY = $01; {file} + A_HIDDEN = $02; {file/dir} + A_SYSTEM = $04; {file/dir} + A_EXECUTE_ONLY = $08; {file} + A_DIRECTORY = $10; {file} + A_NEEDS_ARCHIVED = $20; {file} + A_undocumented = $40; + A_SHAREABLE = $80; {file} + + A_LO_SEARCH = $0100; {file} + A_MID_SEARCH = $0200; {file} + A_HI_SEARCH = $0400; {file} + A_RESERVED = $0800; {file/dir} + A_TRANSACTIONAL = $1000; {file} + A_INDEXED = $2000; {file} + A_READ_AUDIT = $4000; {file} + A_WRITE_AUDIT = $8000; {file} + + A_PURGE = $010000; {file/dir} + A_RENAME_INHIBIT = $020000; {file/dir} + A_DELETE_INHIBIT = $040000; {file/dir} + A_COPY_INHIBIT = $080000; {file} + + { Trustee Attributes / directory access rights } + TA_NONE = $00; + TA_READ = $01; {R open/read} + TA_WRITE = $02; {W open/write} + TA_RESERVED = $04; { reserved, set to 0 } + TA_CREATE = $08; {C create files or dirs} + TA_DELETE = $10; {E delete files/dirs} + TA_ACCESS = $20; {A set /delete trustees} + TA_SEARCH = $40; {F directory can be searched/file is visible} + TA_MODIFY = $80; {M modify dir/file attributes} + TA_SUPERVISOR =$100; {S supervisor rights to file or directory } + + { Entry Modify flags / see SetEntry } + + EM_ENTRYNAME = $00000001; + EM_ATTRIBUTES = $00000002; + EM_CREATIONTIME = $0000000C; { date = $04, time = $08 } + EM_OWNERID = $00000010; + EM_ARCHIVETIME = $00000060; { date = $20, time = $40 } + EM_ARCHIVERID = $00000080; + EM_MODIFYTIME = $00000300; { date = $0100, time =$0200 } + EM_MODIFIERID = $00000400; + EM_LASTACCESSTIME = $00000800; { date = $0800 } + EM_RIGHTSMASK = $00001000; + EM_MAXDISKSPACE = $00002000; + +Type TvolUsage=record + totalBlocks, {static info} + freeBlocks, {dynamic} + purgableBlocks, {dynamic} + notYetPurgableBlocks, {dynamic} + totalDirEntries, {static} + availDirEntries, {dynamic} + Flags :LongInt; {dynamic} + SectorsPerBlock :byte; {static/number of 512 byte sectors per block} + volumeName :string[16];{static} + end; + + { used By ScanVolForRestrictions } + TobjVolRestr=array[1..64] of record + objId :LongInt; + MaxAllowedBlocks:LongInt; + end; + + +Type Tentry=record + EntryName :String[16]; + + NSType :byte; {namespace number} + DataForkSize :Longint; { =FileSize when NStype=0 (dos) } + {ResourceForkSize:Longint; (Mac data) =0 when NStype=0 (dos) } + FileSize :Longint; {FileSize=Resource+Data forksize } + + Attributes :Longint; + RightsMask :word; {(4)} + + CreationTime, + ArchiveTime, + ModifyTime, + LastAccessTime, + DeleteTime :TnovTime; {salvagable file only} + + OwnerId, + ArchiverId, + ModifierId, + DeletorId :Longint; {salvagable file only} + + end; + { Note: (4) When used with ScanDirectoryInfo, this field + contains the MaximumRightsMask. + Otherwise, the InheritedRightsMask } + +Type TdirRestrList=array[1..56] of record + Level:Byte; + MaxBlocks, + AvailableBlocks:Longint; + end; + {when MaxBlocks and Availableblocks are set to to $7FFFFFFF, + no restrictions are enforced -at this level-} + +Type TtrusteeInformation=record + NumberOfTrustees:Byte; + TrusteeID :array[1..20] of Longint; + TrusteeRights:array[1..20] of Word; + end; + +{-------------------- Volumes----------------------- } +{F216/05 [2.15c+]} +Function GetVolumeNumber( volumeName:String; Var volumeNumber:Byte ):boolean; +{ Returns the volume number of a given volume name } + +{F216/06 [2.15c+]} +Function GetVolumeName( volumeNumber:Byte; Var volumeName:String ):boolean; +{ Returns the volume name of a give volume number [0..31]. + If the volume is not mounted at the time of this call, a null-string is returned. } + +{F216/2C [2.15c+]} +Function GetVolumeUsage(volumeNumber:byte; Var VolUsage: TvolUsage):boolean; + +{F212 [2.15c+]} +Function IsVolumeRemovable( volumeNumber:Byte; + Var volIsRemoveable:Boolean):boolean; + +{F216/15 [2.15c+]} +Function GetVolumeNameWithHandle( dirHandle:Byte; + Var volumeName:String ):boolean; +{F216/29 [3.x]} +Function GetObjectVolRestriction(VolumeNumber:byte; objId:LongInt; + Var MaxAllowedBlocks,BlocksInUse:LongInt):boolean; + +{F216/21 [3.x]} +Function SetObjectVolRestriction(VolumeNumber:byte; objId, + MaxAllowedBlocks:LongInt):boolean; +{F216/22 [3.x]} +Function ClearObjectVolRestriction(VolumeNumber:byte; objId:LongInt):boolean; + + +{F216/20 [3.x]} +Function ScanVolForRestrictions(VolumeNumber:byte; + {i/o} Var sequenceNbr:LongInt; + {out} Var NbrOfObjects:byte; + Var ResultBuffer:TobjVolRestr):boolean; +{ 1st call: sequenceNbr=0, + after last call: sequenceNbr=0 again. } + +{-------------------- Directory Handles/ Drives -------------} + +{F216/01} +Function GetDirectoryPath(DirHandle:byte; Var PathName:string):boolean; + +{EF00 [2.0/2.1/3.x]} +Function GetDriveHandle( DriveNumber:Byte; Var DirHandle:Byte ):boolean; +{ The call returns a pointer to the shell's Drive Handle Table. (32 bytes) + (Drives A..Z and temporary drives [\]^_' ) + If a drive has been assigned a directory handle on the file server, + the handle can be found in the DHT at the position corresponding with the drive letter.} + +{EF00 [2.0/2.1/3.x]} +Function SetDriveHandle( DriveNumber:Byte; DirHandle:Byte ):boolean; + +{E900 [2.0/2.1/3.x]} +Function GetDirectoryHandle( DriveNumber:Byte; Var dirHandle,status:byte):Boolean; +{ Returns directory handle and status flags for a drive. } +{ Drivenumber = 0..31 (A..Z = 0..25) and temp drives (26..31) } + +{EF01 [2.0/2.1/3.x]} +Function GetDriveFlag( DriveNumber:Byte; Var DriveStatus:Byte ):Boolean; +{ This call returns a pointer to the shell's Drive Flag Table (32 Bytes) + Each entry indicates a drive's status (permanent,temporary,local,unassigned) + For further explanation see the DRIVE_xxx constants.} + +{EF01 [2.0/2.1/3.x]} +Function SetDriveFlag( DriveNumber:Byte; DriveStatus:Byte ):Boolean; + +{F216/14 [2.15c+]} +function DeallocateDirHandle(DirHandle : Byte) : Boolean; +{ This function deletes a directory handle } + + +{EF02 [2.0/2.1/3.x]} +Function GetDriveConnectionID( DriveNumber:Byte; Var connID:Byte):boolean; +{ returns the servernumber (1..8) associated with a drive. } + +{EF02 [2.0/2.1/3.x]} +Function SetDriveConnectionID( DriveNumber:Byte; connID:Byte):boolean; + +{F216/00 [2.15c+]} +Function SetDirectoryHandle( sourceDirHandle:Byte; sourceDirPath:String; + targetDirHandle:Byte ):boolean; +{ make handle 'targetHandle' point to the directory provided by + sourceHandle and/or sourceDirPath. } + +{F216/12 [2.15c+]} +FUNCTION AllocPermanentDirHandle( DriveNumber:Byte; + DirHandle : byte; DirPath : string ; + var NewDirHandle, EffectiveRights: byte ) :boolean; + +{F216/13 [2.15c+]} +function AllocTemporaryDirHandle( DriveNumber:byte; + DirHandle : Byte; DirPath : String; + var NewDirHandle,EffectiveRights : Byte) : Boolean; +{ Allocates a temporary directory handle, deleted automatically by EOJ. } + +{E901} +Function GetSearchDriveVector(Var vector:TsearchDriveVector):boolean; + +{E902 } +Function SetSearchDriveVector(vector:TsearchDriveVector):boolean; + +{E905 (shell 3.01+)} +Function MapFakeRootDirectory(DriveNumber:byte; DirPath:string):boolean; + +{E906 (shell 3.01+)} +Function DeleteFakeRootDirectory(DriveNumber:byte):boolean; + +{E907 (shell 3.01+)} +Function GetRelativeDriveDepth(DriveNumber:byte; Var depth:byte):boolean; + +{BA.. } +Function GetEnvPath(Var EnvPath:string):boolean; + +{BA.. } +Function SetEnvPath(EnvPath:string):boolean; + + +{secondary } +FUNCTION MapDrive(DriveNumber:byte; DirectoryPath:string; + Root, Permanent:boolean):boolean; + +{secondary } +FUNCTION MapPermanentDrive(DriveNumber:byte; DirectoryPath:string; + Root:boolean):boolean; + +{secondary} +Function MapSearchDrive(DriveNumber:byte; DirPath:string; + PathPosition:byte; + Insert,Root,Permanent:Boolean):boolean; + +{secondary} +Function DeleteDriveMapping(DriveNumber:Byte):boolean; + +{secondary} +Function DeleteConnectionsDriveMappings(ConnId:Byte):Boolean; + +{secondary} +Function IsSearchDrive(DriveNumber:byte):boolean; + +{4409 } +Function IsNetworkDrive(driveNumber:Byte):boolean; +{ isNetworkDrive is set to TRUE if the drive is a) a network drive, and + b) a legal drive letter was used. } + + +{------------------------- entries -----------------------------------------} + +{F217/0F [2.15c+]} +Function ScanFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + {i/o} VAR SequenceNbr:Integer; + {out} VAR fileInfo:Tentry):Boolean; + +{F217/F4 [3.0+]} +Function ConvertPathToDirEntryId(dirHandle:Byte; dirPath:string; + Var VolNbr :byte; + Var dirEntryID:LongInt):boolean; +{ aka ConvertPathToDirEntry / requires console rights } + +{F216/02} +Function ScanDirectoryInformation(dirHandle:byte; searchDirPath:string; + {i/o} Var sequenceNumber:word; + {out:} Var dirInfo:Tentry ):boolean; + +{F216/1F [2.15c+]} +Function GetDirectoryEntry(DirHandle:byte; + Var dirEntry:Tentry):boolean; + +{F216/1E [2.15c+]} +Function ScanDirectoryEntry(DirHandle:Byte; EntryName:string; SearchFlags:Longint; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; + +{F217/F3 [3.0+]} +Function MapDirEntryIdToPath(VolNbr:byte;DirEntryId:Longint; NStype:byte; + Var ExtPath:string):boolean; + +{F216/25 [2.15c+] } +Function SetEntry(DirHandle:Byte;EntryId:Longint;SearchFlags:Byte; + ModFlags:Longint; Entry:Tentry ):boolean; + +{F217/10 [2.15c+]} +Function SetFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + fileInfo:TEntry):boolean; + +{F216/1B [2.15c+]} +Function ScanSalvagableFiles(DirHandle:Byte; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; + +{F216/1D [3.0+]} +Function PurgeSalvagableFile(DirHandle:Byte; + EntryId:Longint; FileName:string):boolean; + +{F216/1C [3.0+] } +Function RecoverSalvagableFile(dirHandle:Byte; EntryId:Longint; + OldName,NewName:string):boolean; + +{F244 [2.1x/3.x]} +Function EraseFiles(dirHandle, searchAttrib:Byte; filePath:string ):boolean; + +{60.. (extended DOS call)} +Function GetTrueEntryName(DirPath:string; Var CanonicalPath:string):boolean; + + +{F216/0F [2.0/2.1/3.x]} +Function RenameDirectory( dirHandle:Byte; dirPath, newDirName :String):Boolean; + +{F216/0B [2.15c+]} +Function DeleteDirectory(DirHandle:Byte; DirPath:string):boolean; + +{F216/0A [2.15+]} +Function CreateDirectory(DirHandle:Byte; DirPath:string; MaxRightsMask:byte):boolean; + +{3B.. } +Function ChangeDirectory(DirPath:string):boolean; + + +{F216/24 [3.0+]} +Function SetDirRestriction(DirHandle:Byte; DiskSpaceLimit:Longint):boolean; + +{F216/23 [3.0+]} +Function ScanDirRestrictions(DirHandle:Byte; + Var NumberOfEntries:Byte; + Var RestrInfo:TdirRestrList):boolean; + +{--------------------------- Rights/trustees ---------------------------} + +{F216/27 [3.0+]} +Function SetTrustee(DirHandle:Byte;DirPath:string; + TrusteeObjectID:Longint; + RightsMask:Word ):boolean; + +{F216/2B [3.0+]} +Function DeleteTrustee(DirHandle:Byte;DirPath:String; + TrusteeObjectId:Longint):boolean; + +{F216/2A [3.0+]} +function GetEffectiveRights(DirHandle:Byte;DirPath:String; + var Rights:Word) : Boolean; + +{F216/04 [2.15c+]} +Function ModifyMaximumRightsMask(DirHandle:Byte;DirPath:string; + RevokeRightsMask,GrantRightsMask:Word):boolean; + + +{F217/47 [2.15c+]} +Function ScanBinderyObjectTrusteePaths(TrusteeObjectId:Longint; + VolumeNumber:Byte; + {i/o} Var SequenceNumber:word; + {out} Var AccessMask:Word; + Var Path:string ):boolean; + +{F216/26 [3.0+]} +Function ScanEntryForTrustees(DirHandle:Byte;DirPath:String; + {i/o} Var SequenceNumber:Byte; + {out} Var TrusteeInfo: TtrusteeInformation):boolean; + +IMPLEMENTATION{============================================================} + +{$IFDEF MSDOS} +uses dos; { file handles / 'normal' file attributes } +{$ENDIF} + +Type TintEntry=record { Unit internal Entry type } + { 0} _res1 :Longint; { low word = Dir Id of parent Dir } + { 4} _attrib :Longint; + { 8} _res2 :word; + { 10} _NStype :Byte; + { 11} _name :string[12]; + { 24} _creationTime :Longint; + { 28} _OwnerId :Longint; { hi-lo} + { 32} _ArchiveTime :Longint; + { 36} _ArchiverId :Longint; { hi-lo} + { 40} _modifyTime :Longint; + + { 44} _ModifierId :Longint; { files only } + { 48} _ForkSize :Longint; { files only } + { 52} _res3 :array[1..44] of byte; { Trustee obj IDs and Tr. rights } + { 96} _FileRightsMask:word; { files only } + { 98} _AccessDate :word; { files only } + + {100} _DirRightsMask :word; { directories only } + {102} _res4 :word; {Unique Dir ID, hi-lo} { directories only } + {104} _DeleteTime :Longint; { salvageable files only } + {108} _DeletorID :LongInt; { salvageable files only } + {112} _res5 :array[1..16] of byte; + {128} end; + +Procedure Convert2ExtEntry(Var Ie:TintEntry;Var Oe:Tentry); +begin +FillChar(Oe,Sizeof(Tentry),#$0); +with Ie,Oe + do begin + Attributes:=_Attrib; + NStype:=_NStype; + Entryname:=_name; + DosTime2NovTime(_CreationTime,CreationTime); + OwnerId:=Lswap(_OwnerId); {force lo-hi} + DosTime2NovTime(_ArchiveTime,ArchiveTime); + ArchiverId:=Lswap(_ArchiverID); {force lo-hi} + DosTime2NovTime(_ModifyTime,ModifyTime); + if (_attrib and $10)>0 { is entry a directory ? } + then begin + RightsMask:=_DirRightsMask; + end + else begin + ModifierId:=LSwap(_ModifierId); {force lo-hi} + DataForksize:=_Forksize; + if _NSType=0 + then FileSize:=_ForkSize; + RightsMask:=_FileRightsMask; + DosTime2NovTime(MakeLong(_accessDate,0),LastAccessTime); + DosTime2NovTime(_DeleteTime,DeleteTime); + DeletorId:=Lswap(_DeletorID); {force lo-hi} + end; + end; +end; + +Procedure Convert2IntEntry(Var Oe:TEntry;Var Ie:TIntEntry); +Var TempTime:Longint; +begin +FillChar(Ie,Sizeof(Tentry),#$0); +with Ie,Oe + do begin + _Attrib:=Attributes; + _NStype:=NStype; + _Name:=EntryName; + NovTime2DosTime(CreationTime,_CreationTime); + _OwnerId:=Lswap(OwnerId); {force hi-lo} + NovTime2DosTime(ArchiveTime,_ArchiveTime); + _ArchiverId:=Lswap(ArchiverId); {force hi-lo} + NovTime2DosTime(ModifyTime,_ModifyTime); + if (Attributes and $10)>0 { is entry a directory ? } + then begin + _DirRightsMask:=RightsMask; + end + else begin + _ModifierId:=Lswap(ModifierId); { force hi-lo } + _ForkSize:=DataForkSize; + _FileRightsMask:=RightsMask; + NovTime2DosTime(LastAccessTime,TempTime); + _AccessDate:=HiLong(TempTime); + NovTime2DosTime(DeleteTime,_DeleteTime); + _DeletorID:=Lswap(DeletorId); { force hi-lo } + end; + end; +end; + +Procedure ConvertPathToVolFormat(Var path:string); +{ reformat \\server\vol\path to VOL:PATH + server/vol:path to VOL:PATH } +Var pcolon,pslash:byte; +begin +if (Path[0]>#1) and (Path[1]='\') and (Path[2]='\') + then begin + delete(Path,1,2); + Path:=Path+'\'; + pslash:=pos('\',Path); + if pslash>0 + then begin + delete(Path,1,pslash); { remove servername from path } + pslash:=pos('\',Path); + if pslash>0 + then Path:=copy(Path,1,pslash-1)+':'+copy(Path,pslash+1,255); + end; + while Path[ord(Path[0])]='\' do dec(Path[0]); + end + else begin + pcolon:=pos(':',path); + if (path[0]>#3) and (pcolon>3) + then begin + pslash:=pos('/',path); + if (pslash=0) or (pslash>pcolon) + then pslash:=pos('\',path); + if (pslash>0) and (pslash#16 + then volumeName[0]:=#16; + volName:=volumeName; + if volname[ord(volName[0])]=':' + then dec(volName[0]); + len:=2+ord(volName[0]); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +volumenumber:=TPrep(GlobalReplyBuf)^.volNbr; +getVolumeNumber:=(result=0) +{resultcodes: + 00 success; 98h volume doesn't exist } +end; + + +{F216/15 [2.15c+]} +Function GetVolumeNameWithHandle( dirHandle:Byte; + Var volumeName:String ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _dirHandle :Byte; + end; + Trep=record + _sectPerBlock :Word; {hi-lo} + _TotalBlocks :Word; {hi-lo} + _availBlocks :Word; {hi-lo} { Use GetVolumeUsage for the other fields } + _TotalDirSlots:Word; {hi-lo} + _availDirSlots:Word; {hi-lo} + _volName :array[1..16] of byte; + _volRemoveable:Word; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$15; + _dirHandle:=dirHandle; + end; +F2SystemCall($16,Sizeof(Treq),SizeOf(Trep),result); +ZStrCopy(volumeName,TPrep(GlobalReplyBuf)^._volName,16); +if volumeName='' + then result:=$9B; { Invalid directory handle } +getVolumeNameWithHandle:=(result=0) +{ resultcodes: 00 success; $9B invalid directory handle } +end; + + +{F212 [2.15c+]} +Function IsVolumeRemovable( volumeNumber:Byte; + Var volIsRemoveable:Boolean):boolean; +{ stripped down version of the GetVolumeInfoWithNumber call } +Type Treq=Byte; + Trep=record + _sectPerBlock :Word; {hi-lo} + _TotalBlocks :Word; {hi-lo} + _availBlocks :Word; {hi-lo} + _TotalDirSlots :Word; {hi-lo} + _availDirSlots :Word; {hi-lo} + _volName :array[1..16] of byte; + _volRemoveable :Word; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +TPreq(GlobalReqBuf)^:=volumeNumber; +F2SystemCall($12,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + volIsRemoveable:=(_volRemoveable>0); + if _volName[1]=0 + then result:=$98; + end; +IsVolumeRemovable:=(result=0); +{ resultcodes: 00 success; 98h Invalid volume number / volume not mounted } +end; + +{F216/22 [3.x]} +Function ClearObjectVolRestriction(VolumeNumber:byte; objId:LongInt):boolean; +{ If the objId doesn't exist, no error is returned. } +Type Treq=record + len:word; + subFunc:byte; + _volNbr:byte; + _objId:LongInt; { hi-lo } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$22; + _volNbr:=VolumeNumber; + _objId:=Lswap(objId); { force hi-lo } + end; +F2SystemCall($16,SizeOf(Treq),0,result); +ClearObjectVolRestriction:=(result=0) +{ $8C No supervisor rights } +end; + +{F216/29 [3.x]} +Function GetObjectVolRestriction(VolumeNumber:byte; objId:LongInt; + Var MaxAllowedBlocks,BlocksInUse:LongInt):boolean; +{ If MaxAllowedBlocks is equal to $40000000 on return, there are no + disk restrictions for the object on this volume. } +{ You need not be logged in to use this call. } +Type Treq=record + len :word; + subFunc:byte; + _volNbr:byte; + _objId :Longint; {hi-lo} + end; + Trep=record + _MaxAllowedBlocks, + _BlocksInUse :Longint; + end; + TPreq=^Treq; + TPrep=^Trep; +Var objName:string; + objType:word; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len :=SizeOf(Treq)-2; + subFunc:=$29; + _volNbr:=VolumeNumber; + _objId :=Lswap(objId); {force hi-lo} + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + MaxAllowedBlocks:=_MaxAllowedBlocks; + BlocksInUse:=_BlocksInUse; + If BlocksInUse=0 + then if NOT nwBindry.GetBinderyObjectName(objId,objName,objType) + then result:=$FF; + end; +GetObjectVolRestriction:=(result=0) +{resultcodes: 00 success; $FF Invalid objectId } +end; + +{F216/20 [3.x]} +Function ScanVolForRestrictions(VolumeNumber:byte; + {i/o} Var sequenceNbr:LongInt; + {out} Var NbrOfObjects:byte; + Var ResultBuffer:TobjVolRestr):boolean; +{ 1st call: sequenceNbr=0, + // n-th call: sequenceNbr(n):=sequenceNbr(n-1)+NbrOfObjects + // (addition done by function itself) + + after last call: sequenceNbr=0 again. } +Type Treq=record + len:word; + subFunc:byte; + _volNbr:byte; + _seqNbr:LongInt; { lo-hi !} + end; + Trep=record + _NbrOfObjects:byte; + _buff :TobjVolRestr; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$20; + _volNbr:=VolumeNumber; + _seqNbr:=sequenceNbr; + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +if result=0 + then begin + With TPrep(GlobalReplyBuf)^ + do begin + NbrOfObjects:=_NbrOfObjects; + ResultBuffer:=_buff; + For t:=1 to NbrOfObjects + do ResultBuffer[t].objId:=Lswap(_buff[t].ObjId); + if _NbrOfObjects=0 + then result:=$FF + else sequenceNbr:=sequenceNbr+_NbrOfObjects; + end + end + else NbrOfObjects:=0; +ScanVolForRestrictions:=(result=0) +{ $98 VolumeNumber doesn't exist; + $FF No New restriction data (end of iteration) } +end; + +{F216/21 [3.x]} +Function SetObjectVolRestriction(VolumeNumber:byte; objId,MaxAllowedBlocks:LongInt):boolean; +{ If the objId doesn't exist, no error is returned. } +Type Treq=record + len :word; + subFunc:byte; + _volNbr:byte; + _objId :Longint; {hi-lo} + _maxBlocks:LongInt; {lo-hi !!} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$21; + _volNbr:=VolumeNumber; + _objId:=Lswap(objId); { force hi-lo } + _maxBlocks:=MaxAllowedBlocks; + end; +F2SystemCall($16,SizeOf(Treq),0,result); +SetObjectVolRestriction:=(result=0) +{ $8C No supervisor Rights } +end; + + +{--------------Dir handles/ drive mappings----------------------------------} + + +{BA.. } +Function GetEnvPath(Var EnvPath:string):boolean; {#d} +Type Tarr=array[1..2048] of byte; +Var regs:TTregisters; + penv:^Tarr; + i,envSize:word; + state:byte; +begin +regs.ah:=$BA; +RealModeIntr($21,regs); +envSize:=byte(nwPtr(regs.dx-1,3)^) SHL 4; +penv:=nwPtr(regs.dx,0); +i:=1; +state:=0; +while (i0) + do begin + EnvPath:=EnvPath+chr(penv^[i]); + inc(i); + end; +if i>envSize + then begin + result:=$301; + GetEnvPath:=false; + exit; + end; +result:=0; +GetEnvPath:=true; +{ 00 successful + 300 'Path' not found + 301 Path value could not be read } +end; + +{BA.. } +Function SetEnvPath(EnvPath:string):boolean; {#d} +Type Tarr=array[1..2048] of byte; +Var regs:TTregisters; + penv:^Tarr; + i,t,envSize:word; + state:byte; + pbegin,pend:word; + NewPathSize,OldPathSize:byte; + diff:integer; + sVector:TsearchDriveVector; + Vecind,p:byte; + dn:Byte; +begin +Upstring(EnvPath); +If pos('PATH=',envPath)=1 + then delete(EnvPath,1,5); +regs.ah:=$BA; +RealModeIntr($21,regs); +envSize:=word(nwPtr(regs.dx-1,3)^) SHL 4; +penv:=nwPtr(regs.dx,0); + +i:=1; +state:=0; +while (i0) + do inc(i); +if i>envSize + then begin + result:=$301; + SetEnvPath:=false; + exit; + end; +dec(i); +pend:=i; + +{ determine end of 'active' environment / marked by $00 00} +while (ienvSize + then begin + result:=$302; + SetEnvPath:=false; + exit; + end; + +diff:=NewPathSize-OldPathSize; +if diff>0 + then for t:=i downto pend + do penv^[t+diff]:=penv^[t]; +if diff<0 + then for t:=pend to i + do penv^[t+diff]:=penv^[t]; +Move(EnvPath[1],penv^[pbegin],NewPathSize); + +FillChar(Svector,SizeOf(TsearchDriveVector),#$FF); +VecInd:=1; +REPEAT +p:=pos(':',envPath); +if p>0 + then begin + dn:=ord(ord(envPath[p-1])-ord('A')); + p:=pos(';',envPath); + if p=0 + then envPath:='' + else delete(envPath,1,p); + IF IsNetworkDrive(dn) + then begin + Svector[VecInd]:=dn; + inc(VecInd) + end; + end; +UNTIL (p=0) or (VecInd=17); +SetSearchDriveVector(Svector); + +result:=0; +SetEnvPath:=true; +{ 00 successful + 300 'Path' not found + 301 Environment failure + 302 Environment overflow (new path too large) } +end; + + +{F216/01} +Function GetDirectoryPath(DirHandle:byte; Var PathName:string):boolean; +{ path includes volumename } +Type Treq=record + len :word; + subFunc:byte; + _dh :byte; + end; + Trep=record + DirPath:string[255]; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$01; + _dh:=DirHandle; + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +PathName:=TPrep(GlobalReplyBuf)^.DirPath; +GetDirectoryPath:=(result=0) +{ 00 Successful 9B Bad directory handle } +end; + +{EF02 [2.0/2.1/3.x]} +Function GetDriveConnectionID( DriveNumber:Byte; Var connID:Byte):boolean; +{ returns the servernumber (1..8) associated with a drive. } +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF02; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + connID:=Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]; + Result:=0; + end; +GetDriveConnectionID:=(Result=0); +end; + +{EF02 [2.0/2.1/3.x]} +Function SetDriveConnectionID( DriveNumber:Byte; connID:Byte):boolean; +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF02; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]:=connId; + Result:=0; + end; +SetDriveConnectionID:=(Result=0); +end; + + +{EF00 [2.0/2.1/3.x]} +Function GetDriveHandle( DriveNumber:Byte; Var DirHandle:Byte ):boolean; +{ The call returns a pointer to the shell's Drive Handle Table. (32 bytes) + (Drives A..Z and temporary drives [\]^_' ) + If a drive has been assigned a directory handle on the file server, + the handle can be found in the DHT at the position corresponding with the drive letter.} +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF00; +RealModeIntr($21,regs); +if DriveNumber>31 + then result:=$0105 + else begin + DirHandle:=Parr(nwPtr(Regs.Es,Regs.Si))^[DriveNumber]; + Result:=0; + end; +GetDriveHandle:=(Result=0); +end; + +{EF00 [2.0/2.1/3.x]} +Function SetDriveHandle( DriveNumber:Byte; DirHandle:Byte ):boolean; +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF00; +RealModeIntr($21,regs); +if DriveNumber>31 + then result:=$0105 + else begin + Parr(nwPtr(Regs.Es,Regs.Si))^[DriveNumber]:=DirHandle; + Result:=0; + end; +SetDriveHandle:=(Result=0); +end; + +{EF01 [2.0/2.1/3.x]} +Function GetDriveFlag( DriveNumber:Byte; Var DriveStatus:Byte ):Boolean; +{ This call returns a pointer to the shell's Drive Flag Table (32 Bytes) + Each entry indicates a drive's status (permanent,temporary,local,unassigned) + For further explanation see the DRIVE_xxx constants.} +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF01; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + DriveStatus:=Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]; + Result:=0; + end; +GetDriveFlag:=(Result=0); +end; + +{EF01 [2.0/2.1/3.x]} +Function SetDriveFlag( DriveNumber:Byte; DriveStatus:Byte ):Boolean; +Type pArr=^arr; + arr=array[0..31] of byte; +Var regs:TTregisters; +begin +regs.ax:=$EF01; +RealModeIntr($21,Regs); +If DriveNumber>31 + then result:=$0105 + else begin + Parr(nwPtr(Regs.es,regs.si))^[DriveNumber]:=DriveStatus; + Result:=0; + end; +SetDriveFlag:=(Result=0); +end; + + +{E900 [2.0/2.1/3.x]} +Function GetDirectoryHandle( DriveNumber:Byte; Var dirHandle,status:byte):Boolean; +{ Returns directory handle and status flags for a drive. } +{ Drivenumber = 0..31 (A..Z = 0..25) and temp drives (26..31) } +{ Status Byte + 7 6 5 4 3 2 1 0 + | | +-Permenant Directory Handle + | +----Temporary Directory Handle + +----------------------Mapped to a local drive } +{ in case of an invalid driveNumber, handle and status will be set to 0 } +Var Regs:TTRegisters; +begin +With Regs +do begin + AX:=$E900; + DX:=DriveNumber; + RealModeIntr($21,Regs); + { AH = Status Flags; + 01 mapped to a permanent dir handle; + 02 mapped to a temporary dir handle; + 80 local drive. } + dirHandle:=AL; + status:=AH; + If dirHandle=0 + then begin status:=0;Result:=$FF end {INVALID_DRIVE_NUMBER} + else Result:=0; + GetDirectoryHandle:=(Result=0) + end; +{ result: $00 success; $FF Invalid Drive Number } +end; + + +{F216/00 [2.15c+]} +Function SetDirectoryHandle( sourceDirHandle:Byte; sourceDirPath:String; + targetDirHandle:Byte ):boolean; +{ make handle 'targetHandle' point to the directory provided by + sourceHandle and/or sourceDirPath. ( "Volume:dir\subdir" ) } +Type Treq=record + len :word; + subFunc :byte; + _TargetDH :Byte; + _SourceDH :Byte; + _SourceDP :String[255] + end; + TPreq=^Treq; +Var p:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$00; + _TargetDH:=targetDirHandle; + _SourceDH:=SourceDirHandle; + if SourceDirHandle=0 + then ConvertPathToVolFormat(SourceDirPath); + _sourceDP:=sourceDirPath; + UpString(_sourceDP); + len:=4+ord(_SourceDP[0]); + F2SystemCall($16,len+2,0,result); + end; +SetDirectoryHandle:=(result=0) +{ resultcodes: + 00 Success; 98h Volume does not exist; + 9Bh Bad directory handle; 9Ch Invalid Path. } +end; + + +{F216/12 [2.15c+]} +FUNCTION AllocPermanentDirHandle( DriveNumber:Byte; + DirHandle : byte; DirPath : string ; + var NewDirHandle, EffectiveRights: byte ) :boolean; +{ Effective server must be the server involved, i.e. where the dir is stored } +Type Treq=record + len : word; + subf : byte; + _dirHandle : byte; + _driveLetter : char; + _DirectoryPath: String[255]; + end; + Trep=record + _newDirHandle : byte; + _EffectiveRights : byte; { e.r. mask } + end; + TPreq=^Treq; + TPrep=^Trep; +Var p:Byte; +BEGIN +With TPreq(GlobalReqBuf)^ + do begin + subf := $12; + _dirHandle := dirHandle; + _driveLetter := chr(DriveNumber+ord('A')); + if Dirhandle=0 + then ConvertPathToVolFormat(DirPath); + _DirectoryPath:=DirPath; + UpString(_DirectoryPath); + len:=4+ord(_DirectoryPath[0]); + F2SystemCall($16,len+2,sizeof(Trep),result); + end; +if result = 0 + then with TPrep(GlobalReplyBuf)^ + do begin + effectiveRights := _effectiveRights; + newDirHandle := _newDirHandle; + end; +AllocPermanentDirHandle:=(result=0); +{ $00 Successful $98 Volume doen't exist $9C Invalid path } +end; + + + + + +{F216/13 [2.15c+]} +function AllocTemporaryDirHandle( DriveNumber:byte; + DirHandle : Byte; DirPath : String; + var NewDirHandle,EffectiveRights : Byte) : Boolean; +{ Allocates a temporary directory handle, deleted automatically by EOJ. } +{ Effective server must be the server involved, i.e. where the dir is stored } +Type TReq=record + Len : Word; + SubF : Byte; + Handle : Byte; + Letter : Char; + _DirectoryPath : String; + end; + TRep=record + NewH : Byte; + Mask : Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Var p:Byte; +begin +with TPReq(GlobalReqBuf)^ + do begin + SubF := $13; + Handle := DirHandle; + Letter := chr(DriveNumber+ord('A')); + { Allocating handles requires paths to be in + the VOL:path format.. NOT canonical } + if handle=0 + then ConvertPathToVolFormat(DirPath); + _DirectoryPath:=DirPath; + UpString(_DirectoryPath); + Len:=4+length(_DirectoryPath); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +with TPrep(GlobalReplyBuf)^ + do begin + NewDirHandle := NewH; + EffectiveRights := Mask; + end; +AllocTemporaryDirHandle:=(result=0); +{ result: 00 success; 98h Volume doesn't exist; 9Ch Invalid Path } +end; + + +{F216/14 [2.15c+]} +function DeallocateDirHandle(DirHandle : Byte) : Boolean; +{ This function deletes a directory handle } +Type TReq=record + Len : Word; + SubF : Byte; + Handle : Byte; + end; + TPreq=^Treq; +begin +with TPReq(GlobalReqBuf)^ + do begin + Len := 2; + SubF := $14; + Handle:= DirHandle; + end; +F2SystemCall($16,Sizeof(Treq),0,result); +DeallocateDirHandle:=(result=0); +{ result: + 00h - Success; 9Bh - Bad directory handle } +end; + + +{E901 } +Function GetSearchDriveVector(Var vector:TsearchDriveVector):boolean; +Var regs:TTregisters; + tmp1,tmp2:word; +begin +regs.ax:=$E901; +GetGlobalBufferAddress(tmp1,tmp2,regs.ds,regs.dx); +{ DS:DX real-mode address of GlobalReplyBuffer } +RealModeIntr($21,regs); +result:=0; +Move(GlobalReplyBuf^,vector,sizeof(TsearchDriveVector)); +vector[17]:=$FF; +GetSearchDriveVector:=True; +end; + +{E902 } +Function SetSearchDriveVector(vector:TsearchDriveVector):boolean; +Var regs:TTregisters; + tmp1,tmp2:word; +begin +regs.ax:=$E902; +Move(vector,GlobalReqBuf^,sizeof(TsearchDriveVector)); +GetGlobalBufferAddress(regs.ds,regs.dx,tmp1,tmp2); +{ DS:DX real-mode address of GlobalRequestBuffer } +RealModeIntr($21,regs); +result:=0; +SetSearchDriveVector:=True; +end; + +Function IsSearchDrive(DriveNumber:byte):boolean; +Var pth:string; +begin +IsSearchDrive:=(getEnvPath(pth) + and (pos(chr(DriveNumber+ord('A'))+':',pth)>0)); +end; + + +{E905 (shell 3.00+)} +Function MapFakeRootDirectory(DriveNumber:byte; DirPath:string):boolean; +{ Dirpath may include server and volumename } +Var regs:TTregisters; + tmp1,tmp2:word; + PName:string; +begin +with regs + do begin + ax:=$E905; + bl:=driveNumber+1; { FF default, 0=A, 2= B etc. } + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { VLM patch for SERVER/VOL: and VOL: type paths } + if (DirPath[0]>#2) and (pos(':',DirPath)>2) + then GetTrueEntryName(DirPath,PName) + else PName:=DirPath; + Pname:=Pname+#0; + move(PName[1],GlobalReqBuf^,ord(PName[1])); + { DS:DX real-mode address of GlobalRequestBuffer holding new path } + RealModeIntr($21,regs); + if (flags and 1 {carry})>0 + then result:=al + else result:=0; + end; +MapFakeRootDirectory:=(result=0); +{ $00 Successful $03 Invalid path $0F Invalid Drive $11 Not same device } +end; + +{E906 (shell 3.00+)} +Function DeleteFakeRootDirectory(DriveNumber:byte):boolean; +Var regs:TTregisters; +begin +with regs + do begin + ax:=$E906; + bl:=DriveNumber+1; + RealModeIntr($21,regs); + result:=0; + end; +DeleteFakeRootDirectory:=(result=0); +end; + +{E907 (shell 3.00+)} +Function GetRelativeDriveDepth(DriveNumber:byte; Var depth:byte):boolean; +Var regs:TTregisters; +begin +with regs + do begin + ax:=$E907; + bl:=DriveNumber+1; + RealModeIntr($21,regs); + depth:=al; + if al<$FF + then result:=0 + else result:=$FF; { no fake root assigned } + end; +GetRelativeDriveDepth:=(result=0); +{ 00 Succesful $FF No fake root assigned } +end; + +{secondary} +Function DeleteDriveMapping(DriveNumber:Byte):boolean; +Var dirHandle,status:byte; + pth:string; + ch:char; + p:byte; + DDepth,Dflag:byte; +begin +{ if searchdrive, remove drive from searchtable and PATH environment string } +IF GetEnvPath(pth) + then begin + if pth[ord(pth[0])]<>';' + then pth:=pth+';'; + p:=pos(chr(DriveNumber+ord('A'))+':',pth); + if p>0 + then begin { it is a searchdrive, remove from path } + Repeat + ch:=pth[p]; + delete(pth,p,1); + UNTIL ch=';'; + SetEnvPath(pth); { also creates a new searchdriveVector } + end; + end; +IF (result=0) and GetDirectoryHandle(DriveNumber,dirHandle,status) + then begin + IF GetRelativeDriveDepth(DriveNumber,DDepth) { is it a fake root ? } + then DeleteFakeRootDirectory(DriveNumber); + GetDriveFlag(DriveNumber,Dflag); + SetDriveFlag(DriveNumber,(Dflag and $F0) or DRIVE_UNUSED); + SetDriveHandle(DriveNumber,0); + SetDriveConnectionId(DriveNumber,0); + DeallocateDirHandle(dirHandle); + end; +DeleteDriveMapping:=(result=0); +end; + + +{secondary } +FUNCTION MapPermanentDrive(DriveNumber:byte; DirectoryPath:string; + Root:boolean):boolean; +var pth : string; + DriveHandle: Byte; +begin +IF GetTrueEntryName(DirectoryPath,pth) + then begin + while pth[ord(pth[0])] IN ['\','.','*','?'] + do dec(pth[0]); + if pth[1]<>'\' + then result:=$104 { attempt to map network drive to local drive } + else begin + If GetDriveHandle(DriveNumber,DriveHandle) and (DriveHandle<>0) + then DeleteDriveMapping(DriveNumber); + + IF MapFakeRootDirectory(DriveNumber,pth) + then begin + if (not root) + then DeleteFakeRootDirectory(DriveNumber); + { does not delete the mapping itself, + only the fake root. } + end; + end; + end + else result:=$101; { direcory not locatable } +MapPermanentDrive:=(result=0); +end; + +{secondary} +FUNCTION MapDrive(DriveNumber:Byte; DirectoryPath:string; + Root, Permanent:boolean):boolean; +var rights : byte; + newHandle : byte; + HandlePth,pth,srvr,vol: string; + OldConnId,VolConnId:byte; + p:byte; + VolNbr:byte; + Dflag:byte; +begin +IF Permanent + then begin + MapDrive:=MapPermanentDrive(DriveNumber,DirectoryPath,Root); + exit; + end; +{ map temporary drive } +IF GetTrueEntryName(DirectoryPath,pth) + then begin + if pth[ord(pth[0])]<>'\' + then pth:=pth+'\'; + if pth[1]<>'\' + then result:=$104 { attempt to map network drive to local drive } + else begin + delete(pth,1,2); + p:=pos('\',pth); + if p=0 then result:=$106; + srvr:=copy(pth,1,p-1); + delete(pth,1,p); + p:=pos('\',pth); + if p=0 then result:=$105; { volume does not exist } + vol:=copy(pth,1,p-1); + delete(pth,1,p); + IF NOT GetConnectionId(srvr,VolConnId) + then result:=$106; { server does not exist } + end; + end + else result:=$101; { direcory not locatable } +if (result=0) + then begin + while pth[ord(pth[0])] IN ['\','.','*','?'] + do dec(pth[0]); + + { rebuild path: Alloc handle requires VOL:path format } + HandlePth:=vol+':\'+pth; + GetPreferredConnectionId(OldConnId); + SetPreferredConnectionId(VolConnId); + + { IF Permanent + then AllocPermanentDirHandle(DriveNumber,0,HandlePth, + newHandle,rights) + else} + AllocTemporaryDirHandle(DriveNumber,0,HandlePth, + newHandle,rights); + if (result=0) + then begin + GetDriveFlag(DriveNumber,Dflag); + {If Permanent + then SetDriveFlag(DriveNumber,(Dflag and $F0) or DRIVE_PERMANENT) + else} + SetDriveFlag(DriveNumber,(Dflag and $F0) or DRIVE_TEMPORARY); + SetDriveHandle(DriveNumber,newHandle); + SetDriveConnectionId(DriveNumber,VolConnId); + IF root + then MapFakeRootDirectory(DriveNumber,'\\'+srvr+'\'+vol+'\'+pth); + end; + SetPreferredConnectionId(OldConnId); + end; +MapDrive:=(result=0); +end; + + + +Function MapSearchDrive(DriveNumber:byte; DirPath:string; + PathPosition:byte; + Insert,Root,Permanent:Boolean):boolean; +Var pth:string; + p,scCount:byte; + ch:char; +begin +IF MapDrive(DriveNumber,DirPath,Root,Permanent) + then begin + GetEnvPath(pth); + if pth[ord(pth[0])]<>';' + then pth:=pth+';'; + scCount:=1;p:=1; + while (scCount=ord(pth[0])); + pth:=copy(pth,1,p-1)+chr(DriveNumber+ord('A')) + +':.;'+copy(pth,p,255); + end + else pth:=pth+chr(DriveNumber+ord('A'))+':.;'; + SetEnvPath(pth); + end; +MapSearchDrive:=(result=0); +end; + +{secondary} +Function DeleteConnectionsDriveMappings(ConnId:Byte):Boolean; +Var t,connId2,res:Byte; +begin +res:=$FF; +for t:=0 to 31 + do if GetDriveConnectionId(t,connId2) and (connId2=connId) + then begin + DeleteDriveMapping(t); + if result=0 + then res:=0; + end; +result:=res; +DeleteConnectionsDriveMappings:=(result=0); +{00 successful FF No mappings affected OR Invalid connectionId } +end; + + +{4409 / implemented as a secondary function } +Function IsNetworkDrive(driveNumber:Byte):boolean; +{ isNetworkDrive is set to TRUE if the drive is a) a network drive, and + b) a legal drive letter was used. } +Var regs:TTRegisters; +begin +With regs +do begin + AX:=$4409; + BL:=DriveNumber+1; + RealModeIntr($21,Regs); + IsNetworkDrive:=(DX and $1000)<>0 + end; +end; + + +{--======================-- Entries --===============================--} + + +{60.. (extended DOS call)} +Function GetTrueEntryName(DirPath:string; Var CanonicalPath:string):boolean; +{ SERVER/VOL:[\]Path -> \\SERVER\VOL\path + VOL:[\]Path -> \\effective_server_name\VOL\path + D:\ -> D:\. + +{ if a volumename is supplied without a servername, the name of the + effective server will be returned. } + +{ Format of returned string: + a) D:\path\file.ext or + b) \\servername\volumename\path\file.ext } + +LABEL skip; + +Var reply :array[1..128] of byte; + regs :TTregisters; + pcolon, + pslash :byte; + srvr, + volname:string[47]; + connId :Byte; +begin +{ ----- Pre processing } +if DirPath[0]>#2 + then begin + if ((DirPath[1]='\') and (DirPath[2]='\')) + then begin + CanonicalPath:=DirPath; + UpString(Canonicalpath); + goto skip + end; + pcolon:=pos(':',DirPath); + if (pcolon=2) and (DirPath[0]=#3) and (DirPath[3]='\') + then DirPath:=DirPath+'.'; + { fix known problem of netware: D:\. instead of D:\ } + if (pcolon=2) and (DirPath[0]=#2) + then DirPath:=DirPath+'.'; + { fix know problem of -among others- OS/2-dos: D:. instead of D: } + end; +pcolon:=pos(':',DirPath); +if pcolon>2 + then begin { format must be VOL:[\]path or SERVER/VOL:[\]Path } + pslash:=pos('/',DirPath); + if pslash=0 + then pslash:=$FF; + if (pslash#0) and (dirPath[1]='\') + then delete(DirPath,1,1); + DirPath:='\\'+srvr+'\'+volname+'\'+DirPath; + end; +if dirPath='' + then dirPath:='\'; +{ ----- actual call } +dirPath:=dirPath+#0; { zero terminate } +WITH regs + do begin + Move(dirPath[1],GlobalReqBuf^,ord(dirPath[0])); + GetGlobalBufferAddress(ds,si,es,di); + { DS:SI real mode pointer to GlobalRequestBuffer holding asciiz path ; + ES:DI real mode pointer to GlbalReplyBuffer } + ah:=$60; + RealModeIntr($21,regs); + Move(GlobalReplyBuf^,reply[1],128); + if (regs.flags and 1 {carry})>0 + then begin + result:=ax; + reply[1]:=0; + end + else result:=0; + end; +ZstrCopy(CanonicalPath,reply[1],128); +{ ----- post-processing -- strip \ and . } +skip: ; +While CanonicalPath[ord(CanonicalPath[0])] in ['\','.'] + do dec(CanonicalPath[0]); +GetTrueEntryName:=(result=0); +{ $00 successful + $02 Invalid component in directory path OR drive letter only + $03 Malformed path OR invalid drive letter } +end; + + + +{3B.. } +Function ChangeDirectory(DirPath:string):boolean; +{ does not change the default drive } +Var regs:TTregisters; + tmp1,tmp2:word; +begin +if DirPath[0]>#63 + then result:=$110 { length of path too long } + else begin + DirPath:=DirPath+#0; + with regs + do begin + ah:=$3b; + Move(DirPath[1],GlobalReqBuf^,ord(DirPath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real-mode pointer to GlobalRequestBuffer holding DirPath } + RealModeIntr($21,regs); + If (flags and 1 {carry})>0 + then result:=$111 { invalid pathname } + else result:=0; + end; + end; +ChangeDirectory:=(result=0); +end; + +{F216/0A [2.15+]} +Function CreateDirectory(DirHandle:Byte; DirPath:string; MaxRightsMask:byte):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + _MRM :byte; + _dirPath :string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ +do begin + subFunc:=$0A; + _dirHandle:=DirHandle; + _MRM:=MaxRightsMask; + _DirPath:=DirPath; + len:=4+ord(_dirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +CreateDirectory:=(result=0) +{ 00 successful 84 No create privileges 98 Volume doesn't exist + FF directory already exists } +end; + + +{F216/0B [2.15c+]} +Function DeleteDirectory(DirHandle:Byte; DirPath:string):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + unused :byte; + _DirPath :string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalreqBuf)^ +do begin + subFunc:=$0B; + _DirHandle:=DirHandle; + _DirPath:=DirPath; + unused:=0; + len:=4+ord(_DirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +DeleteDirectory:=(result=0) +{ 00 successful 8A No delete privileges + 98 Volume doesn't exist 9B Bad directory handle + 9C Invalid path 9F Directory in use + A0 Directory not empty } +end; + + +{F217/F4 [3.0+]} +Function ConvertPathToDirEntryId(dirHandle:Byte; dirPath:string; + Var VolNbr :byte; + Var dirEntryID:LongInt):boolean; +{ aka ConvertPathToDirEntry } +Type Treq=record + len :word; + subFunc :byte; + _dirHandle:byte; + _DirPath :string[255]; + end; + Trep=record + _volNbr:Byte; + _EntryId:Longint; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + subFunc:=$F4; + _dirHandle:=DirHandle; + _dirPath:=DirPath; + UpString(_DirPath); + If DirHandle=0 + then ConvertPathToVolFormat(_DirPath); + len:=3+ord(_DirPath[0]); + F2SystemCall($17,len+2,SizeOf(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ +do begin + VolNbr :=_volNbr; + dirEntryId:=_EntryId; + end; +ConvertPathToDirEntryId:=(result=0) +{ 00 Successful 9B Bad directory Handle + 9C Invalid Path C6 No console rights } +end; + +{F217/F3 [3.0+]} +Function MapDirEntryIdToPath(VolNbr:byte;DirEntryId:Longint; NStype:byte; + Var ExtPath:string):boolean; +{aka MapDirectoryNumberToPath } +{ Returns full path/ with nameSpace information; + Doesn't return server or volumename. } +Type Treq=record + len :word; + subFunc :byte; + _VolNbr :byte; + _EntryId:longint; {hi-lo} + _NameSp :byte; + end; + Trep=record + _path:array[1..255] of byte; {!! maximum: 512 bytes in path ! } + end; + TPreq=^Treq; + TPrep=^Trep; +Var TempPath:string; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$F3; + _VolNbr:=VolNbr; + _EntryId:=DirEntryId; + _NameSp:=NStype; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +if result=0 + then begin + With TPrep(GlobalReplyBuf)^ + do ZstrCopy(TempPath,_path,255); + { TempPath according to the 'new' Novell format; + translate into a 'DOS' style path } + NovPath2DOSPath(TempPath,ExtPath); { dir\subdir (no server or volume name) } + end; +MapDirentryIdtoPath:=(result=0) +{ 00 Successful C6 No console rights FF ? } +end; + + +{F216/02} +Function ScanDirectoryInformation(dirHandle:byte; searchDirPath:string; + {i/o} Var sequenceNumber:word; + {out:} Var dirInfo:Tentry ):boolean; +{ set sequenceNumber to 0 before the first call. + + If wildcards (* or ?) are included in the searchDirPath: + Iterate until a $9C error is returned. + + If you don't include a wildcard in the searchDirPath, only use + this call once. Do not iterate, the same entry will be returned + eternaly. + + } +Type Treq=record + len :word; + subFunc :byte; + _dirHandle :byte; + _subDirNumber:word; {hi-lo} + _dirPath :string[255] + end; + Trep=record + _subDirName :array[1..16] of byte; + _creationDate :word; + _creationTime :word; + _ownerObjId :LongInt; {hi-lo} + _maxRightsMask:word; + _SubDirNbr :word; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$02; + _dirHandle:=dirHandle; + _subDirNumber:=swap(sequenceNumber); { force hi-lo} + _dirPath:=searchDirPath; + UpString(_dirPath); + len:=5+ord(searchDirPath[0]); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + FillChar(dirInfo,SizeOf(Tentry),0); + ZstrCopy(dirInfo.EntryName,_SubDirName,16); + + DosTime2NovTime(MakeLong(swap(_CreationDate),swap(_CreationTime)), + dirInfo.creationTime); + dirInfo.ownerId:=Lswap(_ownerObjId); + dirInfo.RightsMask:=_maxRightsMask; + sequenceNumber:=swap(_SubDirNbr)+1; + end; +ScanDirectoryInformation:=(result=0) +{resultcodes: $00 success; $98 Volume does not exist; + $9B Bad directory Handle $9C Invalid Path } +end; + + +{F216/0F [2.0/2.1/3.x]} +Function RenameDirectory( dirHandle:Byte; dirPath, newDirName :String):Boolean; +{ The new directory name must be a regular (legal) directory name, + max 14 chars long. + The user must have Parental and Modify rights in the parent directory of + the directory to be renamed. } +Type Treq=record + len :word; + subFunc :byte; + _dirHandle :Byte; + _dirNames :Array[0..255+1+14] of byte; { _dirpath[0] is allowed to be 0 } + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$0F; + _dirHandle:=dirHandle; + Upstring(dirPath); + UpString(newDirName); + Move(DirPath[0],_DirNames[0],ord(DirPath[0])+1); + Move(newDirName[0],_DirNames[1+_DirNames[0]],ord(newDirName[0])+1); + len:=4+ord(dirPath[0])+ord(newDirName[0]); + F2SystemCall($16,len+2,0,result); + end; +RenameDirectory:=(result=0) +{ Possible ResultCodes: + 8B No Rename Privileges; 9B Bad Directory Handle; + 9C Invalid Path; 9E Invalid (new) Dir Name. } +end; + + +{F216/1F [2.15c+]} +Function GetDirectoryEntry(DirHandle:byte; + Var dirEntry:Tentry):boolean; +Type Treq=record + len:word; + subFunc:byte; + _dirHandle:byte; + end; + Trep=record + _Entry :TintEntry; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$1F; + _dirHandle:=dirHandle; + end; +F2SystemCall($16,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + Convert2ExtEntry(_entry,dirEntry); + end; +GetDirectoryEntry:=(result=0) +{ 00 successful 98 Volume doesn't exist + 9B Bad directory handle 9C Invalid path } +end; + + +{B601 [2.0+] } +function SetExtendedFileAttributes(FilePath:String; Attr:Byte) : Boolean; +{ See GetExtFAttr for meaning of Attr the Attribute + Function result code: + 00h Success; + FFh File not found; + FEh Access denied } +Var Novregs:TTRegisters; + tmp1,tmp2:word; +begin +with NovRegs +do begin + AX := $B601; + if FilePath[0]=#255 + then FilePath[255]:=#0 + else FilePath:=FilePath+#0; + Move(FilePath[1],GlobalReqBuf^,ord(FilePath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real mode pointer to GlobalRequestBuffer holding FilePath } + CL := Attr; + RealModeIntr($21,NovRegs); + IF (Flags AND 1 {carry})>0 + then Result:=AL + else Result:=$00; + Result := AL + end; +SetExtendedFileAttributes:=(Result=0); +end; + + + +{B600 [2.0+]} +function GetExtendedFileAttributes(FilePath:String; var Attributes:Byte) : Boolean; +{ Meaning of Attributes: + 7 6 5 4 3 2 1 0 + | | | | | | | + | | | | +---+---+------Search mode + | | | +----------------------transactional bit A_TRANSACTIONAL + | | +--------------------------Indexing bit A_INDEXED + | +------------------------------Read Audit bit A_READ_AUDIT + +----------------------------------Write Audit bit A_WRITE_AUDIT + } +Var NovRegs:TTRegisters; + tmp1,tmp2:word; +begin +with NovRegs +do begin + AX := $B600; + if FilePath[0]=#255 + then FilePath[255]:=#0 + else FilePath:=FilePath+#0; { null terminate string } + Move(FilePath[1],GlobalReqBuf^,ord(FilePath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real mode pointer to GlobalRequestBuffer hloding FilePath } + RealModeIntr($21,NovRegs); + IF (Flags and 1 {carry})>0 + then Result := AL + else Result:=$00; + Attributes := CL; + end; +GetExtendedFileAttributes:=(Result=0); +{ $8C caller lacks privileges + FEh not permitted to search directory + FFh file not found } +end; + + + + +{F3.. [2.x/3.x]} +Function FileServerFileCopy( sourceFileHandle, destFileHandle:word; + sourceFileOffset, destFileOffset:Longint; + numberOfBytesToCopy :Longint; + VAR numberOfBytesCopied :Longint ):boolean; +{Note: both source and destination must be on the same file server +SeeAlso: 3C..,3F..} +Type Treq=record + _sFH,_dFH :word; {lo-hi} {as returned by GetFileHandle.} + _sFoffs,_dfOffs:Longint; {lo-hi} + _NbrOfBytes :Longint; {lo-hi} + end; + TPreq=^Treq; +Var regs:TTRegisters; + tmp1,tmp2:word; +begin +with TPreq(GlobalReqBuf)^ + do begin + _sFH:=sourceFileHandle; + _dFH:=destFileHandle; + _sFoffs:=sourceFileOffset; + _dFoffs:=destFileOffset; + _NbrOfBytes:=numberOfBytesToCopy; + end; +with regs + do begin + AH:=$F3; + GetGlobalBufferAddress(es,di,tmp1,tmp2); + { ES:DI real mode pointer to GlobalRequestBuffer } + RealModeIntr($21,regs); + result:=AL; + end; +numberOfBytesCopied:=MakeLong(regs.cx,regs.dx); { ? swap those regs for correct byte order ? } +FileServerFileCopy:=(Result=0); +end; + +{level-0 function. See GetFileAttributes and SetFileAttributes } +Function DoFileAttributes(subf:byte;FilePath:string;VAR attr:byte):boolean; +Var regs:TTregisters; + tmp1,tmp2:word; +begin +with regs +do begin + AH:=$43; + AL:=subf; + if subf=$01 then CX:=attr; + if filePath[0]=#255 + then filePath[255]:=#0 + else filePath:=filePath+#0; + Move(FilePath[1],GlobalReqBuf^,ord(FilePath[0])); + GetGlobalBufferAddress(ds,dx,tmp1,tmp2); + { DS:DX real mode pointer to GlobalRequestBuffer holding FilePath } + RealModeIntr($21,regs); + IF ((Flags and 1 {Fcarry})<>0) + then result:=AL + else begin + result:=$00; + if subf=$00 then attr:=CX + end; + end; +DoFileAttributes:=(result=$00); +{ resultcodes: 00 success; 01 invalid function; + 03 path not found; 05 access denied. } +end; + +{4300 [1.x/2.x/3.x]} +Function GetFileAttributes(FilePath:string; Var attr:byte):boolean; +{ A_READ_ONLY,A_HIDDEN,A_SYSTEM and A_SHAREABLE only. } +begin +GetFileAttributes:=DoFileAttributes($00,FilePath,attr); +end; + +{4301 [1.x/2.x/3.x]} +Function SetFileAttributes(FilePath:string; attr:byte):boolean; +{ A_READ_ONLY,A_HIDDEN,A_SYSTEM and A_SHAREABLE only. } +Var _attr:byte; +begin +_attr:=attr; +SetFileAttributes:=DoFileAttributes($01,FilePath,_attr); +end; + + + +{F217/0F [2.15c+]} +Function ScanFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + {i/o} VAR SequenceNbr:Integer; + {out} VAR fileInfo:Tentry):Boolean; +{ To be called Iteratatively; initial value for seqNbr=-1 } +{ wildcards in filename allowed. + Iterate util an error $FF occurs } +Type Treq=record + len :word; + subFunc :byte; + _seqNbr :word; {hi-lo} + _dirHandle :byte; + _searchAttrib:Byte; + _filePath :string; + end; + Trep=record + _seqNbr :word; {hi-lo} + _fileName :array[1..14] of byte; + _Fattr, + _ExtFattr :Byte; + _Fsize :LongInt; {hi-lo} + _Crdate :word; {hi-lo} + _LastAccDate :word; {hi-lo} + _LastUpdDate, + _LastUpdTime :Word; + _ownerObjId :Longint; {hi-lo} + _LastArchDate, + _lastArchTime:Word; + _reserved :array[1..56] of byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + subFunc:=$0F; + _seqNbr:=swap(word(SequenceNbr)); { force hi-lo } + _dirHandle:=dirHandle; + _searchAttrib:=searchAttrib; + _filePath:=FilePath; + len:=6+ord(_filePath[0]); + F2SystemCall($17,len+2,SizeOf(Trep),result); + end; +with TPrep(GlobalReplyBuf)^ +do begin + FillChar(fileInfo,sizeOf(fileInfo),#0); + SequenceNbr:=Integer(swap(_seqNbr)); { force lo-hi } + ZstrCopy(fileInfo.EntryName,_filename,15); + fileInfo.Attributes:=(_ExtFattr SHL 8)+_Fattr; + fileInfo.filesize:=Lswap(_Fsize); { force lo-hi} + fileinfo.OwnerID:=Lswap(_ownerObjID); { force lo-hi} + DosTime2NovTime(MakeLong(swap(_CrDate),0),fileinfo.creationTime); + DosTime2NovTime(MakeLong(swap(_LastAccDate),0),fileinfo.lastAccessTime); + DosTime2NovTime(MakeLong(swap(_LastUpdDate),swap(_LastUpdTime)) + ,fileinfo.ModifyTime); + DosTime2NovTime(MakeLong(swap(_LastArchDate),swap(_lastArchTime)) + ,fileinfo.ArchiveTime); + end; +ScanFileInformation:=(result=0) +{ 89 No search privileges FF No more matching files } +end; + + +{F217/10 [2.15c+]} +Function SetFileInformation(DirHandle:Byte; FilePath:string; + SearchAttrib:Byte; + fileInfo:TEntry):boolean; +Type Treq=record + len :word; + subFunc :byte; + _Fattr, + _ExtFattr :Byte; + reserved1 :LongInt; {hi-lo} + _crDate :word; {hi-lo} + _lastAccDate :word; {hi-lo} + _lastUpdTime :Longint; + _ownerObjId :Longint; {hi-lo} + _lastArchTime:Longint; + reserved2 :array[1..56] of byte; + _dirHandle :Byte; + _searchAttr :byte; + _filePath :string; + end; + TPreq=^Treq; +Var DummyDate:Longint; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + subFunc:=$10; + _Fattr:=Lo(LowLong(fileInfo.Attributes)); + _ExtFattr:=Hi(LowLong(fileinfo.Attributes)); + _ownerObjId:=Lswap(fileinfo.OwnerId); {force hi-lo} + _dirHandle:=DirHandle; + _searchAttr:=SearchAttrib; + _filePath:=FilePath; + If Dirhandle=0 + then ConvertPathToVolFormat(_FilePath); + UpString(_filePath); + NovTime2DosTime(fileinfo.CreationTime,dummyDate); + _crDate:=HiLong(dummyDate); + NovTime2DosTime(fileinfo.LastAccessTime,dummyDate); + _lastAccDate:=HiLong(dummyDate); + NovTime2DosTime(fileinfo.ModifyTime,_lastUpdTime); + NovTime2DosTime(fileinfo.ArchiveTime,_lastArchTime); + len:=82+ord(_filepath[0]); + F2SystemCall($17,len+2,0,result); + end; +SetFileInformation:=(result=0); +{ result codes: 00 Success } +end; + + +{F244 [2.1x/3.x]} +Function EraseFiles(dirHandle, searchAttrib:Byte; filePath:string ):boolean; +{ marks files for deletion / in DOS parlance: delete file, file remains purgable } +Type Treq=record + _dirHandle:Byte; + _Sattr:Byte; + _filePath:string; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ +do begin + _dirHandle:=dirHandle; + _Sattr:=searchAttrib; + _filePath:=filePath; + F2SystemCall($44,3+ord(_filepath[0]),0,result); + end; +EraseFiles:=(result=0); +{ resultcodes: 00 Success; 98h Volume doesn't exist; 9Bh bad directory handle; + 9Ch invalid path; FFh no files found error. } +end; + +{F216/1B [3.0+]} +Function ScanSalvagableFiles(DirHandle:Byte; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; +{ Iterate (with entryId set to -1 at first) until an error $FF occurs } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:Byte; + _EntryId :Longint; {low_word-hi_word & each word lo-hi } + end; + Trep=record + _EntryId :Longint; + _Entry :TintEntry; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$1B; + _DirHandle:=DirHandle; + _EntryId:=EntryId; + end; +F2SystemCall($16,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + EntryId:=_EntryId; {return next EntryId for iteration} + {low_word-hi_word & each word lo-hi } + Convert2ExtEntry(_Entry,Entry); + end; +ScanSalvagableFiles:=(result=0) +{ 98 Volume does not exist FF No more erased files } +end; + +{F216/1D [3.0+]} +Function PurgeSalvagableFile(DirHandle:Byte; + EntryId:Longint; FileName:string):boolean; +{ either supply an entryId and an empty filename, + or supply an entryId of -1 and a filename. Note that the filename + may not be unique: there may be more than one old deleted versions + of a filename. } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:Byte; + _EntryId :Longint; {low_word-hi_word & each word lo-hi } + _Name :string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$1D; + _DirHandle:=DirHandle; + _EntryId:=EntryId; + _Name:=FileName; + UpString(_name); + len:=7+ord(_Name[0]); + F2SystemCall($16,len+2,0,result); + end; +PurgeSalvagableFile:=(result=0) +end; + +{F216/1C [3.0+] } +Function RecoverSalvagableFile(dirHandle:Byte; EntryId:Longint; + OldName,NewName:string):boolean; +{ entryId may be set to -1 + OldName is the name of the file before it was deleted. + NewName is the name to be assigned to the recovered file } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle :Byte; + _EntryId :Longint; {low_word-hi_word & each word lo-hi } + _OldAndNewName:string[255]; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$1C; + _DirHandle:=DirHandle; + _EntryId:=EntryId; + UpString(OldName); + UpString(NewName); + _OldAndNewName:=OldName; + move(NewName[0],_OldAndNewName[ord(oldname[0])+1],ord(NewName[0])+1); + len:=8+ord(oldName[0])+ord(NewName[0]); + F2SystemCall($16,len+2,0,result); + end; +RecoverSalvagableFile:=(result=0) +{ 98 Volume does not exist FF No more erased files } +end; + + +{F216/24 [3.0+]} +Function SetDirRestriction(DirHandle:Byte; DiskSpaceLimit:Longint):boolean; +{ limit expressed in Blocks. set limit to 0 to lift limit. + use a negative number if limit should be equal to 0 } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:Byte; + _Limit :Longint; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$24; + _DirHandle:=DirHandle; + _Limit:=DiskSpaceLimit; + end; +F2SystemCall($16,SizeOf(Treq),0,result); +SetDirRestriction:=(result=0) +end; + + +{F216/23 [3.0+]} +Function ScanDirRestrictions(DirHandle:Byte; + Var NumberOfEntries:Byte; + Var RestrInfo:TdirRestrList):boolean; +Type Treq=record + len:word; + subFunc:byte; + _DirHandle:Byte; + end; + Trep=record + _Entries:Byte; + _Info:TdirRestrList; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$23; + _DirHandle:=DirHandle; + end; +F2SystemCall($16,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + NumberOfEntries:=_Entries; + RestrInfo:=_Info; + end; +ScanDirRestrictions:=(result=0) +end; + + +Procedure FixEntryNameFormat(Var s:string); +Var res:string; + p:byte; +begin +res:=''; +for p:=1 to ord(s[0]) + do begin + if s[p]='?' + then res:=res+#$FF+#$BF + else if s[p]='*' + then res:=res+#$FF+'*' + else res:=res+s[p] + end; +s:=res; +end; + + +{F216/1E [2.15c+]} +Function ScanDirectoryEntry(DirHandle:Byte; EntryName:string; SearchFlags:Longint; + {i/o} Var EntryId:Longint; + {out} Var Entry:Tentry ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle :Byte; + _SearchFlags:Byte; { standard: $16 for dirs / $06 for files } + _SeqNbr :Longint; { lo-hi , set to -1 initially } + _EntryName :string; + end; + + Trep=record { len = 84h = 132 dec. } + _EntryID :Longint; { lo-hi } + _Entry :TintEntry; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$1E; + _DirHandle:=DirHandle; + _SearchFlags:=SearchFlags; + _SeqNbr:=EntryId; + _EntryName:=EntryName;UpString(_EntryName); + FixEntryNameFormat(_EntryName); + len:=8+ord(_EntryName[0]); + F2SystemCall($16,len+2,Sizeof(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + EntryId:=_EntryId; {return next EntryId for iteration} + Convert2ExtEntry(_Entry,entry); + end; +ScanDirectoryEntry:=(result=0) +end; + +{F216/25 [2.15c+] } +Function SetEntry(DirHandle:Byte;EntryId:Longint;SearchFlags:Byte; + ModFlags:Longint; Entry:Tentry ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _dirHandle:Byte; + _SFlags :Byte; + _EntryId :Longint; {lo-hi} + _ModFlags :Longint; {lo-hi} + _Entry :TintEntry; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$25; + _dirHandle:=DirHandle; + _EntryId:=EntryId; + _ModFlags:=ModFlags; + Convert2IntEntry(Entry,_Entry); + end; +F2SystemCall($16,SizeOf(Treq),0,result); +SetEntry:=(result=0) +end; + +{------------------ Secondary Functions ----------------------------} + +Function IsFileShareable(Path : String):boolean; + +var F: File; + FAttr : Word; + +begin + { Assign(F, Path); + GetFAttr(F, FAttr); + result:=DOSerror; } + IsFileShareable:=(result=0) and ((FAttr and $80)>0) +end; + +function FlagFileShareable(Path : String) : Boolean; +{ when the file could NOT be made shareable, false is returned as the + function result, a doserror# is returned as the result code. } +var F : File; + Attr : Word; + ErrCode : word; + Share : Boolean; +begin +if NOT IsFileShareable(Path) { Share: is it sharable? } + then begin + Assign(F,Path); + {SetFAttr(F,Attr or A_SHAREABLE); OR existing atrib. with SHARE bit } + {Result := DOSError;} + end; +FlagFileShareable := (Result=0); +end; + + +Function GetFileHandle(Var f):word; +begin +{GetFileHandle:=filerec(f).handle;} +end; + +{------===================-- Trustee/Max. Rights masks --=================--} + + +{F216/27 [3.0+]} +Function SetTrustee(DirHandle:Byte;DirPath:string; + TrusteeObjectID:Longint; + RightsMask:Word ):boolean; +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + _ObjId :Longint; { hi-lo } + _Rights :Word; { lo-hi } + _DirPath :string; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$27; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _DirPath:=DirPath;UpString(_DirPath); + _ObjId:=Lswap(TrusteeObjectId); + _Rights:=RightsMask; + len:=9+ord(_DirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +SetTrustee:=(result=0) +{ Possible resultcodes: 8C No modify privileges; + 98 Volume doesn't exist; 9B Bad directory handle + 9C Invalid path; FC No such bindery object } +end; + + +{F216/2B [3.0+]} +Function DeleteTrustee(DirHandle:Byte;DirPath:String; + TrusteeObjectId:Longint):boolean; +{ If DirHandle equals 0, DirPath should be according to the + VOL:\path format. All other path formats will result in + an resultcode of 98h (No such volume) } +Type Treq=record + len :word; + subFunc :byte; + _DirHandle:byte; + _ObjId :Longint; { hi-lo } + _Unused :Byte; + _DirPath :string; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$2B; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _DirPath:=DirPath;UpString(_DirPath); + _ObjId:=Lswap(TrusteeObjectId); + _Unused:=0; + len:=8+ord(_DirPath[0]); + F2SystemCall($16,len+2,0,result); + end; +DeleteTrustee:=(result=0); +{ Possible resultcodes: 98 Volume doesn't exist + 9B Bad directory handle; 9C Invalid path + FE no such trustee } +end; + + +{F216/2A [3.0+]} +function GetEffectiveRights(DirHandle:Byte;DirPath:String; + var Rights:Word) : Boolean; +{ returns the requesting workstation's effective directory rights } +Type Treq=record + Len : word; + SubF : Byte; + _DirHandle : Byte; + _DirName : String; + end; + TRep=record + _RightsMask : Word; + end; + TPreq=^Treq; + TPrep=^Trep; +begin +with TPreq(GlobalReqBuf)^ + do begin + SubF := $2A; + _DirHandle := DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _DirName := DirPath;UpString(_DirName); + Len := 3+ord(DirPath[0]); + F2SystemCall($16,len+2,SizeOf(Trep),result); + end; +with TPrep(GlobalReplyBuf)^ + do Rights:=_RightsMask; +GetEffectiveRights:=(Result=0); +{ return byte + 00h - Success + 98h - Volume Does Not Exist + 9Bh - Bad Directory Handle } +end; + + +{F216/04 [2.15c+]} +Function ModifyMaximumRightsMask(DirHandle:Byte;DirPath:string; + RevokeRightsMask,GrantRightsMask:Word):boolean; +Type Treq=record + len:word; + subFunc:byte; + _DirHandle:Byte; + _GrantRM, + _RevokeRM:Byte; + _DirPath:String; + end; + Trep=record + _EffectiveRightsMask:Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=5+ord(DirPath[0]); + subFunc:=$04; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _GrantRM:=MapV3RightsToV2(GrantRightsMask); + _RevokeRM:=MapV3RightsToV2(RevokeRightsMask); + _DirPath:=DirPath; + F2SystemCall($16,len+2,Sizeof(Trep),result); + end; +{With TPrep(GlobalReplyBuf)^ + do begin + --- nothing is done with the returned value--- + end;} +ModifyMaximumRightsMask:=(result=0) +{ result codes: 8C No modify privileges; 98 Volume dosn't exist; + 9C Invalid path } +end; + + + +{F217/47 [2.15c+]} +Function ScanBinderyObjectTrusteePaths(TrusteeObjectId:Longint; + VolumeNumber:Byte; + {i/o} Var SequenceNumber:word; + {out} Var AccessMask:Word; + Var Path:string ):boolean; +{ You must be supervisor (-equivalent) or the TrusteeObject itself + to use this function. + Initially, sequencenumber should be set to 0. } +Type Treq=record + len :word; + subFunc:byte; + _VolNbr:Byte; + _SeqNbr:word; {hi-lo} + _ObjId :Longint; {hi-lo} + end; + Trep=record + _NextSeqNbr:Word; {hi-lo} + _ObjId :Longint; {hi-lo} + _AccMask :byte; + _Path :string; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$47; + _VolNbr:=VolumeNumber; + _SeqNbr:=swap(SequenceNumber); + _ObjId:=Lswap(TrusteeObjectId); + end; +F2SystemCall($17,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + SequenceNumber:=Lswap(_NextSeqNbr); + Accessmask:=_AccMask; {MapV2RightsToV3(_accMask);} + Path:=_Path; + end; +ScanBinderyObjectTrusteePaths:=(result=0) +{ resultcodes: + $96 Server out of memory; $F0 Wildcard not allowed; + $F1 Invalid bindery security; $FC No such object; + $FE Server bindery locked; $FF Bindery failure } +end; + +{F216/26 [3.0+]} +Function ScanEntryForTrustees(DirHandle:Byte;DirPath:String; + {i/o} Var SequenceNumber:Byte; + {out} Var TrusteeInfo: TtrusteeInformation):boolean; +{ Set SequenceNumber to 0 initially, + iterate until error $9C (no more trustees) is returned } +{ see GETTR in the XFILE archive for an example } +Type Treq=record + len:word; + subFunc:byte; + _DirHandle:Byte; + _SeqNbr:Byte; + _DirPath:String; + end; + Trep=record + _Info:TtrusteeInformation; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=4+ord(DirPath[0]); + subFunc:=$26; + _DirHandle:=DirHandle; + if DirHandle=0 + then ConvertPathToVolFormat(DirPath); + _SeqNbr:=SequenceNumber; + _DirPath:=DirPath;UpString(_DirPath); + F2SystemCall($16,len+2,Sizeof(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + inc(SequenceNumber); + TrusteeInfo.NumberOfTrustees:=_Info.NumberOfTrustees; + for t:=1 to 20 + do begin + TrusteeInfo.TrusteeId[t]:=Lswap(_Info.TrusteeId[t]); + TrusteeInfo.TrusteeRights[t]:=_Info.TrusteeRights[t]; + end; + end; +ScanEntryForTrustees:=(result=0) +{ resultcodes: + $9C No more trustees } +end; + + + + +{F2 [2.15c+] +Function ( ):boolean; +Type Treq=record + len:word; + subFunc:byte; + + end; + Trep=record + + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$ + + end; +F2SystemCall($ ,SizeOf(Treq),Sizeof(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + + end; + :=(result=0) +end; } + +end. \ No newline at end of file diff --git a/SRC/UNITS/NWINTR.DCU b/SRC/UNITS/NWINTR.DCU new file mode 100644 index 0000000..7e4e124 Binary files /dev/null and b/SRC/UNITS/NWINTR.DCU differ diff --git a/SRC/UNITS/NWINTR.PAS b/SRC/UNITS/NWINTR.PAS new file mode 100644 index 0000000..e98dc19 --- /dev/null +++ b/SRC/UNITS/NWINTR.PAS @@ -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,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$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. + + diff --git a/SRC/UNITS/NWIPX.PAS b/SRC/UNITS/NWIPX.PAS new file mode 100644 index 0000000..8482ee5 --- /dev/null +++ b/SRC/UNITS/NWIPX.PAS @@ -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. diff --git a/SRC/UNITS/NWLOCK.PAS b/SRC/UNITS/NWLOCK.PAS new file mode 100644 index 0000000..33b6f98 --- /dev/null +++ b/SRC/UNITS/NWLOCK.PAS @@ -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. \ No newline at end of file diff --git a/SRC/UNITS/NWMESS.DCU b/SRC/UNITS/NWMESS.DCU new file mode 100644 index 0000000..25c7829 Binary files /dev/null and b/SRC/UNITS/NWMESS.DCU differ diff --git a/SRC/UNITS/NWMESS.PAS b/SRC/UNITS/NWMESS.PAS new file mode 100644 index 0000000..231e567 --- /dev/null +++ b/SRC/UNITS/NWMESS.PAS @@ -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 result1: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 result1list: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; +result1:=$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 result1code: $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 result1:=$FF + else result1:=$00; + end + else result1:=$FF; +SetBroadcastMode:=(result1=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),result1); +If result1=0 + then bmessage:=TPrep(GlobalReplyBuf)^._message; + +if bmessage[0]=#0 then result1:=$103; { whups! empty message } + +GetBroadCastMessage:=(result1=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 result1list:TconnectionList ):boolean; +{ Sends a broadcast message to a number of logical connections. + The connectionlist is an array[1..connCount] of logical connection numbers, + the result1 of the broadcast can be found in the result1List parameter. + example: + connCount=5 + connList= [ 4,9,1,5,2 ] + + result1List= [$00, $00, $FC, $FD, $FF] + + possible codes in result1List: + $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; + _result1List: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),result1); +If result1=0 + then with TPrep(GlobalReplyBuf)^ + do result1List:=_result1list; +SendBroadcastMessage:=(result1=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,result1); +BroadcastToConsole:=(result1=0); +{ result1codes: 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,result1); +SendConsoleBroadcast:=(result1=0); +{result1codes: $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,result1List:TconnectionList; +begin +IF NwConn.GetObjectConnectionNumbers(UserName,1 {OT_USER},NbrOfConn,connList) + AND (NbrOfConn>0) + then SendBroadcastMessage(Message,NbrOfConn,connList,result1List); +end; + + +end. {unit nwMess} diff --git a/SRC/UNITS/NWMISC.DCU b/SRC/UNITS/NWMISC.DCU new file mode 100644 index 0000000..472f511 Binary files /dev/null and b/SRC/UNITS/NWMISC.DCU differ diff --git a/SRC/UNITS/NWMISC.PAS b/SRC/UNITS/NWMISC.PAS new file mode 100644 index 0000000..3b9e1ff --- /dev/null +++ b/SRC/UNITS/NWMISC.PAS @@ -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:=' ' + 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 result1:Word; +begin +if (V2Rights and $FF)>0 + then result1:=$1FF + else begin + result1:=(V2Rights and RightsNotChanged); + if (V2Rights and ($01+$04))>0 + then result1:=result1 or $01; + if (V2Rights and ($02+$04))>0 + then result1:=result1 or $02; + if (V2Rights and $04)>0 + then result1:=result1 or $01; + if (V2Rights and $20)>0 + then result1:=result1 or $28; + end; +MapV2RightsToV3:=result1; +end; + +Function MapV3RightsToV2(V3Rights:Word):Byte; +CONST RightsNotChanged:word=$10+$20+$40+$80; +Var result1:Byte; +begin +If (V3Rights and $0100)>0 + then result1:=$FF + else begin + result1:=(lo(V3Rights) and RightsNotChanged); + If (V3Rights and $01)>0 + then result1:=result1 or $05; + If (V3Rights and $02)>0 + then result1:=result1 or $06; + {If (V3Rights and $04)>0 + then result:=result or $00;} + If (V3Rights and $08)>0 + then result1:=result1 or $28; + end; +MapV3RightsToV2:=result1; +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. diff --git a/SRC/UNITS/NWQMS.PAS b/SRC/UNITS/NWQMS.PAS new file mode 100644 index 0000000..c2a2d25 --- /dev/null +++ b/SRC/UNITS/NWQMS.PAS @@ -0,0 +1,1149 @@ +{$X+,B-,V-} {essential compiler directives} + +UNIT nwQMS; + +{ nwQMS unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R. Spronk } +{ Based in part on a unit containing queue services routines, written by + Erik van Heyningen in April 1994. } + +INTERFACE + +Uses nwMisc; + +{ Function: Interrupt: Comments: + + Queue Server Functions: + +. AbortServicingQueueJob (F217/73) (S) +. AttachQueueServerToQueue (F217/6F) (S) +. ChangeToClientRights (F217/74) (S) +. DetachQueueServerFromQueue (F217/70) (S) +. FinishServicingQueueJob (F217/72) (S) +. RestoreQueueServerRights (F217/75) (S) +. ServiceQueueJob (F217/71) (S) +. SetQueueServerStatus (F217/77) (S) + + Queue Operator Functions: + +. ChangeQueueJobPosition (F217/6E) (O) +* CreateQueue (F217/64) (SUP) +* DestroyQueue (F217/65) (SUP) +. SetQueueStatus (F217/67) (O) + + Queue User Functions: + +. CreateQueueJob (F217/68) (C) +. StartQueueJob (F217/69) (C) (1) + + Miscellaneous Queue Functions: + +. ChangeQueueJobEntry (F217/6D) (C-O) +* GetQueueJobList (F217/6B) (C-O) +* GetQueueJobsFileSize (F217/78) (C-O-S) +* ReadQueueStatus (F217/66) (C-O) +* ReadQueueJobEntry (F217/6C) (C-O-S) +. ReadQueueServerStatus (F217/76) (C-O) +* RemoveJobFromQueue (F217/6A) (C-O) + + +Notes: C : Function available to Clients (Queue Users); + S : Function available to Servers (Queue Servers); + O : Functions availaible to Operators (Queue Operators); + SUP: Functions available to Supervisors/Workgroup managers. + + (1): StartQueueJob is a.k.a. CloseFileAndStartQueueJob +} + +CONST { Queue status flag } + QS_ALL_OK = $00; + QS_CANT_ADD_JOBS = $01; { possibility to add jobs disabled by operator } + QS_SERVERS_CANT_ATTACH = $02; { attachment of servers to queue disabled by operator } + QS_CANT_SERVICE_JOBS = $04; { queue halted by operator } + { QS_XXXX constants can be ORed to form a QstatusFlag } + + QF_NONE = $00; + QF_AUTO_START = $08; + QF_SERVICE_RESTART = $10; + QF_ENTRY_OPEN = $20; + QF_USER_HOLD = $40; + QF_OPERATOR_HOLD = $80; + +CONST MaxQueueJobs = 250; + +Type TQueueStatus= RECORD + ObjectId : Longint; { Object id of queue } + Status : Byte; { status of queue QS_XXX } + NbrOfJobs : Byte; { Number of jobs in queue } + NbrOfServers : Byte; { Number of servers attached to queue } + ServerObjectIds : array[1..25] of Longint; + { List of Objects-ids of attached servers } + ServerConnNbrs : array[1..25] of Byte; + { List of attached server stations } + MaxNbrOfServers : Byte; { ??? } + end; + + TQueueServerStatus= Array[1..64] of Byte; + { undefined structure -as far as QMS is concerned-} + +Type TJobNumberList = Array[1..MaxQueueJobs] OF Word; + TQueueJobList = record + JobCount : Word; + JobNbrs : TJobNumberList; { List of jobs numbers by position in queue } + MaxJobs : Word; {????} { Maximum job numbers } + end; + + TJobFileHandle=Array[1..6] of Byte; + TQueueJobEntry =Record { Unit external Type } + ClientConnNbr : Byte; + ClientTaskNbr : Byte; + ClientObjectID : Longint; + JobEntryTime : TnovTime; + JobNumber : Word; + JobFileName : String[14]; + JobFileHandle : TjobFileHandle; + + TargetServerIDnumber : Longint; {2} + TargetExecutionTime : TnovTime; {2} + JobType : Word; {2} + JobControlFlags : Byte; {2} + JobDescription : String[50]; {2} + ClientRecordArea : Array[1..152] OF Byte; {2} + + JobPosition : Byte; {2/operators only} + + ServerConnNbr, {1} + ServerTaskNbr : Byte; {1} + ServerObjectID : Longint; {1} + End; + { 1: Filled by Queue server. As long as ServerTaskNbr=0, + queue entry is not being serviced. + 2: Can be changed by queue operators and/or the 'owner' of + the job after job has been placed in queue + } + +Var result:Word; + +{F217/64 {2.1x+} +Function CreateQueue(Qname :string; QobjectType:Word; + dirHandle :Byte; pathName :string; + VAR QobjID:Longint ):Boolean; +{ Creates an object of an object_queue_type in the bindery, checks that + all settings are valid before creating. Returns the object_id of the + created queue if creation was successfull. } + +{F217/65 [2.1x+]} +Function DestroyQueue(QobjID:Longint):Boolean; +{ Destroys the specified Queue; aborts all jobs in the queue; + associated files/directories are deleted; + queue object is removed from the bindery. } + + +{F217/76 [2.1x/3.x]} +Function ReadQueueStatus(QobjID:Longint; + Var Qstatus:TQueueStatus):Boolean; +{ Read the status of a queue. This information is changed by queueservers.} + +{F217/67 [2.1x+]} +Function SetQueueStatus(QobjId:Longint; NewQstatusFlag:Byte):Boolean; +{ Change the queue status flag. Use the QS_XXXX constants } + +{F217/6B} +FUNCTION GetQueueJobList( QueueObjId: Longint; + Var QJobList:TQueueJobList): Boolean; +{ You need to be either a Q_USER or a Q_OPERATOR } + +{F217/6C} +FUNCTION ReadQueueJobEntry( QObjId: Longint;JobNbr: Word; + VAR QJob: TQueueJobEntry): Boolean; +{ You need to be either a Q_USER, Q_OPERATOR or a Q_SERVER } + +{F217/6A} +FUNCTION RemoveJobFromQueue( QObjId: Longint; JobNbr: Word): Boolean; +{ You need to be Q_OPERATOR or the Q_USER who queued the job } + +{F217/69 [2.1x+]} +Function StartQueueJob(QobjId:Longint;JobNbr:Word):Boolean; + + +{F217/6E [2.1x+]} +Function ChangeQueueJobPosition(QobjId:Longint; JobNbr:Word; + NewJobPos:Byte ):Boolean; +{ Q_OPERATOR only } + + +{F217/6F [2.1x+]} +Function AttachQueueServerToQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } + + +{F217/70 [2.1x+]} +Function DetachQueueServerFromQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } + + +{F217/71 [2.1x+]} +Function ServiceQueueJob(QobjID:Longint; JobType:Word; + Var QjobEntry:TQueueJobEntry):Boolean; +{ Q_SERVERs only } + +{F217/72 [2.1x+]} +Function FinishServicingQueueJob(QobjId:Longint;JobNbr:Word; + Charge:Longint ):Boolean; +{ Q_SERVERs only } + +{F217/73 [2.1x+]} +Function AbortServicingQueueJob(QobjId:Longint; JobNbr:Word):Boolean; + +{F217/74 [2.1x+]} +Function ChangeToClientRights(QobjId:Longint;JobNbr:Word):Boolean; +{ Q_SERVERs servicing job only } + +{F217/75 [2.1x+]} +Function RestoreQueueServerRights:Boolean; +{ Q_SERVERs, servicing job and having previously called + ChangeToClientRights only } + +{F217/76 [2.1x+]} +Function ReadQueueServerStatus(QobjId :Longint; + QserverObjId :Longint; + QserverConnNbr:Byte; + Var Qstatus:TQueueServerStatus):Boolean; + + +{F217/77 [2.1x+]} +Function SetQueueServerStatus(QobjId:Longint; Qstatus:TqueueServerStatus):Boolean; + +{F217/78 [2.1x+]} +Function GetQueueJobsFileSize(QobjId:Longint; JobNbr:Word; + Var JobSize:Longint ):Boolean; + +{F217/68 [2.1x+]} +Function CreateQueueJob(QobjId:Longint; + {i/o} Var Qjob:TqueueJobEntry):Boolean; + +{F217/6D [2.1x+]} +Function ChangeQueueJobEntry(QobjId:Longint;Qjob:TQueueJobEntry):Boolean; + +IMPLEMENTATION {============================================================} + +Uses nwIntr; + +Type TIntJobStruct =Record { Unit internal Type } + _ClientConnNbr, + _ClientTaskNbr : Byte; + _ClientObjectID, {hi-lo} + _TargetServerIDnumber : Longint; {hi-lo} + _TargetExecutionTime, + _JobEntryTime : Array[1..6] OF Byte; { YMDHMS } + _JobNumber, {hi-lo} + _JobType : Word; {hi-lo} + _JobPosition, + _JobControlFlags : Byte; + _JobFileName : Array[1..14] OF CHAR; { ASCIIZ } + _JobFileHandle : TJobFileHandle; + _ServerConnNbr, + _ServerTaskNbr : Byte; + _ServerObjectID : Longint; {hi-lo} + _JobDescription : Array[1..50] OF CHAR; { ASCIIZ } + _ClientRecordArea : Array[1..152] OF Byte + End; + +Procedure ConvertQJE2ext(qje:TintJobStruct;VAR ext:TQueueJobEntry; + Unrestricted:Boolean); +{convert the internal QueueJobEntry type into the equivalent + unit external type } +begin +With qje,ext + do begin + ClientConnNbr:=_ClientConnNbr; + ClientTaskNbr:=_ClientTaskNbr; + ClientObjectId:=Lswap(_ClientObjectId); + Move(_JobEntryTime,JobEntryTime,6); JobEntryTime.DayOfWeek:=0; + { # fix year for year 2000+ ? } + JobNumber:=swap(_JobNumber); + ZstrCopy(JobFileName,_JobFileName,14); + JobFileHandle:=_JobFileHandle; + TargetServerIdNumber:=Lswap(_TargetServerIdNumber); + Move(_TargetExecutionTime,TargetExecutionTime,6); TargetExecutionTime.DayOfWeek:=0; + { # fix year for year 2000+ ? } + JobType:=swap(_JobType); + JobControlFlags:=_JobControlFlags; + IF UnRestricted + then begin + ZstrCopy(JobDescription,_JobDescription,50); + Move(_ClientRecordArea,ClientRecordArea,152); + end; + JobPosition:=_JobPosition; + ServerConnNbr:=_ServerConnNbr; + ServerTaskNbr:=_ServerTaskNbr; + ServerObjectId:=Lswap(_ServerObjectId); + end; +end; + +Procedure ConvertQJE2int(qje:TQueueJobEntry;VAR int:TintJobStruct); +{convert the external QueueJobEntry type into the equivalent + unit internal type } +Var s:string[50]; +begin +With qje,int + do begin + _ClientConnNbr:=ClientConnNbr; + _ClientTaskNbr:=ClientTaskNbr; + _ClientObjectId:=Lswap(ClientObjectId); + _TargetServerIdNumber:=Lswap(TargetServerIdNumber); + Move(TargetExecutionTime,_TargetExecutionTime,6); + { # fix year for year 2000+ ? } + Move(JobEntryTime,_JobEntryTime,6); + { # fix year for year 2000+ ? } + _JobNumber:=swap(JobNumber); + _JobType:=swap(JobType); + _JobPosition:=JobPosition; + _JobControlFlags:=JobControlFlags; + PStrCopy(s,JobFilename,14);Move(s[1],_JobFileName,14); + _JobFileHandle:=JobFileHandle; + _ServerConnNbr:=ServerConnNbr; + _ServerTaskNbr:=ServerTaskNbr; + _ServerObjectId:=Lswap(ServerObjectId); + PstrCopy(s,JobDescription,50);Move(s[1],_JobDescription,50); + Move(ClientRecordArea,_ClientRecordArea,152); + end; +end; + + +{--- Initial Functions, create and destroy Job Queue --------------------} + +{F217/64 {2.1x+} +Function CreateQueue(Qname :string; QobjectType:Word; + dirHandle :Byte; pathName :string; + VAR QobjID:Longint ):Boolean; +{ Creates an object of an object_queue_type in the bindery, checks that + all settings are valid before creating. Returns the object_id of the + created queue if creation was successfull. } +{ QobjectType= OT_PRINT_QUEUE, OT_JOB_QUEUE, + OT_ARCHIVE_QUEUE, own obj.type >$8000 } +{ You need supervisor-equivalent or workgroup-manager rights to perform + this action. } +{ To add (remove) Queue operators or + (dis-)allow Queue servers to attach to a queue or + (dis-)allow objects (users/groups) to use a queue, + use the AddBinderyObjectToSet and DeleteBinderyObjectFromSet functions + in the nwBindry unit with the property names Q_OPERATORS, Q_SERVERS + and Q_USERS respectively. } +Type Treq=record + len :Word; + subFunc :Byte; + _Qtype :Word; { hi-lo} + _QdivData :array[1..168] of Byte; + end; + Trep=record + _Qid:Longint; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Var i:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$64; + _Qtype:=swap(QobjectType); { force hi-lo } + i:=ord(Qname[0])+1; + UpString(Qname);Move(Qname[0],_QdivData[1],i); + + inc(i); + _QdivData[i]:=DirHandle; + + inc(i); + UpString(PathName); + Move(PathName[0],_QDivData[i],ord(PathName[0])+1); + + len:=3+i+ord(PathName[0]); + F2SystemCall($17,len+2,SizeOf(Trep),result); + end; +With TPrep(GlobalReplyBuf)^ + do begin + QobjID:=Lswap(_Qid); { force lo-hi } + end; +CreateQueue:=(result=0) +{ resultcodes: $00 Success ; $96 Server Out Of Memory; $99 Drectory Full; + $9B Bad Directory Handle; $9C Invalid Path; $ED Property Already Exists; + $EE Object Already Exists; $EF Invalid Name; $F0 Wildcard Not Allowed; + $F1 Invalid Bindery Security; $F5 No Object Create Privilege; + $F7 No Property Create Privilege; $FC No Such Object; + $FE Server Bindery Locked; $FF Bindery Failure. } +end; + +{F217/65 [2.1x+]} +Function DestroyQueue(QobjID:Longint):Boolean; +{ Destroys the specified Queue; aborts all jobs in the queue; + associated files/directories are deleted; + queue object is removed from the bindery. } +Type Treq=record + len:Word; + subFunc:Byte; + _QobjID:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$65; + _QobjID:=Lswap(QobjID); { force hi-lo } + end; +F2SystemCall($17,Sizeof(Treq),0,result); +DestroyQueue:=(result=0); +{ resultcodes: $00 Success ; $96 Server Out Of Memory; $9C Invalid Path; + $D0 Queue Error; $D1 No Queue; $FF Hardware Failure. } +end; + +{----------------Client or Diagnostic Functions-----------------------------} + +{F217/76 [2.1x/3.x]} +Function ReadQueueStatus(QobjID:Longint; + Var Qstatus:TQueueStatus):Boolean; +{ Read the status of a queue. This information is changed by queueservers.} +Type Treq=record + len :Word; + subFunc:Byte; + _QobjID:Longint; {hi-lo} + end; + Trep=record + _QobjID:Longint; {hi-lo} + _Qstatus:Byte; + _NbrOfJobs:Byte; + _NbrOfServers:Byte; {max.25} + _serverIDlist:array[1..25] of Longint; {hi-lo} + _ServerConnNbrs:array[1..25] of Byte; + _MaxNumberOfServers:Byte; + end; + TPreq=^Treq; + TPrep=^Trep; +Var t:Byte; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + len:=SizeOf(Treq)-2; + subFunc:=$66; + _QobjID:=Lswap(QobjID); {force hi-lo} + end; +F2SystemCall($17,Sizeof(Treq),SizeOf(Trep),result); +With Qstatus, TPrep(GlobalReplyBuf)^ + do begin + ObjectId:=Lswap(_QobjId); + status:=_Qstatus; + NbrOfJobs:=_NbrOfJobs; + NbrOfServers:=_NbrOfServers; + + for t:=1 to NbrOfServers + do ServerObjectIDs[t]:=Lswap(_ServerIDlist[t]); + Move(_ServerConnNbrs,ServerConnNbrs,25); + MaxNbrOfServers:=_MaxNumberOfServers; + end; +ReadQueueStatus:=(result=0) +end; + +{F217/67 [2.1x+]} +Function SetQueueStatus(QobjId:Longint; NewQstatusFlag:Byte):Boolean; +{ Change the queue status flag. Use the QS_XXXX constants } +Type Treq=record + len:Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _Qstatus:Byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$67; + _QobjId:=Lswap(QobjId); + _Qstatus:=NewQStatusFlag; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +SetQueueStatus:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. +} +end; + + + +{F217/6B} +FUNCTION GetQueueJobList( QueueObjId: Longint; + Var QJobList:TQueueJobList): Boolean; +{ You need to be either a Q_USER or a Q_OPERATOR } +Type TReq=Record + BufLen : Word; + func : Byte; + _QueueObjId: Longint; {hi-lo} + end; + TRep=Record + _JobCount:Word; {max 250, hi-lo} + _JobBuf :TJobNumberList; {array, entries hi-lo} + _MaxJobs :Word; {hi-lo} + End; + TPrep=^Trep; + TPreq=^Treq; +Var i:Word; +Begin +With TPReq(GlobalReqBuf)^ + do Begin + func:= $6B; + _QueueObjId:= LSwap(QueueObjId); + BufLen:=5; + End; +F2SystemCall($17,Sizeof(Treq),SizeOf(Trep),result); +IF result = 0 + Then with QJobList, TPrep(GlobalReplyBuf)^ + do Begin + JobCount:= Swap(_JobCount); + IF (JobCount > MaxQueueJobs) + Then JobCount:= MaxQueueJobs; + FOR i:= 1 TO JobCount + DO JobNbrs[i]:= Swap(_JobBuf[i]); + MaxJobs:=swap(_MaxJobs); + End; +GetQueueJobList:= (result = 0); +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +End; + +{F217/6C} +FUNCTION ReadQueueJobEntry( QObjId: Longint;JobNbr: Word; + VAR QJob: TQueueJobEntry): Boolean; +{ You need to be either a Q_USER, Q_OPERATOR or a Q_SERVER } +Type TReq=Record + BufLen : Word; + func : Byte; + _QueueObjId: Longint; {hi-lo} + _JobNumber : Word {hi-lo} + End; + TRep=Record + buf : TintJobStruct; { Unit INTERNAL type. To be converted } + End; + TPreq=^Treq; + TPrep=^Trep; +Begin +With TPReq(GlobalReqBuf)^ + do Begin + Buflen:= 7; + func:= $6C; + _QueueObjId:= LSwap(QObjId); + _JobNumber:= Swap(JobNbr); + End; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +IF result= 0 + Then with TPrep(GlobalReplyBuf)^ + do Begin + ConvertQJE2ext(buf,QJob,True); + End; +ReadQueueJobEntry:= result = 0; +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $D5 No Queue Job; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +End; + +{F217/6A} +FUNCTION RemoveJobFromQueue( QObjId: Longint; JobNbr: Word): Boolean; +{ You need to be Q_OPERATOR or the Q_USER who queued the job } +Type TReq=Record + BufLen: Word; + func: Byte; + _QueueObjId: Longint; {hi-lo} + _JobNumber:Word {hi-lo} + End; + TPreq=^Treq; +Begin +With TPReq(GlobalReqBuf)^ + do Begin + Buflen:= 7; + func:= $6A; + _QueueObjId:= LSwap(QObjId); + _JobNumber:= Swap(JobNbr); + End; +F2SystemCall($17,SizeOf(Treq),0,result); +RemoveJobFromQueue:= result = 0; +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D6 No Job Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. } +End; + + +{F217/69 [2.1x+]} +Function StartQueueJob(QobjId:Longint;JobNbr:Word):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$69; + _QobjId:=Lswap(QobjID); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +StartQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D6 No Job Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/6E [2.1x+]} +Function ChangeQueueJobPosition(QobjId:Longint; JobNbr:Word; + NewJobPos:Byte ):Boolean; +{ Q_OPERATOR only } +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _JobNbr :Word; {hi-lo} + _NewJobPos:Byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$6E; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + _NewJobPos:=NewJobPos; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +ChangeQueueJobPosition:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D5 No Queue Job; + $D6 No Job Rights; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/6F [2.1x+]} +Function AttachQueueServerToQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$6F; + _QobjId:=Lswap(QobjId); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +AttachQueueServerToQueue:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/70 [2.1x+]} +Function DetachQueueServerFromQueue(QobjId:Longint):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$70; + _QobjId:=Lswap(QobjId); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +DetachQueueServerFromQueue:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/71 [2.1x+]} +Function ServiceQueueJob(QobjID:Longint; JobType:Word; + Var QjobEntry:TQueueJobEntry):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _JobType:Word; {hi-lo} + end; + Trep=Record + _qje:TintJobStruct; { EXCEPT last two fields } + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$71; + _QobjId:=Lswap(QobjId); + _JobType:=swap(JobType); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep)-50-152,result); +With TPrep(GlobalReplyBuf)^ + do begin + ConvertQJE2Ext(_qje,QjobEntry,false); + FillChar(QjobEntry.JobDescription,50,#$0); + FillChar(QjobEntry.ClientRecordArea,152,#$0); + { Use the ReadQueueJobEntry function to get job's + descriptionstring and clientRecordArea. } + end; +ServiceQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D9 Connection not Queue Server; + $DA Queue Halted; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/72 [2.1x+]} +Function FinishServicingQueueJob(QobjId:Longint;JobNbr:Word; + Charge:Longint ):Boolean; +{ Q_SERVERs only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + _Charge:Longint; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$72; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + _Charge:=Lswap(Charge); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +FinishServicingQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D6 No Job Rights; } +end; + +{F217/73 [2.1x+]} +Function AbortServicingQueueJob(QobjId:Longint; JobNbr:Word):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$73; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +AbortServicingQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D6 No Job Rights; + $D9 Connection not Queue Server; } +end; + +{F217/74 [2.1x+]} +Function ChangeToClientRights(QobjId:Longint;JobNbr:Word):Boolean; +{ Q_SERVERs servicing job only } +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$74; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +ChangeToClientRights:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D6 No Job Rights; + $D9 Connection not Queue Server; } +end; + +{F217/75 [2.1x+]} +Function RestoreQueueServerRights:Boolean; +{ Q_SERVERs, servicing job and having previously called + ChangeToClientRights only } +Type Treq=record + len :Word; + subFunc:Byte; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$75; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +RestoreQueueServerRights:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D3 No Queue Rights; + $D5 No Queue Job; + $D9 Connection not Queue Server; + $DA Queue Halted; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/76 [2.1x+]} +Function ReadQueueServerStatus(QobjId :Longint; + QserverObjId :Longint; + QserverConnNbr:Byte; + Var Qstatus:TQueueServerStatus):Boolean; +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _QSobjId :Longint; {hi-lo} + _QSconnNbr:Byte; + end; + Trep=record + _Qstatus:TqueueServerStatus; + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$76; + _QobjId:=Lswap(QobjId); + _QSobjId:=Lswap(QserverObjId); + _QSconnNbr:=QserverConnNbr; + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + Move(_Qstatus,Qstatus,SizeOf(TQueueServerStatus)); + end; +ReadQueueServerStatus:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $F1 Invalid Bindery Security; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/77 [2.1x+]} +Function SetQueueServerStatus(QobjId:Longint; Qstatus:TqueueServerStatus):Boolean; +Type Treq=record + len :Word; + subFunc :Byte; + _QobjId :Longint; {hi-lo} + _Qstatus:TQueueServerStatus; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$77; + _QobjId:=Lswap(QobjId); + Move(Qstatus,_Qstatus,Sizeof(TQueueServerStatus)); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +SetQueueServerStatus:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/78 [2.1x+]} +Function GetQueueJobsFileSize(QobjId:Longint; JobNbr:Word; + Var JobSize:Longint ):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _JobNbr:Word; {hi-lo} + end; + Trep=record + _QobjId :Longint; {hi-lo} + _JobNbr :Word; {hi-lo} + _JobSize:Longint; {hi-lo} + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$78; + _QobjId:=Lswap(QobjId); + _JobNbr:=swap(JobNbr); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep),result); +With TPrep(GlobalReplyBuf)^ + do begin + JobSize:=Lswap(_JobSize); + end; +GetQueueJobsFileSize:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $9C Invalid Path; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{F217/68 [2.1x+]} +Function CreateQueueJob(QobjId:Longint; + {i/o} Var Qjob:TqueueJobEntry):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _Qjob :TintJobStruct; + end; + Trep=record + _QjobR:TintJobStruct; { Except the last two fields ! } + end; + TPreq=^Treq; + TPrep=^Trep; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$68; + _QobjId:=Lswap(QobjId); + ConvertQJE2Int(Qjob,_Qjob); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),SizeOf(Trep)-152-50,result); +With TPrep(GlobalReplyBuf)^ + do begin + ConvertQJE2Ext(_QjobR,Qjob,False); + { False => Last 2 fields remain unchanged } + end; +CreateQueueJob:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $99 Directory Full; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $D4 Queue Full; + $DA Queue Halted; + $ED Property Already Exists; + $EF Invalid Name; + $F0 Wildcard Not Allowed; + $F1 Invalid Bindery Security; + $F7 No Property Create Privilege; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + +{F217/6D [2.1x+]} +Function ChangeQueueJobEntry(QobjId:Longint;Qjob:TQueueJobEntry):Boolean; +Type Treq=record + len :Word; + subFunc:Byte; + _QobjId:Longint; {hi-lo} + _Qjob :TintJobStruct; + end; + TPreq=^Treq; +Begin +WITH TPreq(GlobalReqBuf)^ + do begin + subFunc:=$6D; + _QobjId:=Lswap(QobjId); + ConvertQJE2Int(Qjob,_Qjob); + len:=SizeOf(Treq)-2; + end; +F2SystemCall($17,SizeOf(Treq),0,result); +ChangeQueueJobEntry:=(result=0) +{ Valid completion codes: + $00 Success + $96 Server Out Of Memory; + $D0 Queue Error; + $D1 No Queue; + $D5 No Queue Job; + $D7 Queue Servicing; + $FE Server Bindery Locked; + $FF Bindery Failure. } +end; + + +{$IFDEF Template} {--------------- Q unit function template ---------------} + +{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 + $96 Server Out Of Memory; + $99 Drectory Full; + $9B Bad Directory Handle; + $9C Invalid Path; + $D0 Queue Error; + $D1 No Queue; + $D2 No Queue Server; + $D3 No Queue Rights; + $D4 Queue Full; + $D5 No Queue Job; + $D6 No Job Rights; + $D7 Queue Servicing; + $D9 Connection not Queue Server; + $DA Queue Halted; + $DB Max Queue Servers; + $ED Property Already Exists; + $EE Object Already Exists; + $EF Invalid Name; + $F0 Wildcard Not Allowed; + $F1 Invalid Bindery Security; + $F5 No Object Create Privilege; + $F7 No Property Create Privilege; + $FC No Such Object; + $FE Server Bindery Locked; + $FF Bindery Failure. +} +end; + +{$ENDIF} + +end. diff --git a/SRC/UNITS/NWSEMA.PAS b/SRC/UNITS/NWSEMA.PAS new file mode 100644 index 0000000..0128660 --- /dev/null +++ b/SRC/UNITS/NWSEMA.PAS @@ -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. \ No newline at end of file diff --git a/SRC/UNITS/NWSERV.DCU b/SRC/UNITS/NWSERV.DCU new file mode 100644 index 0000000..3896f5f Binary files /dev/null and b/SRC/UNITS/NWSERV.DCU differ diff --git a/SRC/UNITS/NWSERV.PAS b/SRC/UNITS/NWSERV.PAS new file mode 100644 index 0000000..1cd2e8c --- /dev/null +++ b/SRC/UNITS/NWSERV.PAS @@ -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 result1: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,result1); +ClearConnectionNumber:=(result1=0); +{result1 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),result1); +Time:=TPrep(GlobalreplyBuf)^; +if time.year>100 + then time.year:=time.year-100; +{ year<80 : 21st century } +result1:=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,result1); +SetFileServerDateAndTime:=(result1=$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,result1); +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:=(result1=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),result1); +companyName:=''; VersionAndRevision:=''; +revisionDate:=''; copyrightNotice:=''; +if result1=$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:=(result1=$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,result1); +DownFileServer:=(result1=0); +{ result1codes: 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,result1); +DisableTransactionTracking:=(result1=0); +{ result1codes: 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,result1); +EnableTransactionTracking:=(result1=0); +{ result1codes: 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,result1); +DisableFileServerLogin:=(result1=0); +{ result1codes: 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,result1); +EnableFileServerLogin:=(result1=0); +{ result1codes: 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 } +{ result1 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),result1); +LoginEnabled:=Boolean(TPrep(GlobalReplyBuf)^.Flag); +GetFileServerLoginStatus := (result1=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,result1); +CheckConsolePrivileges := (result1=$00); +{ result1 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),result1); +if result1=$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:=(result1=$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),result1); +if result1=$00 + then with TPrep(GlobalReplyBuf)^ + do begin + + end + else begin + NbrOfRecords:=0; + LastRecordSeen:=0; + end; +GetConnectionsUsingAFile:=(result1=$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),result1); +if result1=$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:=(result1=$00); +{result1codes: 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),result1); +with TPrep(GlobalReplyBuf)^ + do begin + ApplicNbr:=swap(_applicNbr); { force lo-hi } + serialNbr:=Lswap(_serNbr); { force lo-hi } + end; +GetNetworkSerialNumber := (result1=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),result1); +with TPrep(GlobalReplyBuf)^ +do begin + ApplicNbr:=swap(_applicNbr); { force lo-hi } + end; +VerifyNetworkSerialNumber := (result1=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} \ No newline at end of file diff --git a/SRC/UNITS/NWSPX.PAS b/SRC/UNITS/NWSPX.PAS new file mode 100644 index 0000000..8939fcc --- /dev/null +++ b/SRC/UNITS/NWSPX.PAS @@ -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. diff --git a/SRC/UNITS/SENDMSG.DCU b/SRC/UNITS/SENDMSG.DCU new file mode 100644 index 0000000..208d45d Binary files /dev/null and b/SRC/UNITS/SENDMSG.DCU differ diff --git a/SRC/UNITS/SENDMSG.DFM b/SRC/UNITS/SENDMSG.DFM new file mode 100644 index 0000000..95e8c37 Binary files /dev/null and b/SRC/UNITS/SENDMSG.DFM differ diff --git a/SRC/UNITS/SENDMSG.PAS b/SRC/UNITS/SENDMSG.PAS new file mode 100644 index 0000000..46b030c --- /dev/null +++ b/SRC/UNITS/SENDMSG.PAS @@ -0,0 +1,37 @@ +unit Sendmsg; + +interface + +uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, + StdCtrls, nwMess, ExtCtrls; + +type + TBtnBottomDlg4 = class(TForm) + OKBtn: TBitBtn; + CancelBtn: TBitBtn; + Bevel1: TBevel; + Edit1: TEdit; + Edit2: TEdit; + Label1: TLabel; + Label2: TLabel; + procedure OKBtnClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + BtnBottomDlg4: TBtnBottomDlg4; + +implementation + +{$R *.DFM} + +procedure TBtnBottomDlg4.OKBtnClick(Sender: TObject); +begin + SendMessageToUser(Edit1.Text, Edit2.Text); + Close; +end; + +end. diff --git a/SRC/USER.DCU b/SRC/USER.DCU new file mode 100644 index 0000000..1808a1e Binary files /dev/null and b/SRC/USER.DCU differ diff --git a/SRC/USER.DFM b/SRC/USER.DFM new file mode 100644 index 0000000..f8dfd63 Binary files /dev/null and b/SRC/USER.DFM differ diff --git a/SRC/USER.PAS b/SRC/USER.PAS new file mode 100644 index 0000000..5f30e3b --- /dev/null +++ b/SRC/USER.PAS @@ -0,0 +1,118 @@ +unit User; + +interface + +uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, + StdCtrls, ExtCtrls, SysUtils, Dialogs; + +type + TBtnBottomDlg = class(TForm) + Bevel1: TBevel; + ListBox1: TListBox; + Label1: TLabel; + BitBtn1: TBitBtn; + BitBtn2: TBitBtn; + BitBtn3: TBitBtn; + BitBtn4: TBitBtn; + Label2: TLabel; + + procedure FormCreate(Sender: TObject); + procedure BitBtn4Click(Sender: TObject); + procedure BitBtn2Click(Sender: TObject); + procedure FormPaint(Sender: TObject); + procedure BitBtn1Click(Sender: TObject); + procedure BitBtn3Click(Sender: TObject); + private + { Private declarations } + public + function GetUnixUser(UserNm: String): String; + { Public declarations } + end; + +var + BtnBottomDlg: TBtnBottomDlg; + +implementation + + +Uses Startfrm, nwconn, nwbindry, adduser, eduser; +{$R *.DFM} + +function TBtnBottomDlg.GetUnixUser(UserNm: String): String; +var MyProperty: TProperty; + MorSegs: Boolean; + PropFlg: Byte; +begin + if ReadPropertyValue(UserNm, OT_USER, 'UNIX_USER', 1, MyProperty, MorSegs, PropFlg) + =false then result:='' else result:=StrPas(Addr(MyProperty)); +end; + +procedure TBtnBottomDlg.FormCreate(Sender: TObject); +var ID: Byte; + ObjName1, UserName: String[24]; + longint1 :longint; + RepID1: longint; + RepType1: Word; + RepFlag1, RepSecu1: Byte; + RepProp1: Boolean; +begin + Caption:='Editing User accounts at '+Form1.panel1.caption; + {Get Usernames, with Unix names and add to listbox1} + longint1:=-1; + while ScanBinderyObject('*', OT_USER, longint1, ObjName1, RepType1, + RepID1, RepFlag1, RepSecu1, RepProp1)=true do + begin + UserName:=ObjName1; + RepID1:=RepID1 AND $7FFF; + ListBox1.Items.Add(ObjName1+', '+IntToStr(RepID1)+', '+GetUnixUser(UserName)); + end; +end; + + +procedure TBtnBottomDlg.BitBtn4Click(Sender: TObject); +begin + Close; +end; + +procedure TBtnBottomDlg.BitBtn2Click(Sender: TObject); +var UserName: String; + Int1: Integer; +begin + {Don't clear up groups yet, just remove bind. entry} + if ListBox1.ItemIndex<>-1 then + begin + UserName:=''; Int1:=1; + While ListBox1.Items[ListBox1.ItemIndex][Int1]<>',' do + begin + UserName:=UserName+ListBox1.Items[ListBox1.ItemIndex][Int1]; + Int1:=Int1+1; + end; + if UserName='SUPERVISOR' then MessageDlg('Deleting SUPERVISOR would be a VERY BAD idea!', mtWarning, [mbOK], 0); + if MessageDlg('Delete user '+UserName+'?', mtConfirmation, [mbYes, mbNo], 0)=mrYes + then begin + if DeleteBinderyObject(UserName,OT_USER)<>TRUE then + MessageDlg('Could not remove user '+UserName, mtError, [mbCancel], 0); + end; + Paint; + end; +end; + +procedure TBtnBottomDlg.FormPaint(Sender: TObject); +begin + ListBox1.Items.Clear; + FormCreate(self); +end; + +procedure TBtnBottomDlg.BitBtn1Click(Sender: TObject); +begin + BtnBottomDlg2.ShowModal; + FormPaint(self); +end; + +procedure TBtnBottomDlg.BitBtn3Click(Sender: TObject); +begin + if ListBox1.ItemIndex<>-1 then BtnBottomDlg3.ShowModal; + FormPaint(self); +end; + +end.