unit NetTpu;

INTERFACE

uses Objects, Dos;

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;
	Str48			= string[48];
	Buffer			= array[1..512] of byte;
	Byte128			= string[127];

const
	GetAllMsg					= 0;
	GetConsoleMsg				= 1;
	RejectAllMsg				= 2;
	PufferingMsg				= 3;
	MaxConnections 				= 255;
	WILD 						= $FFFF;
	MaxServers 					= 8;
	NET_USER					= 1;
	FILE_SERVER					= 4;
	GETSHELLTABLEADDRESS 		= $EF;
	DRIVEHANDLETABLE      		= 0;
	DRIVEFLAGTABLE        		= 1;
	DRIVESERVERTABLE      		= 2;
	PERM  						= $01;
	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
	NetStr 			= string[47];
	GenStr 			= string[128];
	ServerItem 		= array [1..48] of char;
	ServerName 		= array[1..MaxServers] of ServerItem;
	ServerNamePtr 	= ^ServerName;
	PDriveArr		= ^DriveArr;
	DriveArr		= array[1..$8000] of byte;

	FourBytes = array [1..4] of byte;

	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;

	DayOfTheWeek	= (Sunday,Monday,Tuesday,Wednesday,Thursday,
					   Friday,Saturday);
	ConnectionList  = record
		Count : byte;
		List  : Array[1..MaxConnections] of byte;
	end;

	BroadcastStr	= string[80];

	NovDateType		= record
		Year,Month,
		Day,Hour,Minute,
		Second     : Byte;
		WeekDay    : DayOfTheWeek;
		Filler     : Byte;
	end;

	ConnInfoType     = record
		ObjectID   	: LongInt;
		ObjectType 	: Word;
		ObjectName 	: String[48];
		LoginDate  	: NovDateType;
	end;

	PUser 		= ^TUser;
	TUser 		= object(TObject)
		Name		: PString;
		FullName	: PString;
		ConnNo		: word;
		constructor	Init(NewName,NewFullName : String;NewConnNo : word);
		destructor 	Done; virtual;
	end;

	PUserCollection = ^TUserCollection;
	TUserCollection = object(TSortedCollection)
		function 	KeyOf(Item: Pointer): pointer; virtual;
		function 	Compare(Key1, Key2: pointer): Integer; virtual;
	end;

	PNetWare		= ^TNetWare;
	TNetWare		= object(TObject)
		NovRegs 		: registers;
		ServerDriveTable	: PChar;
		ServerDriveHandles	: PChar;
		ServerDriveFlags	: PChar;
		ServerMappTable  	: ServerMappingPtr;
		ServerNameTable 	: ServerNamePtr;
		constructor		Init;
		procedure		SetBroadcastMsg(Mode : byte);
		function		ServerIsAttached(SName : string) : boolean;
		function		GetBroadcastMsg(var Msg : string) : byte;
		function		GetPipeMsg(ConnNo : byte) : string;
		function		SendPipeMsg(ConnNo : byte) : word;
		function		SendMessage(ConnNo : byte;Msg : BroadcastStr) : word;
		function 		GetConnNo : Byte;
		function 		ReadUsers(Users : PUserCollection) : integer;
		function		GetUserId(Name : Str48) : longint;
		function		GetFullName(Name : Str48) : string;
		function		Id2FullName(Id : longint) : string;
		function		Id2Name(Id : longint) : string;
		procedure 		ReadServers(Servers : PStringCollection);
		procedure 		ReadAllUsers(Users : PStringCollection);
		procedure		ReadAllUserWithFullName(Users : PUserCollection);
		procedure		ReadAttachedServers(Servers : PStringCollection);
		function 		LoginAnObject(Name:NetStr; Otype:word; Passw: NetStr):byte;
		function 		SetPreferredServer(SNo: byte): byte;
		function 		SetPrimaryServer(SNo: byte): byte;
		function 		GetEffectiveServer:byte;
		function		SelectNewServer(SName : string) : byte;
		function 		AttachServer(Func : byte; Name : NetStr) : byte;
		function 		AttachServerNumber(Func : byte; SN : byte) : byte;
		function 		InsertServer(Name : NetStr):byte;
		function 		GetServerNumber(S: NetStr): byte;
		function 		GetFirstFreeNetDrive : char;
		function 		SearchObject(OName : Str48;OType : word) : boolean;
		function 		DetachFromFileServer(SName : NetStr) : byte;
		function 		UpcaseStr(S: string) : string;
		function 		NetWareShellInstalled : Boolean;
		function 		NetWareLoaded(var LoggedOn : Boolean) : Boolean;
		procedure 		MapDrive(MappedDrive : char;SName : NetStr);
		procedure 		UnMapDrive(MappedDrive : char);
		function		GetMyServer : string;
		function		GetMyName : string;
		function 		MapServer2Drive(MappedDrive : char;
							SName : NetStr;OName,Passw : string) : byte;
		function 		MapNameToNumber(ObjectType : word;ObjectName : NetStr;
							var ObjectID : FourBytes): byte;
		function 		ReadPropertyValue(ObjectType : word; ObjectName : NetStr;
							Segnr : byte; Property : NetStr;
							var Item): byte;
		procedure 		GetConnInfo(ConnNo : Byte;
							var ConnInfo : ConnInfoType);
		procedure		SendBroadcastMsg(Msg : BroadcastStr;
							var Connect,Result : ConnectionList);
		function 		AttachToFileServer(SName : NetStr;
							OName,Passw : string) : byte;
		function 		LoginToFileServer(Name: NetStr;
							OType: word; Passw: GenStr): byte;
	private
		function 		Detach(SN : byte) : byte;
		function 		GetString(var NameEntry: ServerItem): GenStr;
		procedure 		Str2Az(St: GenStr; var AscZ; Size: integer);
		procedure 		DefaultRegs;
		function 		CallNetware(RegAH : byte; var Request, Reply): byte;
		function 		AsciiZ2Str(var Buffer; Max : Byte) : String;
		procedure 		Encrypt(var FRa, Buff, TIL);
		procedure 		Shuffle(var LOn, Buff; BuffLen : word; var Target);
		procedure 		Shuffle1(var Temp : Buf32; var Target);
		function 		LoginEncrypted(Name : NetStr; OType : word; var Key : Buf8): byte;
		function 		GetEncryptionKey(var Key : Buf8): byte;
		function 		FileServiceRequest( Func : byte;
								var Req; ReqLen : word;
								var Reply; RepLen: word): byte;
		function 		GetLibObj(var Name	: Str48;OType : word;
							LastId : longint) : longint;
		procedure 		GetServerMappingPtr(var TmpPtr: ServerMappingPtr);
		procedure 		GetServerNamePtr(var TmpPtr: ServerNamePtr);
		procedure 		GetServerDriveTable(var TmpPtr : PChar);
		procedure 		GetServerDriveHandles(var TmpPtr : PChar);
		procedure 		GetServerDriveFlags(var TmpPtr : PChar);
	end;

var
	NetWare : PNetWare;

IMPLEMENTATION

function NetWareSwapLong(L : LongInt) : LongInt;
Inline(
	$5A/
	$86/$D6/
	$58/
	$86/$C4
);

{***************************************************************************}
{ TUser }

constructor TUser.Init(NewName,NewFullName : String;NewConnNo : word);
begin
	Name := NewStr(NewName);
	FullName := NewStr(NewFullNAme);
	ConnNo := NewConnNo;
end;

destructor TUser.Done;
begin
	DisposeStr(Name);
	DisposeStr(FullName);
end;

{***************************************************************************}
{ TUserCollection }

function TUserCollection.KeyOf(Item: Pointer): Pointer;
begin
	KeyOf := PUser(Item)^.Name;
end;

function TUserCollection.Compare(Key1, Key2: Pointer): Integer;
begin
	if PString(Key1)^ = PString(Key2)^ then
		Compare := 0
	else if PString(Key1)^ < PString(Key2)^ then
		Compare := -1
	else
		Compare := 1;
end;

{***************************************************************************}
{TNetWare}

procedure TNetWare.SendBroadcastMsg(Msg : BroadcastStr;
						var Connect,Result : ConnectionList);
var
	I,W,L            : Word;
	Reply,Req        : array[1..384] of byte;
begin
	W := SizeOf(Reply) - SizeOf(Word);
	Move(W,Reply,SizeOf(Word));
	I := 1;
	L := Length(Msg);
	W := Connect.Count + L + 3;
	Move(W,Req[I],SizeOf(Word));
	Inc(I,SizeOf(Word));
	Req[I] := $00;
	Inc(I);
	W := Succ(Connect.Count);
	Move(Connect,Req[I],W);
	Inc(I,W);
	W := Succ(L);
	Move(Msg,Req[I],W);
	Inc(I,W);
	CallNetware($E1,Req,Reply);
	Move(Reply[3],Result,SizeOf(Result));
end;

function TNetWare.SendMessage(ConnNo : byte;Msg : BroadcastStr) : word;
var
	Connect,Result	: ConnectionList;
	Num,I			: byte;
	UserName 		: string;
	Idx		 		: integer;
	User     		: PUser;
begin
	with Connect do begin
		List[1] := ConnNo;
		Count := 1;
		SendBroadcastMsg(Msg,Connect,Result);
	end;
	SendMessage := Result.List[1];
end;


function TNetWare.AsciiZ2Str(var Buffer; Max : Byte) : String;
const
	AsciiZMAX        = 255;
type
	AsciiZBuffer     = Array[1..AsciiZMAX] of Char;
var
	A	: AsciiZBuffer absolute Buffer;
	I   : Word;
	S   : String;
begin
	I := 1;
	while (A[I] <> #0) and (I < Max) do begin
		S[I] := A[I];
		Inc(I);
	end;
	S[0] := Char(I-1);
	AsciiZ2Str := S
end;

function TNetWare.GetConnNo : Byte;
begin

  with NovRegs do
	AX := $DC00;
  MsDos(NovRegs);
  GetConnNo := NovRegs.AL
end;

procedure TNetWare.GetConnInfo(ConnNo : Byte; var ConnInfo : ConnInfoType);
var
	Request : record
		Len     : Word;
		SubF    : Byte;
		Conn    : Byte;
	end;
	Reply	: record
		Len     : Word;
		ID      : LongInt;
		ObjType : Word;
		ObjName : Array[1..48] of Char;
		Time    : NovDateType;
	end;
begin
	Reply.Len := SizeOf(Reply) - 2;
	with Request do begin
		Len  := 2;
		SubF := $16;
		Conn := ConnNo;
	end;
	CallNetware($E3,Request,Reply);
	with ConnInfo do begin
		ObjectID   := NetWareSwapLong(Reply.ID);
		ObjectType := Swap(Reply.ObjType);
		ObjectName := AsciiZ2Str(Reply.ObjName,48);
		LoginDate  := Reply.Time;
	end;
end;

function TNetWare.ReadUsers(Users : PUserCollection) : integer;
var
	ConnInfo		: ConnInfoType;
	T				: word;
	Tmp				: string;
	db				: integer;
	MyConnection	: byte;
begin
	MyConnection := GetConnNo;
	db := 0;
	Users^.Duplicates := True;
	for T := 1 to 255 do begin
		GetConnInfo(T,ConnInfo);
		if ((ConnInfo.ObjectName <> '') and (T <> MyConnection) and
			 (ConnInfo.ObjectName <> 'NOT-LOGGED-IN')) then begin
			with ConnInfo do begin
				Users^.Insert(New(PUser, Init(ObjectName,'',T)));
				inc(db);
			end;
		end;
	end;
	ReadUsers := db;
end;

function TNetWare.SearchObject(OName : Str48;OType : word) : boolean;
var
	Req	: record
		Len		: word;
		SFunc     : byte;
		LastId	: longint;
		ObjType	: word;
		Search	: string[48];
	end;

	Repl	: record
		Len		: word;
		ObjId	: longint;
		ObjType	: word;
		ObjName	: string[47];
		Password: byte;
		Security: byte;
		Owner	: byte;
	end;

begin
	Req.SFunc := $37;
	Req.LastId := $FFFFFFFF;
	Req.ObjType := Swap(OType);
	Req.Search := OName;
	Req.Len := 8 + byte(OName[0]);
	FillChar(Repl,SizeOf(Repl),0);
	Repl.Len := SizeOf(Repl) - SizeOf(word);
	SearchObject := CallNetware($E3,Req,Repl) = 0;
end;

function TNetWare.GetLibObj(var Name	: Str48;OType : word;
							LastId : longint) : longint;
var
	Req	: record
		Len		: word;
		SFunc     : byte;
		LastId	: longint;
		ObjType	: word;
		Search	: string[1];
	end;

	Repl	: record
		Len		: word;
		ObjId	: longint;
		ObjType	: word;
		ObjName	: string[47];
		Password: byte;
		Security: byte;
		Owner	: byte;
	end;

	T	: byte;

begin
	Req.Len := SizeOf(Req) - SizeOf(word);
	Req.SFunc := $37;
	Req.LastId := LastId;
	Req.ObjType := Swap(OType);
	Req.Search := '*';
	FillChar(Repl,SizeOf(Repl),0);
	Repl.Len := SizeOf(Repl) - SizeOf(word);
	CallNetware($E3,Req,Repl);
	Move(Repl.ObjName,Name[1],48);
	T := 1;
	while (Name[T] <> #0) do inc(T);
	Name[0] := char(T);
	GetLibObj := Repl.ObjId;
end;

procedure TNetWare.ReadServers(Servers : PStringCollection);
var
	Name		: Str48;
	LastId 		: longint;
	LastName 	: string[48];
	T			: integer;

begin
	Name := '';
	LastName := '';
	LastId := GetLibObj(Name,FILE_SERVER,$FFFFFFFF);
	Servers^.Insert(NewStr(Name));
	repeat
		LastName := Name;
		LastId := GetLibObj(Name,FILE_SERVER,LastId);
		if (LastName <> Name)and (Name[1] <> #0) then begin
			Servers^.Insert(NewStr(Name));
		end;
	until (LastName = Name) or (NetWareSwapLong(LastId) = -1) or (Name[1] = #0);
end;

procedure TNetWare.ReadAllUsers(Users : PStringCollection);
var
	Name		: Str48;
	LastId 		: longint;
	LastName 	: string[48];
	T			: integer;

begin
	Name := '';
	LastName := '';
	LastId := GetLibObj(Name,NET_USER,$FFFFFFFF);
	Users^.Insert(NewStr(Name));
	repeat
		LastName := Name;
		LastId := GetLibObj(Name,NET_USER,LastId);
		if (LastName <> Name)and (Name[1] <> #0) then begin
			Users^.Insert(NewStr(Name));
		end;
	until (LastName = Name) or (NetWareSwapLong(LastId) = -1) or (Name[1] = #0);
end;

procedure TNetWare.ReadAllUserWithFullName(Users : PUserCollection);
var
	Name		: Str48;
	FullName	: Str48;
	LastId 		: longint;
	LastName 	: string[48];
	T			: integer;

begin
	Name := '';
	LastName := '';
	LastId := GetLibObj(Name,NET_USER,$FFFFFFFF);
	FullName := GetFullName(Name);
	Users^.Insert(New(PUser,Init(Name,FullName,0)));
	repeat
		LastName := Name;
		LastId := GetLibObj(Name,NET_USER,LastId);
		if (LastName <> Name) and (Name[1] <> #0) then begin
			FullName := GetFullName(Name);
			Users^.Insert(New(PUser,Init(Name,FullName,0)));
		end;
	until (LastName = Name) or (NetWareSwapLong(LastId) = -1) or (Name[1] = #0);
end;

{************************************************************************}
{***********  ******  ***           ****  *********  ********************}
{***********    ****  ***  *************  *********  ********************}
{***********  *  ***  ***  *************  *********  ********************}
{***********  **  **  ***          *****  *********  ********************}
{***********  ***  *  ***  **************  *** ***  *********************}
{***********  ****    ***  ***************  *   *  **********************}
{***********  *****   ***           *******  ***  ***********************}
{************************************************************************}
procedure TNetWare.ReadAttachedServers(Servers : PStringCollection);
var
	T : ServerNamePtr;
	M : ServerMappingPtr;
	I : integer;
	Name : string;
begin
{
	GetServerNamePtr(T);
	GetServerMappingPtr(M);
}

	M := ServerMappTable;
	T := ServerNameTable;

	for I:=1 to MaxServers do begin
		if (M^[I].SlotInUse = $FF) then begin
			Name := '';
			Name := GetString(T^[I]);
			Servers^.Insert(NewStr(Name));
		end;
	end;
end;

function TNetWare.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;

function TNetWare.ServerIsAttached(SName : string) : boolean;
begin
	ServerIsAttached := GetServerNumber(SName) <> 0;
end;

function TNetWare.GetServerNumber(S: NetStr): byte;
var
	T : ServerNamePtr;
	M : ServerMappingPtr;
	I : integer;
begin
	M := ServerMappTable;
	T := ServerNameTable;

	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 TNetWare.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 TNetWare.InsertServer(Name : NetStr):byte;
var
	MapPtr  : ServerMappingPtr;
	NamePtr : ServerNamePtr;
	Res     : byte;
	UnUsed,I  : integer;
	Data    : array [1..130] of byte;
	SN		: byte;

function LowerAddr(var A, B): boolean;
type
	Net_Address = array [1..10] of char;
var
	PtrA : Net_Address absolute A;
	PtrB : Net_Address absolute B;
begin
	LowerAddr := PtrA < PtrB;
end;

begin
	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 := ServerMappTable;
	UnUsed := 1;
	while (MapPtr^[UnUsed].SlotInUse = $FF) do begin
		UnUsed := UnUsed + 1;
		if UnUsed > MaxServers then begin
			InsertServer := $7C;
			Exit;
		end;
	end;

	NamePtr := ServerNameTable;
	with MapPtr^[UnUsed] do begin
		Move(Data, ServerNet, 12);
		Str2Az(Name, NamePtr^[UnUsed], SizeOf(NamePtr^[UnUsed]));
		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 TNetWare.AttachServerNumber(Func : byte; SN : byte) : byte;
begin
	DefaultRegs;
	NovRegs.ah := $F1;
	NovRegs.al := Func;
	NovRegs.dl := SN;
	MsDos(NovRegs);
	AttachServerNumber := NovRegs.al;
end;

function TNetWare.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 TNetWare.GetEffectiveServer:byte;
begin
	DefaultRegs;
	NovRegs.ax := $F002;
	MsDos(NovRegs);
	GetEffectiveServer := NovRegs.al;
end;

function TNetWare.SetPreferredServer(SNo: byte): byte;
begin
	DefaultRegs;
	NovRegs.ax := $F000;
	NovRegs.dl := SNo;
	MsDos(NovRegs);
	NovRegs.ax := $F001;
	MsDos(NovRegs);
	SetPreferredServer := NovRegs.AL;
end;

function TNetWare.SetPrimaryServer(SNo: byte): byte;
begin
	DefaultRegs;
	NovRegs.ax := $F000;
	NovRegs.dl := SNo;
	MsDos(NovRegs);

{	NovRegs.ax := $F001;
	MsDos(NovRegs);}

	NovRegs.ax := $F004;
	NovRegs.dl := SNo;
	MsDos(NovRegs);

	NovRegs.ax := $F005;
	MsDos(NovRegs);
	SetPrimaryServer := NovRegs.AL;
end;

function TNetWare.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;
	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 TNetWare.FileServiceRequest( Func:            byte;
							 var Req; ReqLen:     word;
							 var Reply; RepLen: word): byte;
begin
	DefaultRegs;
	NovRegs.DS := Seg(Req);
	NovRegs.SI := Ofs(Req);
	NovRegs.CX := ReqLen;
	NovRegs.ES := Seg(Reply);
	NovRegs.DI := Ofs(Reply);
	NovRegs.DX := RepLen;
	NovRegs.AH := $F2;
	NovRegs.AL := Func;
	MsDos(NovRegs);
	FileServiceRequest := NovRegs.AL;
end;

function TNetWare.GetEncryptionKey(var Key : Buf8): byte;
var
	Rep : record
		PLen : word;
		Func : byte;
	end;
begin
	Rep.PLen := 1;
	Rep.Func := $17;
	GetEncryptionKey := FileServiceRequest($17, Rep, SizeOf(Rep), Key, SizeOf(Key));
end;

function TNetWare.LoginEncrypted(Name : NetStr; OType : word; var Key : Buf8): byte;
var
	Req : record
		PLen : word;
		Func : byte;
		Key  : Buf8;
		otyp : word;
		Name : NetStr;
	end;
begin
	Req.PLen := Length(Name) + 12;
	Req.Func := $18;
	Req.Key  := Key;
	Req.otyp := Swap(OType);
	Req.Name := Name;
	LoginEncrypted := FileServiceRequest($17, Req, Length(Name)+14, Mem[0:0], 0);
end;

procedure TNetWare.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 TNetWare.Shuffle(var LOn, Buff; BuffLen : word; var Target);
var
	L : Buf4 absolute LOn;
	B : array [0..127] OF byte absolute Buff;
	B2 : word;
	Temp : Buf32;
	S, D : word;
begin
	if BuffLen > 0 then
		while (BuffLen > 0) and (B[BuffLen-1] = 0) do
			BuffLen := BuffLen - 1;

	FillChar(Temp, SizeOf(Temp), #0);

	D := 0;
	while BuffLen >= 32 do begin
		for S := 0 to 31 do begin
			Temp[S] := Temp[S] xor B[D];
			D := D + 1;
		end;
		BuffLen := BuffLen - 32;
	end;
	B2 := D;

	if BuffLen > 0 then begin
		for S := 0 to 31 do begin
			if D + BuffLen = 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 TNetWare.Encrypt(var FRa, Buff, TIL);
var
	F : Buf8  absolute FRa;
	T : Buf8  absolute TIL;
	K : Buf32;
	S : word;
begin
	Shuffle(F[0], Buff, 16, K[0]);
	Shuffle(F[4], Buff, 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 TNetWare.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 TNetWare.LoginToFileServer(Name: NetStr; OType: word; Passw: GenStr): byte;
var
	Key : Buf8;
	ID  : FourBytes;
	Buff : Buf32;
	Res : byte;

begin
	Res := GetEncryptionKey(Key);
	if Res = 0 then begin
		Res := MapNameToNumber(OType, Name, ID);
		if Res = 0 then begin
			Shuffle(ID, Passw[1], Length(Passw), Buff);
			Encrypt(Key, Buff, Key);
			Res := LoginEncrypted(Name, OType, Key);
		end;
	end
	else begin
		Res := LoginAnObject(Name, OType, Passw);
	end;

	LoginToFileServer := Res;
end;

function TNetWare.GetFirstFreeNetDrive : char;
var
	UnUsed : byte;
begin
	UnUsed := 6;
	while (PDriveArr(ServerDriveHandles)^[UnUsed] <> 0) and (UnUsed < 32) do
		inc(UnUsed);
	if UnUsed < 32 then begin
		GetFirstFreeNetDrive := char(UnUsed + 64);
	end
	else begin
		GetFirstFreeNetDrive := #$FF	{no free drive for mapping}
	end;
end;

procedure TNetWare.MapDrive(MappedDrive : char;SName : NetStr);
var
	UnUsed,SN		: byte;
begin
	SN := GetServerNumber(SName);
	if Sn <> 0 then begin
		UnUsed := byte(MappedDrive) - 64;
		PDriveArr(ServerDriveHandles)^[UnUsed] := 1;
		PDriveArr(ServerDriveFlags)^[UnUsed] := PERM;
		PDriveArr(ServerDriveTable)^[UnUsed] := SN;
	end;
end;

procedure TNetWare.UnMapDrive(MappedDrive : char);
var
	UnUsed		: byte;
begin
	UnUsed := byte(MappedDrive) - 64;
	PDriveArr(ServerDriveHandles)^[UnUsed] := 0;
end;

function TNetWare.MapServer2Drive(MappedDrive : char;SName : NetStr;OName,Passw : string) : byte;
var
	UnUsed,Sn		: byte;
begin
	if AttachToFileServer(SName,OName,Passw) = 0 then begin
		SN := GetServerNumber(SName);
		if Sn <> 0 then begin
			UnUsed := byte(MappedDrive) - 64;
			PDriveArr(ServerDriveHandles)^[UnUsed] := 1;
			PDriveArr(ServerDriveFlags)^[UnUsed] := PERM;
			PDriveArr(ServerDriveTable)^[UnUsed] := SN;
		end;
		MapServer2Drive := 0;
	end
	else MapServer2Drive := $FF;
end;

function TNetWare.AttachToFileServer(SName : NetStr;OName,Passw : string) : byte;
var
	SN, Res, RC : byte;
	Curr_Server : byte;
begin
	SN := GetServerNumber(SName);

	if SN = 0 then begin
		Res := InsertServer(SName);
		if Res <> 0 then begin
			AttachToFileServer := Res;
			Exit;
		end;
		SN := GetServerNumber(SName);
	end;

	Res := AttachServerNumber(0, SN);
	if Res <> 0 then begin
		AttachToFileServer := Res;
		Exit;
	end;

	Curr_Server := GetEffectiveServer;
	if SetPreferredServer(SN) = SN then
		RC := LoginToFileServer(OName, NET_USER, Passw)
	else
		RC := $7A;
	Res := SetPreferredServer(Curr_Server);
	AttachToFileServer := RC;
end;

function TNetWare.UpcaseStr(S: string) : string;
var
	I 	: integer;
	Tmp : string;
begin
	Tmp := '';
	for I := 1 to Length(S) do begin
		Tmp := Tmp + UpCase(S[I]);
	end;
	UpcaseStr := Tmp;
end;

procedure TNetWare.DefaultRegs;
begin
	NovRegs.DS := DSeg;
	NovRegs.ES := DSeg;
end;

procedure TNetWare.Str2Az(St: GenStr; var AscZ; Size: integer);
begin
	Fillchar(AscZ, Size, 0);
	Move(St[1], AscZ, byte(St[0]));
end;

function TNetWare.CallNetware(RegAH : byte; var Request, Reply): byte;
begin
	DefaultRegs;
	NovRegs.AH := RegAH;
	NovRegs.DS := Seg(Request);
	NovRegs.SI := ofs(Request);
	NovRegs.ES := Seg(Reply);
	NovRegs.DI := Ofs(Reply);
	MsDos(NovRegs);
	CallNetware := NovRegs.AL;
end;

	  {***********************    E N D   ****************************}

procedure TNetWare.GetServerMappingPtr(var TmpPtr: ServerMappingPtr);
begin
	DefaultRegs;
	NovRegs.AX := $EF03;
	MsDos(NovRegs);
	TmpPtr  := Ptr(NovRegs.ES, NovRegs.SI);
end;

procedure TNetWare.GetServerNamePtr(var TmpPtr: ServerNamePtr);
begin
	DefaultRegs;
	NovRegs.AX := $EF04;
	MsDos(NovRegs);
	TmpPtr  := Ptr(NovRegs.ES, NovRegs.SI);
end;

procedure TNetWare.GetServerDriveTable(var TmpPtr : PChar);
begin
	NovRegs.AH := GETSHELLTABLEADDRESS;
	NovRegs.AL := DRIVESERVERTABLE;
	MsDos(NovRegs);
	TmpPtr := System.Ptr(NovRegs.ES,NovRegs.SI);
end;

procedure TNetWare.GetServerDriveHandles(var TmpPtr : PChar);
begin
	NovRegs.AH := GETSHELLTABLEADDRESS;
	NovRegs.AL := DRIVEHANDLETABLE;
	MsDos(NovRegs);
	TmpPtr := System.Ptr(NovRegs.ES,NovRegs.SI);
end;

procedure TNetWare.GetServerDriveFlags(var TmpPtr : PChar);
begin
	NovRegs.AH := GETSHELLTABLEADDRESS;
	NovRegs.AL := DRIVEFLAGTABLE;
	MsDos(NovRegs);
	TmpPtr := System.Ptr(NovRegs.ES,NovRegs.SI);
end;

function TNetWare.Detach(SN : byte) : byte;
begin
	DefaultRegs;
	NovRegs.ah := $F1;
	NovRegs.al := 1;
	NovRegs.dl := SN;
	MsDos(NovRegs);
	Detach := NovRegs.al;
end;

function TNetWare.DetachFromFileServer(SName : NetStr) : byte;
var
	SN, Res, RC : byte;
	Curr_Server : byte;
	t : ServerNamePtr;
	m : ServerMappingPtr;
	i : integer;
begin
	SN := GetServerNumber(SName);
	if SN = 0 then begin
		DetachFromFileServer := $FF;
		Exit;
	end;
	Res := Detach(SN);
	m := ServerMappTable;
	t := ServerNameTable;
	i := SN;
	m^[i].SlotInUse := $00;
	DetachFromFileServer := Res;
end;

constructor TNetWare.Init;
begin
	inherited Init;
	GetServerNamePtr(ServerNameTable);
	GetServerMappingPtr(ServerMappTable);
	GetServerDriveTable(ServerDriveTable);
	GetServerDriveHandles(ServerDriveHandles);
	GetServerDriveFlags(ServerDriveFlags);
end;

function TNetWare.NetWareLoaded(var LoggedOn : Boolean) : Boolean;
var
	Res 	: byte;
	Req		: record
		Len    : Word;
		SubF   : Byte;
	end;
	Repl	: record
		Len    : Word;
		Access : Byte;
		ID     : LongInt;
	end;
begin
	FillChar(Repl,SizeOf(Repl),0);
	Repl.Len := 5;
	with Req do begin
		Len := 1;
		SubF := $46;
	end;
	Res := CallNetWare($E3,Req,Repl);
	with Repl do begin
		NetWareLoaded := (Res = 0) and (ID <> 0);
		LoggedOn      := (Res = 0) and ((ID <> 0) and (ID <> -1));
	end;
end;

function TNetWare.NetWareShellInstalled : Boolean;
var
	Logged : Boolean;
begin
	NetWareShellInstalled := NetWareLoaded(Logged);
end;

function TNetWare.SelectNewServer(SName : string) : byte;
begin
	SelectNewServer := AttachServer(2,SName);
end;

procedure TNetWare.SetBroadcastMsg(Mode : byte);
begin
	NovRegs.AH	:= $DE;
	NovRegs.DL	:= Mode;
	MsDos(Novregs);
end;

function TNetWare.GetBroadcastMsg(var Msg : string) : byte;
var
	Res	: byte;
	Req	: record
		Len : word;
		Fn	: byte;
	end;

	Rep : record
		Len : word;
		Msg : string[60];
	end;
begin
	Req.Len := SizeOf(Req) - 2;
	Req.Fn	:= 1;
	Rep.Len := SizeOf(Rep) - 2;
	Rep.Msg := '';
	Res := CallNetWare($E1,Req,Rep);
	if Res = 0 then Msg := Rep.Msg
	else Msg := '';
	GetBroadcastMsg := Res;
end;

function TNetWare.Id2Name(Id : longint) : string;
var
	Req : record
		Len		: word;
		SFun    : byte;
		ObjId	: longint;
	end;

	Rep	: record
		Len		: word;
		ObjId	: longint;
        ObjTyp	: word;
        Name	: Str48;
	end;
begin
	Req.Len 	:= 3;
    Req.SFun    := $36;
    Req.ObjId	:= Id;
    Rep.Len		:= 48 + 4;
	FillChar(Rep.ObjId,Rep.Len,0);
	CallNetWare($E3,Req,Rep);
    Id2Name := AsciiZ2Str(Rep.Name,48);
end;

function TNetWare.GetUserId(Name : Str48) : longint;
var
	Req	: record
		Len		: word;
		SFun    : byte;
		UName	: Str48;
	end;

	Rep	: record
		Len		: word;
		ObjId	: longint;
	end;
begin
	Req.Len		:= 2 + byte(Name[0]);
	Req.Sfun	:= 3;
	Req.UName	:= Name;
	FillChar(Rep,SizeOf(Rep),0);
	Rep.Len		:= 4;
	CallNetWare($E3,Req,Rep);
	GetUserId := Rep.ObjId;
end;

function TNetWare.GetFullName(Name : Str48) : string;
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;

	Tmp			: string[48];
    Property	: string;

begin
	Property	:= 'IDENTIFICATION';
	Req.Func 	:= $3D;
	Req.OType 	:= Swap(NET_USER);
	Req.PLen 	:= Length(Name) + Length(Property) + 6;
	Req.filler 	:= Name + #1 + char(Length(Property)) + Property;
	Req.filler[0] := char(Length(Name));
	Rep.PLen := SizeOf(Rep) - 2;
	if CallNetware($E3,Req,Rep) = 0 then
		GetFullName := AsciiZ2Str(Rep.Data,48)
	else
		GetFullName := 'No full name.';
end;

function TNetWare.Id2FullName(Id : longint) : string;
var
	Name	: string;
begin
    Name := Id2Name(Id);
	Id2FullName := GetFullName(Name);
end;

function TNetWare.GetMyServer : string;
var
	NamePtr : ServerNamePtr;
	SN		: byte;
	Name	: Str48;
	t		: byte;
begin
	t := GetEffectiveServer;
	NamePtr := ServerNameTable;
	Move(NamePtr^[t], Name[1], 48);
	t := 1;
	while Name[t] <> #0 do inc(t);
	Name[0] := char(t - 1);
	GetMyServer := Name;
end;

function TNetWare.GetMyName : string;
var
	ConnInfo		: ConnInfoType;
begin
	GetConnInfo(GetConnNo,ConnInfo);
	GetMyName := ConnInfo.ObjectName;
end;

function TNetWare.GetPipeMsg(ConnNo : byte) : string;
begin
end;

function TNetWare.SendPipeMsg(ConnNo : byte) : word;
begin
end;

end.