home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / netcraft / netcraft.pas < prev    next >
Pascal/Delphi Source File  |  1988-06-10  |  17KB  |  637 lines

  1. {*********************************************************************
  2.  
  3.   NETCraft - A unit of NetWare Application Program Interfaces
  4.              for Turbo Pascal 4.0 and Advanced NetWare (any verison)
  5.  
  6.   Copyright (C) 1988, Richard S. Sadowsky
  7.   All rights reserved
  8.  
  9.   version .8 6/10/88 by Richard S. Sadowsky
  10.  
  11. **********************************************************************}
  12. Unit NetCraft;
  13. {$I-,V-,S+,R+}
  14.  
  15. interface
  16.  
  17. uses DOS;
  18. const
  19.   _SHAREABLE       = $80;
  20.  
  21.   { Effective Rights constants represent bit in Mask }
  22.   _READ            = $01;
  23.   _WRITE           = $02;
  24.   _OPEN            = $04;
  25.   _CREATE          = $08;
  26.   _DELETE          = $10;
  27.   _PARENTAL        = $20;
  28.   _SEARCH          = $40;
  29.   _MODIFY          = $80;
  30.  
  31.   { status byte }
  32.   _PERMENANT       = $01;
  33.   _TEMPORARY       = $02;
  34.   _LOCAL           = $80;
  35.  
  36. {gerneral error codes }
  37.   _SUCCESS         = $00;
  38.  
  39.  
  40. type
  41.   Str9             = String[9];
  42.   Str10            = String[10];
  43.   Str20            = String[20];
  44.   Str80            = String[80];
  45.   PhysicalNodeAddress
  46.                    = array[1..6] of Byte;
  47.  
  48. var
  49.   NovRegs          : Registers; { register type for DOS/Novell calls }
  50.  
  51. function GetExtFAttr(var Path : String; var Attributes : Byte) : Byte;
  52. {
  53.   Meaning of Attributes:
  54.   7   6   5   4   3   2   1   0
  55.   |   |   |   |       |   |   |
  56.   |   |   |   |       +---+---+------Search mode  [210]
  57.   |   |   |   +----------------------transactional bit [4]
  58.   |   |   +--------------------------Indexing bit [5]
  59.   |   +------------------------------Read Audit bit [6]
  60.   +----------------------------------Write Audit bit [7]
  61.   Function returns error code:
  62.     0  - Success
  63.     2  - File not found
  64.     18 - No more files (requesting workstation does not have search
  65.                         rights)
  66. }
  67.  
  68. function SetExtFAttr(var PathName : Str80; Attr : Byte) : Byte;
  69. {
  70.   See GetExtFAttr for meaning of Attr the Attribute
  71.   Function returns error code:
  72.     0  - Success
  73.     2  - File not found
  74.     5  - Access denied
  75. }
  76.  
  77. function FileIsSharable(Path : String; var FAttr : Word; var ErrCode : Word)
  78.                        : Boolean;
  79. { Return TRUE if ifle is flagged as shareable, return file attrib in FAttr }
  80.  
  81. function MakeFileSharable(Path : String) : Word;
  82.  
  83. function ConsolePriv : Boolean;
  84.  
  85. function GetConnNo : Byte;
  86. { returns connection number of requesting WS (1..100) }
  87.  
  88. function ServerConnNo: Byte;
  89. { returns connection number of default file server (1..8) }
  90.  
  91. procedure EndOfJob(All : Boolean);
  92. {
  93.   forces an end of job
  94.   If All is TRUE, then ends all jobs, otherwise ends a single job.
  95.   Ending a job unlocks and clears all locked or logged files and records.
  96.   It close all open network and local files and resets error and lock modes
  97. }
  98.  
  99. function GetDirHandle(Drive : Char; var StatusFlags : Byte) : Byte;
  100. { returns directory handle and status flags for a drive }
  101. { return byte:
  102.   00   - Invalid Drive Number
  103.   otherwise returned directory handle
  104.  
  105.   Status Byte
  106.   7  6  5  4  3  2  1  0
  107.   |                 |  +-Permenant Directory Handle
  108.   |                 +----Temporary Directory Handle
  109.   +----------------------Mapped to a local drive
  110. }
  111.  
  112. function GetDirPath(DirHandle : Byte; var DirPath : String) : Byte;
  113. { returns directory path of a directory handle }
  114. { return byte
  115.   00h  - Success
  116.   9Bh  - Bad Directory Handle
  117. }
  118.  
  119. function GetDirRights(DirHandle : Byte; PathName : String;
  120.                       var Rights : Byte) : Byte;
  121. { returns the requesting workstation's effective directory rights }
  122. { return byte
  123.   00h  - Success
  124.   98h  - Volume Does Not Exist
  125.   9Bh  - Bad Directory Handle
  126.  
  127.   Rights
  128.   7  6  5  4  3  2  1  0
  129.   |  |  |  |  |  |  |  +--Read bit (file reads allowed)
  130.   |  |  |  |  |  |  +-----Write bit (file writes allowed)
  131.   |  |  |  |  |  +--------Open bit (files can be opened)
  132.   |  |  |  |  +-----------Create bit (files can be created)
  133.   |  |  |  +--------------Delete bit (files may be deleted)
  134.   |  |  +-----------------Parental bit (subdirs may be created/deleted
  135.   |  |                                  and trustee rights granted/revoked)
  136.   |  +--------------------Search bit (directory may be searched)
  137.   +-----------------------Modify bit (file status bits can be modified)
  138. }
  139.  
  140. function IsLockModeExtended : Boolean;
  141. {
  142.   returns TRUE if using Advanced NetWare Extended Lock Mode, if FALSE,
  143.   then in compatability mode (for compat with NetWare 4.61 and prior).
  144. }
  145.  
  146. function AllocPermDirHandle(DirHandle : Byte; DriveLetter : Char;
  147.                             DirPath : String;
  148.                             var NewHandle,Rights : Byte) : Byte;
  149. { Allocates a permament directory handle, not deleted automatically by EOJ.
  150.  
  151. return byte:
  152.   00h  - Success
  153.   98h  - Volume does not exist
  154.   9Ch  - Invalid Path
  155. }
  156.  
  157. function AllocTempDirHandle(DirHandle : Byte; DriveLetter : Char;
  158.                             DirPath : String;
  159.                             var NewHandle,Rights : Byte) : Byte;
  160. { Allocates a temporary directory handle, deleted automatically by EOJ.
  161.  
  162. return byte:
  163.   00h  - Success
  164.   98h  - Volume does not exist
  165.   9Ch  - Invalid Path
  166. }
  167.  
  168. function DeallocDirHandle(DirHandle : Byte) : Byte;
  169. { This function deletes a directory handle }
  170. { return byte:
  171.   00h  - Success
  172.   9Bh  - Bad directory handle
  173. }
  174.  
  175. function ClearConnectionNumber(ConnNo : Byte) : Byte;
  176. { Clears a logical connection from the file server }
  177.  
  178. function HiLong(Long : LongInt) : Word;
  179. { This inline directive is similar to Turbo's Hi() function, except }
  180. { it returns the high word of a LongInt                             }
  181. Inline(
  182.   $5A/       {pop      dx    ; low word of long}
  183.   $58);      {pop      ax    ; hi word of long}
  184.  
  185. function LowLong(Long : LongInt) : Word;
  186. { This inline directive is similar to Turbo's Lo() function, except }
  187. { it returns the Low word of a LongInt                              }
  188. Inline(
  189.   $5A/       {pop      dx    ; low word of long}
  190.   $58/       {pop      ax    ; hi word of long}
  191.   $89/$D0);  {mov      ax,dx ; return lo word as function result in Ax}
  192.  
  193. function MakeLong(HiWord,LoWord : Word) : LongInt;
  194. {takes hi and lo words and makes a longint }
  195. Inline(
  196.   $58/    { pop ax ; pop low word into AX }
  197.   $5A);   { pop dx ; pop high word into DX }
  198.  
  199. implementation
  200.  
  201. function FileIsSharable(Path : String; var FAttr : Word; var ErrCode : Word)
  202.                        : Boolean;
  203. { Return TRUE if ifle is flagged as shareable, return file attrib in FAttr }
  204.  
  205. var
  206.   F                : File;
  207.  
  208. begin
  209.   Assign(F,Path);
  210.   GetFAttr(F,FAttr);
  211.   ErrCode := DOSError;
  212.   FileIsSharable := (FAttr and _SHAREABLE) <> 0   { see if SHARE }
  213.                                                   { bit set.     }
  214. end;
  215.  
  216. function MakeFileSharable(Path : String) : Word;
  217.  
  218. var
  219.   F                : File;
  220.   Attr             : Word;
  221.   ErrCode          : Word;
  222.   Share            : Boolean;
  223.  
  224. begin
  225.   Share := FileIsSharable(Path,Attr,ErrCode);  { is it sharable? }
  226.   if (ErrCode = 0) and (not Share) then begin
  227.     Assign(F,Path);
  228.     SetFAttr(F,Attr or _SHAREABLE); { OR existing at with SHARE bit }
  229.     ErrCode := DOSError;
  230.   end;
  231.   MakeFileSharable := ErrCode;
  232. end;
  233.  
  234. function SetExtFAttr(var PathName : Str80; Attr : Byte) : Byte;
  235. {
  236.   See GetExtFAttr for meaning of Attr the Attribute
  237.   Function returns error code:
  238.     0  - Success
  239.     2  - File not found
  240.     5  - Access denied
  241. }
  242.  
  243. begin
  244.   with NovRegs do begin
  245.     AX := $B601;
  246.     PathName := PathName + #0;
  247.     DS := Seg(PathName[1]);
  248.     DX := Ofs(PathName[1]);
  249.     CL := Attr;
  250.     MsDos(NovRegs);
  251.     if Flags and FCarry <> 0 then
  252.       SetExtFAttr := AL
  253.     else
  254.       SetExtFAttr := 0;
  255.   end;
  256. end;
  257.  
  258. function GetExtFAttr(var Path : String; var Attributes : Byte) : Byte;
  259. {
  260.   Meaning of Attributes:
  261.   7   6   5   4   3   2   1   0
  262.   |   |   |   |       |   |   |
  263.   |   |   |   |       +---+---+------Search mode  [210]
  264.   |   |   |   +----------------------transactional bit [4]
  265.   |   |   +--------------------------Indexing bit [5]
  266.   |   +------------------------------Read Audit bit [6]
  267.   +----------------------------------Write Audit bit [7]
  268.   Function returns error code:
  269.     0  - Success
  270.     2  - File not found
  271.     18 - No more files (requesting workstation does not have search
  272.                         rights)
  273. }
  274. begin
  275.   with NovRegs do begin
  276.     AX := $B600;
  277.     Path[Succ(Length(Path))] := #0; { null terminate string }
  278.     DS := Seg(Path[1]);             { skip length byte for AsciiZ string }
  279.     DX := Ofs(Path[1]);
  280.     MsDos(NovRegs);
  281.     GetExtFAttr := AL;
  282.     Attributes := CL;
  283.   end;
  284. end;
  285.  
  286. procedure EndOfJob(All : Boolean);
  287. {
  288.   forces an end of job
  289.   If All is TRUE, then ends all jobs, otherwise ends a single job.
  290.   Ending a job unlocks and clears all locked or logged files and records.
  291.   It close all open network and local files and resets error and lock modes
  292. }
  293. begin
  294.   with NovRegs do begin
  295.     AX := $D600;
  296.     if All then
  297.       BX := $FFFF
  298.     else
  299.       BX := $00;
  300.   end;
  301.   MsDos(NovRegs);
  302. end;
  303.  
  304. function GetConnNo : Byte;
  305. { returns connection number of requesting WS (1..100) }
  306.  
  307. begin
  308.   with NovRegs do
  309.     AX := $DC00;
  310.   MsDos(NovRegs);
  311.   GetConnNo := NovRegs.AL
  312. end;
  313.  
  314. function ServerConnNo : Byte;
  315. { returns connection number of default file server (1..8) }
  316.  
  317. begin
  318.   with NovRegs do
  319.     AX := $F005;
  320.   MsDos(NovRegs);
  321.   ServerConnNo := NovRegs.AL
  322. end;
  323.  
  324. function ConsolePriv : Boolean;
  325.  
  326. var
  327.   Reply            : Word;
  328.   Request          : record
  329.                        Len  : Word;
  330.                        SubF : Byte;
  331.                      end;
  332.  
  333. begin
  334.   Reply := 0;
  335.   with Request do begin
  336.     Len  := 1;
  337.     SubF := $C8;
  338.   end;
  339.   with NovRegs do begin
  340.     AX := $E300;
  341.     DS := Seg(Request);
  342.     SI := Ofs(Request);
  343.     ES := Seg(Reply);
  344.     DI := Ofs(Reply);
  345.     MsDos(NovRegs);
  346.     ConsolePriv := AL <> $C6;
  347.   end;
  348. end;
  349.  
  350. function GetDirHandle(Drive : Char; var StatusFlags : Byte) : Byte;
  351. { returns directory handle and status flags for a drive }
  352. { return byte:
  353.   00   - Invalid Drive Number
  354.   otherwise returned directory handle
  355.  
  356.   Status Byte
  357.   7  6  5  4  3  2  1  0
  358.   |                 |  +-Permenant Directory Handle
  359.   |                 +----Temporary Directory Handle
  360.   +----------------------Mapped to a local drive
  361. }
  362.  
  363. var
  364.   NovRegs          : Registers; { register type for DOS/Novell calls }
  365.  
  366. begin
  367.   with NovRegs do begin
  368.     AX := $E900;
  369.     DX := Ord(UpCase(Drive)) - Ord('A');
  370.     MsDos(NovRegs);
  371.     GetDirHandle := AL;
  372.     StatusFlags := AH;
  373.   end
  374. end;
  375.  
  376. function GetDirPath(DirHandle : Byte; var DirPath : String) : Byte;
  377. { returns directory path of a directory handle }
  378. { return byte
  379.   00h  - Success
  380.   9Bh  - Bad Directory Handle
  381. }
  382.  
  383. var
  384.   Reply            : record
  385.                        Len     : Word;
  386.                        Name    : String;
  387.                      end;
  388.   Request          : record
  389.                        Len     : Word;
  390.                        SubF    : Byte;
  391.                        Handle  : Byte;
  392.                      end;
  393.  
  394. begin
  395.   Reply.Len := 256;
  396.   with Request do begin
  397.     Len     := 2;
  398.     SubF    := $01;
  399.     Handle  := DirHandle;
  400.   end;
  401.   with NovRegs do begin
  402.     AX := $E200;
  403.     DS := Seg(Request);
  404.     SI := Ofs(Request);
  405.     ES := Seg(Reply);
  406.     DI := Ofs(Reply);
  407.     MsDos(NovRegs);
  408.     GetDirPath := AL;
  409.   end;
  410.   with Reply do
  411.     DirPath := Name;
  412. end;
  413.  
  414. function GetDirRights(DirHandle : Byte; PathName : String;
  415.                       var Rights : Byte) : Byte;
  416. { returns the requesting workstation's effective directory rights }
  417. { return byte
  418.   00h  - Success
  419.   98h  - Volume Does Not Exist
  420.   9Bh  - Bad Directory Handle
  421.  
  422.   Rights
  423.  
  424.   7  6  5  4  3  2  1  0
  425.   |  |  |  |  |  |  |  +--Read bit (file reads allowed)
  426.   |  |  |  |  |  |  +-----Write bit (file writes allowed)
  427.   |  |  |  |  |  +--------Open bit (files can be opened)
  428.   |  |  |  |  +-----------Create bit (files can be created)
  429.   |  |  |  +--------------Delete bit (files may be deleted)
  430.   |  |  +-----------------Parental bit (subdirs may be created/deleted
  431.   |  |                                  and trustee rights granted/revoked)
  432.   |  +--------------------Search bit (directory may be searched)
  433.   +-----------------------Modify bit (file status bits can be modified)
  434. }
  435.  
  436. var
  437.   Reply            : record
  438.                        Len     : Word;
  439.                        Mask    : Byte;
  440.                      end;
  441.   Request          : record
  442.                        Len     : Word;
  443.                        SubF    : Byte;
  444.                        Handle  : Byte;
  445.                        Name    : String;
  446.                      end;
  447.  
  448. begin
  449.   Reply.Len := 1;
  450.   with Request do begin
  451.     Len     := 3 + Length(PathName);
  452.     SubF    := $03;
  453.     Handle  := DirHandle;
  454.     Name    := PathName;
  455.   end;
  456.   with NovRegs do begin
  457.     AX := $E200;
  458.     DS := Seg(Request);
  459.     SI := Ofs(Request);
  460.     ES := Seg(Reply);
  461.     DI := Ofs(Reply);
  462.     MsDos(NovRegs);
  463.     GetDirRights := AL;
  464.   end;
  465.   with Reply do
  466.     Rights := Mask;
  467. end;
  468.  
  469. function IsLockModeExtended : Boolean;
  470. {
  471.   returns TRUE if using Advanced NetWare Extended Lock Mode, if FALSE,
  472.   then in compatability mode (for compat with NetWare 4.61 and prior).
  473. }
  474. begin
  475.   with NovRegs do begin
  476.     AX := $C602;
  477.     MsDos(NovRegs);
  478.     IsLockModeExtended := AL = 1;
  479.   end;
  480. end;
  481.  
  482. function AllocPermDirHandle(DirHandle : Byte; DriveLetter : Char;
  483.                             DirPath : String;
  484.                             var NewHandle,Rights : Byte) : Byte;
  485. { Allocates a permament directory handle, not deleted automatically by EOJ.
  486.  
  487. return byte:
  488.   00h  - Success
  489.   98h  - Volume does not exist
  490.   9Ch  - Invalid Path
  491. }
  492. var
  493.   Req              : record
  494.                        Len     : Word;
  495.                        SubF    : Byte;
  496.                        Handle  : Byte;
  497.                        Letter  : Char;
  498.                        PName   : String;
  499.                      end;
  500.   Reply            : record
  501.                        Len     : Word;
  502.                        NewH    : Byte;
  503.                        Mask    : Byte;
  504.                      end;
  505.  
  506. begin
  507.   Reply.Len := 2;
  508.   with Req do begin
  509.     Len     := 4 + Length(DirPath);
  510.     SubF    := $12;
  511.     Handle  := DirHandle;
  512.     Letter  := UpCase(DriveLetter);
  513.     PName   := DirPath;
  514.   end;
  515.   with NovRegs do begin
  516.     AX := $E200;
  517.     DS := Seg(Req);
  518.     SI := Ofs(Req);
  519.     ES := Seg(Reply);
  520.     DI := Ofs(Reply);
  521.     MsDos(NovRegs);
  522.     AllocPermDirHandle := AL;
  523.   end;
  524.   with Reply do begin
  525.     NewHandle := NewH;
  526.     Rights    := Mask;
  527.   end;
  528. end;
  529.  
  530. function AllocTempDirHandle(DirHandle : Byte; DriveLetter : Char;
  531.                             DirPath : String;
  532.                             var NewHandle,Rights : Byte) : Byte;
  533. { Allocates a temporary directory handle, deleted automatically by EOJ.
  534.  
  535. return byte:
  536.   00h  - Success
  537.   98h  - Volume does not exist
  538.   9Ch  - Invalid Path
  539. }
  540. var
  541.   Req              : record
  542.                        Len     : Word;
  543.                        SubF    : Byte;
  544.                        Handle  : Byte;
  545.                        Letter  : Char;
  546.                        PName   : String;
  547.                      end;
  548.   Reply            : record
  549.                        Len     : Word;
  550.                        NewH    : Byte;
  551.                        Mask    : Byte;
  552.                      end;
  553.  
  554. begin
  555.   Reply.Len := 2;
  556.   with Req do begin
  557.     Len     := 4 + Length(DirPath);
  558.     SubF    := $13;
  559.     Handle  := DirHandle;
  560.     Letter  := UpCase(DriveLetter);
  561.     PName   := DirPath;
  562.   end;
  563.   with NovRegs do begin
  564.     AX := $E200;
  565.     DS := Seg(Req);
  566.     SI := Ofs(Req);
  567.     ES := Seg(Reply);
  568.     DI := Ofs(Reply);
  569.     MsDos(NovRegs);
  570.     AllocTempDirHandle := AL;
  571.   end;
  572.   with Reply do begin
  573.     NewHandle := NewH;
  574.     Rights    := Mask;
  575.   end;
  576. end;
  577.  
  578. function DeallocDirHandle(DirHandle : Byte) : Byte;
  579. { This function deletes a directory handle }
  580. { return byte:
  581.   00h  - Success
  582.   9Bh  - Bad directory handle
  583. }
  584. var
  585.   Reply            : Word;
  586.   Req              : record
  587.                        Len    : Word;
  588.                        SubF   : Byte;
  589.                        DH     : Byte;
  590.                      end;
  591.  
  592. begin
  593.   Reply := 0;
  594.   with Req do begin
  595.     Len   := 2;
  596.     SubF  := $14;
  597.     DH    := DirHandle;
  598.   end;
  599.   with NovRegs do begin
  600.     MsDos(NovRegs);
  601.     DeallocDirHandle := AL;
  602.   end;
  603. end;
  604.  
  605. function ClearConnectionNumber(ConnNo : Byte) : Byte;
  606. { Clears a logical connection from the file server }
  607. { must have supervisor equivelent security rights  }
  608.  
  609. var
  610.   Reply            : Word;
  611.   Req              : Record
  612.                        Len   : Word;
  613.                        SubF  : Byte;
  614.                        Conn  : Byte;
  615.                      end;
  616.  
  617. begin
  618.   Reply := 0;
  619.   with Req do begin
  620.     Len   := 2;
  621.     SubF  := $D2;
  622.     Conn  := ConnNo;
  623.   end;
  624.   with NovRegs do begin
  625.     AX := $E300;
  626.     DS := Seg(Req);
  627.     SI := Ofs(Req);
  628.     ES := Seg(Reply);
  629.     DI := Ofs(Reply);
  630.     MsDos(NovRegs);
  631.     ClearConnectionNumber := AL;
  632.   end;
  633. end;
  634.  
  635. end. { of Unit NetCraft }
  636.  
  637.