[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]
{$R+,V-}
{ This program will prompt for a server, login id and password. All }
{ input will be echoed to the screen! }
PROGRAM LOGON;
USES
Dos,
Crt;
CONST
NET_USER = 1;
USER_GROUP = 2;
FILE_SERVER = 4;
MaxServers = 8;
DriveHandleTable = 0;
DriveFlagTable = 1;
DriveServerTable = 2;
ServerMapTable = 3;
ServerNameTable = 4;
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 [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);
TYPE
WORD = INTEGER;
NetStr = STRING[47];
GenStr = STRING[128];
FourBytes = ARRAY [1..4] of BYTE;
MemBlock = ARRAY [1..128] OF CHAR;
{ RegsType = RECORD case integer of
1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);
2: (AL, AH, BL, BH, CL, CH, DL, DH : BYTE);
END; }
ServerItem = ARRAY [1..48] OF CHAR;
ServerName = ARRAY[1..MaxServers] OF ServerItem;
ServerNamePtr = ^ServerName;
ServerMappingEntry = RECORD
SlotInUse : BYTE;
OrderNumber : BYTE;
ServerNet : ARRAY [1..10] OF CHAR;
ServerSocket : WORD;
RouterNet : ARRAY [1..10] OF CHAR;
RouterSocket : WORD;
ShellInternal : ARRAY [1..6] OF CHAR;
END;
ServerMappingTable = ARRAY [1..MaxServers] OF ServerMappingEntry;
ServerMappingPtr = ^ServerMappingTable;
VAR
rc : BYTE;
Regs : Registers;
{ Regs : RegsType; }
{ -------------------------------------------------------------- }
FUNCTION GetString(VAR NameEntry: ServerItem): GenStr;
VAR tmp: GenStr;
i: INTEGER;
ct: BYTE;
BEGIN
i := 1;
ct := 0;
WHILE NameEntry[i] <> CHR(0) DO
BEGIN
tmp[i] := NameEntry[i];
i := i + 1;
ct := ct + 1;
END;
tmp[0] := CHAR(ct);
GetString := tmp;
END;
PROCEDURE Str2Az(st: GenStr; VAR az; size: INTEGER);
VAR p: ^BYTE;
BEGIN
Fillchar(az, size+1, 0);
p := ADDR(st[1]);
Move(p^, az, size);
END;
PROCEDURE DefaultRegs(VAR r: Registers);
BEGIN
r.DS := DSeg;
r.ES := DSeg;
{ r.AX := 0;
r.BX := 0;
r.CX := 0;
r.DX := 0;
r.BP := 0;
r.SI := 0;
r.DI := 0; }
END;
FUNCTION FileServiceRequest( func: BYTE;
VAR q; qlen: WORD;
VAR reply; rlen: WORD): BYTE;
BEGIN
DefaultRegs(Regs);
Regs.DS := Seg(q);
Regs.SI := Ofs(q);
Regs.CX := qlen;
Regs.ES := Seg(reply);
Regs.DI := Ofs(reply);
Regs.DX := rlen;
Regs.AH := $F2;
Regs.AL := func;
MSDOS(Regs);
FileServiceRequest := Regs.AL;
END;
FUNCTION CallNetware(RegAH : BYTE; VAR request, reply): BYTE;
BEGIN
DefaultRegs(Regs);
Regs.AH := RegAH;
Regs.DS := Seg(request);
Regs.SI := Ofs(request);
Regs.ES := Seg(reply);
Regs.DI := Ofs(reply);
MSDOS(Regs);
CallNetware := Regs.AL;
END;
PROCEDURE UpcaseStr(VAR s: GenStr);
VAR i : INTEGER;
BEGIN
for i := 1 to Length(s) do
Begin
s[i] := UpCase(s[i]);
End;
END;
FUNCTION GetServerMappingPtr : ServerMappingPtr;
VAR TmpPtr: ServerMappingPtr;
BEGIN
DefaultRegs(Regs);
Regs.AX := $EF03;
MSDOS(Regs);
TmpPtr := Ptr(Regs.ES, Regs.SI);
GetServerMappingPtr := TmpPtr;
END;
FUNCTION GetServerNamePtr : ServerNamePtr;
VAR TmpPtr: ServerNamePtr;
BEGIN
DefaultRegs(Regs);
Regs.AX := $EF04;
MSDOS(Regs);
TmpPtr := Ptr(Regs.ES, Regs.SI);
GetServerNamePtr := TmpPtr;
END;
FUNCTION GetServerNumber(s: NetStr): BYTE;
VAR
t : ServerNamePtr;
m : ServerMappingPtr;
i : INTEGER;
BEGIN
m := GetServerMappingPtr;
t := GetServerNamePtr;
UpCaseStr(s);
FOR i:=1 TO MaxServers DO BEGIN
IF (m^[i].SlotInUse = $FF) AND (GetString(t^[i]) = s) THEN BEGIN
GetServerNumber := i;
Exit;
END;
END;
GetServerNumber := 0;
END;
FUNCTION ReadPropertyValue(ObjectType : WORD; ObjectName : NetStr;
Segnr : BYTE; Property : NetStr;
VAR item): BYTE;
VAR
req : RECORD
plen : WORD;
func : BYTE;
otype : WORD;
Filler : GenStr;
END;
rep : RECORD
plen : WORD;
Data : ARRAY [1..128] OF BYTE;
More : BYTE;
PropFlags : BYTE;
END;
BEGIN
req.func := 61;
req.otype := Swap(ObjectType);
req.plen := Length(ObjectName) +
Length(Property) + 6;
req.filler := ObjectName + Char(Segnr) +
Char(Length(Property)) +
Property;
req.filler[0] := Char(Length(ObjectName));
rep.plen := SizeOf(rep) - 2;
ReadPropertyValue := CallNetware($E3,req,rep);
Move(rep.data, item, SizeOf(rep.data) + 2);
END;
FUNCTION InsertServer(Name : NetStr):BYTE;
VAR
MapPtr : ServerMappingPtr;
NamePtr : ServerNamePtr;
res : BYTE;
free,i : INTEGER;
data : ARRAY [1..130] OF BYTE;
FUNCTION LowerAddr(VAR a, b): BOOLEAN;
TYPE
Net_Address = ARRAY [1..10] OF CHAR;
VAR
a_addr : Net_Address ABSOLUTE a;
b_addr : Net_Address ABSOLUTE b;
BEGIN
LowerAddr := a_addr < b_addr;
END;
BEGIN
UpCaseStr(Name);
IF GetServerNumber(Name) <> 0 THEN BEGIN
InsertServer := 0;
Exit;
END;
res := ReadPropertyValue(FILE_SERVER, name, 1, 'NET_ADDRESS', data);
IF res <> 0 THEN BEGIN
InsertServer := $7D;
Exit;
END;
MapPtr := GetServerMappingPtr;
free := 1;
WHILE (MapPtr^[free].SlotInUse = $FF) DO BEGIN
free := free + 1;
IF free > MaxServers THEN BEGIN
InsertServer := $7C;
Exit;
END;
END;
NamePtr := GetServerNamePtr;
WITH MapPtr^[free] DO BEGIN
Move(data, ServerNet, 12);
Str2Az(name, NamePtr^[free], SizeOf(NamePtr^[free]));
OrderNumber := 1;
FOR i := 1 TO MaxServers DO BEGIN
IF MapPtr^[i].SlotInUse = $FF THEN BEGIN
IF LowerAddr(MapPtr^[i].ServerNet, ServerNet) THEN
OrderNumber := OrderNumber + 1
ELSE
MapPtr^[i].OrderNumber := MapPtr^[i].OrderNumber + 1;
END;
END;
SlotInUse := $FF;
END;
InsertServer := 0;
END;
FUNCTION AttachServerNumber(func : BYTE; sn : BYTE) : BYTE;
BEGIN
DefaultRegs(Regs);
Regs.ah := $F1;
Regs.al := func;
Regs.dl := sn;
MSDOS(Regs);
AttachServerNumber := Regs.al;
END;
FUNCTION AttachServer(func : BYTE; name : NetStr) : BYTE;
VAR
sn : BYTE;
BEGIN
sn := GetServerNumber(name);
IF sn = 0 THEN BEGIN
AttachServer := $7B;
Exit;
END;
AttachServer := AttachServerNumber(func,sn);
END;
FUNCTION GetEffectiveServer:BYTE;
BEGIN
DefaultRegs(Regs);
Regs.ax := $F002;
MSDOS(Regs);
GetEffectiveServer := Regs.al;
END;
PROCEDURE SetPrimaryServer(sno:BYTE);
BEGIN
DefaultRegs(Regs);
Regs.ax := $F004;
Regs.dl := sno;
MSDOS(Regs);
END;
FUNCTION GetPrimaryServer:BYTE;
BEGIN
DefaultRegs(Regs);
Regs.ax := $F005;
MSDOS(Regs);
GetPrimaryServer := Regs.al;
END;
FUNCTION SetPreferredServer(sno: BYTE): BYTE;
BEGIN
DefaultRegs(Regs);
Regs.ax := $F000;
Regs.dl := sno;
MSDOS(Regs);
Regs.ax := $F001;
MSDOS(Regs);
SetPreferredServer := Regs.AL;
END;
FUNCTION MapNameToNumber(ObjectType : WORD;ObjectName : NetStr;
VAR ObjectID : FourBytes): BYTE;
VAR
req : RECORD
plen : WORD;
func : BYTE;
otype : WORD;
name : NetStr;
END;
rep : RECORD
plen : WORD;
objID : FourBytes;
otype : WORD;
name : ARRAY [1..48] OF CHAR;
END;
BEGIN
req.func := 53; {Get an object's number}
req.otype := Swap(ObjectType);
req.name := ObjectName;
req.plen := Length(ObjectName) + 4;
rep.plen := SizeOf(rep) - 2;
MapNameToNumber := CallNetware($E3, req, rep);
ObjectID := rep.objID;
END;
FUNCTION MapNumberToName(ID : FourBytes; VAR Name; VAR Otype : WORD):BYTE;
VAR
req : RECORD
plen : WORD;
func : BYTE;
OID : FourBytes;
END;
rep : RECORD
plen : WORD;
OID : FourBytes;
otyp : WORD;
Oname : ServerItem;
END;
nam : NetStr ABSOLUTE Name;
BEGIN
req.func := 54; {Get an object's name}
req.OID := ID;
req.plen := SizeOf(req) - 2;
rep.plen := SizeOf(rep) - 2;
MapNumberToName := CallNetware($E3,req,rep);
Nam := GetString(rep.OName);
Otype:= Swap(rep.Otyp);
END;
FUNCTION LoginAnObject( Name:NetStr; Otype:WORD; Passw: NetStr):BYTE;
VAR
req : RECORD
plen : WORD;
func : BYTE;
otype : WORD;
NamePass : STRING[96];
END;
rep : RECORD
plen : WORD;
END;
BEGIN
req.plen := 5 + Length(Name) + Length(Passw);
req.func := 20;
UpCaseStr(Passw);
UpCaseStr(Name);
req.otype := Swap(otype);
req.NamePass:=Name;
Move(Passw, req.NamePass[Length(Name)+1], Length(Passw) + 1);
rep.plen := 0;
LoginAnObject := CallNetware($E3, req, rep);
END;
FUNCTION LoginUser(Name, Password: NetStr): BYTE;
VAR
req : RECORD
plen : INTEGER;
func : BYTE;
NamePass : STRING[96];
END;
rep : RECORD
plen : INTEGER;
END;
BEGIN
req.plen := 3 + Length(Name) + Length(Password);
req.func := 0;
UpcaseStr(Password);
UpcaseStr(Name);
req.NamePass := Name;
Move(Password, req.NamePass[Length(Name)+1], Length(Password)+1);
rep.plen := 0;
LoginUser := CallNetware($E3, req, rep);
END;
FUNCTION GetEncryptionKey(VAR key : Buf8): BYTE;
VAR
q : RECORD
plen : WORD;
func : BYTE;
END;
BEGIN
q.plen := 1;
q.func := $17;
GetEncryptionKey := FileServiceRequest($17, q, SizeOf(q), key, SizeOf(key));
END;
FUNCTION LoginEncrypted(name : NetStr; otype : WORD; VAR key : Buf8): BYTE;
VAR
a : RECORD
plen : WORD;
func : BYTE;
key : Buf8;
otyp : WORD;
name : NetStr;
END;
BEGIN
a.plen := Length(name) + 12;
a.func := $18;
a.key := key;
a.otyp := Swap(otype);
a.name := name;
LoginEncrypted := FileServiceRequest($17, a, Length(name)+14, Mem[0:0], 0);
END;
PROCEDURE Shuffle1(VAR temp : Buf32; VAR target);
VAR
t : Buf16 ABSOLUTE target;
b4 : WORD;
b3 : BYTE;
s, d, b2, i : WORD;
BEGIN
b4 := 0;
FOR b2 := 0 TO 1 DO BEGIN
FOR s := 0 TO 31 DO BEGIN
b3 := Lo(Lo(temp[s] + b4)
XOR Lo(temp[(s + b4) AND 31]
- EncryptKeys[s]));
b4 := b4 + b3;
temp[s] := b3;
END;
END;
FOR i := 0 TO 15 DO
t[i] := EncryptTable[temp[i Shl 1]]
OR (EncryptTable[temp[i Shl 1 +1]] Shl 4);
END;
PROCEDURE Shuffle(VAR lon, buf; buflen : WORD; VAR target);
VAR
l : Buf4 ABSOLUTE lon;
b : ARRAY [0..127] OF BYTE ABSOLUTE buf;
b2 : WORD;
temp : Buf32;
s, d : WORD;
BEGIN
IF buflen > 0 THEN
WHILE (buflen > 0) AND (b[buflen-1] = 0) DO
buflen := buflen - 1;
FillChar(temp, SizeOf(temp), #0);
d := 0;
WHILE buflen >= 32 DO BEGIN
FOR s := 0 TO 31 DO BEGIN
temp[s] := temp[s] XOR b[d];
d := d + 1;
END;
buflen := buflen - 32;
END;
b2 := d;
IF buflen > 0 THEN BEGIN
FOR s := 0 TO 31 DO BEGIN
IF d + buflen = b2 THEN BEGIN
b2 := d;
temp[s] := temp[s] XOR EncryptKeys[s];
END
ELSE BEGIN
temp[s] := temp[s] XOR b[b2];
b2 := b2 + 1;
END;
END;
END;
FOR s := 0 TO 31 DO
temp[s] := temp[s] XOR l[s AND 3];
Shuffle1(temp, target);
END;
PROCEDURE Encrypt(VAR fra, buf, til);
VAR
f : Buf8 ABSOLUTE fra;
t : Buf8 ABSOLUTE til;
k : Buf32;
s : WORD;
BEGIN
Shuffle(f[0], buf, 16, k[0]);
Shuffle(f[4], buf, 16, k[16]);
FOR s := 0 TO 15 DO
k[s] := k[s] XOR k[31-s];
FOR s := 0 TO 7 DO
t[s] := k[s] XOR k[15-s];
END;
FUNCTION LoginToFileServer(name: NetStr; otype: WORD; passw: GenStr): BYTE;
VAR
key : Buf8;
id : FourBytes;
buf : Buf32;
res : BYTE;
BEGIN
UpCaseStr(passw);
res := GetEncryptionKey(key);
IF res = 0 THEN BEGIN
res := MapNameToNumber(otype, name, id);
IF res = 0 THEN BEGIN
Shuffle(id, passw[1], Length(passw), buf);
Encrypt(key, buf, key);
res := LoginEncrypted(name, otype, key);
END;
END
ELSE BEGIN
res := LoginAnObject(name, otype, passw);
END;
LoginToFileServer := res;
END;
FUNCTION Login(Sname, OName : NetStr; OType : WORD; Passw : NetStr) : BYTE;
VAR
sn, res, rc : BYTE;
Curr_Server : BYTE;
BEGIN
UpCaseStr(SName);
sn := GetServerNumber(Sname);
IF sn = 0 THEN BEGIN
res := InsertServer(SName);
IF res <> 0 THEN BEGIN
Login := res;
Exit;
END;
sn := GetServerNumber(SName);
END;
res := AttachServerNumber(0, sn);
IF res <> 0 THEN BEGIN
Login := res;
Exit;
END;
Curr_Server := GetEffectiveServer;
IF SetPreferredServer(sn) = sn THEN
rc := LoginToFileServer(OName, Otype, Passw)
ELSE
rc := $7A;
res := SetPreferredServer(Curr_Server);
Login := rc;
END;
BEGIN
IF ParamCount <> 3 THEN BEGIN
Writeln('Please supply server name, your user id, and a password.');
Exit;
END;
rc := Login(ParamStr(1), ParamStr(2), NET_USER, ParamStr(3));
IF rc <> 0 THEN BEGIN
Writeln('Login failed.');
Exit;
END;
END.
[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]