home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
NWTP04
/
NWMISC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-01
|
24KB
|
712 lines
{$X+,B-,V-}
UNIT NWMISC;
{ nwMisc unit as of 931228 / NwTP 0.4 API. (c) 1994, R.Spronk }
INTERFACE
{ This unit consists of three parts:
1.It contains some functions that perform startup checks:
IsShellLoaded ( moved to unit nwBindry )
IsUserLoggedOn ( moved to unit nwBindry )
IsV3Supported
2...,some level 0 support functions, used by the other NW units:
UpString
HexString
PStrCopy
ZStrCopy
LoNibble
HiNibble
Lswap
HiLong
LowLong
MakeLong
GetNWversion
NovTimeRec2String
EncryptPassword
3...and types and constants used by more than one NW unit:
Type
NovTimeRec
TconnectionList
TencryptionKey
TnetworkAdress
Tnodeadress
TinternetworkAddress
Const
<error numbers>
}
Type NovTimeRec=record
year,month,day,hour,min,sec,DayOfWeek:byte; { 0=sunday }
end;
TconnectionList=array[1..250] of byte;
TencryptionKey=array[0..7] of byte;
TnetworkAddress=array[1..4] of byte; { hi-endian }
TnodeAddress =array[1..6] of byte; { Hi-endian }
TinterNetworkAdress=record
net :TnetworkAddress; {hi-lo}
node :Tnodeaddress; {hi-lo}
socket:word; {lo-hi}
end;
Function IsV3Supported:Boolean;
Procedure NovTimeRec2String(tim:NovTimeRec;Var DateStr:string);
{ Puts the time/date information of a NovTimeRec into a string.
output format: 'DOW, dd mmm yyyy hh:mm:ss' DOW= day of the week. }
{============================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;
{ Coverts dw into a hex-string of length len }
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;source:array of byte;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. }
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;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 }
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_ATTEMT_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{=============================================================}
Uses dos;
Procedure EncryptPassword(objId:longint;password:string;Var Ekey:TencryptionKey);
{ called by LoginTo3Xserver }
{ Source of the encryption routine: LOGON.PAS by Barry Nance, [1:141/209]
BYTE March'93 }
TYPE
Buf32 = ARRAY [0..31] OF Byte;
Buf16 = ARRAY [0..15] OF Byte;
Buf4 = ARRAY [0..3] OF Byte;
CONST
EncryptTable : ARRAY [Byte] 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 : Buf32 =
($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);
Var buf:buf32;
TobjId:Longint;
Tpassword:string;
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;
PROCEDURE Shuffle(VAR ShuffleKey, buf; buflen : Word; VAR target);
{ id, password[1.. ],length(passw), OUT: buf }
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 een 32-voud, lengte password was: IndexOfBufBytes + buflen }
{ temp gevuld met XOR folding van de eerste IndexOfBufBytes bytes. }
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 encrypted login name/id within 'buf'.
Result: the Password to login with (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;
begin
TobjId:=objId;
Tpassword:=password;
Shuffle(TObjId,Tpassword[1],length(password),buf);
Encrypt(Ekey,buf,Ekey);
end;
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;
{$IFDEF newcalls}
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. }
begin
FillChar(dest[1],len,#0);
move(source[1],dest[1],ord(source[0]));
dest[0]:=chr(len);
end;
procedure ZStrCopy(Var dest:String;source:array of byte;len:byte);
{ 1. Copies len bytes from 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. }
begin
Move(source,dest[1],len);
while (dest[len]=#0) and (len>0) do dec(len);
dest[0]:=chr(len);
end;
{$ENDIF}
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 ZStrCopy(dest:String;source:array of byte;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 { fast save current DS }
les di,dest
lds si,source
xor ah,ah { ah:=0 }
mov al,len
mov es:[di],al { dest[0]:=len }
inc di { es:di => dest[1] ; ds:si => source[0] }
mov cx,ax
cld
rep movsb
{ begin DeleteTrailingNulls }
les di,dest
xor bh,bh
mov bl,len
@rep:
mov al,es: [di] [bx]
and al,al
jne @cont
dec bl
jne @rep
@cont:
mov es:[di],bl { set length of dest string }
{ end DeleteTrailingNulls }
mov ds,dx { restore DS }
end;
Procedure NovTimeRec2String(tim:NovTimeRec;Var DateStr:string);
CONST day:array[0..6] of string[3]
=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
Month:array[1..12] of string[3]
=('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
Type string4=string[4];
Var sday,syear,shour,smin,ssec:string4;
Procedure zstr(n:byte;Var s:string4);
begin
str(n,s);
if s[0]=#1 then s:='0'+s;
end;
begin
if (tim.month>12) or (tim.month<1)
or (tim.day<1) or (tim.day>31)
or (tim.hour>23) or (tim.min>59) or (tim.sec>59)
then DateStr:='<invalid date & time> '
else begin
zstr(tim.day,sday);
if sday[1]='0' then sday[1]:=' ';
if tim.year<80 then str(tim.year+2000,syear)
else str(tim.year+1900,syear);
zstr(tim.hour,shour);
zstr(tim.min,smin);
zstr(tim.sec,ssec);
DateStr:=day[tim.DayOfWeek]+', '+
sday+' '+Month[tim.month]+' '+syear+' '+
shour+':'+smin+':'+ssec;
end;
end;
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;
Procedure GetNWversion(Var version:word);
{ determine the version of the software installed on the current file server. }
{ see GetServerInformation 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: 100 (advanced netware 1.00) and upwards }
{ note: you don't have to be logged in to call this function. }
Var Reg : Registers;
RequestBuffer : Record
PacketLength : Word;
FunctionVal : Byte;
End;
ReplyBuffer:array[1..$80] of byte;
ReplyLength:word ABSOLUTE ReplyBuffer; { not needed for F2 call }
Begin
With RequestBuffer
Do Begin
PacketLength := 1; FunctionVal := $11;
End;
With reg
do begin
ax := $f217;
ds:=SEG(requestBuffer); si := OFs(requestBuffer);
cx:=sizeOf(requestBuffer);
es:=SEG(replyBuffer); di := OFs(replyBuffer);
dx:=sizeOf(replyBuffer);
MsDos(reg);
end;
If reg.AL=0
then version:=(ReplyBuffer[49]*100)+ReplyBuffer[50]
else begin { If F217/11 failed, try old E3../11 call }
ReplyLength := $80;
With Reg
Do Begin
Ah := $e3;
Ds := Seg(RequestBuffer); Si := Ofs(RequestBuffer);
Es := Seg(ReplyBuffer); Di := Ofs(ReplyBuffer);
End;
MsDos(Reg);
if reg.AL<>0
then version:=$00
else version:=(ReplyBuffer[51]*100)+ReplyBuffer[52];
end;
End;
Function IsV3Supported:boolean;
Var version:word;
begin
GetNWversion(version);
IsV3Supported:=(version>=300);
end;
END.