home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lan
/
netcraft
/
netcraft.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-06-10
|
17KB
|
637 lines
{*********************************************************************
NETCraft - A unit of NetWare Application Program Interfaces
for Turbo Pascal 4.0 and Advanced NetWare (any verison)
Copyright (C) 1988, Richard S. Sadowsky
All rights reserved
version .8 6/10/88 by Richard S. Sadowsky
**********************************************************************}
Unit NetCraft;
{$I-,V-,S+,R+}
interface
uses DOS;
const
_SHAREABLE = $80;
{ Effective Rights constants represent bit in Mask }
_READ = $01;
_WRITE = $02;
_OPEN = $04;
_CREATE = $08;
_DELETE = $10;
_PARENTAL = $20;
_SEARCH = $40;
_MODIFY = $80;
{ status byte }
_PERMENANT = $01;
_TEMPORARY = $02;
_LOCAL = $80;
{gerneral error codes }
_SUCCESS = $00;
type
Str9 = String[9];
Str10 = String[10];
Str20 = String[20];
Str80 = String[80];
PhysicalNodeAddress
= array[1..6] of Byte;
var
NovRegs : Registers; { register type for DOS/Novell calls }
function GetExtFAttr(var Path : String; var Attributes : Byte) : Byte;
{
Meaning of Attributes:
7 6 5 4 3 2 1 0
| | | | | | |
| | | | +---+---+------Search mode [210]
| | | +----------------------transactional bit [4]
| | +--------------------------Indexing bit [5]
| +------------------------------Read Audit bit [6]
+----------------------------------Write Audit bit [7]
Function returns error code:
0 - Success
2 - File not found
18 - No more files (requesting workstation does not have search
rights)
}
function SetExtFAttr(var PathName : Str80; Attr : Byte) : Byte;
{
See GetExtFAttr for meaning of Attr the Attribute
Function returns error code:
0 - Success
2 - File not found
5 - Access denied
}
function FileIsSharable(Path : String; var FAttr : Word; var ErrCode : Word)
: Boolean;
{ Return TRUE if ifle is flagged as shareable, return file attrib in FAttr }
function MakeFileSharable(Path : String) : Word;
function ConsolePriv : Boolean;
function GetConnNo : Byte;
{ returns connection number of requesting WS (1..100) }
function ServerConnNo: Byte;
{ returns connection number of default file server (1..8) }
procedure EndOfJob(All : 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
}
function GetDirHandle(Drive : Char; var StatusFlags : Byte) : Byte;
{ returns directory handle and status flags for a drive }
{ return byte:
00 - Invalid Drive Number
otherwise returned directory handle
Status Byte
7 6 5 4 3 2 1 0
| | +-Permenant Directory Handle
| +----Temporary Directory Handle
+----------------------Mapped to a local drive
}
function GetDirPath(DirHandle : Byte; var DirPath : String) : Byte;
{ returns directory path of a directory handle }
{ return byte
00h - Success
9Bh - Bad Directory Handle
}
function GetDirRights(DirHandle : Byte; PathName : String;
var Rights : Byte) : Byte;
{ returns the requesting workstation's effective directory rights }
{ return byte
00h - Success
98h - Volume Does Not Exist
9Bh - Bad Directory Handle
Rights
7 6 5 4 3 2 1 0
| | | | | | | +--Read bit (file reads allowed)
| | | | | | +-----Write bit (file writes allowed)
| | | | | +--------Open bit (files can be opened)
| | | | +-----------Create bit (files can be created)
| | | +--------------Delete bit (files may be deleted)
| | +-----------------Parental bit (subdirs may be created/deleted
| | and trustee rights granted/revoked)
| +--------------------Search bit (directory may be searched)
+-----------------------Modify bit (file status bits can be modified)
}
function IsLockModeExtended : Boolean;
{
returns TRUE if using Advanced NetWare Extended Lock Mode, if FALSE,
then in compatability mode (for compat with NetWare 4.61 and prior).
}
function AllocPermDirHandle(DirHandle : Byte; DriveLetter : Char;
DirPath : String;
var NewHandle,Rights : Byte) : Byte;
{ Allocates a permament directory handle, not deleted automatically by EOJ.
return byte:
00h - Success
98h - Volume does not exist
9Ch - Invalid Path
}
function AllocTempDirHandle(DirHandle : Byte; DriveLetter : Char;
DirPath : String;
var NewHandle,Rights : Byte) : Byte;
{ Allocates a temporary directory handle, deleted automatically by EOJ.
return byte:
00h - Success
98h - Volume does not exist
9Ch - Invalid Path
}
function DeallocDirHandle(DirHandle : Byte) : Byte;
{ This function deletes a directory handle }
{ return byte:
00h - Success
9Bh - Bad directory handle
}
function ClearConnectionNumber(ConnNo : Byte) : Byte;
{ Clears a logical connection from the file server }
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 function 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 }
implementation
function FileIsSharable(Path : String; var FAttr : Word; var ErrCode : Word)
: Boolean;
{ Return TRUE if ifle is flagged as shareable, return file attrib in FAttr }
var
F : File;
begin
Assign(F,Path);
GetFAttr(F,FAttr);
ErrCode := DOSError;
FileIsSharable := (FAttr and _SHAREABLE) <> 0 { see if SHARE }
{ bit set. }
end;
function MakeFileSharable(Path : String) : Word;
var
F : File;
Attr : Word;
ErrCode : Word;
Share : Boolean;
begin
Share := FileIsSharable(Path,Attr,ErrCode); { is it sharable? }
if (ErrCode = 0) and (not Share) then begin
Assign(F,Path);
SetFAttr(F,Attr or _SHAREABLE); { OR existing at with SHARE bit }
ErrCode := DOSError;
end;
MakeFileSharable := ErrCode;
end;
function SetExtFAttr(var PathName : Str80; Attr : Byte) : Byte;
{
See GetExtFAttr for meaning of Attr the Attribute
Function returns error code:
0 - Success
2 - File not found
5 - Access denied
}
begin
with NovRegs do begin
AX := $B601;
PathName := PathName + #0;
DS := Seg(PathName[1]);
DX := Ofs(PathName[1]);
CL := Attr;
MsDos(NovRegs);
if Flags and FCarry <> 0 then
SetExtFAttr := AL
else
SetExtFAttr := 0;
end;
end;
function GetExtFAttr(var Path : String; var Attributes : Byte) : Byte;
{
Meaning of Attributes:
7 6 5 4 3 2 1 0
| | | | | | |
| | | | +---+---+------Search mode [210]
| | | +----------------------transactional bit [4]
| | +--------------------------Indexing bit [5]
| +------------------------------Read Audit bit [6]
+----------------------------------Write Audit bit [7]
Function returns error code:
0 - Success
2 - File not found
18 - No more files (requesting workstation does not have search
rights)
}
begin
with NovRegs do begin
AX := $B600;
Path[Succ(Length(Path))] := #0; { null terminate string }
DS := Seg(Path[1]); { skip length byte for AsciiZ string }
DX := Ofs(Path[1]);
MsDos(NovRegs);
GetExtFAttr := AL;
Attributes := CL;
end;
end;
procedure EndOfJob(All : 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
}
begin
with NovRegs do begin
AX := $D600;
if All then
BX := $FFFF
else
BX := $00;
end;
MsDos(NovRegs);
end;
function GetConnNo : Byte;
{ returns connection number of requesting WS (1..100) }
begin
with NovRegs do
AX := $DC00;
MsDos(NovRegs);
GetConnNo := NovRegs.AL
end;
function ServerConnNo : Byte;
{ returns connection number of default file server (1..8) }
begin
with NovRegs do
AX := $F005;
MsDos(NovRegs);
ServerConnNo := NovRegs.AL
end;
function ConsolePriv : Boolean;
var
Reply : Word;
Request : record
Len : Word;
SubF : Byte;
end;
begin
Reply := 0;
with Request do begin
Len := 1;
SubF := $C8;
end;
with NovRegs do begin
AX := $E300;
DS := Seg(Request);
SI := Ofs(Request);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
ConsolePriv := AL <> $C6;
end;
end;
function GetDirHandle(Drive : Char; var StatusFlags : Byte) : Byte;
{ returns directory handle and status flags for a drive }
{ return byte:
00 - Invalid Drive Number
otherwise returned directory handle
Status Byte
7 6 5 4 3 2 1 0
| | +-Permenant Directory Handle
| +----Temporary Directory Handle
+----------------------Mapped to a local drive
}
var
NovRegs : Registers; { register type for DOS/Novell calls }
begin
with NovRegs do begin
AX := $E900;
DX := Ord(UpCase(Drive)) - Ord('A');
MsDos(NovRegs);
GetDirHandle := AL;
StatusFlags := AH;
end
end;
function GetDirPath(DirHandle : Byte; var DirPath : String) : Byte;
{ returns directory path of a directory handle }
{ return byte
00h - Success
9Bh - Bad Directory Handle
}
var
Reply : record
Len : Word;
Name : String;
end;
Request : record
Len : Word;
SubF : Byte;
Handle : Byte;
end;
begin
Reply.Len := 256;
with Request do begin
Len := 2;
SubF := $01;
Handle := DirHandle;
end;
with NovRegs do begin
AX := $E200;
DS := Seg(Request);
SI := Ofs(Request);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
GetDirPath := AL;
end;
with Reply do
DirPath := Name;
end;
function GetDirRights(DirHandle : Byte; PathName : String;
var Rights : Byte) : Byte;
{ returns the requesting workstation's effective directory rights }
{ return byte
00h - Success
98h - Volume Does Not Exist
9Bh - Bad Directory Handle
Rights
7 6 5 4 3 2 1 0
| | | | | | | +--Read bit (file reads allowed)
| | | | | | +-----Write bit (file writes allowed)
| | | | | +--------Open bit (files can be opened)
| | | | +-----------Create bit (files can be created)
| | | +--------------Delete bit (files may be deleted)
| | +-----------------Parental bit (subdirs may be created/deleted
| | and trustee rights granted/revoked)
| +--------------------Search bit (directory may be searched)
+-----------------------Modify bit (file status bits can be modified)
}
var
Reply : record
Len : Word;
Mask : Byte;
end;
Request : record
Len : Word;
SubF : Byte;
Handle : Byte;
Name : String;
end;
begin
Reply.Len := 1;
with Request do begin
Len := 3 + Length(PathName);
SubF := $03;
Handle := DirHandle;
Name := PathName;
end;
with NovRegs do begin
AX := $E200;
DS := Seg(Request);
SI := Ofs(Request);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
GetDirRights := AL;
end;
with Reply do
Rights := Mask;
end;
function IsLockModeExtended : Boolean;
{
returns TRUE if using Advanced NetWare Extended Lock Mode, if FALSE,
then in compatability mode (for compat with NetWare 4.61 and prior).
}
begin
with NovRegs do begin
AX := $C602;
MsDos(NovRegs);
IsLockModeExtended := AL = 1;
end;
end;
function AllocPermDirHandle(DirHandle : Byte; DriveLetter : Char;
DirPath : String;
var NewHandle,Rights : Byte) : Byte;
{ Allocates a permament directory handle, not deleted automatically by EOJ.
return byte:
00h - Success
98h - Volume does not exist
9Ch - Invalid Path
}
var
Req : record
Len : Word;
SubF : Byte;
Handle : Byte;
Letter : Char;
PName : String;
end;
Reply : record
Len : Word;
NewH : Byte;
Mask : Byte;
end;
begin
Reply.Len := 2;
with Req do begin
Len := 4 + Length(DirPath);
SubF := $12;
Handle := DirHandle;
Letter := UpCase(DriveLetter);
PName := DirPath;
end;
with NovRegs do begin
AX := $E200;
DS := Seg(Req);
SI := Ofs(Req);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
AllocPermDirHandle := AL;
end;
with Reply do begin
NewHandle := NewH;
Rights := Mask;
end;
end;
function AllocTempDirHandle(DirHandle : Byte; DriveLetter : Char;
DirPath : String;
var NewHandle,Rights : Byte) : Byte;
{ Allocates a temporary directory handle, deleted automatically by EOJ.
return byte:
00h - Success
98h - Volume does not exist
9Ch - Invalid Path
}
var
Req : record
Len : Word;
SubF : Byte;
Handle : Byte;
Letter : Char;
PName : String;
end;
Reply : record
Len : Word;
NewH : Byte;
Mask : Byte;
end;
begin
Reply.Len := 2;
with Req do begin
Len := 4 + Length(DirPath);
SubF := $13;
Handle := DirHandle;
Letter := UpCase(DriveLetter);
PName := DirPath;
end;
with NovRegs do begin
AX := $E200;
DS := Seg(Req);
SI := Ofs(Req);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
AllocTempDirHandle := AL;
end;
with Reply do begin
NewHandle := NewH;
Rights := Mask;
end;
end;
function DeallocDirHandle(DirHandle : Byte) : Byte;
{ This function deletes a directory handle }
{ return byte:
00h - Success
9Bh - Bad directory handle
}
var
Reply : Word;
Req : record
Len : Word;
SubF : Byte;
DH : Byte;
end;
begin
Reply := 0;
with Req do begin
Len := 2;
SubF := $14;
DH := DirHandle;
end;
with NovRegs do begin
MsDos(NovRegs);
DeallocDirHandle := AL;
end;
end;
function ClearConnectionNumber(ConnNo : Byte) : Byte;
{ Clears a logical connection from the file server }
{ must have supervisor equivelent security rights }
var
Reply : Word;
Req : Record
Len : Word;
SubF : Byte;
Conn : Byte;
end;
begin
Reply := 0;
with Req do begin
Len := 2;
SubF := $D2;
Conn := ConnNo;
end;
with NovRegs do begin
AX := $E300;
DS := Seg(Req);
SI := Ofs(Req);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
ClearConnectionNumber := AL;
end;
end;
end. { of Unit NetCraft }