SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00028 NOVELL/LANTASTIC NETWORK ROUTINES 1 05-28-9313:52ALL SWAG SUPPORT TEAM DETCNETX.PAS IMPORT 13 ,î, {π▒i'm trying to find a method by which i can, from within a TP Program,π▒detect whether or not the NetWare shell has been loaded (Net3, NetX, orπ▒whatever); i've figured out how to determine if IPX is running, butπ▒can't seem to nail down the shell; the general idea is to detect IPX,π▒detect the shell, determine whether or not the user is logged in, and ifπ▒not, give them the oppurtUnity to do so; i've got most of the restπ▒figured out, but can't find the shell; any help would be greatlyπ▒appreciatedππTry Interrupt 21h, Function EAh, GetShellVersion;π}ππUsesπ {$IFDEF DPMI}π WinDos;π {$ELSE}π Dos;π {$endIF}πVarπ vOS,π vHardwareType,π vShellMajorVer,π vShellMinorVer,π vShellType,π vShellRevision : Byte;π {$IFDEF DPMI}π vRegs : tRegisters;π {$ELSE}π vRegs : Registers;π {$endIF}ππProcedure GetShellVersion;πbeginπ vOS := 0;π vHardwareType := 0;π vShellMajorVer := 0;π vShellMinorVer := 0;π vShellType := 0;π vShellRevision := 0;π FillChar(vRegs, SizeOf(vRegs), 0);π With vRegs DOπ beginπ AH := $EA;π Intr($21, vRegs);π vOS := AH; (* $00 = MS-Dos *)π vHardwareType := AL; (* $00 = PC, $01 = Victor 9000 *)π vShellMajorVer := BH;π vShellMinorVer := BL;π vShellType := CH; (* $00 = conventional memory *)π (* $01 = expanded memory *)π (* $02 = extended memory *)π vShellRevision := CL;π end;πend;ππbeginπ GetShellVersion;π Writeln(vOS);π Readln;πend. 2 05-28-9313:52ALL SWAG SUPPORT TEAM GET-ID1.PAS IMPORT 24 ,îµI { TS> Can anybody help me finding the interrupt For gettingπ TS> a novell current user_name and the current station adress ??π}πProcedure GetConnectionInfoπ(Var LogicalStationNo: Integer; Var Name: String; Var HEX_ID: String;π Var ConnType : Integer; Var DateTime : String; Var retcode:Integer);ππVarπ Reg : Registers;π I,X : Integer;π RequestBuffer : Recordπ PacketLength : Integer;π FunctionVal : Byte;π ConnectionNo : Byte;π end;π ReplyBuffer : Recordπ ReturnLength : Integer;π UniqueID1 : Packed Array [1..2] of Byte;π UniqueID2 : Packed Array [1..2] of Byte;π ConnType : Packed Array [1..2] of Byte;π ObjectName : Packed Array [1..48] of Byte;π LoginTime : Packed Array [1..8] of Byte;π end;π Month : String[3];π Year,π Day,π Hour,π Minute : String[2];ππbeginπ With RequestBuffer Do beginπ PacketLength := 2;π FunctionVal := 22; { 22 = Get Station Info }π ConnectionNo := LogicalStationNo;π end;π ReplyBuffer.ReturnLength := 62;π With Reg Do beginπ Ah := $e3;π Ds := Seg(RequestBuffer);π Si := ofs(RequestBuffer);π Es := Seg(ReplyBuffer);π Di := ofs(ReplyBuffer);π end;π MsDos(Reg);π name := '';π hex_id := '';π connType := 0;π datetime := '';π if Reg.al = 0 then beginπ With ReplyBuffer Do beginπ I := 1;π While (I <= 48) and (ObjectName[I] <> 0) Do beginπ Name[I] := Chr(Objectname[I]);π I := I + 1;π end { While };π Name[0] := Chr(I - 1);π if name<>'' thenπ beginπ Str(LoginTime[1]:2,Year);π Month := Months[LoginTime[2]];π Str(LoginTime[3]:2,Day);π Str(LoginTime[4]:2,Hour);π Str(LoginTime[5]:2,Minute);π if Day[1] = ' ' then Day[1] := '0';π if Hour[1] = ' ' then Hour[1] := '0';π if Minute[1] = ' ' then Minute[1] := '0';π DateTime := Day+'-'+Month+'-'+Year+' ' + Hour + ':' + Minute;π end;π end { With };π end;π retcode := reg.al;π if name<>'' thenπ beginπ hex_id := '';π hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];π ConnType := replybuffer.connType[2];π { Now we chop off leading zeros }π While hex_id[1]='0' do hex_id := copy(hex_id,2,length(hex_id));π end;πend; { GetConnectInfo };ππ 3 05-28-9313:52ALL SWAG SUPPORT TEAM GET-ID2.PAS IMPORT 19 ,î]l {π> Okay, here goes. I am using Borland Pascal 7.0 under MS-Dos 5.0.π>Basically, the Program I am writing will be run under Novell Netwareπ>3.11. What I need to do is determine the User's full user name. Iπ>could do this using Novell Interrupts, but they are impossible to figureπ>out (At least For me). So what I wanted to do, was use Novell'sπ>"WHOAMI" command. What this does is return the user's full name andππWell, I think you'll find it harder to to a Dos exec and parse the output afterπreading it from a File than asking Netware what it is. Plus you must depend onπthe user having access to use the command. I'm on some Novell networks whereπthat command File is not present because it wasn't considered important.πHere's how to get the user name from Netware...π}πProgram UserID;ππUsesπ Dos, Strings;ππTypeπ RequestBuf = Recordπ RequestLen : Word; { Number of Bytes in the rest of the Record }π SubFunction : Byte; { Function from Novell we are requesting }π ConnectionNum : Byte; { Connection number that is making the call }π end;ππ ReplyBuf = Recordπ ReplyLength : Word; { Number of Bytes in the rest of the Record }π ObjectId : LongInt; { Novell refers to everything by Objects like users}π ObjectType : Word;π ObjectName : Array[1..48] of Char;π LoginTime : Array[1..7] of Char;π end;ππVarπ I:Word;π ReqBuf : RequestBuf;π RepBuf : ReplyBuf;π Regs : Registers;π UserName : String[48];ππbeginπ Regs.AH := $DC;π MsDos(Regs); { Get the connection number }ππ ReqBuf.RequestLen := 2; { User ID request, must give connection }π ReqBuf.SubFunction := $16; { number }π ReqBuf.ConnectionNum := Regs.AL;ππ RepBuf.ReplyLength := 61; { Return buffer For name }ππ Regs.AH := $E3; { Call Novell For user name }π Regs.DS := Seg(ReqBuf); { Passing it the request buffer indicating }π Regs.SI := Ofs(ReqBuf); { the data we want and a reply buffer to send }π Regs.ES := Seg(RepBuf); { us back the information }π Regs.DI := Ofs(RepBuf);π MsDos(Regs);ππ { Object name now contians the users ID, use the StringS Unit Functions }π { to print the null-terminated String }π WriteLn(StrPas(@RepBuf.ObjectName));πend.ππ{πThat will read in a Novell User ID For you.π}π 4 05-28-9313:52ALL SWAG SUPPORT TEAM GET-ID3.PAS IMPORT 22 ,î─å {π[ Does anyone know the syntax For Novell-specific interrupts in Pascalπ[(or C)? I have posted this message in all the pascal confs nad haven'tπ[had any replies. Any help is appreciated.π[ Specifically, I need to use interrupts to find the username, securityπ[in a certain directory and groups belongs to.ππSince this is Novell-specific I hope the moderator won't mind if Iπanswer this one in this conference, rather than Pascal conf...ππYou Absolutely NEED a copy of "System Calls - Dos" from Novell. Thisπbook has every last call you'll ever need For getting inFormation out ofπNetWare. Warning: some of their inFormation is erroneous, and you'llπjust have to do things like count up the size of the Reply buffers, Forπexample, and not trust their reported Record sizes.ππJust as an example of how to use the inFormation from the System Callsπbook, here's an example of a Function I slapped together to return aπ3-Character username. Pretty much all the Novell calls work the sameπway: you set up a Request buffer and a Reply buffer, then you read yourπresults into whatever Format you want them. Hope this helps:π}ππFunction GetNetUserID:String;πVarπ NovRegs:Registers;π Answer:String[3];π iii:Integer;π ConnectNo:Byte;π Request : Recordπ Len : Word; {LO-HI}π SubF : Byte;π ConnNum: Word; {HI-LO}π end;π Reply : Recordπ Len : Word; {LO-HI}π ObjID : LongInt; {HI-LO}π ObjType: Word;π ObjName: Array[1..48] of Byte;π LogTime: Array[1..7] of Byte;π end;πbeginπ if (ReqdNetType <> Novell) thenπ GetNetUserID := copy(ParamStr(2),1,3);π if (ReqdNetType = Novell) thenππ beginππ With NovRegs doπ beginπ AH := $dc;π AL := $00;π cx := $0000;π end;ππ MsDos(NovRegs);π ConnectNo:=NovRegs.AL;ππ For iii := 1 to 48 doπ beginπ Reply.ObjName[iii] := $00;π end;ππ With Request doπ beginπ Len := Sizeof(Request) - 2;π SubF := $16;π ConnNum:= (ConnectNo);π end;ππ Reply.Len := Sizeof(Reply) - 2;ππ With NovRegs doπ beginπ AH := $e3;π DS := Seg(Request);π SI := ofs(Request);π ES := Seg(Reply);π DI := ofs(Reply);π end;ππ MsDos(NovRegs);π Answer:=' ';ππ For iii:= 1 to 3 doπ beginπ Answer[iii]:= chr(Reply.ObjName[iii]);π end;ππ GetNetUserID:= Answer;π end;πend; {GetNetUserID}ππ{πThat $e3 in the AH register is the generic bindery call. $16 is theπsubFunction For "Get Connection Name" in the Bindery calls.π}π 5 05-28-9313:52ALL SWAG SUPPORT TEAM ISFILOPN.PAS IMPORT 4 ,î╦╠ Varπ Fi : File;ππFunction ISOpen(Var Fil:File):Boolean;π(* Returns True is File has is open ON A NETWORK!!! *)πVarπ P:^Byte;πbeginπ P:=@Fil;π If P^=0 then IsOpen:=False else IsOpen:=True;πend;ππbeginπ Assign(Fi,'FileOPEN.PAS');π Writeln(ISOpen(Fi));πend. 6 05-28-9313:52ALL SWAG SUPPORT TEAM LOCKREC.PAS IMPORT 15 ,îd² {πThe following Program is a slight modification of one posted by ZachπLinnet. The problem is it doesn't lock the use of the File and allowsπmultiple PC's to access the File at the same time. Also, it seems toπtake input from the keyboard when it isn't supposed to and I am unableπto locate why. How could I improve this to actually lock the File?πWhat if I just wanted to lock one or two Records?π}ππProgram Sample_File_Locking_Program;πUsesπ Crt;πTypeπ Fi = File of Integer;πVarπ FileName : String;π f : Fi;π x, n : Integer;π Choice : Char;ππbeginπ {$I-}π FileName := 'e:\test\test.dat';π Assign(f,FileName);π Repeatπ Write('Option [rwq] ? '); choice := ReadKey;π Writeln(choice);π Case choice ofπ 'r' : beginπ Writeln('Attempting to read : ');π Reset(f);π While Ioresult <> 0 doπ beginπ Writeln('Busy waiting...');π Reset(f);π end;π Write('Reading now...');π For x := 1 to 1000 doπ Read(f,n);π Writeln('done!');π Close(f);π end;π 'w' : beginπ Writeln('Attempting to Write : ');π Reset(f);π if Ioresult = 2 thenπ ReWrite(f);π While Ioresult <> 0 doπ beginπ Writeln('Busy waiting...');π Reset(f);π end;π Write('Writing now...');π For x := 1 to 1000 doπ Write(f,x);π Writeln('done!');π Close(f);π end;π end; { Case }π Until Choice = 'q';π {$I+}πend.π 7 08-17-9308:47ALL SWAG SUPPORT TEAM NETINFO Unit IMPORT 60 ,î¡> PROGRAM NetInfo;πUSES Crt, Dos;πCONSTπ Redirector = $08;π Receiver = $80;π Messenger = $04;π Server = $40;π AnyType = $CC;ππTYPEπ String15 = STRING[15];π LocalDevice = ARRAY[1..16] OF Char;π RedirDevice = ARRAY[1..128] OF Char;π DevicePtr = ^DevInfo;π DevInfo = RECORDπ LD : LocalDevice;π RD : RedirDevice;π ND : DevicePtrπ END;ππVAR Done:Boolean;π Name:String15;π Ver:Word;π I,Key:Integer;π DevIn:STRING[16];π RedIn:STRING[128];π LDevice:LocalDevice;π RDevice:RedirDevice;π DeviceList,NextDevice : DevicePtr;ππPROCEDURE ClrCursor;πVAR Regs : Registers;πBEGINπ Regs.CH:=$20;π Regs.AH:=$01;π INTR($10,Regs);πEND;ππPROCEDURE SetCursor;πVAR Regs : Registers;πBEGINπ Regs.AH:=1;π IF LastMode <> Mono THENπ BEGINπ Regs.CH:=6;π Regs.CL:=7π ENDπ ELSEπ BEGINπ Regs.CH:=12;π Regs.CL:=13π END;π INTR($10,Regs);πEND;ππFUNCTION GetExtended : Integer;πVAR CH:Char;πBEGINπ CH:=#0;GetExtended:=0;CH:=ReadKey;π IF Ord(CH)=0 THENπ BEGINπ CH:=ReadKey;π GetExtended:=Ord(CH)π ENDπEND;ππFUNCTION GetFileName(S:STRING):STRING;πVAR FileName:STRING[11];π I:Integer;πBEGINπ FileName:='';π I:=1;π WHILE S[I]<>#0 DOπ BEGINπ FileName[I]:=(S[I]);π I:=I+1π END;π FileName[0]:=Chr(i-1);π GetFileName:=FileNameπEND;ππFUNCTION ChkNetInterface : Boolean;πVAR NetRegs:Registers;πBEGINπ NetRegs.AH:=$00;π INTR($2A,NetRegs);π IF NetRegs.AH = 0 THEN ChkNetInterface:=FALSEπEND;ππPROCEDURE ChkPCLan;πVAR NetRegs:Registers;π ChkType:Integer;πBEGINπ NetRegs.AX:=$B800;π INTR($2F,NetRegs);π IF NetRegs.AH = 0 THENπ WriteLn('Network Not Installed')π ELSEπ BEGINπ ChkType:= NetRegs.BL AND AnyType;π IF (ChkType AND Server > 0) THENπ WriteLn('Server')π ELSEπ IF (ChkType AND Messenger > 0) THENπ WriteLn('Messenger')π ELSEπ IF (ChkType AND Receiver > 0) THENπ WriteLn('Receiver')π ELSEπ IF (ChkType AND Redirector > 0) THENπ WriteLn('Redirector')π ELSEπ WriteLn('Unknown Type')π ENDπEND;ππFUNCTION NetName : String15;πVAR NetRegs:Registers;π Name:ARRAY[1..15] OF Char;ππBEGINπ WITH NetRegs DOπ BEGINπ AH:=$5E;π AL:=$00;π DS:=Seg(Name);π DX:=Ofs(Name)π END;π MsDos(NetRegs);π IF NetRegs.CH<>0 THENπ NetName:=Nameπ ELSEπ NetName:='NOT DEFINED'πEND;ππFUNCTION ChkDrive(DriveNo:Integer):Integer;πVAR DriveRegs: Registers;πBEGINπ WITH DriveRegs DOπ BEGINπ AH:=$44;π AL:=$09;π BL:=DriveNo;π MsDos(DriveRegs);π IF (FLAGS AND 1) = 0 THENπ IF (DX AND $1000) = $1000 THENπ ChkDrive := 1π ELSEπ ChkDrive := 0π ELSEπ ChkDrive := AX * -1π ENDπEND;ππFUNCTION GetDevices: DevicePtr;πVAR NetRegs: Registers;π FstDevice, CurDevice,NewDevice : DevicePtr;π DevName: LocalDevice;π RedName: RedirDevice;π NextDev: Integer;π More : Boolean;ππBEGINπMore:=TRUE;πFstDevice:=NIL;πCurDevice:=NIL;πNextDev:=0;πWHILE More DOπBEGINπ WITH NetRegs DOπ BEGINπ AH:=$5F;π AL:=$02;π BX:=NextDev;π DS:=Seg(DevName);π SI:=Ofs(DevName);π ES:=Seg(RedName);π DI:=Ofs(RedName)π END;π MsDos(NetRegs);π IF (NetRegs.FLAGS AND 1) = 1 THENπ More:=FALSEπ ELSEπ BEGINπ NEW(NewDevice);π NewDevice^.LD:=DevName;π NewDevice^.RD:=RedName;π NewDevice^.ND:=NIL;π IF (CurDevice = NIL) AND (FstDevice=NIL) THENπ BEGINπ CurDevice:=NewDevice;π FstDevice:=NewDeviceπ ENDπ ELSEπ BEGINπ CurDevice^.ND:=NewDevice;π CurDevice:=NewDeviceπ END;π Inc(NextDev)π ENDπEND;πGetDevices:=FstDeviceπEND;ππPROCEDURE AssignDevice(DevName:LocalDevice;π RedName:RedirDevice);πVAR NetRegs: Registers;π DevType: Byte;π Dummy : Integer;ππBEGINπIF Pos(':',DevName)=2 THENπ DevType:=4π ELSEπ DevType:=3;ππ WITH NetRegs DOπ BEGINπ AH:=$5F;π AL:=$03;π BL:=DevType;π CX:=0;π DS:=Seg(DevName);π SI:=Ofs(DevName);π ES:=Seg(RedName);π DI:=Ofs(RedName)π END;π MsDos(NetRegs);π IF (NetRegs.FLAGS AND 1) = 1 THENπ BEGINπ TextColor(Red);GotoXY(WhereX+6,WhereY);π WriteLn('An Error Occurred on Assign');π TextColor(Red+128);GotoXY(WhereX+13,WhereY);π Write('Press Any Key');π Dummy:=GetExtended;π TextColor(White);π ClrScrπ ENDπEND;ππPROCEDURE DeleteDevice(DevName:LocalDevice);πVAR NetRegs: Registers;π Dummy : Integer;ππBEGINπ WITH NetRegs DOπ BEGINπ AH:=$5F;π AL:=$04;π DS:=Seg(DevName);π SI:=Ofs(DevName)π END;π MsDos(NetRegs);π IF (NetRegs.FLAGS AND 1) = 1 THENπ BEGINπ TextColor(Red);GotoXY(WhereX+6,WhereY);π WriteLn('An Error Occurred on Delete');π TextColor(Red+128);GotoXY(WhereX+13,WhereY);π Write('Press Any Key');π Dummy:=GetExtended;π TextColor(White);π ClrScrπ ENDπEND;ππFUNCTION SrchDevice(Drive:LocalDevice):DevicePtr;πVAR NDevice:DevicePtr;πBEGINπ NDevice:=GetDevices;π WHILE (NDevice <> NIL) ANDπ (Copy(NDevice^.LD,1,3) <>π Copy(Drive,1,3)) DOπ BEGINπ NDevice:=NDevice^.NDπ END;πSrchDevice:=NDeviceπEND;ππPROCEDURE DisplayDrives;πVAR I:Integer;π LDevice:LocalDevice;π NextDevice : DevicePtr;πBEGINπ FOR I:=1 TO 26 DOπ BEGINπ CASE ChkDrive(I) OFπ 0 : BEGINπ Write(#32,#32,Chr(64+I),':');π GotoXY(WhereX+3,WhereY);π WriteLn('Local')π END;π 1 : BEGINπ Write(#32,#32,Chr(64+I),':');π GotoXY(WhereX+3,WhereY);π Write('Remote');π LDevice[1]:=Chr(64+I);π LDevice[2]:=':';π LDevice[3]:=#0;π NextDevice:=SrchDevice(LDevice);π GotoXY(WhereX+7,WhereY);π WITH NextDevice^ DOπ WriteLn(Copy(RD,1,Pos(#0,RD)))π ENDπ ENDπ ENDπEND;ππPROCEDURE ScrnSetup;πBEGINπ ClrCursor;π TextBackground(Blue);π TextColor(White);π ClrScr;π GotoXY(30,2);Write('Network Status');π TextColor(LightGray);π GotoXY(2,5);Write('Dos Version:');π GotoXY(21,5);Write('Network Name:');π GotoXY(51,5);Write('Node Type:');π TextColor(White);π GotoXY(31,7);Write('Drive Status');π TextColor(LightGray);π GotoXY(20,9);Write('Drive');π GotoXY(27,9);Write('Location');π GotoXY(40,9);Write('Connection');π GotoXY(15,25);Write('F1 - Assign Device');π GotoXY(35,25);Write('F2 - Delete Device');π GotoXY(55,25);Write('F10 - Exit');π TextBackground(Black);π Ver:=DosVersion;π GotoXY(15,5);π WriteLn(Lo(Ver),'.',Hi(Ver))πEND;ππPROCEDURE SetScreen(W,X,Y,Z,Back,Txt:Integer);πBEGINπ Window(W,X,Y,Z);π TextColor(Txt);π TextBackground(Back);π ClrScrπEND;ππBEGINπ ScrnSetup;π IF ChkNetInterface THENπ BEGINπ GotoXY(35,5); WriteLn(NetName);GotoXY(62,5);π ChkPCLan;π Window(20,10,60,20);ClrScr;π DisplayDrives;π REPEATπ SetScreen(20,21,60,24,Blue,White);π Key:=GetExtended;π CASE Key OFπ 59:BEGINπ SetCursor;π Write('Drive to Redirect ');π ReadLn(DevIn);π Write('Remote Definition ');π ReadLn(RedIn);π ClrCursor;π FOR I:= 1 TO Ord(DevIn[0]) DOπ LDevice[I]:=DevIn[I];π LDevice[Ord(DevIn[0])+1]:=#0;π FOR I:= 1 TO Ord(RedIn[0]) DOπ RDevice[I]:=RedIn[I];π RDevice[Ord(RedIn[0])+1]:=#0;π AssignDevice(LDevice,RDevice)π END;π 60:BEGINπ Write('Drive to Delete ');π SetCursor;π ReadLn(DevIn);π ClrCursor;π FOR I:= 1 TO Ord(DevIn[0]) DOπ LDevice[I]:=DevIn[I];π LDevice[Ord(DevIn[0])+1]:=#0;π DeleteDevice(LDevice)π ENDπ END;π SetScreen(20,10,60,20,Black,LightGray);π DisplayDrives;π UNTIL Key = 68;ππ ENDπ ELSEπ WriteLn('NetBIOS Interface Not Available')πEND.ππ 8 08-27-9321:42ALL JEFF SHANNON Novell File Locking IMPORT 14 ,î ≤ {πJEFF SHANNONππNovell/File Locking/Sharingππ> Does anyone have any samples of network File sharing/access code For Turboπ> Pascal/Borland Pascal 6-7.ππThis is from the Advanced Turbo Pascal Techniques book by Chris Ohlsen andπGary Stroker. It's For TP 5.5 but I'm sure you could make use of it.ππOops, I hope I didn't violate any copyright laws by posting this code. Iπdoubt the authors of the book would sue me as it is a FINE book and Iπrecommend it to all. Now the publishers are a different story...π}ππUnit FileLock;ππInterfaceππUsesπ Dos;ππFunction Lock(Var UnTyped; pos, size : LongInt) : Boolean;πFunction UnLock(Var UnTyped; pos, size : LongInt) : Boolean;ππImplementationππFunction Lock(Var UnTyped; pos, size : LongInt) : Boolean;πVarπ reg : Registers;π f : File Absolute UnTyped;ππbeginπ pos := pos * FileRec(f).RecSize;π size := size * FileRec(f).RecSize;π reg.AH := $5C;π reg.AL := $00;π reg.BX := FileRec(f).Handle;π reg.CX := Hi(pos);π reg.DX := Lo(pos);π reg.SI := Hi(size);π reg.DI := lo(size);π Intr($21, reg);π if ((reg.Flags and FCarry) <> 0) thenπ Lock := Falseπ elseπ Lock := True;πend;ππFunction UnLock(Var UnTyped; pos, size : LongInt) : Boolean;πVarπ reg : Registers;π f : File Absolute UnTyped;πbeginπ pos := pos * FileRec(f).RecSize;π size := size * FileRec(f).RecSize;π reg.AH := $5C;π reg.AL := $01;π reg.BX := FileRec (f).Handle;π reg.CX := Hi(pos);π reg.DX := Lo(pos);π reg.SI := Hi(size);π reg.DI := Lo(size);π Intr($21, reg);π if ((reg.Flags and FCarry) <> 0) thenπ Unlock := Falseπ elseπ Unlock := True;πend;ππend.π 9 08-27-9321:42ALL ROBERT KOHLBUS Netware Bindary Object IMPORT 39 ,îNµ {πRobert C. Kohlbusππ I'm trying to compile and run a program that I wrote, with BP70π'real' mode, in 'Protected Mode'. This program uses Interrupt 21hπfunctions B80Xh and E3h, the Novell Netware ones. The program worked fineπin 'real' mode, but gives incorrect information in 'Protected Mode'. Afterπcalling Borland, they said it was because the DPMI overlay file didn't knowπhow to handle the interrupts I was trying to access. They suggested that Iπlook at a file from their BBS called READWRTE.PAS that shows how to handleπinterrupts in a 'Protected Mode' program. Basically this example file, justπinterrupt 31h (Simulate Real Mode Interrupt). My problem is that my programπcontinues to hang up, even after following their example. Below is a sampleπpart of my program. If anyone can lend a hand, I would be in their debt.π}ππProgram Getid; { Get unique Id for Novell Netware Bindery Object }ππusesπ Dos, Crt, WinApi;ππtypeπ TDPMIRegs = recordπ edi, esi, ebp, reserved, ebx, edx, ecx, eax: LongInt;π flags, es, ds, fs, gs, ip, cs, sp, ss : Word;π end;ππvarπ Hexid : string;π R: TDPMIRegs;ππ RequestBuffer : recordπ PacketLength : integer;π functionval : byte;π ObjectType : packed array [1..2] of byte;π NameLength : byte;π ObjectName : packed array [1..47] of char;π end;ππ ReplyBuffer : recordπ ReturnLength : integer;π UniqueID1 : packed array [1..2] of byte;π UniqueID2 : packed array [1..2] of byte;π ObjectType : packed array [1..2] of byte;π ObjectName : packed array [1..48] of byte;π end;πππfunction DPMIRealInt(IntNo, CopyWords: Word; var R: TDPMIRegs): Boolean; assembler;πasmπ mov ax, 0300hπ mov bx, IntNoπ mov cx, CopyWordsπ les di, Rπ int 31hπ jc @errorπ mov ax, 1π jmp @doneπ@error:π xor ax, axπ @Done:πend;ππfunction LongFromBytes(HighByte, LowByte: Byte): LongInt; assembler;πasmπ mov dx, 0π mov ah, HighByteπ mov al, LowByteπend;ππfunction LongFromWord(LoWord: Word): LongInt; assembler;πasmπ mov dx, 0π mov ax, LoWord;πend;ππfunction RealToProt(P: Pointer; Size: Word; var Sel: Word): Pointer;πbeginπ SetSelectorBase(Sel, LongInt(HiWord(LongInt(P))) Shl 4 + LoWord(LongInt(P)));π SetSelectorLimit(Sel, Size);π RealToProt := Ptr(Sel, 0);πend;πππprocedure GetObjectID(Name : string; ObjType : Word);πconstπ HEXDIGITS : Array [0..15] of char = '0123456789ABCDEF';ππvar Reg : Registers;π i : integer;π Hex_ID, S : string;π ErrorCode : word;π ObjectId : array[1..8] of byte;πππbeginπ with RequestBuffer doπ beginπ PacketLength := 52;π FunctionVal := $35;π ObjectType[1] := $0;π ObjectType[2] := ObjType;π NameLength := length(Name);π for i := 1 to length(Name) doπ ObjectName[i] := Name[i];π end;π ReplyBuffer.ReturnLength := 55;ππ { Original Code that worked in Real Mode }π{π Reg.ah := $E3;π Reg.ds := seg(RequestBuffer);π Reg.si := ofs(RequestBuffer);π Reg.es := seg(ReplyBuffer);π Reg.di := ofs(ReplyBuffer);ππ MsDos(Reg);π}ππ { New Code From Borland Example }π FillChar(R, SizeOf(TDPMIRegs), #0);π R.Eax := $E3;π R.ds := seg(RequestBuffer);π R.Esi := LongFromWord(ord(RequestBuffer));π R.es := seg(ReplyBuffer);π R.Edi := LongFromWord(ord(ReplyBuffer));π DPMIRealInt($21, 0, R);ππ{π S := 'None';π Errorcode := Reg.al;π if Errorcode = $96 then S := 'Server out of memory';π if Errorcode = $EF then S := 'Invalid name';π if Errorcode = $F0 then S := 'Wildcard not allowed';π if Errorcode = $FC then S := 'No such object *'+QueueName+'*';π if Errorcode = $FE then S := 'Server bindery locked';π if Errorcode = $FF then S := 'Bindery failure';π S := 'Error : '+ S;π Writeln(S);π}π Hex_ID := '';ππ Hex_ID := hexdigits[ReplyBuffer.UniqueID1[1] shr 4];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID1[1] and $0F];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID1[2] shr 4];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID1[2] and $0F];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[1] shr 4];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[1] and $0F];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[2] shr 4];π Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[2] and $0F];π while Hex_ID[1] = '0' doπ Hex_ID := copy(Hex_ID,2,length(Hex_ID));ππ Hexid := Hex_ID;ππend;ππbeginπ Hexid := '';π ClrScr;ππ { Get An Objects Idπ Parameters (2) Object Name, Object Typeπ Object Name = String[8];π Object Type = Word;π 1 Userπ 2 User Groupπ 3 Print Queueπ 4 File Serverπ 5 Job Serverπ 6 Gatewayπ 7 Print Serverπ }π GetObjectID('BUSINESS', 3); { Get Print Queue's ID }π Writeln('Hexid for BUSINESS is ',hexid);ππend.π 10 08-27-9321:49ALL KERRY SOKALSKY Network "Real" name IMPORT 19 ,îÄN {π-> I don't have an answer to your question, but would you happen to knowπ-> how to return a user's full name (as stored in syscon)? Thanks.ππI assume you already have the user's login name. Here is a procedureπthat will get a user's full name. If you are going to do a lot ofπNetware programming I suggest you get "Programmers Guide to Netware" byπCharles Rose. ISBN # 0-07-607029-8. It documents all of the Netwareπfunctions and also talks about IPX/SPX programming.π}ππUsesπ Dos;ππVarπ Regs : Registers;ππFunction Full_Name(User_Name : String) : String;πTypeπ RequestBuffer = Recordπ RequestBufferLength : Word;π Code : Byte;π ObjectType : Word;π ObjectNameLength : Byte;π ObjectName : Array[1..48] of char;π SegmentNumber : Byte;π PropertyNameLength : Byte;π PropertyName : Array[1..15] of char;π end;ππ ReplyBuffer = Recordπ ReplyBufferLength : Word;π PropertyValue : Array[1..128] of char;π MoreSegments : Byte;π PropertyFlags : Byte;π end;ππVarπ Request : RequestBuffer;π Reply : ReplyBuffer;π PropertyName : String[15];π Counter : Byte;π Temp : String[128];ππbeginπ PropertyName := 'IDENTIFICATION';π Request.RequestBufferLength := SizeOf(Request) - 2;π Request.Code := $3D;π Request.SegmentNumber := 1;π Request.ObjectType := $0100;π Request.ObjectNameLength := SizeOf(Request.ObjectName);π FillChar(Request.ObjectName, SizeOf(Request.ObjectName), #0);ππ For Counter := 1 to length(User_Name) doπ Request.ObjectName[Counter] := User_Name[Counter];ππ Request.PropertyNameLength := SizeOf(Request.PropertyName);π FillChar(Request.PropertyName, SizeOf(Request.PropertyName), #0);ππ For Counter := 1 to Length(PropertyName) doπ Request.PropertyName[Counter] := PropertyName[Counter];ππ Regs.AH := $E3;π Regs.DS := Seg(Request);π Regs.SI := Ofs(Request);ππ Reply.ReplyBufferLength := SizeOf(Reply) - 2;π Regs.ES := Seg(Reply);π Regs.DI := Ofs(Reply);ππ MSDos(Regs);ππ Temp := '';π Counter := 1;π While (Reply.PropertyValue[Counter] <> #0) doπ beginπ Temp := Temp + Reply.PropertyValue[Counter];π inc(Counter);π end;π Full_Name := Temp;πend;ππbeginπ Writeln(Full_Name('SOKALSKY'));πend. 11 11-21-9309:43ALL NORBERT IGL NETWARE User name IMPORT 15 ,î╢ {πFrom: NORBERT IGLπSubj: Netware "User name"ππ I need a way to get the current user name from the netware shell.π For instance, if I'm logged into server MYSERVER as user SUPERVISOR,π I need some way to get 'supervisor' as the user name. (Kind of likeπ WHOAMI would return: You are user SUPERVISOR on server MYSERVER)π}ππuses dos;ππfunction lStationNumber:byte; { MY logical Station(connection)-Number }πvar regs : Registers;πbeginπ regs.ah := $DC;π MsDos(regs );π lStationNumber := pcregs.al;πend;ππfunction GetUserName( Station: byte):String;πVarπ i : byte;π Regs : Registers;π name : string[50];π Reply : Recordπ Filler1 : Array [1..8] of byte;π ObjectName : Array [1..48] of Byte;π Filler2me : Array [1..8] of Byte;π End;π Request : Recordπ PacketLen : Integer;π vFunc : Byte;π ConnNb : Byte;π End;ππBeginπ With Request doπ beginπ PacketLen := 2;π vFunc := 22;π ConnNbm := Station;π End;π Reply.ReturnLength := 62;π With Regs Do Beginπ Ah := $e3;π Ds := Seg(Request);π Si := Ofs(Request);π Es := Seg(Reply);π Di := Ofs(Reply);π End;π MsDos(Reg);π { 1 2 3 4 }π {123456789012345678901234567890123456789012345678}π name := ' ';π If Regs.al = 0 Then with reply doπ beginπ move( objectName[1] , name[1], 48 );π i := pos(#0, name );π name[0] := char(i-1);π end;πend;ππ[...]ππvar me : byte;ππbeginπ me := lStationNumber;π writeln(' Hello, ', GetUserName( me ),π ' you''re hooked in on Station # ', me );πend.π 12 11-21-9309:50ALL JIM ROBB WHOBE For NETWARE IMPORT 28 ,î3 {πFrom: JIM ROBBπSubj: Re: Netware "User name"ππ I need a way to get the current user name from the netware shell.π For instance, if I'm logged into server MYSERVER as user SUPERVISOR,π I need some way to get 'supervisor' as the user name...ππThis should do the job. The two calls are "Get Connection Number" (DCh) andπ"Get Connection Information" (E3h 16h), both from the Connection Services API.πThe calls work with Advanced Netware 1.0 and all later versions. Code testedπon 3.11 NetWare.ππBeware the weak error-checking - the program doesn't check the version ofπNetware, or even that the user is logged onto the network.π}ππprogram WhoBeMe;ππuses Dos;πππprocedure GetUserName( var UserName : string );ππvarπ Request : record { Request buffer for "Get Conn Info" }π Len : Word; { Buffer length - 2 }π Func : Byte; { Subfunction number ( = $16 ) }π Conn : Byte { Connection number to be researched }π end;ππ Reply : record { Reply buffer for "Get Conn Info" }π Len : Word; { Buffer length - 2 }π ID : Longint; { Object ID (hi-lo order) }π Obj : Word; { Object type (hi-lo order again) }π Name : array[ 1..48 ] of Byte; { Object name as ASCII string }π Time : array[ 1.. 7 ] of Byte; { Y, M, D, Hr, Min, Sec, DOW }π { Y < 80 is in the next century }π { DOW = 0 -> 6, Sunday -> Saturday }π Filler : Byte { Call screws up without this! }π end;ππ Regs : Registers;π W : Word;ππbeginπ Regs.AX := $DC00; { "Get Connection Number" }π MsDos( Regs );π { "Get Connection Information" }ππ with Request do { Initialize request buffer: }π beginπ Len := 2; { Buffer length, }π Func := $16; { API function, }π Conn := Regs.AL { Returned in previous call! }π end;ππ Reply.Len := SizeOf( Reply ) - 2; { Initialize reply buffer length }ππ with Regs doπ beginπ AH := $E3; { Connection Services API call }π DS := Seg( Request ); { Location of request buffer }π SI := Ofs( Request );π ES := Seg( Reply ); { Location of reply buffer }π DI := Ofs( Reply );π MsDos( Regs )π end;ππ if ( Regs.AL = 0 ) { Success code returned in AL }π and ( Hi( Reply.Obj ) = 1 ) { Obj of 1 is a user, }π and ( Lo( Reply.Obj ) = 0 ) then { stored Hi-Lo }π with Reply doπ beginπ Move( Name, UserName[ 1 ], 48 ); { Convert ASCIIZ to string }π UserName[ 0 ] := #48;π W := 1;π while ( UserName[ W ] <> #0 )π and ( W < 48 ) doπ Inc( W );π UserName[ 0 ] := Char( W - 1 )π endπ elseπ UserName := ''πend;ππvarπ TheName : string;ππbeginπ GetUserName( TheName );π WriteLn( 'I be ', TheName )πend.π 13 01-27-9412:10ALL DENNIS RUSH Novell Detection IMPORT 32 ,îü` {π> Is there a way to detect if a system is running under Novellπ> Netware? There must be an interrupt to do that, but wich one?πππ Yes there is. Although this is in assembly, I'm sure you can digπout what you need and convert it to Pascal or inline ASM. I've alsoπincluded for the more common multitaskers. I always try to check forπeach at the beginning of a program so I can code to take advantage ofπthe features of whatever system it's operating under, or at leastπprevent problems.π}ππ;*****************************************************************π;* Check to see if we are running under a Novell Network *π;*****************************************************************π.public chk_novellπ.proc chk_novell autoπ .push es,di ; Protect the registers well useπ xor ax,ax ; and clear themπ push axπ push axπ .pop es,diπ mov ax,07A00H ; Novel Netware installation checkπ int 2FH ; Check itπ or al,al ; If installed, al = 0FFHπ ; ES:DI ptr -> far entry point forπ ; routines otherwise accessed throughπ ; INT 21Hπ jnz double_check ; Appears to be installed, see if thereπ ; is a far address in ES:DIπ stc ; Set carry to indicate no networkπ .pop es,di ; restore what we usedπ ret ; and exitπdouble_check:π push di ; Checkπ pop axπ or ax,ax ; Is it emptyπ jnz in_novell ; No has pointer so were in a networkπ push esπ pop axπ or ax,ax ; Is it emptyπ jnz in_novell ; No has pointerπ stc ; No pointer to far address so no networkπ ; Chance of a ptr to 0000:0000 areπ ; basically non-existantπin_novell:π .pop es,di ; Clean up after ourselvesπ ret ; and go homeπ.endp chk_novellπ;***********************************************************************π;* Check to see if we are running under Desqview, TopView, or TaskView *π;***********************************************************************π.public chk_desqπ.proc chk_desq autoπ .push ax,bx ; Save registers we will useπ mov ax,1022H ; This is the get version functionπ ; that TopView installs for Int 15H.π ; Most TopView compatibles use theπ ; same function so we can check forπ ; several with just one callπ xor dx,dx ; Clear dxπ int 15H ; Make the callπ cmp bx,0a01H ; DesqView 2.x returns 0A01Hπ jnz try_task ; Did we get itπ mov @dataseg:Desqview,1 ; YES, save it and go homeπ jmp short No_Viewπtry_task: ; No, Try TaskViewπ cmp bx,0001H ; TaskView Returns 0001Hπ jnz try_top ; Get itπ mov @dataseg:TaskView,1 ; Yesπ jmp short No_Viewπtry_top: ; No, try TopView. Top View returns it'sπ or bx,bx ; version so just test for non-zeroπ jz No_View ; is it non-zeroπ mov @dataseg:TopView,1 ; Yes, save itπNo_View:π .pop ax,bx ; Restore regs and go homeπ retπ.endp chk_desqππ{π Hope this helps. BTW, I don't know about the later versions ofπWindows, but the older versions respected the Desqview installationπcheck.π}π 14 01-27-9412:16ALL JIM ROBB Novell User Name 2 IMPORT 27 ,î8 {π> I need a way to get the current user name from the netware shell.π> For instance, if I'm logged into server MYSERVER as user SUPERVISOR,π> I need some way to get 'supervisor' as the user name...ππThis should do the job. The two calls are "Get Connection Number" (DCh) andπ"Get Connection Information" (E3h 16h), both from the Connection Services API.πThe calls work with Advanced Netware 1.0 and all later versions. Code testedπon 3.11 NetWare.ππBeware the weak error-checking - the program doesn't check the version ofπNetware, or even that the user is logged onto the network.π}ππprogram WhoBeMe;ππuses Dos;πππprocedure GetUserName( var UserName : string );ππvarπ Request : record { Request buffer for "Get Conn Info" }π Len : Word; { Buffer length - 2 }π Func : Byte; { Subfunction number ( = $16 ) }π Conn : Byte { Connection number to be researched }π end;ππ Reply : record { Reply buffer for "Get Conn Info" }π Len : Word; { Buffer length - 2 }π ID : Longint; { Object ID (hi-lo order) }π Obj : Word; { Object type (hi-lo order again) }π Name : array[ 1..48 ] of Byte; { Object name as ASCII string }π Time : array[ 1.. 7 ] of Byte; { Y, M, D, Hr, Min, Sec, DOW }π { Y < 80 is in the next century }π { DOW = 0 -> 6, Sunday -> Saturday }π Filler : Byte { Call screws up without this! }π end;ππ Regs : Registers;π W : Word;ππbeginπ Regs.AX := $DC00; { "Get Connection Number" }π MsDos( Regs );π { "Get Connection Information" }ππ with Request do { Initialize request buffer: }π beginπ Len := 2; { Buffer length, }π Func := $16; { API function, }π Conn := Regs.AL { Returned in previous call! }π end;ππ Reply.Len := SizeOf( Reply ) - 2; { Initialize reply buffer length }ππ with Regs doπ beginπ AH := $E3; { Connection Services API call }π DS := Seg( Request ); { Location of request buffer }π SI := Ofs( Request );π ES := Seg( Reply ); { Location of reply buffer }π DI := Ofs( Reply );π MsDos( Regs )π end;ππ if ( Regs.AL = 0 ) { Success code returned in AL }π and ( Hi( Reply.Obj ) = 1 ) { Obj of 1 is a user, }π and ( Lo( Reply.Obj ) = 0 ) then { stored Hi-Lo }π with Reply doπ beginπ Move( Name, UserName[ 1 ], 48 ); { Convert ASCIIZ to string }π UserName[ 0 ] := #48;π W := 1;π while ( UserName[ W ] <> #0 )π and ( W < 48 ) doπ Inc( W );π UserName[ 0 ] := Char( W - 1 )π endπ elseπ UserName := ''πend;ππvarπ TheName : string;ππbeginπ GetUserName( TheName );π WriteLn( 'I be ', TheName )πend.π 15 01-27-9412:16ALL GLENN CROUCH Novell User Name 3 IMPORT 25 ,îOI {π>I need a way to get the current user name from the netware shell.π>For instance, if I'm logged into server MYSERVER as user SUPERVISOR,π>I need some way to get 'supervisor' as the user name. (Kind of likeπ>WHOAMI would return: You are user SUPERVISOR on server MYSERVER)ππIn our library of routines we've developed (and continue to do so) lots ofπroutines for Novell Netware. The following routines (developed by Peter Ogdenπis to and myself) are to get the current user and I hope I've removed all ourπinter-library references so that it's of use to you:π}ππtypeπ String48 = string [48];ππconstπ NetError : Integer = 0;ππfunction GetConnNo : Byte; assembler;ππasmπ MOV AX, $DC00π INT $21πend;ππprocedure GetConnInfo (ConnectionNum : Byte; var ObjType : Word;π var ObjName : String48);ππvarπ ReqBuf : recordπ Size : Word;π FixedValue : Byte;π ConnNumber : Byte;π end;ππ ReplyBuf : recordπ Size : Word;π ID : LongInt;π ObType : Word;π Name : array [1..48] of Byte;π Reserved : Byte;π LoginTime : array [1..7] of Byte;π end;ππ Regs : Registers;π Counter : Integer;π NameString : String;ππbeginπ with ReqBuf doπ beginπ Size := SizeOf (ReqBuf) - 2;π FixedValue := $16;π ConnNumber := ConnectionNum;π end;ππ ReplyBuf.Size := SizeOf (ReplyBuf) - 2;π with Regs doπ beginπ AH := $E3;π DS := Seg (ReqBuf);π SI := Ofs (ReqBuf);π ES := Seg (ReplyBuf);π DI := Ofs (ReplyBuf);π MsDos (Regs);ππ NetError := AL;π if NetError <> 0 thenπ beginπ ObjType := 0;π ObjName := '';π endπ elseπ with ReplyBuf doπ if ID <> 0 thenπ beginπ Counter := 1;π NameString := '';π while (Name[Counter] <> 0) doπ beginπ NameString := NameString + Chr (Name [Counter]);π Inc (Counter);π end;π ObjName := NameString;π ObjType := Swap (ObType);π endπ elseπ beginπ ObType := 0;π ObjName := '';π end;π end;πend;ππfunction GetUserID : String48;ππvarπ CN : Byte;π UserName : String48;π ObjType : Word;ππbeginπ CN := GetConnNo;π GetConnInfo (CN, ObjType, UserName);π GetUserID := UserName;πend;πππI use this with Novell Netware 386 v3.11, as that is the Network that most ofπour Commercial Applications have been developed for. I know speed ups areπpossible especially in processing the ASCIIZ, but hey we only call this routineπonce in an application so it's not high on our priorities for optimisation.ππ 16 01-27-9412:16ALL JIM ROBB Novell Name IMPORT 29 ,î⌡S {π>To anyone that can help me, this is my problem: I want to program a simpleπ>E-Mail program for Novel Network v2.1. But i have one problem. While inπ>a pascal programmed program, how do i find out the user login nameπ>automatically?ππI tested this code on Novell 3.11, but the API calls should also work on yourπ2.1 network. The login time is also available as a by-product.π}ππprogram ShowUser;ππuses Dos;ππtypeπ NovTime = recordπ LoginYear : byte; { 0 to 99; if < 80, year is in 21st century }π LoginMonth : byte; { 1 to 12 }π LoginDay : byte; { 1 to 31 }π LoginHour : byte; { 0 to 23 }π LoginMin : byte; { 0 to 59 }π LoginSec : byte; { 0 to 59 }π LoginDOW : byte; { 0 to 6, 0 = Sunday, 1 = Monday ... }π end;πππ{ GetConnInfo --------------------------------------------------------------}π{ ----------- }ππfunction GetConnInfo( Connection : Byte;π var ConnName : string;π var ConnTime : NovTime ) : Byte;πVARπ NameArray : array[ 0..48 ] of Byte absolute ConnName;π NovRegs : Registers;ππ Request : recordπ Len : Word;π Func : Byte;π Conn : Byteπ end;ππ Reply : recordπ Len : Word;π ID : Longint;π Obj : Word; { Object type }π Name : array[ 1..48 ] of Byte;π Time : NovTime;π Filler : Byte { Isn't in my Novell docs, but won't work without! }π end;πππbeginπ with Request do { Initialize request buffer: }π beginπ Len := 2; { Buffer length, }π Func := $16; { API function, }π Conn := Connection { Connection # to query }π end;ππ Reply.Len := SizeOf( Reply ) - 2; { Initialize reply buffer length }ππ with NovRegs doπ beginπ AH := $E3; { Connection Services API call }π DS := Seg( Request ); { Location of request buffer }π SI := Ofs( Request );π ES := Seg( Reply ); { Location of reply buffer }π DI := Ofs( Reply );π MsDos( NovRegs ); { Make the call }π GetConnInfo := AL { Completion code is function result }π end;ππ with Reply doπ beginπ Obj := Swap( Obj ); { If object is a user and }π if ( Obj = 1 ) and ( NovRegs.AL = 0 ) then { call was successful, }π beginπ ConnTime := Time; { Return login time }π Move( Name, NameArray[ 1 ], 48 ); { Convert ASCIIZ to string }π NameArray[ 0 ] := 1;π while ( NameArray[ NameArray[ 0 ] ] <> 0 )π and ( NameArray[ 0 ] < 48 ) doπ Inc( NameArray[ 0 ] );π Dec( NameArray[ 0 ] )π endπ endπend;πππ{ GetConnNo ----------------------------------------------------------------}π{ --------- }ππfunction GetConnNo : byte;ππvarπ NovRegs : Registers;ππbeginπ NovRegs.AH := $DC;π MsDos( NovRegs );π GetConnNo := NovRegs.ALπend;πππ{ MAIN =====================================================================}π{ ==== }ππvarπ UserName : string;π LoginTime : NovTime;ππbeginπ GetConnInfo( GetConnNo, UserName, LoginTime );π WriteLn( 'User''s name is ', UserName )πend.π 17 01-27-9412:23ALL PER-ERIC LARSSON Using Novell? IMPORT 5 ,îü` {π> Is there a way to detect if a system is running under Novell Netware?π> There must be an interrupt to do that, but wich one?π}ππUsesπ Dos;ππFunction stationno : byte;πvarπ B : byte;π Regs : Registers;πbeginπ With Regs doπ beginπ ah := $DC;π ds := 0;π si := 0;π end;π MsDos( Regs ); {INT $21,ah=dh}π b := Regs.al;π stationno := b;πend;ππ{ Should return 0 if not attached to a novell server otherwiseπ workstation number }ππbeginπ Writeln(StationNo);πend.π 18 02-15-9407:51ALL RICK RYAN Misc NOVELL API Calls IMPORT 29 ,îΓb Program Novell_API_Examples;ππ{ Misc. Novell Advanced Netware 2.1+ API examples to retrieve info on theπ user who is running this programπ}ππUSES DOS, CRT;ππCONSTπ HexDigit: array [0..15] of char = '0123456789ABCDEF';π Days_Of_Week : Array[0..6] of string = ('Sunday','Monday','Tuesday',π 'Wednesday','Thursday','Friday',π 'Saturday');πππTYPEπ string2 = STRING[2];π string4 = STRING[4];πππVARπ Reg : DOS.Registers;π RCode : Integer;π Connect : Byte;π Address : String;πππfunction HexByte(B: byte): string2;π beginπ HexByte := HexDigit[B shr 4] + HexDigit[B and $F];π end;πππfunction Hex(I: integer): string4;π beginπ Hex := HexByte(hi(I)) + HexByte(lo(I));π end;πππFunction Get_Connection_Number : Integer;π { |π | Returns the connection number for the current sessionπ |π }π beginπ Reg.AH := $DC;π intr($21,Reg);π Get_Connection_Number := Reg.AL;π end;πππFunction Get_Station_Address(var Address: String): Integer;π { |π | Returns the Physical Station Address (NIC Number)π |π }π varπ S1, S2, S3 : String;π beginπ Reg.AH := $EE;π intr($21,Reg);π Address := Hex(Reg.CX) + Hex(Reg.BX) + Hex(Reg.AX);π Get_Station_Address := $00;π end;πππFunction Get_Login_Name : String;π { |π | Who's calling?π |π }π varπ Reg : DOS.REGISTERS;π Loop,π Connection : Byte;π TmpStr : String;π Request_Buf : Recordπ BufLen : Integer;π SubFunc : Byte;π Connection : Byte;π end;π Reply_Buf : Recordπ BufLen : Integer;π Obj_ID : LongInt;π Obj_Type : Integer;π Obj_Name : Array[1..48] of char;π Login_Time : Recordπ Year : Byte;π Month : Byte;π Day : Byte;π Hour : Byte;π Minute : Byte;π Second : Byte;π Day_No : Byte;π end;π end;ππ beginπ TmpStr := '';π RCode := 0;π Connect := Get_Connection_Number;π fillchar(Request_Buf,sizeof(Request_Buf),0);π fillchar(Reply_Buf,sizeof(Reply_Buf),0);ππ Request_Buf.SubFunc := $16;π Request_Buf.Connection := Connect;π Request_Buf.BufLen := sizeof(Request_Buf);π Reply_Buf.BufLen := sizeof(Reply_Buf);π Reg.AH := $E3;π Reg.DS := seg(Request_Buf);π Reg.SI := ofs(Request_Buf);π Reg.ES := seg(Reply_Buf);π Reg.DI := ofs(Reply_Buf);π intr($21,Reg);π Loop := 1;π while ((Reply_Buf.Obj_Name[Loop] <> #0) and (Loop <= 48)) doπ beginπ TmpStr := TmpStr + Reply_Buf.Obj_Name[Loop];π inc(loop);π end;π Get_Login_Name := TmpStr;π end;πππProcedure Pause;π varπ ch : char;π beginπ writeln;π write('Press Any Key To Continue ');π ch := readkey;π writeln;π end;πππBEGINπ clrscr;π writeln('Get Novell Station Info - (C) Rick Ryan, 1989');π writeln;π Connect := Get_Connection_Number;π Writeln(' Connection ID: ', Connect);ππ RCode := Get_Station_Address(Address);π writeln('Station Address: ',Address,' With ErrCode of ', RCode);ππ writeln('Login Name = ',Get_Login_Name);ππ Pause;ππEND. 19 02-18-9406:59ALL NORBERT IGL Novell Detection IMPORT 9 ,î▐ π{π MB> First - How can I detect if Novell netware is running on aπ MB> computer? and if you can tell me that... how can I get theπ MB> current version? }ππuses dos ;πvar Regs : registers ;π ReplyBuffer : array[1..40] of char ;πππfunction IPX_Loaded:boolean;πbeginπ Regs.AX := $7A00 ;π intr($2F,Regs) ;π IPX_Loaded := (Regs.AL = $FF)πend;ππfunction Netbios_Loaded:Boolean;πbeginπ Regs.AH := $35; (* DOS function that checks an interrupt vector *)π Regs.AL := $5C; (* Interrupt vector to be checked *)π NetBios_Installed := True;π msdos(Regs) ;π if ((Regs.ES = 0) or (Regs.ES = $F000))π then NetBios_Installed := Falseπend;πππfunction NetShell_Installed:Boolean;πbeginπ with Regs do beginπ AH := $EA ;π AL := 1 ;π BX := 0 ;π ES := seg(ReplyBuffer) ;π DI := ofs(ReplyBuffer) ;π end ; (* with do begin *)π msdos(regs) ;π NetShell_Installed := (Regs.BX = 0)πend.ππ 20 05-25-9408:22ALL JIM ROBB Re: Get Server Date SWAG9405 14 ,î╛╘ {π MP> Can someone show me what a PASCAL procedure would look like toπ MP> encapsulate the following information (from Brown's int list):π MP> INT 21 - Novell NetWare - FILE SERVER - GET FILE SERVER DATE AND TIMEππI tested this on our Novell 3.11 network:π}ππprogram ServDate;ππuses Dos;ππtypeπ tDateAndTime = recordπ Year : Byte;π Month : Byte;π Day : Byte;π Hours : Byte;π Minutes : Byte;π Seconds : Byte;π DayOfWeek : Byteπ end;ππ String9 = string[ 9 ];ππconstπ DayArray : array[ 0..6 ] of String9 =π ( 'Sunday', 'Monday', 'Tuesday', 'Wednesday',π 'Thursday', 'Friday', 'Saturday' );ππ MonthArray : array[ 1..12 ] of String9 =π ( 'January', 'February', 'March', 'April', 'May', 'June',π 'July', 'August', 'September', 'October', 'November',π 'December' );πππfunction GetFileServerDateAndTime( var DTBuf : tDateAndTime ) : Byte;ππvar NovRegs : Registers;ππbeginπ with NovRegs doπ beginπ AH := $E7;π DS := Seg( DTBuf );π DX := Ofs( DTBuf );π MSDos( NovRegs );π GetFileServerDateAndTime := ALπ endπend;ππvarπ DateAndTime : tDateAndTime;π ResultCode : Byte;ππbeginπ ResultCode := GetFileServerDateAndTime( DateAndTime );π if ResultCode = 0 thenπ with DateAndTime doπ beginπ Write( 'File server date/time = ', DayArray[ DayOfWeek ], ', ',π MonthArray[ Month ], ' ', Day );π if ( Year < 80 ) thenπ Write( ', 20', Year )π elseπ Write( ', 19', Year );π WriteLn( ' at ', Hours, ':', Minutes, ':', Seconds )π endπ elseπ WriteLn( 'Date/time call unsuccessful' )πend.π 21 05-26-9406:20ALL MARK BRAMWELL NOVELL Library IMPORT 463 ,î πUNIT Novell;π{---------------------------------------------------------------------------}π{ }π{ This UNIT provides a method of obtaining Novell information from a user }π{ written program. This UNIT was tested on an IBM AT running DOS 5.0 & }π{ using Netware 2.15. The unit compiled cleanly under Turbo Pascal 6.0 }π{ }π{ The UNIT has been updated to compile and run under Turbo Pascal for }π{ Windows. }π{ }π{ *** Tested ok with Netware 386 3.11 Sept/91 }π{ }π{ Last Update: 11 Dec 91 }π{ }π{---------------------------------------------------------------------------}π{ }π{ Any questions can be directed to: }π{ }π{ Mark Bramwell }π{ University of Western Ontario }π{ London, Ontario, N6A 3K7 }π{ }π{ Phone: 519-473-3618 [work] 519-473-3618 [home] }π{ }π{ Bitnet: mark@hamster.business.uwo.ca Packet: ve3pzr @ ve3gyq }π{ }π{ Anonymous FTP Server Internet Address: 129.100.22.100 }π{ }π{---------------------------------------------------------------------------}ππ{ Any other Novell UNITS gladly accepted. }πππ{πmods February 1 1991, Ross Lazarus (rml@extro.ucc.su.AU.OZ)π var retcodes in procedure getservername, get_broadcast_message,π verify_object_password comments, password conversion to upper case,ππSeems to work fine on a Netware 3.00 and on 3.01 servers -π}πππINTERFACEππ{$IFDEF WINDOWS}πUses WinDos;π{$ENDIF WINDOWS}ππ{$IFNDEF WINDOWS}πUses Dos;π{$ENDIF WINDOWS}ππConstπ Months : Array [1..12] of String[3] = ('JAN','FEB','MAR','APR','MAY','JUN',π 'JUL','AUG','SEP','OCT','NOV','DEC');ππ HEXDIGITS : Array [0..15] of char = '0123456789ABCDEF';ππType byte4 = array [1..4] of byte;ππ byte6 = array [1..6] of byte;ππVARππ{----------------------------------------------------------------------}π{ The following values can be pulled from an user written application }π{ }π{ The programmer would first call GetServerInfo. }π{ Then he could writeln(serverinfo.name) to print the server name }π{----------------------------------------------------------------------}ππ ServerInfo : Recordπ ReturnLength : Integer;π Server : Packed Array [1..48] of Byte;π NetwareVers : Byte;π NetwareSubV : Byte;π ConnectionMax : array [1..2] of byte;π ConnectionUse : array [1..2] of byte;π MaxConVol : array [1..2] of byte; {}π OS_revision : byte;π SFT_level : byte;π TTS_level : byte;π peak_used : array [1..2] of byte;π accounting_version : byte;π vap_version : byte;π queuing_version : byte;π print_server_version : byte;π virtual_console_version : byte;π security_restrictions_version : byte;π Internetwork_version_version : byte;π Undefined : Packed Array [1..60] of Byte;π peak_connections_used : integer;π Connections_max : integer;π Connections_in_use : integer;π Max_connected_volumes : integer;π name : string;π End;πππprocedure get_server_lan_driver_information(var _lan_board_number : integer;π{ This will return info on what } var _text1,_text2:string;π{ type of network cards are being } var _network_address : byte4;π{ used in the server. } var _host_address : byte6;π var _driver_installed,π _option_number,π _retcode : integer);ππprocedure GetConnectionInfo(var LogicalStationNo: integer;π var name,hex_id:string;π var conntype:integer;π var datetime:string;π var retcode:integer);π{ returns username and login date/time when you supply the station number. }ππprocedure clear_connection(connection_number : integer; var retcode :πinteger);π{ kicks the workstation off the server}ππprocedure GetHexID(var userid,hexid: string;π var retcode: integer);π{ returns the novell hexid of an username when you supply the username. }ππprocedure GetServerInfo;π{ returns various info of the default server }ππprocedure GetUser( var _station: integer;π var _username: string;π var retcode:integer);π{ returns logged-in station username when you supply the station number. }ππprocedure GetNode( var hex_addr: string;π var retcode: integer);π{ returns your physical network node in hex. }ππprocedure GetStation( var _station: integer;π var retcode: integer);π{ returns the station number of your workstation }ππprocedure GetServerName(var servername : string;π var retcode : integer);ππ{ returns the name of the current server }ππprocedure Send_Message_to_Username(username,message : string;π var retcode: integer);π{ Sends a novell message to the userid's workstation }ππprocedure Send_Message_to_Station(station:integer;π message : string;π var retcode: integer);π{ Sends a message to the workstation station # }ππprocedure Get_Volume_Name(var volume_name: string;π volume_number: integer;π var retcode:integer);π{ Gets the Volume name from Novell network drive }π{ Example: SYS Note: default drive must be a }π{ network drive. }ππprocedure get_realname(var userid:string;π var realname:string;π var retcode:integer);π{ You supply the userid, and it returns the realname as stored by syscon. }π{ Example: userid=mbramwel realname=Mark Bramwell }ππprocedure get_broadcast_mode(var bmode:integer);ππprocedure set_broadcast_mode(bmode:integer);ππprocedure get_broadcast_message(var bmessage: string;π var retcode : integer);ππprocedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);π{ pulls from the server the date, time and Day Of Week }ππprocedure set_date_from_server;π{ pulls the date from the server and updates the workstation's clock }ππprocedure set_time_from_server;π{ pulls the time from the server and updates the workstation's clock }ππprocedure get_server_version(var _version : string);ππprocedure open_message_pipe(var _connection, retcode : integer);ππprocedure close_message_pipe(var _connection, retcode : integer);ππprocedure check_message_pipe(var _connection, retcode : integer);ππprocedure send_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);ππprocedure get_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);ππprocedure get_drive_connection_id(var drive_number,π server_number : integer);π{pass the drive number - it returns the server number if a network volume}ππprocedure get_file_server_name(var server_number : integer;π var server_name : string);ππprocedure get_directory_path(var handle : integer;π var pathname : string;π var retcode : integer);ππprocedure get_drive_handle_id(var drive_number, handle_number : integer);ππprocedure set_preferred_connection_id(server_num : integer);ππprocedure get_preferred_connection_id(var server_num : integer);ππprocedure set_primary_connection_id(server_num : integer);ππprocedure get_primary_connection_id(var server_num : integer);ππprocedure get_default_connection_id(var server_num : integer);ππprocedure Get_Internet_Address(station : integer;π var net_number, node_addr, socket_number :πstring;π var retcode : integer);ππprocedure login_to_file_server(obj_type:integer; _name,_password : string;varπretcode:integer);ππprocedure logout;ππprocedure logout_from_file_server(var id: integer);ππprocedure down_file_server(flag:integer;var retcode : integer);ππprocedure detach_from_file_server(var id,retcode:integer);ππprocedure disable_file_server_login(var retcode : integer);ππprocedure enable_file_server_login(var retcode : integer);ππprocedure alloc_permanent_directory_handle(var _dir_handle : integer;π var _drive_letter : string;π var _dir_path_name : string;π var _new_dir_handle : integer;π var _effective_rights: byte;π var _retcode : integer);ππprocedure map(var drive_spec:string;π var _rights:byte;π var _retcode : integer);ππprocedure scan_object(var last_object: longint;π var search_object_type: integer;π var search_object : string;π var replyid : longint;π var replytype : integer; var replyname : string;π var replyflag : integer; var replysecurity : byte;π var replyproperties : integer; var retcode : integer);ππprocedure verify_object_password(var object_type:integer; varπobject_name,password : string; var retcode : integer);ππ{--------------------------------------------------------------------------}π{ file locking routines }π{-----------------------}ππprocedure log_file(lock_directive:integer; log_filename: string;πlog_timeout:integer; var retcode:integer);ππprocedure clear_file_set;ππprocedure lock_file_set(lock_timeout:integer; var retcode:integer);ππprocedure release_file_set;ππprocedure release_file(log_filename: string; var retcode:integer);ππprocedure clear_file(log_filename: string; var retcode:integer);ππ{--------------------------------------------------------------------------π---}ππprocedure open_semaphore( _name:string;π _initial_value:shortint;π var _open_count:integer;π var _handle:longint;π var retcode:integer);ππprocedure close_semaphore(var _handle:longint; var retcode:integer);ππprocedure examine_semaphore(var _handle:longint; var _value:shortint; varπ_count, retcode:integer);ππprocedure signal_semaphore(var _handle:longint; var retcode:integer);ππprocedure wait_on_semaphore(var _handle:longint; _timeout:integer; varπretcode:integer);ππprocedure purge_all_erased_files(var retcode:integer);ππprocedure purge_erased_files(var retcode:integer);π{--------------------------------------------------------------------------π---}πππIMPLEMENTATIONππconstπ zero = '0';ππvarπ retcode : byte; { return code for all functions }ππ{$IFDEF WINDOWS}π regs : TRegisters; { Turbo Pascal for Windows }π{$ENDIF WINDOWS}ππ{$IFNDEF WINDOWS}π regs : registers; { Turbo Pascal for Dos }π{$ENDIF WINDOWS}ππprocedure get_volume_name(var volume_name: string; volume_number: integer;π var retcode:integer);π{πpulls volume names from default server. Use set_preferred_connection_id toπset the default server.πretcodes: 0=ok, 1=no volume assigned 98h= # out of rangeπ}ππVARπ count,count1 : integer;ππ requestbuffer : recordπ len : integer;π func : byte;π vol_num : byte;π end;ππ replybuffer : recordπ len : integer;π vol_length : byte;π name : packed array [1..16] of byte;π end;ππbeginπWith Regs doπbeginπ ah := $E2;π ds := seg(requestbuffer);π si := ofs(requestbuffer);π es := seg(replybuffer);π di := ofs(replybuffer);π end;π With requestbuffer doπ beginπ len := 2;π func := 6;π vol_num := volume_number; {passed from calling program}π end;π With replybuffer doπ beginπ len := 17;π vol_length := 0;π for count := 1 to 16 do name[count] := $00;π end;π msdos(Regs);π volume_name := '';π if replybuffer.vol_length > 0 thenπ for count := 1 to replybuffer.vol_length doπ volume_name := volume_name + chr(replybuffer.name[count]);π retcode := Regs.al;πend;ππprocedure verify_object_password(var object_type:integer; varπobject_name,password : string; var retcode : integer);π{πfor netware 3.xx remember to have previously (eg in the autoexec file )πset allow unencrypted passwords = onπon the console, otherwise this call always fails !πNote that intruder lockout status is affected by this call !πNetware security isn't that stupid....πPasswords appear to need to be converted to upper caseππretcode apparent meaning as far as I can work out....ππ0 verification of object_name/password combinationπ197 account disabled due to intrusion lockoutπ214 unencrypted password calls not allowed on this v3+ serverπ252 no such object_name on this serverπ255 failure to verify object_name/password combinationππ}πvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π obj_type : array [1..2] of byte;π obj_name_length : byte;π obj_name : array [1..47] of byte;π password_length : byte;π obj_password : array [1..127] of byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π end;ππ count : integer;ππbeginπ With request_buffer doπ beginπ buffer_length := 179;π subfunction := $3F;π obj_type[1] := 0;π obj_type[2] := object_type;π obj_name_length := 47;π for count := 1 to 47 doπ obj_name[count] := $00;π for count := 1 to length(object_name) doπ obj_name[count] := ord(object_name[count]);π password_length := length(password);π for count := 1 to 127 doπ obj_password[count] := $00;π if password_length > 0 thenπ for count := 1 to password_length doπ obj_password[count] := ord(upcase(password[count]));π end;π With reply_buffer doπ buffer_length := 0;π With regs doπ beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);π End;π msdos(regs);π retcode := regs.al;πend; { verify_object_password }ππππprocedure scan_object(var last_object: longint; var search_object_type:πinteger;π var search_object : string; var replyid : longint;π var replytype : integer; var replyname : string;π var replyflag : integer; var replysecurity : byte;π var replyproperties : integer; var retcode : integer);πvarπ request_buffer : recordπ buffer_length : integer;π subfunction : byte;π last_seen : longint;π search_type : array [1..2] of byte;π name_length : byte;π search_name : array [1..47] of byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π object_id : longint;π object_type : array [1..2] of byte;π object_name : array [1..48] of byte;π object_flag : byte;π security : byte;π properties : byte;π end;ππ count : integer;ππbeginπwith request_buffer doπbeginπ buffer_length := 55;π subfunction := $37;π last_seen := last_object;π if search_object_type = -1 then { -1 = wildcard }π beginπ search_type[1] := $ff;π search_type[2] := $ff;π end elseπ beginπ search_type[1] := 0;π search_type[2] := search_object_type;π end;πname_length := length(search_object);πfor count := 1 to 47 do search_name[count] := $00;πif name_length > 0 then for count := 1 to name_length doπ search_name[count] := ord(upcase(search_object[count]));πend;πWith reply_buffer doπbeginπ buffer_length := 57;π object_id:= 0;π object_type[1] := 0;π object_type[2] := 0;π for count := 1 to 48 do object_name[count] := $00;π object_flag := 0;π security := 0;π properties := 0;πend;πWith Regs Do Beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);πEnd;πmsdos(regs);πretcode := regs.al;πWith reply_buffer doπbeginπ replyflag := object_flag;π replyproperties := properties;π replysecurity := security;π replytype := object_type[2];π replyid := object_id;πend;πcount := 1;πreplyname := '';πWhile (count <= 48) and (reply_buffer.Object_Name[count] <> 0) Do Beginπ replyName := replyname + Chr(reply_buffer.Object_name[count]);π count := count + 1;π End { while };πend;πππprocedure alloc_permanent_directory_handleπ (var _dir_handle : integer; var _drive_letter : string;π var _dir_path_name : string; var _new_dir_handle : integer;π var _effective_rights: byte; var _retcode : integer);ππvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π dir_handle : byte;π drive_letter : byte;π dir_path_length : byte;π dir_path_name : packed array [1..255] of byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π new_dir_handle : byte;π effective_rights : byte;π end;ππ count : integer;ππbeginπWith request_buffer doπbeginπ buffer_length := 259;π subfunction := $12;π dir_handle := _dir_handle;π drive_letter := ord(upcase(_drive_letter[1]));π dir_path_length := length(_dir_path_name);π for count := 1 to 255 do dir_path_name[count] := $0;π if dir_path_length > 0 then for count := 1 to dir_path_length doπ dir_path_name[count] := ord(upcase(_dir_path_name[count]));πend;πWith reply_buffer doπbeginπ buffer_length := 2;π new_dir_handle := 0;π effective_rights := 0;πend;πWith Regs Do Beginπ Ah := $E2;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);πEnd;πmsdos(regs);π_retcode := regs.al;π_effective_rights := $0;π_new_dir_handle := $0;πif _retcode = 0 thenπbeginπ _effective_rights := reply_buffer.effective_rights;π _new_dir_handle := reply_buffer.new_dir_handle;πend;πend;ππprocedure map(var drive_spec:string; var _rights:byte; var _retcode :πinteger);πvarπ dir_handle : integer;π path_name : string;π rights : byte;π drive_number : integer;π drive_letter : string;π new_handle : integer;π retcode : integer;ππbeginπ {first thing is we strip leading and trailing blanks}π while drive_spec[1]=' ' do drive_spec :=πcopy(drive_spec,2,length(drive_spec));π while drive_spec[length(drive_spec)]=' ' do drive_spec :=πcopy(drive_spec,1,length(drive_spec)-1);π drive_number := ord(upcase(drive_spec[1]))-65;π drive_letter := upcase(drive_spec[1]);π path_name := copy(drive_spec,4,length(drive_spec));π get_drive_handle_id(drive_number,dir_handle);π alloc_permanent_directory_handle(dir_handle,drive_letter,path_name,new_handle,π rights,retcode);π _retcode := retcode;π _rights := rights;πend;πππππprocedure down_file_server(flag:integer;var retcode : integer);πvarππrequest_buffer : recordπ buffer_length : integer;π subfunction : byte;π down_flag : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π end;ππbeginπWith request_buffer doπbeginπ buffer_length := 2;π subfunction := $D3;π down_flag := flag;πend;πreply_buffer.buffer_length := 0;πWith Regs Do Beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);πEnd;πmsdos(regs);πretcode := regs.al;πend;πππprocedure set_preferred_connection_id(server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $00;π regs.ds := 0;π regs.es := 0;π regs.dl := server_num;π msdos(regs);πend;ππprocedure set_primary_connection_id(server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $04;π regs.ds := 0;π regs.es := 0;π regs.dl := server_num;π msdos(regs);πend;ππprocedure get_primary_connection_id(var server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $05;π regs.es := 0;π regs.ds := 0;π msdos(regs);π server_num := regs.al;πend;ππprocedure get_default_connection_id(var server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $02;π regs.es := 0;π regs.ds := 0;π msdos(regs);π server_num := regs.al;πend;ππprocedure get_preferred_connection_id(var server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $02;π regs.ds := 0;π regs.es := 0;π msdos(regs);π server_num := regs.al;πend;πππprocedure get_drive_connection_id(var drive_number, server_number : integer);πvarππ drive_table : array [1..32] of byte;π count : integer;π p : ^byte;ππbeginπ regs.ah := $EF;π regs.al := $02;π regs.es := 0;π regs.ds := 0;π msdos(regs);π p := ptr(regs.es, regs.si);π move(p^,drive_table,32);π if ((drive_number < 0) or (drive_number > 32)) then drive_number := 1;π server_number := drive_table[drive_number];πend;ππprocedure get_drive_handle_id(var drive_number, handle_number : integer);πvarπ drive_table : array [1..32] of byte;π count : integer;π p : ^byte;ππbeginπ regs.ah := $EF;π regs.al := $00;π regs.ds := 0;π regs.es := 0;π msdos(regs);π p := ptr(regs.es, regs.si);π move(p^,drive_table,32);π if ((drive_number < 0) or (drive_number > 32)) then drive_number := 1;π handle_number := drive_table[drive_number];πend;πππprocedure get_file_server_name(var server_number : integer; var server_name :πstring);πvarπ name_table : array [1..8*48] of byte;π server : array [1..8] of string;π count : integer;π count2 : integer;π p : ^byte;π no_more : integer;ππbeginπ regs.ah := $EF;π regs.al := $04;π regs.ds := 0;π regs.es := 0;π msdos(regs);π no_more := 0;π p := ptr(regs.es, regs.si);π move(p^,name_table,8*48);π for count := 1 to 8 do server[count] := '';π for count := 0 to 7 doπ beginπ no_more := 0;π for count2 := (count*48)+1 to (count*48)+48 do if name_table[count2] <>π$00π thenπ beginπ if no_more=0 then server[count+1] := server[count+1] +πchr(name_table[count2]);π end else no_more:=1; {scan until 00h is found}π end;π if ((server_number<1) or (server_number>8)) then server_number := 1;π server_name := server[server_number];πend;ππprocedure disable_file_server_login(var retcode : integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byteπ end;ππ reply_buffer : recordπ buffer_length : integer;π end;ππbeginπ With Regs Do Beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);π End;π With request_buffer doπ beginπ buffer_length := 1;π subfunction := $CB;π end;π reply_buffer.buffer_length := 0;π msdos(regs);π retcode := regs.al;πend;ππprocedure enable_file_server_login(var retcode : integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byteπ end;ππ reply_buffer : recordπ buffer_length : integer;π end;ππbeginπ With Regs Do Beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);π End;π With request_buffer doπ beginπ buffer_length := 1;π subfunction := $CC;π end;π reply_buffer.buffer_length := 0;π msdos(regs);π retcode := regs.al;πend;πππprocedure get_directory_path(var handle : integer; var pathname : string; varπretcode : integer);πvar count : integer;ππ request_buffer : recordπ len : integer;π subfunction : byte;π dir_handle : byte;π end;ππ reply_buffer : recordπ len : integer;π path_len : byte;π path_name : array [1..255] of byte;π end;ππbeginπ With Regs Do Beginπ Ah := $e2;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);π End;π With request_buffer doπ beginπ len := 2;π subfunction := $01;π dir_handle := handle;π end;π With reply_buffer doπ beginπ len := 256;π path_len := 0;π for count := 1 to 255 do path_name[count] := $00;π end;π msdos(regs);π retcode := regs.al;π pathname := '';π if reply_buffer.path_len > 0 then for count := 1 to reply_buffer.path_len doπ pathname := pathname + chr(reply_buffer.path_name[count]);πend;ππprocedure detach_from_file_server(var id,retcode:integer);πbeginπ regs.ah := $F1;π regs.al := $01;π regs.dl := id;π msdos(regs);π retcode := regs.al;πend;πππprocedure getstation( var _station: integer; var retcode: integer);πbeginπ With Regs doπ beginπ ah := $DC;π ds := 0;π si := 0;π end;π MsDos( Regs );π _station := Regs.al;π retcode := 0;π end;πππprocedure GetHexID( var userid,hexid: string; var retcode: integer);πvarπ i,x : integer;π hex_id : string;π requestbuffer : recordπ len : integer;π func : byte;π conntype : packed array [1..2] of byte;π name_len : byte;π name : packed array [1..47] of char;π end;π replybuffer : recordπ len : integer;π uniqueid1: packed array [1..2] of byte;π uniqueid2: packed array [1..2] of byte;π conntype : word;π name : packed array [1..48] of byte;π end;ππbeginπ regs.ah := $E3;π requestbuffer.func := $35;π regs.ds := seg(requestbuffer);π regs.si := ofs(requestbuffer);π regs.es := seg(replybuffer);π regs.di := ofs(replybuffer);π requestbuffer.len := 52;π replybuffer.len := 55;π requestbuffer.name_len := length(userid);π for i := 1 to length(userid) do requestbuffer.name[i] := userid[i];π requestbuffer.conntype[2] := $1;π requestbuffer.conntype[1] := $0;π replybuffer.conntype := 1;π msdos(regs);π retcode := regs.al; {π if retcode = $96 then writeln('Server out of memory');π if retcode = $EF then writeln('Invalid name');π if retcode = $F0 then writeln('Wildcard not allowed');π if retcode = $FC then writeln('No such object *',userid,'*');π if retcode = $FE then writeln('Server bindery locked');π if retcode = $FF then writeln('Bindery failure'); }π hex_id := '';π if retcode = 0 thenπ beginπ hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];π { Now we chop off leading zeros }π while hex_id[1] = '0' do hex_id := copy(hex_id,2,length(hex_id));π end;π hexid := hex_id;πend;πππProcedure GetConnectionInfoπ(Var LogicalStationNo: Integer; Var Name: String; Var HEX_ID: String;π Var ConnType : Integer; Var DateTime : String; Var retcode:integer);ππVarπ I,X : Integer;π RequestBuffer : Recordπ PacketLength : Integer;π FunctionVal : Byte;π ConnectionNo : Byte;π End;π ReplyBuffer : Recordπ ReturnLength : Integer;π UniqueID1 : Packed Array [1..2] of byte;π UniqueID2 : Packed Array [1..2] of byte;π NWConnType : Packed Array [1..2] of byte;π ObjectName : Packed Array [1..48] of Byte;π LoginTime : Packed Array [1..8] of Byte;π End;π Month : String[3];π Year,π Day,π Hour,π Minute : String[2];ππBeginπ With RequestBuffer Do Beginπ PacketLength := 2;π FunctionVal := 22; { 22 = Get Station Info }π ConnectionNo := LogicalStationNo;π End;π ReplyBuffer.ReturnLength := 62;π With Regs Do Beginπ Ah := $e3;π ds := 0;π es := 0;π Ds := Seg(RequestBuffer);π Si := Ofs(RequestBuffer);π Es := Seg(ReplyBuffer);π Di := Ofs(ReplyBuffer);π End;π MsDos(Regs);π retcode := regs.al;π name := '';π hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];π hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];π { Now we chop off leading zeros }π while ( (hex_id[1]='0') and (length(hex_id) > 1) )π do hex_id := copy(hex_id,2,length(hex_id));π ConnType := replybuffer.nwconntype[2];π datetime := '';π If hex_id <> '0' Then Begin {Grab username}π With ReplyBuffer Do Beginπ I := 1;π While (I <= 48) and (ObjectName[I] <> 0) Doπ Beginπ Name[I] := Chr(Objectname[I]);π I := I + 1;π End { while };π Name[0] := Chr(I - 1);π End; {With} End; {if}π If hex_id <> '0' then With replybuffer do {Grab login time}π beginπ Str(LoginTime[1]:2,Year);π Month := Months[LoginTime[2]];π Str(LoginTime[3]:2,Day);π Str(LoginTime[4]:2,Hour);π Str(LoginTime[5]:2,Minute);π If Day[1] = ' ' Then Day[1] := '0';π If Hour[1] = ' ' Then Hour[1] := '0';π If Minute[1] = ' ' Then Minute[1] := '0';π DateTime := Day+'-'+Month+'-'+Year+' ' + Hour + ':' + Minute;π End;πEnd { GetConnectInfo };ππprocedure login_to_file_server(obj_type:integer;_name,_password : string;varπretcode:integer);πvar request_buffer : recordπ B_length : integer;π subfunction : byte;π o_type : packed array [1..2] of byte;π name_length : byte;π obj_name : packed array [1..47] of byte;π password_length : byte;π password : packed array [1..27] of byte;π end;ππ reply_buffer : recordπ R_length : integer;π end;ππ count : integer;ππbeginπWith request_buffer doπbeginπ B_length := 79;π subfunction := $14;π o_type[1] := 0;π o_type[2] := obj_type;π for count := 1 to 47 do obj_name[count] := $0;π for count := 1 to 27 do password[count] := $0;π if length(_name) > 0 thenπ for count := 1 to length(_name) doπobj_name[count]:=ord(upcase(_name[count]));π if length(_password) > 0 thenπ for count := 1 to length(_password) doπpassword[count]:=ord(upcase(_password[count]));π {set to full length of field}π name_length := 47;π password_length := 27;πend;πWith reply_buffer doπbeginπ R_length := 0;πend;π With Regs Do Beginπ Ah := $e3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π End;π MsDos(Regs);π retcode := regs.alπend;ππprocedure logout;π{logout from all file servers}πbeginπ regs.ah := $D7;π msdos(regs);πend;ππprocedure logout_from_file_server(var id: integer);π{logout from one file server}πbeginπ regs.ah := $F1;π regs.al := $02;π regs.dl := id;π msdos(regs);πend;πππππprocedure send_message_to_username(username,message : string; var retcode:πinteger);πVARπ count1 : byte;π userid : string;π stationid : integer;π ret_code : integer;ππbeginπ ret_code := 1;π for count1:= 1 to length(username) doπ username[count1]:=upcase(username[count1]); { Convert to upper case }π getserverinfo;π for count1:= 1 to serverinfo.connections_max doπ beginπ stationid := count1;π getuser( stationid, userid, retcode);π if userid = username thenπ beginπ ret_code := 0;π send_message_to_station(stationid, message, retcode);π end;π end; { end of count }π retcode := ret_code;π { retcode = 0 if sent, 1 if userid not found }πend; { end of procedure }πππProcedure GetServerInfo;πVarπ RequestBuffer : Recordπ PacketLength : Integer;π FunctionVal : Byte;π End;π I : Integer;ππBeginπ With RequestBuffer Do Beginπ PacketLength := 1;π FunctionVal := 17; { 17 = Get Server Info }π End;π ServerInfo.ReturnLength := 128;π With Regs Do Beginπ Ah := $e3;π Ds := Seg(RequestBuffer);π Si := Ofs(RequestBuffer);π Es := Seg(ServerInfo);π Di := Ofs(ServerInfo);π End;π MsDos(Regs);π With serverinfo doπ beginπ connections_max := connectionmax[1]*256 + connectionmax[2];π connections_in_use := connectionuse[1]*256 + connectionuse[2];π max_connected_volumes := maxconvol[1]*256 + maxconvol[2];π peak_connections_used := peak_used[1]*256 + peak_used[2];π name := '';π i := 1;π while ((server[i] <> 0) and (i<>48)) doπ beginπ name := name + chr(server[i]);π i := i + 1;π end;π end;πEnd;ππprocedure GetServerName(var servername : string; var retcode : integer);π{-----------------------------------------------------------------}π{ This routine returns the same as GetServerInfo. This routine }π{ was kept to maintain compatibility with the older novell unit. }π{-----------------------------------------------------------------}πbeginπ getserverinfo;π servername := serverinfo.name;π retcode := 0;π end;ππprocedure send_message_to_station(station:integer; message : string; var retcode : integer);πVARπ req_buffer : recordπ buffer_len : integer;π subfunction: byte;π c_count : byte;π c_list : byte;π msg_length : byte;π msg : packed array [1..55] of byte;π end;ππ rep_buffer : recordπ buffer_len : integer;π c_count : byte;π r_list : byte;π end;ππ count1 : integer;ππbeginπ if length(message) > 55 then message:=copy(message,1,55);π With Regs doπ beginπ ah := $E1;π ds:=seg(req_buffer);π si:=ofs(req_buffer);π es:=seg(rep_buffer);π di:=ofs(rep_buffer);π End;π With req_buffer doπ beginπ buffer_len := 59;π subfunction := 00;π c_count := 1;π c_list := station;π for count1:= 1 to 55 do msg[count1]:= $00; { zero the buffer }π msg_length := length(message); { message length }π for count1:= 1 to length(message) doπmsg[count1]:=ord(message[count1]);π End;π With rep_buffer doπ beginπ buffer_len := 2;π c_count := 1;π r_list := 0;π End;π msdos( Regs );π retcode:= rep_buffer.r_list;π end;πππprocedure getuser( var _station: integer; var _username: string; var retcode:πinteger);π{This procedure provides a shorter method of obtaining just the USERID.}πvarπ gu_hexid : string;π gu_conntype : integer;π gu_datetime : string;ππbeginπ getconnectioninfo(_station,_username,gu_hexid,gu_conntype,gu_datetime,retcode);πend;πππPROCEDURE GetNode( var hex_addr: string; var retcode: integer );π{ get the physical station address }ππConstπ Hex_Set :packed array[0..15] of char = '0123456789ABCDEF';ππBegin { GetNode }π {Get the physical address from the Network Card}π Regs.Ah := $EE;π regs.ds := 0;π regs.es := 0;π MsDos(Regs);π hex_addr := '';π hex_addr := hex_addr + hex_set[(regs.ch shr 4)];π hex_addr := hex_addr + hex_set[(regs.ch and $0f)];π hex_addr := hex_addr + hex_set[(regs.cl shr 4) ];π hex_addr := hex_addr + hex_set[(regs.cl and $0f)];π hex_addr := hex_addr + hex_set[(regs.bh shr 4)];π hex_addr := hex_addr + hex_set[(regs.bh and $0f)];π hex_addr := hex_addr + hex_set[(regs.bl shr 4)];π hex_addr := hex_addr + hex_set[(regs.bl and $0f)];π hex_addr := hex_addr + hex_set[(regs.ah shr 4)];π hex_addr := hex_addr + hex_set[(regs.ah and $0f)];π hex_addr := hex_addr + hex_set[(regs.al shr 4)];π hex_addr := hex_addr + hex_set[(regs.al and $0f)];π retcode := 0;πEnd; { Getnode }πππPROCEDURE Get_Internet_Address(station : integer; var net_number, node_addr,πsocket_number : string; var retcode : integer);πππConstπ Hex_Set :packed array[0..15] of char = '0123456789ABCDEF';ππVar Request_buffer : recordπ length : integer;π subfunction : byte;π connection : byte;π end;ππ Reply_Buffer : recordπ length : integer;π network : array [1..4] of byte;π node : array [1..6] of byte;π socket : array [1..2] of byte;π end;ππ count : integer;π _node_addr : string;π _socket_number : string;π _net_number : string;ππbeginπ With Regs doπ beginπ ah := $E3;π ds:=seg(request_buffer);π si:=ofs(request_buffer);π es:=seg(reply_buffer);π di:=ofs(reply_buffer);π End;π With request_buffer doπ beginπ length := 2;π subfunction := $13;π connection := station;π end;π With reply_buffer doπ beginπ length := 12;π for count := 1 to 4 do network[count] := 0;π for count := 1 to 6 do node[count] := 0;π for count := 1 to 2 do socket[count] := 0;π end;π msdos(regs);π retcode := regs.al;π _net_number := '';π _node_addr := '';π _socket_number := '';π if retcode = 0 thenπ beginπ for count := 1 to 4 doπ beginπ _net_number := _net_number + hex_set[ (reply_buffer.network[count] shr 4)π];π _net_number := _net_number + hex_set[ (reply_buffer.network[count] andπ$0F) ];π end;π for count := 1 to 6 doπ beginπ _node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] shr 4) ]);π _node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] and $0F)π]);π end;π for count := 1 to 2 doπ beginπ _socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count]πshr 4) ]);π _socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count]πand $0F) ]);π end;π end; {end of retcode=0}π net_number := _net_number;π node_addr := _node_addr;π socket_number := _socket_number;π end;ππprocedure get_realname(var userid,realname:string; var retcode:integer);πvarπ requestbuffer : recordπ buffer_length : array [1..2] of byte;π subfunction : byte;π object_type : array [1..2] of byte;π object_length : byte;π object_name : array [1..47] of byte;π segment : byte;π property_length : byte;π property_name : array [1..14] of byte;π end;ππ replybuffer : recordπ buffer_length : array [1..2] of byte;π property_value : array [1..128] of byte;π more_segments : byte;π property_flags : byte;π end;ππ count : integer;π id : string;π fullname : string;ππbeginπ id := 'IDENTIFICATION';π With requestbuffer do beginπ buffer_length[2] := 0;π buffer_length[1] := 69;π subfunction := $3d;π object_type[1]:= 0;π object_type[2]:= 01;π segment := 1;π object_length := 47;π property_length := length(id);π for count := 1 to 47 do object_name[count] := $0;π for count := 1 to length(userid) do object_name[count] :=πord(userid[count]);π for count := 1 to 14 do property_name[count] := $0;π for count := 1 to length(id) do property_name[count] := ord(id[count]);π end;π With replybuffer do beginπ buffer_length[1] := 130;π buffer_length[2] := 0;π for count := 1 to 128 do property_value[count] := $0;π more_segments := 1;π property_flags := 0;π end;π With Regs do beginπ Ah := $e3;π Ds := Seg(requestbuffer);π Si := Ofs(requestbuffer);π Es := Seg(replybuffer);π Di := Ofs(replybuffer);π end;π MSDOS(Regs);π retcode := Regs.al;π fullname := '';π count := 1;π if replybuffer.property_value[1] <> 0 thenπ repeatπ beginπ if replybuffer.property_value[count]<>0π then fullname := fullname + chr(replybuffer.property_value[count]);π count := count + 1;π end;π until ((count=128) or (replybuffer.property_value[count]=0));π {if regs.al = $96 then writeln('server out of memory');π if regs.al = $ec then writeln('no such segment');π if regs.al = $f0 then writeln('wilcard not allowed');π if regs.al = $f1 then writeln('invalid bindery security');π if regs.al = $f9 then writeln('no property read priv');π if regs.al = $fb then writeln('no such property');π if regs.al = $fc then writeln('no such object');}π if retcode=0 then realname := fullname else realname:='';πend;ππprocedure get_broadcast_mode(var bmode:integer);πbeginπ regs.ah := $de;π regs.dl := $04;π msdos(regs);π bmode := regs.al;πend;ππprocedure set_broadcast_mode(bmode:integer);πbeginπ if ((bmode > 3) or (bmode < 0)) then bmode := 0;π regs.ah := $de;π regs.dl := bmode;π msdos(regs);π bmode := regs.al;πend;ππprocedure get_broadcast_message(var bmessage: string; var retcode : integer);πvar requestbuffer : recordπ bufferlength : array [1..2] of byte;π subfunction : byte;π end;ππ replybuffer : recordπ bufferlength : array [1..2] of byte;π messagelength : byte;π message : array [1..58] of byte;π end;π count : integer;ππbeginπ With Requestbuffer do beginπ bufferlength[1] := 1;π bufferlength[2] := 0;π subfunction := 1;π end;π With replybuffer do beginπ bufferlength[1] := 59;π bufferlength[2] := 0;π messagelength := 0;π end;π for count := 1 to 58 do replybuffer.message[count] := $0;ππ With Regs do beginπ Ah := $e1;π Ds := Seg(requestbuffer);π Si := Ofs(requestbuffer);π Es := Seg(replybuffer);π Di := Ofs(replybuffer);π end;π MSDOS(Regs);π retcode := Regs.al;π bmessage := '';π count := 0;π if replybuffer.messagelength > 58 then replybuffer.messagelength := 58;π if replybuffer.messagelength > 0 thenπ for count := 1 to replybuffer.messagelength doπ bmessage := bmessage + chr(replybuffer.message[count]);π { retcode = 0 if no message, 1 if message was retreived }π if length(bmessage) = 0 then retcode := 1 else retcode := 0;π end;ππprocedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);πvar replybuffer : recordπ year : byte;π month : byte;π day : byte;π hour : byte;π minute : byte;π second : byte;π dow : byte;π end;ππbeginπ With Regs do beginπ Ah := $e7;π Ds := Seg(replybuffer);π Dx := Ofs(replybuffer);π end;π MSDOS(Regs);π retcode := Regs.al;π _year := replybuffer.year;π _month := replybuffer.month;π _day := replybuffer.day;π _hour := replybuffer.hour;π _min := replybuffer.minute;π _sec := replybuffer.second;π _dow := replybuffer.dow;πend;ππprocedure set_date_from_server;πvar replybuffer : recordπ year : byte;π month : byte;π day : byte;π hour : byte;π minute : byte;π second : byte;π dow : byte;π end;ππbeginπ With Regs do beginπ Ah := $e7;π Ds := Seg(replybuffer);π Dx := Ofs(replybuffer);π end;π MSDOS(Regs);π setdate(replybuffer.year+1900,replybuffer.month,replybuffer.day);πend;ππprocedure set_time_from_server;πvar replybuffer : recordπ year : byte;π month : byte;π day : byte;π hour : byte;π minute : byte;π second : byte;π dow : byte;π end;ππbeginπ With Regs do beginπ Ah := $e7;π Ds := Seg(replybuffer);π Dx := Ofs(replybuffer);π end;π MSDOS(Regs);π settime(replybuffer.hour,replybuffer.minute,replybuffer.second,0);πend;ππprocedure get_server_version(var _version : string);πvar count,x : integer;ππ request_buffer : recordπ buffer_length : integer;π subfunction : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π stuff : array [1..512] of byte;π end;ππ strings : array [1..3] of string;πbeginπ With Regs do beginπ Ah := $e3;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π With request_buffer doπ beginπ buffer_length := 1;π subfunction := $c9;π end;π With reply_buffer doπ beginπ buffer_length := 512;π for count := 1 to 512 do stuff[count] := $00;π end;π MSDOS(Regs);π for count := 1 to 3 do strings[count] := '';π x := 1;π With reply_buffer doπ beginπ for count := 1 to 256 doπ beginπ if stuff[count] <> $0 thenπ beginπ if not ((stuff[count]=32) and (strings[x]='')) then strings[x] :=πstrings[x] + chr(stuff[count]);π end;π if stuff[count] = $0 then if x <> 3 then x := x + 1;π end;π End; { end of with }π _version := strings[2];πend;ππprocedure open_message_pipe(var _connection, retcode : integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π connection_count : byte;π connection_list : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π connection_count : byte;π result_list : byte;π end;πbeginπ With Regs do beginπ Ah := $e1;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π With request_buffer doπ beginπ buffer_length := 3;π subfunction := $06;π connection_count := $01;π connection_list := _connection;π end;π With reply_buffer doπ beginπ buffer_length := 2;π connection_count := 0;π result_list := 0;π end;π MSDOS(Regs);π retcode := reply_buffer.result_list;πend;ππprocedure close_message_pipe(var _connection, retcode : integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π connection_count : byte;π connection_list : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π connection_count : byte;π result_list : byte;π end;πbeginπ With Regs do beginπ Ah := $e1;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π With request_buffer doπ beginπ buffer_length := 3;π subfunction := $07;π connection_count := $01;π connection_list := _connection;π end;π With reply_buffer doπ beginπ buffer_length := 2;π connection_count := 0;π result_list := 0;π end;π MSDOS(Regs);π retcode := reply_buffer.result_list;πend;ππprocedure check_message_pipe(var _connection, retcode : integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π connection_count : byte;π connection_list : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π connection_count : byte;π result_list : byte;π end;πbeginπ With Regs do beginπ Ah := $e1;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π With request_buffer doπ beginπ buffer_length := 3;π subfunction := $08;π connection_count := $01;π connection_list := _connection;π end;π With reply_buffer doπ beginπ buffer_length := 2;π connection_count := 0;π result_list := 0;π end;π MSDOS(Regs);π retcode := reply_buffer.result_list;πend;πππprocedure send_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);πvar count : integer;ππ request_buffer : recordπ buffer_length : integer;π subfunction : byte;π connection_count : byte;π connection_list : byte;π message_length : byte;π message : array [1..126] of byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π connection_count : byte;π result_list : byte;π end;ππbeginπ With Regs do beginπ Ah := $e1;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π With request_buffer doπ beginπ subfunction := $04;π connection_count := $01;π connection_list := _connection;π message_length := length(_message);π buffer_length := length(_message) + 4;π for count := 1 to 126 do message[count] := $00;π if message_length > 0 then for count := 1 to message_length doπ message[count] := ord(_message[count]);π end;π With reply_buffer doπ beginπ buffer_length := 2;π connection_count := 0;π result_list := 0;π end;π MSDOS(Regs);π retcode := reply_buffer.result_list;πend;ππprocedure purge_erased_files(var retcode:integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π end;πbeginπ With request_buffer doπ beginπ buffer_length := 1;π subfunction := $10;π end;π With reply_buffer do buffer_length := 0;π With Regs do beginπ Ah := $E2;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π msdos(regs);π retcode := regs.al;πend;ππprocedure purge_all_erased_files(var retcode:integer);πvar request_buffer : recordπ buffer_length : integer;π subfunction : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π end;πbeginπ With request_buffer doπ beginπ buffer_length := 1;π subfunction := $CE;π end;π With reply_buffer do buffer_length := 0;π With Regs do beginπ Ah := $E3;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π msdos(regs);π retcode := regs.al;πend;πππprocedure get_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);πvar count : integer;ππ request_buffer : recordπ buffer_length : integer;π subfunction : byte;π end;ππ reply_buffer : recordπ buffer_length : integer;π source_connection : byte;π message_length : byte;π message_buffer : array [1..126] of byte;π end;ππbeginπ With Regs do beginπ Ah := $e1;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π With request_buffer doπ beginπ buffer_length := 1;π subfunction := $05;π end;π With reply_buffer doπ beginπ buffer_length := 128;π source_connection := 0;π message_length := 0;π for count := 1 to 126 do message_buffer[count] := $0;π end;π MSDOS(Regs);π _connection := reply_buffer.source_connection;π _message := '';π retcode := reply_buffer.message_length;π if retcode > 0 then for count := 1 to retcode doπ _message := _message + chr(reply_buffer.message_buffer[count]);πend;ππprocedure log_file(lock_directive:integer; log_filename: string;πlog_timeout:integer; var retcode:integer);πbeginπ With Regs do beginπ Ah := $eb;π Ds := Seg(log_filename);π Dx := Ofs(log_filename);π BP := log_timeout;π end;πmsdos(regs);πretcode := regs.al;πend;ππprocedure release_file(log_filename: string; var retcode:integer);πbeginπ With Regs do beginπ Ah := $ec;π Ds := Seg(log_filename);π Dx := Ofs(log_filename);π end;πmsdos(regs);πretcode := regs.al;πend;ππprocedure clear_file(log_filename: string; var retcode:integer);πbeginπ With Regs do beginπ Ah := $ed;π Ds := Seg(log_filename);π Dx := Ofs(log_filename);π end;πmsdos(regs);πretcode := regs.al;πend;ππprocedure clear_file_set;πbeginπ regs.Ah := $cf;π msdos(regs);π retcode := regs.al;πend;ππprocedure lock_file_set(lock_timeout:integer; var retcode:integer);πbeginπ regs.ah := $CB;π regs.bp := lock_timeout;π msdos(regs);π retcode := regs.al;πend;ππprocedure release_file_set;πbeginπ regs.ah := $CD;π msdos(regs);πend;ππprocedure open_semaphore( _name:string;π _initial_value:shortint;π var _open_count:integer;π var _handle:longint;π var retcode:integer);πvar s_name : array [1..129] of byte;π count : integer;π semaphore_handle : array [1..2] of word;πbeginπ if (_initial_value < 0) or (_initial_value > 127) then _initial_value := 0;π for count := 1 to 129 do s_name[count] := $00; {zero buffer}π if length(_name) > 127 then _name := copy(_name,1,127); {limit name length}π if length(_name) > 0 then for count := 1 to length(_name) do s_name[count+1]π:= ord(_name[count]);π s_name[1] := length(_name);π regs.ah := $C5;π regs.al := $00;π move(_initial_value, regs.cl, 1);π regs.ds := seg(s_name);π regs.dx := ofs(s_name);π regs.es := 0;π msdos(regs);π retcode := regs.al;π if retcode = 0 then _open_count := regs.bl else _open_count := 0;π semaphore_handle[1]:=regs.cx;π semaphore_handle[2]:=regs.dx;π move(semaphore_handle,_handle,4);πend;ππprocedure close_semaphore(var _handle:longint; var retcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ move(_handle,semaphore_handle,4);π regs.ah := $C5;π regs.al := $04;π regs.ds := 0;π regs.es := 0;π regs.cx := semaphore_handle[1];π regs.dx := semaphore_handle[2];π msdos(regs);π retcode := regs.al; { 00h=successful FFh=Invalid handle}πend;ππprocedure examine_semaphore(var _handle:longint; var _value:shortint; varπ_count, retcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ move(_handle,semaphore_handle,4);π regs.ah := $C5;π regs.al := $01;π regs.ds := 0;π regs.es := 0;π regs.cx := semaphore_handle[1];π regs.dx := semaphore_handle[2];π msdos(regs);π retcode := regs.al; {00h=successful FFh=invalid handle}π move(regs.cx, _value, 1);π _count := regs.dl;πend;ππprocedure signal_semaphore(var _handle:longint; var retcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ move(_handle,semaphore_handle,4);π regs.ah := $C5;π regs.al := $03;π regs.ds := 0;π regs.es := 0;π regs.cx := semaphore_handle[1];π regs.dx := semaphore_handle[2];π msdos(regs);π retcode := regs.al;π {00h=successful 01h=overflow value > 127 FFh=invalid handle}πend;ππprocedure wait_on_semaphore(var _handle:longint; _timeout:integer; varπretcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ move(_handle,semaphore_handle,4);π regs.ah := $C5;π regs.al := $02;π regs.ds := 0;π regs.es := 0;π regs.bp := _timeout; {units in 1/18 of second, 0 = no wait}π regs.cx := semaphore_handle[1];π regs.dx := semaphore_handle[2];π msdos(regs);π retcode := regs.al;π {00h=successful FEh=timeout failure FFh=invalid handle}πend;ππprocedure clear_connection(connection_number : integer; var retcode :πinteger);πvar con_num : byte;ππ request_buffer : recordπ length : integer;π subfunction : byte;π con_num : byte;π end;ππ reply_buffer : recordπ length : integer;π end;ππbeginπ with request_buffer do beginπ length := 4;π con_num := connection_number;π subfunction := $D2;π end;π reply_buffer.length := 0;π with regs do beginπ Ah := $e3;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π msdos(regs);π retcode := regs.al;πend;πππprocedure get_server_lan_driver_information(var _lan_board_number : integer;π{ This will return info on what } var _text1,_text2:string;π{ type of network cards are being } var _network_address : byte4;π{ used in the server. } var _host_address : byte6;π var _driver_installed,π _option_number,π _retcode : integer);ππvar count : integer;π text : array [1..3] of string;π x1 : integer;ππ request_buffer : recordπ length : integer;π subfunction : byte;π lan_board : byte;π end;ππ reply_buffer : recordπ length : integer;π network_address : byte4;π host_address : byte6;π lan_driver_installed : byte;π option_number : byte;π configuration_text : array [1..160] of byte;π end;πbeginπ with request_buffer do beginπ length := 2;π subfunction := $E3;π lan_board := _lan_board_number; { 0 to 3 }π end;π with reply_buffer do beginπ length := 174;π for count := 1 to 4 do network_address[count] := $0;π for count := 1 to 6 do host_address[count] := $0;π lan_driver_installed := 0;π option_number := 0;π for count := 1 to 160 do configuration_text[count] := $0;π end;π with regs do beginπ Ah := $E3;π Ds := Seg(request_buffer);π Si := Ofs(request_buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π end;π msdos(regs);π retcode := regs.al;π _text1 := '';π _text2 := '';π if retcode <> 0 then exit;π _driver_installed := reply_buffer.lan_driver_installed;π if reply_buffer.lan_driver_installed = 0 then exit;π {-- set some values ---}π for count := 1 to 3 do text[count] := '';π x1 := 1;π with reply_buffer do beginπ _network_address := network_address;π _host_address := host_address;π _option_number := option_number;π for count := 1 to 160 doπ beginπ if ((configuration_text[count] = 0) and (x1 <> 3)) then x1 := x1+1;π if configuration_text[count] <> 0 thenπ text[x1] := text[x1] + chr(configuration_text[count]);π end;π end;π _text1 := text[1];π _text2 := text[2];πend;ππend. { end of unit novell }π 22 05-26-9411:03ALL R. GILOMEN Novell IPX functions IMPORT 398 ,î UNIT IPX;π(****************************************************************************)π(* *)π(* PROJEKT : PASCAL Treiber fuer Novell-NetWare *)π(* MODULE : IPX.PAS *)π(* VERSION : 1.10C *)π(* COMPILER : Turbo Pascal V 6.0 *)π(* DATUM : 13.06.91 *)π(* AUTOR : R. Gilomen *)π(* GEPRUEFT : R. Gilomen *)π(* *)π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Bibliothek mit den IPX-Grunfunktionen. Dieses Modul *)π(* wurde mit IPX Version 2.12 getestet. *)π(* *)π(*--------------------------------------------------------------------------*)π(* *)π(* MODIFIKATIONEN : *)π(* *)π(* Version 1.00A 20.02.91 R. Gilomen Initial Version *)π(* Version 1.10A 28.02.91 R. Gilomen Neue Funktionen *)π(* IPX_To_Addr *)π(* IPX_From_Addr *)π(* IPX_Internetwork_Address *)π(* Version 1.10B 07.03.91 R. Gilomen Fehler in Funktion IPX_Done *)π(* behoben. Bei SEND wurde *)π(* Source.Socket veraendert. *)π(* Version 1.10C 13.06.91 R. Gilomen Defaultwert fuer Parameter *)π(* STAY_OPEN auf $FF gesetzt. *)π(* *)π(****************************************************************************)πππ(*//////////////////////////////////////////////////////////////////////////*)π INTERFACEπ(*//////////////////////////////////////////////////////////////////////////*)πππ(*==========================================================================*)π(* DEKLARATIONEN / DEFINITIONEN *)π(*==========================================================================*)ππCONSTππ(* Allgemeine Deklarationen *)ππ MAX_SOCKETS = 20; (* Maximale Anzahl konfigurierte *)π (* Kommunikationssockel. *)π MAX_DATA_SIZE = 546; (* Maximale Datenlaenge *)π NET_LENGTH = 4; (* Laenge Netzwerkadresse *)π NODE_LENGTH = 6; (* Laenge Knotenadresse *)π ππ(* Code Deklarationen *)ππ SEND = $10;π RECEIVE = $20;πππ(* Deklaration der Rueckgabewerte *)ππ SUCCESS = $00;π NOT_ENDED = $10;π PARAMETER_ERROR = $20;π NO_DESTINATION = $21;π DEVICE_SW_ERROR = $30;π SOCKET_TABLE_FULL = $31;π PACKET_BAD = $32;π PACKET_UNDELIVERIABLE = $33;π PACKET_OVERFLOW = $34;π DEVICE_HW_ERROR = $40;πππTYPE S4Byte = ARRAY [1..4] OF BYTE; (* Datentyp fuer Network *)π S6Byte = ARRAY [1..6] OF BYTE; (* Datentyp fuer Node *)ππ (* Datentyp fuer Daten *)π Data_Packet = ARRAY [1..MAX_DATA_SIZE] OF CHAR;ππ SData = RECORD (* Daten und Laenge *)π Data : Data_Packet;π Length : WORD;π END;ππ Network_Address = RECORD (* Datentyp fuer NW-Adr. *)π Network : S4Byte;π Node : S6Byte;π Socket : WORD;π END;πππ(*==========================================================================*)π(* PROZEDUREN / FUNKTIONEN *)π(*==========================================================================*)πππFUNCTION IPX_Setup : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine initialisiert die IPX-Software und deren *)π(* Funktion. *)π(* *)π(* *)π(* PARAMETER : IN : - *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Open_Socket ( VAR Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine eroeffnet einen Kommunikationssockel. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Nummer des Sockels, der eroeffnet *)π(* werden soll. *)π(* *)π(* OUT: Socket = Nummer des Sockels, der effektiv *)π(* geoeffnet wurde. *)π(* *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Close_Socket ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine schliesst einen Kommunikationssockel. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Nummer des Sockels, der geschlos- *)π(* sen werden soll. *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Send ( Socket : WORD;π Dest_Addr : Network_Address;π Buffer : SDataπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine dient zum senden von Daten an eine oder *)π(* mehrere Gegenstationen. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Sockelnummer, auf der gesendet *)π(* werden soll. *)π(* Dest_Addr = Vollstaendige Netwerkadresse der *)π(* Gegenstation(en). *)π(* Buffer = Daten die gesendet werden und *)π(* dessen Laenge. *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Receive ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine dient zum Empfangen von Daten einer Gegen- *)π(* station. Die Daten koennen, wenn das Kommando beendet *)π(* ist, mit der Funktion IPX_Done vom Netzwerk abgeholt *)π(* werden. *)π(* *)π(* PARAMETER : IN : Socket = Sockelnummer, auf der empfangen *)π(* werden soll. *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Done ( Socket : WORD;π Code : BYTE;π VAR Source_Addr : Network_Address;π VAR Buffer : SDataπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Funktion liefert den Status einer vorher abgesetz- *)π(* ten Routine. Zurueckgegeben wird, ob die Routine schon *)π(* beendet ist oder nicht sowie eventuelle Daten. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Sockelnummer, auf der die Funktion *)π(* ausgefuehrt werden soll. *)π(* Code = Routine, deren Status ueberprueft *)π(* werden soll. *)π(* *)π(* OUT: Source_Addr = Vollstaendige Netzwerkadresse der *)π(* Gegenstation, von der Daten einge- *)π(* troffen sind. *)π(* Buffer = Buffer, in dem eventuelle Daten *)π(* abgelegt werden koennen. *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Internetwork_Address ( VAR Network : S4Byte;π VAR Node : S6Byteπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Funktion liefert die Internetzwerkadresse der *)π(* jeweiligen Station. *)π(* *)π(* *)π(* PARAMETER : OUT: Network = Netzwerkadresse *)π(* Node = Knotenadresse *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_To_Addr ( Network : String;π Node : String;π Socket : String;π VAR Addr : Network_Addressπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine konvertiert die Eingabestrings in die Daten- *)π(* struktur Network_Address. *)π(* *)π(* *)π(* PARAMETER : IN : Network = Netzwerkadresse die konvertiert *)π(* werden soll. *)π(* Node = Knotenadresse die konvertiert *)π(* werden soll. *)π(* Socket = Sockelnummer die konvertiert *)π(* werden soll. *)π(* *)π(* OUT: Addr = Konvertierte vollsaendige Netz- *)π(* werkadresse. *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_From_Addr ( Addr : Network_Address;π VAR Network : String;π VAR Node : String;π VAR Socket : Stringπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine konvertiert die vollstaendige Netzwerk- *)π(* adresse in String's. *)π(* *)π(* *)π(* PARAMETER : IN : Addr = Vollstaendige Netzwerkadresse *)π(* *)π(* OUT: Network = Netzwerkadresse die konvertiert *)π(* wurde. *)π(* Node = Knotenadresse die konvertiert *)π(* wurde. *)π(* Socket = Sockelnummer die konvertiert *)π(* wurde. *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)πππππ(*//////////////////////////////////////////////////////////////////////////*)π IMPLEMENTATIONπ(*//////////////////////////////////////////////////////////////////////////*)πππ(*==========================================================================*)π(* UNITS IMPORT *)π(*==========================================================================*)ππUSES Dos;ππ(*==========================================================================*)π(* DEKLARATIONEN / DEFINITIONEN *)π(*==========================================================================*)πππCONSTππ(* Allgemeine Definitionen *)ππ HEADER = 30; (* Groesse IPX-Header *)π PACKET_SIZE = 576; (* IPX-Paket groesse *)πππ(* Definitionen der IPX-Funktionen *)ππ IPX_TST = $7A00; (* Vorbereiten fuer IPX Test *)π MUX_INTR = $2F; (* Multiplex Interrupt *)π OPEN_SOCKET = $0000; (* Oeffnet einen Sockel *)π CLOSE_SOCKET = $0001; (* Schliesst einen Sockel *)π GET_TARGET = $0002; (* Pruefe Gegenstation *)π DO_SEND = $0003; (* Sendet ein Paket *)π DO_RECEIVE = $0004; (* Empfaengt Pakete *)π GET_ADDR = $0009; (* Bestimmt Internetzwerkadresse *)πππ(* Definitionen der IPX-Parameter *)ππ STAY_OPEN = $FF; (* $00 : Sockel bleibt geoeffnet, *)π (* bis er explizit geschlossen wird *)π (* oder das Programm terminiert. *)π (* $FF : Sockel bleibt geoeffnet, *)π (* bis er explizit geschlossen wird. *)π (* Wird benoetigt fuer TSR-Programme.*)ππ(* Definitionen der IPX-Rueckgabewerte *)ππ IPX_LOADED = $FF; (* IPX ist geladen *)π OPENED = $00; (* Sockel erfolgreich geoeffnet *)π ALREADY_OPEN = $FF; (* Sockel ist bereits goeffnet *)π TABLE_FULL = $FE; (* Sockel Tabelle ist voll *)π EXIST = $00; (* Weg zu Gegenstation existiert *)π NO_SOCKET = $FF; (* Sockel existiert nicht *)π SEND_OK = $00; (* Senden war erfolgreich *)π SOCKET_ERROR = $FC; (* Sockel existiert nicht mehr *)π SIZE_ERROR = $FD; (* Paketgroesse nicht korrekt *)π UNDELIV = $FE; (* Paket nicht ausgeliefert *)π OVERFLOW = $FD; (* Buffer zu klein *)π HW_ERROR = $FF; (* Hardware defekt *)π REC_OK = $00; (* Paket erfolgreich empfangen *)πππ(* Definition der ECB-Parameter *)ππ FINISHED = $00; (* Routine beendet *)π FRAG_COUNT = 1; (* Anzahl Fragmente *)π UNKNOWN = 0; (* Unbekannter Paket Typ *)ππ(* Deklarationen *)ππTYPE S12Byte = ARRAY [1..12] OF BYTE; (* Interner Datentyp *)ππ IPX_Packet = RECORD (* IPX-Paket Struktur *)π CheckSum : WORD;π Length : WORD;π TransportControl : BYTE;π PacketType : BYTE;π Destination : Network_Address;π Source : Network_Address;π IPX_Data : Data_Packet;π END;ππ ECB_Fragment = RECORD (* Fragment der ECB Struktur *)π Address : ^IPX_Packet;π Size : WORD;π END;ππ ECB = RECORD (* ECB Datenstruktur *)π Link_Adress : S4Byte;π ESR_Address : ^BYTE;π InUseFlag : BYTE;π CompletionCode : BYTE;π SocketNumber : WORD;π IPX_Workspace : S4Byte;π DriverWorkspace : S12Byte;π ImmediateAddress : S6Byte;π FragmentCount : WORD;π FragDescr : ECB_Fragment;π END;πππ Int_Addr = RECORD (* Datenstruktur Internetzwerkadr. *)π Network : S4Byte;π Node : S6Byte;π END;πππVAR IPX_Location : ARRAY [1..2] OF WORD; (* Adresse von IPX *)ππ (* Array in dem die ECB's *)π (* verwaltet werden. *)π ECB_Table : ARRAY [1..MAX_SOCKETS] OF ^ECB;πππ(*==========================================================================*)π(* PROZEDUREN / FUNKTIONEN *)π(*==========================================================================*)πππPROCEDURE IPX_Call ( VAR Regs : Registers );π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Diese Prozedur setzt die in Regs spezifizierten *)π(* Register des Prozessors. Anschliessend wird ein IPX- *)π(* Call ausgefuehrt und die Register wieder ausgelesen. *)π(* Es werden nicht alle Register der Datenstruktur *)π(* Regs uebernommen! *)π(* *)π(* PARAMETER : IN : Regs = Register, die gesetzt werden *)π(* sollen. *)π(* *)π(* OUT: Regs = Register, die vom IPX gesetzt *)π(* wurden (Return values). *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR Temp_AX, Temp_BX, Temp_CX, Temp_DX,π Temp_ES, Temp_SI, Temp_DI : WORD;ππBEGINπ Temp_AX := Regs.AX;π Temp_BX := Regs.BX;π Temp_CX := Regs.CX;π Temp_DX := Regs.DX;π Temp_SI := Regs.SI;π Temp_ES := Regs.ES;π Temp_DI := Regs.DI;π ASMπ PUSH BP (* Register sichern *)π PUSH SPπ PUSH SSπ PUSH DSπ PUSH AXπ PUSH BXπ PUSH CXπ PUSH DXπ PUSH SIπ PUSH ESπ PUSH DIπ MOV AX, Temp_AX (* Register setzen *)π MOV BX, Temp_BXπ MOV CX, Temp_CXπ MOV DX, Temp_DXπ MOV SI, Temp_SIπ MOV ES, Temp_ESπ MOV DI, Temp_DIπ CALL DWORD PTR IPX_Location (* IPX aufrufen *)π MOV Temp_AX, AX (* Register auslesen *)π MOV Temp_BX, BXπ MOV Temp_CX, CXπ MOV Temp_DX, DXπ MOV Temp_SI, SIπ MOV Temp_ES, ESπ MOV Temp_DI, DIπ POP DIπ POP ES (* Gesicherte Register wieder *)π POP SI (* zuruecksetzen. *)π POP DXπ POP CXπ POP BXπ POP AXπ POP DS π POP SS π POP SPπ POP BPπ END;ππ Regs.AX := Temp_AX;π Regs.BX := Temp_BX;π Regs.CX := Temp_CX;π Regs.DX := Temp_DX;π Regs.SI := Temp_SI;π Regs.ES := Temp_ES;π Regs.DI := Temp_DI;πEND;ππππFUNCTION IPX_Setup : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine initialisiert die IPX-Software und deren *)π(* Funktion. *)π(* *)π(* *)π(* PARAMETER : IN : - *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR i : INTEGER; (* Laufvariable *)π Temp_Reg : Registers; (* Temporaere Register fuer Int. *)πππBEGINπ Temp_Reg.AX := IPX_TST; (* Test ob IPX geladen. *)π Intr (MUX_INTR,Temp_Reg);π IF (Temp_Reg.AL <> IPX_LOADED) THENπ BEGINπ IPX_Setup := DEVICE_SW_ERROR; (* IPX nicht geladen *)π EXIT;π END;π Temp_Reg.AX := Temp_Reg.ES;π IPX_Location[1] := Temp_Reg.DI; (* Adresse von IPX sichern *)π IPX_Location[2] := Temp_Reg.AX;ππ FOR i := 1 TO MAX_SOCKETS DO (* Array fuer ECB init. *)π ECB_Table[i] := NIL;ππ IPX_Setup := SUCCESS; (* Initialisierung erfolgreich *)πEND;ππππFUNCTION IPX_Open_Socket ( VAR Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine eroeffnet einen Kommunikationssockel. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Nummer des Sockels, der eroeffnet *)π(* werden soll. *)π(* *)π(* OUT: Socket = Nummer des Sockels, der effektiv *)π(* geoeffnet wurde. *)π(* *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR i : INTEGER; (* Laufvariable *)π Index : INTEGER; (* Index auf ECB_Table *)ππ Temp_Reg : Registers; (* Temporaere Register fuer IPX-Call *)πππBEGINπ Socket := Swap(Socket); (* In Motorola Format konvertieren *)ππ FOR i := 1 TO MAX_SOCKETS DO (* Pruefen, ob Sockel existiert *)π IF ECB_Table[i] <> NIL THENπ IF Socket = ECB_Table[i]^.SocketNumber THENπ BEGINπ IPX_Open_Socket := PARAMETER_ERROR;π EXIT;π END;ππ Index := 1;π WHILE (ECB_Table[Index] <> NIL) DO (* Pruefen, ob alle Sockel belegt *)π BEGIN (* falls es noch freie ECB hat, *)π IF Index >= MAX_SOCKETS THEN (* steht Index auf einem solchen. *)π BEGINπ IPX_Open_Socket := SOCKET_TABLE_FULL;π EXIT;π END;π Index := Index + 1;π END;ππ Temp_Reg.BX := OPEN_SOCKET; (* Register fuer Call vorbereiten *)π Temp_Reg.AL := STAY_OPEN;π Temp_Reg.DX := Socket;ππ IPX_Call (Temp_Reg);ππ Socket := Temp_Reg.DX; (* Register auslesen *)ππ IF Temp_Reg.AL <> OPENED THEN (* IPX nicht i.O. *)π BEGINπ IPX_Open_Socket := DEVICE_SW_ERROR;π EXIT;π END;ππ NEW (ECB_Table[Index]); (* Vollstaendiger ECB erzeugen *)π NEW (ECB_Table[Index]^.FragDescr.Address);π ECB_Table[Index]^.SocketNumber := Socket;ππ Socket := Swap(Socket); (* Zurueck in INTEL Format konv. *)π IPX_Open_Socket := SUCCESS;ππEND;ππππFUNCTION IPX_Close_Socket ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine schliesset einen Kommunikationssockel. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Nummer des Sockels, der geschlos- *)π(* sen werden soll. *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR Index : INTEGER; (* Index auf ECB_Table *)ππ Temp_Reg : Registers; (* Temporaere Register fuer IPX-Call *)πππBEGINπ Socket := Swap(Socket); (* In Motorola Format konvertieren *)ππ Index := 1; (* Sockel suchen *)π WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ BEGIN π IF Index >= MAX_SOCKETS THENπ BEGINπ IPX_Close_Socket := PARAMETER_ERROR; (* Sockel existiert nicht *)π EXIT;π END;π Index := Index + 1;π END;ππ Temp_Reg.BX := CLOSE_SOCKET; (* Register fuer Call vorbereiten *)π Temp_Reg.DX := Socket;ππ IPX_Call (Temp_Reg);ππ (* Allozierter Speicher freigeben *)π DISPOSE (ECB_Table[Index]^.FragDescr.Address);π ECB_Table[Index]^.FragDescr.Address := NIL;π DISPOSE (ECB_Table[Index]);π ECB_Table[Index] := NIL;π ππ IPX_Close_Socket := SUCCESS;ππEND;ππππFUNCTION IPX_Send ( Socket : WORD;π Dest_Addr : Network_Address;π Buffer : SDataπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine dient zum senden von Daten an eine oder *)π(* mehrere Gegenstation(en). *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Sockelnummer, auf der gesendet *)π(* werden soll. *)π(* Dest_Addr = Vollstaendige Netwerkadresse der *)π(* Gegenstation(en). *)π(* Buffer = Daten die gesendet werden und *)π(* dessen Laenge. *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR i : INTEGER; (* Laufvariable *)π Index : INTEGER; (* Index auf ECB_Table *)ππ Temp_Reg : Registers; (* Temporaere Register fuer IPX-Call *)ππ Temp_Imm_Addr : S6Byte; (* Temporaere ImmdediateAddress *)ππ Temp_Addr : S12Byte; (* Temporaere Internetworkadresse *)πππBEGINπ Socket := Swap(Socket); (* In Motorola Format konvertieren *)π Dest_Addr.Socket := Swap(Dest_Addr.Socket);ππ Index := 1; (* Sockel suchen *)π WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ BEGINπ IF Index >= MAX_SOCKETS THENπ BEGINπ IPX_Send := PARAMETER_ERROR; (* Sockel existiert nicht *)π EXIT;π END;π Index := Index + 1;π END;ππ IF Buffer.Length > MAX_DATA_SIZE THEN (* Laenge der Daten pruefen *)π BEGINπ IPX_Send := PARAMETER_ERROR;π EXIT;π END;ππ WITH Dest_Addr DO (* Pruefe ob Gegenstation erreichbar *)π BEGINπ FOR i := 1 TO NET_LENGTH DO (* Internetzwerkadresse zusammenst. *)π Temp_Addr[i] := Network[i];π FOR i := 1 TO NODE_LENGTH DOπ Temp_Addr[i + NET_LENGTH] := Node[i];π Temp_Addr[11] := Lo(Socket); (* Low-Byte *)π Temp_Addr[12] := HI(Socket); (* High-Byte *)π END;ππ Temp_Reg.ES := Seg(Temp_Addr); (* Register fuer Call vorbereiten *)π Temp_Reg.SI := Ofs(Temp_Addr);ππ Temp_Reg.DI := Ofs(Temp_Imm_Addr);π Temp_Reg.BX := GET_TARGET;ππ IPX_Call (Temp_Reg);ππ ECB_Table[Index]^.ImmediateAddress := Temp_Imm_Addr;ππ IF Temp_Reg.AL <> EXIST THENπ BEGINπ IPX_Send := NO_DESTINATION; (* Weg nicht verfuegbar *)π EXIT;π END;ππ WITH ECB_Table[Index]^ DO (* ECB mit Parametern fuellen *)π BEGINπ ESR_Address := NIL;π SocketNumber := Socket;π InUseFlag := FINISHED;π FragmentCount := FRAG_COUNT;π WITH FragDescr.Address^ DO (* IPX-Header vorbereiten *)π BEGINπ PacketType := UNKNOWN;π WITH Destination DOπ BEGINπ Network := Dest_Addr.Network;π Node := Dest_Addr.Node;π Socket := Dest_Addr.Socket;π END;π IPX_Data := Buffer.Data;π END;π FragDescr.Size := Buffer.Length + 30;π END;ππ Temp_Reg.ES := Seg(ECB_Table[Index]^); (* Register fuer Call vorbereiten *)π Temp_Reg.SI := Ofs(ECB_Table[Index]^);π Temp_Reg.BX := DO_SEND;ππ IPX_Call (Temp_Reg);ππ IPX_Send := SUCCESS;ππEND;ππππFUNCTION IPX_Receive ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine dient zum Empfangen von Daten einer Gegen- *)π(* station. Die Daten koennen, wenn das Kommando beendet *)π(* ist, mit der Funktion IPX_Done vom Netzwerk abgeholt *)π(* werden. *)π(* *)π(* PARAMETER : IN : Socket = Sockelnummer, auf der empfangen *)π(* werden soll. *)π(* *)π(* OUT: Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR Index : INTEGER; (* Index auf ECB *)π i : INTEGER; (* Laufvariable *)ππ Temp_Reg : Registers; (* Temporaere Register fuer IPX-Call *)πππBEGINπ Socket := Swap(Socket); (* In Motorola Format konvertieren *)ππ Index := 1; (* Sockel suchen *)π WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ BEGINπ IF Index >= MAX_SOCKETS THENπ BEGINπ IPX_Receive := PARAMETER_ERROR; (* Sockel existiert nicht *)π EXIT;π END;π Index := Index + 1;π END;ππ WITH ECB_Table[Index]^ DO (* ECB mit Parametern fuellen *)π BEGINπ ESR_Address := NIL;π FragmentCount := FRAG_COUNT;π FragDescr.Size := PACKET_SIZE;π InUseFlag := FINISHED;π END;ππ Temp_Reg.ES := Seg(ECB_Table[Index]^); (* Register vorbereiten *)π Temp_Reg.SI := Ofs(ECB_Table[Index]^);π Temp_Reg.BX := DO_RECEIVE;ππ IPX_Call (Temp_Reg);ππ IF Temp_Reg.AL = NO_SOCKET THENπ BEGINπ IPX_Receive := DEVICE_SW_ERROR;π EXIT;π END;ππ IPX_Receive := SUCCESS;ππEND;πππππFUNCTION IPX_Done ( Socket : WORD;π Code : BYTE;π VAR Source_Addr : Network_Address;π VAR Buffer : SDataπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Funktion liefert den Status einer vorher abgesetz- *)π(* ten Routine. Zurueckgegeben wird, ob die Routine schon *)π(* beendet ist oder nicht sowie eventuelle Daten. *)π(* *)π(* *)π(* PARAMETER : IN : Socket = Sockelnummer, auf der die Funktion *)π(* ausgefuehrt werden soll. *)π(* Code = Routine, deren Status ueberprueft *)π(* werden soll. *)π(* *)π(* OUT: Source_Addr = Vollstaendige Netzwerkadresse der *)π(* Gegenstation, von der Daten einge- *)π(* troffen sind. *)π(* Buffer = Buffer, in dem eventuelle Daten *)π(* abgelegt werden koennen. *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR i : INTEGER; (* Laufvariable *)π Index : INTEGER; (* Index auf ECB_Table *)ππ Temp_Reg : Registers; (* Temporaere Register fuer IPX-Call *)πππBEGINπ Socket := Swap(Socket); (* In Motorola Format konvertieren *)ππ Index := 1; (* Sockel suchen *)π WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ BEGINπ IF Index >= MAX_SOCKETS THENπ BEGINπ IPX_Done := PARAMETER_ERROR; (* Sockel existiert nicht *)π EXIT;π END;π Index := Index + 1;π END;π (* Test ob Funktion beendet *)π IF ECB_Table[Index]^.InUseFlag <> FINISHED THENπ BEGINπ IPX_Done := NOT_ENDED;π EXIT;π END;ππ CASE Code OFπ SEND :π BEGIN (* Send Completion Code auswerten *)π CASE ECB_Table[Index]^.CompletionCode OFπ SEND_OK : ;π SOCKET_ERROR : BEGINπ IPX_Done := DEVICE_SW_ERROR;π EXIT;π END;π SIZE_ERROR : BEGINπ IPX_Done := PACKET_BAD;π EXIT;π END;π UNDELIV : BEGINπ IPX_Done := PACKET_UNDELIVERIABLE;π EXIT;π END;π HW_ERROR : BEGINπ IPX_Done := DEVICE_HW_ERROR;π EXIT;π ENDπ ELSE BEGINπ IPX_Done := DEVICE_SW_ERROR;π EXIT;π END;π END;π END;π RECEIVE :π BEGIN (* Receive Completion Code auswerten *)π CASE ECB_Table[Index]^.CompletionCode OFπ REC_OK : BEGIN (* Daten in Benutzerbuffer kopieren *)π WITH ECB_Table[Index]^.FragDescr DOπ BEGINπ Buffer.Data := Address^.IPX_Data;π Buffer.Length := Swap(Address^.Length) - HEADER;π END;π (* Netzwerkadresse umkopieren *)π WITH ECB_Table[Index]^.FragDescr.Address^.Source DOπ BEGINπ Source_Addr.Network := Network;π Source_Addr.Node := Node;π Source_Addr.Socket := Swap(Socket);π END;π END;π SOCKET_ERROR : BEGINπ IPX_Done := DEVICE_SW_ERROR;π EXIT;π END;π OVERFLOW : BEGINπ IPX_Done := PACKET_OVERFLOW;π EXIT;π END;π NO_SOCKET : BEGINπ IPX_Done := DEVICE_SW_ERROR;π EXIT;π ENDπ ELSE BEGINπ IPX_Done := DEVICE_SW_ERROR;π EXIT;π END;π END;π ENDπ ELSE BEGINπ IPX_Done := PARAMETER_ERROR;π EXIT;π END;ππ END;ππ IPX_Done := SUCCESS;ππEND;ππππFUNCTION IPX_Internetwork_Address ( VAR Network : S4Byte;π VAR Node : S6Byteπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Funktion liefert die Internetzwerkadresse der *)π(* jeweiligen Station. *)π(* *)π(* *)π(* PARAMETER : OUT: Network = Netzwerkadresse *)π(* Node = Knotenadresse *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR Temp_Reg : Registers; (* Temporaere Register fuer IPX-Call *)ππ Reply_Buffer : Int_Addr; (* Temporaerer Buffer fuer Adressen *)ππBEGINππ Temp_Reg.ES := Seg(Reply_Buffer); (* Register vorbereiten *)π Temp_Reg.SI := Ofs(Reply_Buffer);π Temp_Reg.BX := GET_ADDR;ππ IPX_Call (Temp_Reg);ππ Network := Reply_Buffer.Network; (* Daten umkopieren *)π Node := Reply_Buffer.Node;ππ IPX_Internetwork_Address := SUCCESS;ππEND;ππππFUNCTION IPX_To_Addr ( Network : String;π Node : String;π Socket : String;π VAR Addr : Network_Addressπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine konvertiert die Eingabestrings in die Daten- *)π(* struktur Network_Address. *)π(* *)π(* *)π(* PARAMETER : IN : Network = Netzwerkadresse die konvertiert *)π(* werden soll. *)π(* Node = Knotenadresse die konvertiert *)π(* werden soll. *)π(* Socket = Sockelnummer die konvertiert *)π(* werden soll. *)π(* *)π(* OUT: Addr = Konvertierte vollsaendige Netz- *)π(* werkadresse. *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR i,n,Code : INTEGER;π c : CHAR;π Temp : BYTE;ππBEGINππ (* Pruefe Netzwerk und Node Laenge *)π IF (ORD(Network[0]) <> (2 * NET_LENGTH)) ORπ (ORD(Node[0]) <> (2 * NODE_LENGTH)) THENπ BEGINπ IPX_To_Addr := PARAMETER_ERROR;π EXIT;π END;ππ (* Netzwerkadresse konvertieren *)π i := 1;π n := 1;π WHILE ( i <= (2 * NET_LENGTH)) DOπ BEGINπ c := UPCASE(Network[i]);π CASE c OFπ 'A'..'F': Addr.Network[n] := ORD(c) - 55;π '0'..'9': Addr.Network[n] := ORD(c) - 48π ELSE BEGINπ IPX_To_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π Addr.Network[n] := Addr.Network[n] SHL 4;π c := UPCASE(Network[i + 1]);π CASE c OFπ 'A'..'F': Temp := ORD(c) - 55;π '0'..'9': Temp := ORD(c) - 48;π ELSE BEGINπ IPX_To_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π Addr.Network[n] := Addr.Network[n] + Temp;π i := i + 2;π n := n + 1;π END;πππ (* Node-Adresse konvertieren *)π i := 1;π n := 1;π WHILE ( i <= (2 * NODE_LENGTH)) DOπ BEGINπ c := UPCASE(Node[i]);π CASE c OFπ 'A'..'F': Addr.Node[n] := ORD(c) - 55;π '0'..'9': Addr.Node[n] := ORD(c) - 48;π ELSE BEGINπ IPX_To_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π Addr.Node[n] := Addr.Node[n] SHL 4;π c := UPCASE(Node[i + 1]);π CASE c OFπ 'A'..'F': Temp := ORD(c) - 55;π '0'..'9': Temp := ORD(c) - 48;π ELSE BEGINπ IPX_To_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π Addr.Node[n] := Addr.Node[n] + Temp;π i := i + 2;π n := n + 1;π END;ππ (* Sockelnummer konvertieren *)π VAL (Socket,Addr.Socket,Code);π IF Code <> 0 THENπ BEGINπ IPX_To_Addr := PARAMETER_ERROR;π EXIT;π END;ππ IPX_To_Addr := SUCCESS;ππEND;ππππFUNCTION IPX_From_Addr ( Addr : Network_Address;π VAR Network : String;π VAR Node : String;π VAR Socket : Stringπ ) : BYTE;π(*--------------------------------------------------------------------------*)π(* *)π(* BESCHREIBUNG : Die Routine konvertiert die vollstaendige Netzwerk- *)π(* adresse in String's. *)π(* *)π(* *)π(* PARAMETER : IN : Addr = Vollstaendige Netzwerkadresse *)π(* *)π(* OUT: Network = Netzwerkadresse die konvertiert *)π(* wurde. *)π(* Node = Knotenadresse die konvertiert *)π(* wurde. *)π(* Socket = Sockelnummer die konvertiert *)π(* wurde. *)π(* Rueckgabewert = Fehlercode *)π(* *)π(*--------------------------------------------------------------------------*)ππVAR i,n,Code : INTEGER;π c : CHAR;π TempHi,TempLo : BYTE;ππBEGINππ (* Netzwerkadresse konvertieren *)π i := 1;π n := 1;π WHILE ( i <= (2 * NET_LENGTH)) DOπ BEGINπ TempHi := Addr.Network[n] DIV 16; (* Hi-Nibble *)π CASE TempHi OFπ 10..15 : Network[i] := CHR(TempHi + 55);π 0..9 : Network[i] := CHR(TempHi + 48)π ELSE BEGINπ IPX_From_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π i := i + 1;π TempLo := Addr.Network[n] MOD 16; (* Lo-Nibble *)π CASE TempLo OFπ 10..15 : Network[i] := CHR(TempLo + 55);π 0..9 : Network[i] := CHR(TempLo + 48)π ELSE BEGINπ IPX_From_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π i := i + 1;π n := n + 1;π END;π Network[0] := CHR(i); (* Laenge Netzwerkadresse fuer String *)πππ (* Node-Adresse konvertieren *)π i := 1;π n := 1;π WHILE ( i <= (2 * NODE_LENGTH)) DOπ BEGINπ TempHi := Addr.Node[n] DIV 16; (* Hi-Nibble *)π CASE TempHi OFπ 10..15 : Node[i] := CHR(TempHi + 55);π 0..9 : Node[i] := CHR(TempHi + 48)π ELSE BEGINπ IPX_From_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π i := i + 1;π TempLo := Addr.Node[n] MOD 16; (* Lo-Nibble *)π CASE TempLo OFπ 10..15 : Node[i] := CHR(TempLo + 55);π 0..9 : Node[i] := CHR(TempLo + 48)π ELSE BEGINπ IPX_From_Addr := PARAMETER_ERROR;π EXIT;π END;π END;π i := i + 1;π n := n + 1;π END;π Node[0] := CHR(i - 1); (* Laenge Knotenadr. fuer String *)πππ (* Sockelnummer konvertieren *)π STR (Addr.Socket,Socket);ππ IPX_From_Addr := SUCCESS;πEND;ππEND. 23 08-24-9413:48ALL OLAF BARTELT Netware Encrypted Login SWAG9408 ┘Y┬╛ 109 ,î π{$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.ππ 24 08-24-9413:49ALL NORBERT IGL Encryped logins SWAG9408 äf
╓ 23 ,î {π SM> Have you got any idea on how to do a login under Novell 3.11+?ππ SM> I have some source (SWAG has source for a great TPU), butπ SM> unfortunatly it doesn't do encrypted logins.. I managed to findπ SM> *some* reference to it in the interrupt list (int 21h, the F2hπ SM> multiplexor functions 17h/18h), but it didn't give any details onπ SM> how this is done...ππ hmmm. Novell never released any informations about Password Encrytion !ππ You got two choices (:-)ππ1. do a "Set Allow Unencrypted Passwords = ON" on the server console,π use the following, ripped from an old src "Novapi.zip:Novell.pas"ππ------------------------------------------------------------------------}πuses dos;π[...]ππ{ obj_type: User = 1, group =2 printserver = 3 }ππprocedure login_to_file_server( obj_type:integer;π _name,π _password : string;π var retcode:integer);πvarπ regs : registers;ππ request_buffer : recordπ B_length : integer;π subfunction : byte;π o_type : packed array [1..2] of byte;π name_length : byte;π obj_name : packed array [1..47] of byte;π password_length : byte;π password : packed array [1..27] of byte;π end;ππ reply_buffer : recordπ R_length : integer;π end;ππ count : integer;ππbeginπWith request_buffer doπbeginπ B_length := 79;π subfunction := $14;π o_type[1] := 0;π o_type[2] := obj_type;π for count := 1 to 47 do obj_name[count] := $0;π for count := 1 to 27 do password[count] := $0;π if length(_name) > 0 thenπ for count := 1 to length(_name) doπobj_name[count]:=ord(upcase(_name[count]));π if length(_password) > 0 thenπ for count := 1 to length(_password) doπpassword[count]:=ord(upcase(_password[count]));π {set to full length of field}π name_length := 47;π password_length := 27;πend;πWith reply_buffer doπbeginπ R_length := 0;πend;π With Regs Do Beginπ Ah := $e3; { moved to $F2 for v3.x ??? }π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π End;π MsDos(Regs);π retcode := regs.alπend;ππprocedure logout;π{logout from all file servers}πvar regs : registers;πbeginπ regs.ah := $D7;π msdos(regs);πend;ππprocedure logout_from_file_server(var id: integer);π{logout from one file server}πvar regs : registers;πbeginπ regs.ah := $F1;π regs.al := $02;π regs.dl := id;π msdos(regs);πend;ππ------------------------------------------------------------------------ππ2. get a copy of "Charles Rose: Netware Programming". There are someπ <obj> for "C", and in my German version TPU's for Turbo/BP" !ππ 25 08-24-9413:49ALL KLAUS WIEGAND Network Options SWAG9408 èm'ë 51 ,î {π> I'm looking for information and or code (pascal pref) on the theπ> following network options:π>π> 1. A routine to determine if Novel IPX is available (active/loaded)}ππ(*--------------------------------------------------------------------------*)π(* IsNovellActive --- Checks if Novell network is active *)π(*--------------------------------------------------------------------------*)ππFUNCTION IsNovellActive : BOOLEAN;ππ(*--------------------------------------------------------------------------*)π(* *)π(* Function: IsNovellActive *)π(* *)π(* Purpose: Checks if Novell network active *)π(* *)π(* Calling Sequence: *)π(* *)π(* Novell_On := IsNovellActive : BOOLEAN; *)π(* *)π(* Novell_On --- TRUE if Novell network is active. *)π(* *)π(* Calls: MsDos *)π(* *)π(*--------------------------------------------------------------------------*)ππVARπ Regs : Registers;ππBEGIN (* IsNovellActive *)ππ Regs.CX := 0;π Regs.AL := 0;π (* Request workstation ID. *)π (* This should be ignored if Novell *)π (* network software isn't active. *)π Regs.AH := $DC;ππ MsDos( Regs );π (* If we got back a non-zero station *)π (* ID, then Novell must be loaded. *)ππ IsNovellActive := ( Regs.AL <> 0 );ππEND (* IsNovellActive *);πππ(* ************** second method ******************** *)ππuses dos ;πvar Regs : registers ;π ReplyBuffer : array[1..40] of char ;πππfunction IPX_Loaded:boolean;πbeginπ Regs.AX := $7A00 ;π intr($2F,Regs) ;π IPX_Loaded := (Regs.AL = $FF)πend;ππfunction Netbios_Loaded:Boolean;πbeginπ Regs.AH := $35; (* DOS function that checks an interrupt vector *)π Regs.AL := $5C; (* Interrupt vector to be checked *)π NetBios_Installed := True;π msdos(Regs) ;π if ((Regs.ES = 0) or (Regs.ES = $F000))π then NetBios_Installed := Falseπend;πππfunction NetShell_Installed:Boolean;πbeginπ with Regs do beginπ AH := $EA ;π AL := 1 ;π BX := 0 ;π ES := seg(ReplyBuffer) ;π DI := ofs(ReplyBuffer) ;π end ; (* with do begin *)π msdos(regs) ;π NetShell_Installed := (Regs.BX = 0)πend.π{π> 3. I'm looking for any available NetBIOS-compatible routines whichπ> will yield a "connection number" (not a username or node id). I'mπ> under the impression that this ability is not available via NetBIOS.π> Is this true?π}ππuses dos;πtypeππ DayOfTheWeek = (Sunday,Monday,Tuesday,Wednesday,Thursday,π Friday,Saturday);π NovDateType = recordπ Year, {80=1980}π Month,π Day,π Hour,π Minute,π Second : Byte;π WeekDay : DayOfTheWeek;π Filler : Byte; {!!.03}π end;π ConnInfoType = recordπ ObjectID : LongInt; {the logged in object's ID}π ObjectType : Word; {the logged object's type}π ObjectName : String[48]; {the name of the object}π LoginDate : NovDateType; {the time/date the object}π {logged on to connection}π end;ππfunction NetWareSwapLong(L : LongInt) : LongInt;πInline(π $5A/ { pop dx}π $86/$D6/ { xchg dh,dl}π $58/ { pop ax}π $86/$C4); { xchg ah,al}ππfunction 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;π { search for terminating #0, stop if max string length exceeded}π while (A[I] <> #0) and (I < Max) do beginπ S[I] := A[I];π Inc(I);π end;π S[0] := Char(I-1);π AsciiZ2Str := S {return the string}πend;ππππfunction GetConnNo : Byte;πvarπ Regs : dos.Registers;πbeginπ regs.AX := $DC00;π intr($21,Regs);π GetConnNo := Regs.ALπend;πprocedure GetConnInfo(ConnNo : Byte; var ConnInfo : ConnInfoType);πvarπ Regs : dos.Registers;π 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; {!!.03}π Request.Len := 2;π Request.SubF := $16;π Request.Conn := ConnNo;π Regs.AH := $E3;π Regs.DS := Seg(Request); {DS:SI points to request}π Regs.SI := Ofs(Request);π Regs.ES := Seg(Reply); {ES:DI points to reply}π Regs.DI := Ofs(Reply);π intr($21,Regs);π with ConnInfo do beginπ ObjectID := NetWareSwapLong(Reply.ID);π ObjectType := Swap(Reply.ObjType);π ObjectName := AsciiZ2Str(Reply.ObjName,48);π LoginDate := Reply.Time;π end;πend;ππvarπConnInfo: ConnInfoType;ππbeginπ GetConnInfo(GetConnNo,ConnInfo);π with ConnInfo doπ beginπ WriteLn('ID: ',ObjectId);π WriteLn('Type: ',ObjectType);π WriteLn('Name: ',ObjectName);π WriteLn('Time: ',Logindate.hour:2,':',Logindate.second);π end;πend.π 26 08-25-9409:04ALL ROBIN BOWES Call NETAPI.DLL function SWAG9408 ┴╒r₧ 32 ,î (*πFrom: ROBIN@plato.ucsalf.ac.uk (Robin Bowes)ππI'm trying to call a function in a Windows .dll fromπTurbo Pascal for Windows v1.5.ππThe .dll in question is NETAPI.DLL. The function I want to call isπdefined as follows (in C format):ππ(from Microsoft LAN Manager Programmer's Reference, )ππNetWkstaGetInfo ( const char far * pszServer,π short sLevel,π char far * pbBuffer,π unsigned short cbBuffer,π unsigned short far * pcbTotalAvailπ );ππwhereππpszServerπ contains the name of the server on which to execute NetWkstGetInfo.ππsLevelπ specfies the level of detail to be supplied in the return bufferππpbBufferπ points to the buffer in which data is returnedππcbBufferπ specifies the size of the buffer pointed to by pbBufferππpcbTotalAvailπ points to an unsigned integer in which the number of bytes ofπ information available is returned.πππThe detail level I require is 10 which means that the buffer returnedπwill contain a wksta_info_10 structure which is defined as follows:ππstruct wksta_info_10 {π char far * wki10_computername;π char far * wki10_username;π char far * wki10_langroup;π unsigned char wki10_ver_major;π unsigned char wki10_ver_minor;π char far * wki10_logon_domain;π char far * wki10_oth_domains;π};πππI am having trouble getting this function to work. It will be a .dllπeventually but for now I'm jsut coding it as a program using WinCrt.ππMy code so far looks something like this:π*)πprogram Username;ππuses WinTypes, WinCrt;ππconstπ NERR_BufTooSmall = 2123;π NERR_Success = 0;ππtypeπ Wksta_info_10 =π recordπ wki10_computername : pChar;π wki10_username : pChar;π wki10_langroup : pChar;π wki10_ver_major : Byte;π wki10_ver_minor : Byte;π wki10_logon_domain : pChar;π wki10_oth_domains : pChar;π end;π pWksta_info_10 = ^Wksta_info_10;ππfunction NetWkstaGetInfo( pszServer : pChar;π sLevel : Integer;π var pbBuffer : pWksta_info_10;π cbBuffer : Word;π var pcbTotalAvail : pWordπ ) : Integer; far; external 'NETAPI';ππfunction getUsername(var Username : pChar) : Integer;πvarπ pWI : pWksta_info_10;π sWorkStationInfo : Word;π pbBufLen : pWord;π pbTotalAvail : pWord;π uRetCode : Integer;ππbeginπ {first call will fail but should return the size of theπ buffer needed to hold all the available data}π getMem(pbBufLen, sizeOf(pbBufLen));π pwI := nil;π uRetCode := NetWkstaGetInfo(nil, {Servername (nil -> local machine)}π 10, {Reporting level} π pWI, {target buffer for info}π 0, {Size of target buffer}π pbBufLen {Count of bytes available}π );π {check the return code from the function}π if (uRetCode = NERR_BufTooSmall) thenπ { check available memory }π beginπ if maxAvail < pbBufLen^ thenπ beginπ getUsername := -1;π Exitπ endπ elseπ {allocate memory for buffer to hold information}π beginπ getMem(pWI, pbBufLen^)π endπ endπ elseπ {Unexpected error returned}π beginπ {Pass return code back to calling program}π getUsername := uRetCode;π Exitπ end;ππ {second call to get information}π getMem(pbTotalAvail, sizeOf(pbTotalAvail));π uRetCode := NetWkstaGetInfo(nil, 10, pWI, pbBufLen^, pbTotalAvail);π getUsername := uRetCode;π if uRetCode = NERR_Success thenπ beginπ Username := pWI^.wki10_username;π end;π freeMem(pbBufLen, sizeOf(pbBufLen));π freeMem(pbTotalAvail, sizeOf(pbTotalAvail))πend;ππ{exportsπ getUsername index 1;}ππvarπ retVal : Integer;π uName : pChar;ππbeginπgetMem(uName, sizeOf(uName));πretVal := getUserName(uName);πif retVal = NERR_Success thenπ writeln(uName)πelseπ writeln('Error returned: ', retVal);πfreeMem(uName, sizeOf(uName));πend.π{ππThis compiles OK but throws a GPF in NETAPI.DLL.ππI'm fairly sure it's the conversion of the structure type that's causingπthe problem.ππHas anybody got any ideas ?ππ} 27 08-25-9409:09ALL MICHAEL HOENIE Networking SWAG9408 MF²º 64 ,î {πI'm still looking for help with these networking routines. I've revisedπthem again to make a full standing unit. This NETWORK unit will compileπstand-alone with TP 6.0. I still get an error 162 when using theseπroutines, which from the manual says MACHINE FAILURE or hardware. I haveπrun it on at least 10 different machines and get the same problem.ππIf *ANYONE* has a better way of keeping another node from accessing aπfile, please, PLEASE let me know! I have an ENTIRE project (10,000+πlines) on hold until I get these networking routines done.π}π UNIT NETWORK;ππ interface uses dos;ππ constπ max_timeout=10; { seconds to time out on network timeout }π max_nodes=25;ππ typeπ string80=string[80];π networkrecord=record { basic makeup of the actual user }π x_username:string[5]; { network name of user }π x_active:boolean; { * IMPORTANT * : if node is active }π end;ππ varπ netfile:file of networkrecord;π netdata:networkrecord;π network_node:integer;π time1,time2,time3,date1,date2,date3:string[15];π incom,incom1,out,out1:string[255];π _retval:integer;π _retbol:boolean;ππ function network_exist(filename1:string80):byte;π procedure node_status(filename1:string80);π procedure lock_file(filename2:string80);π procedure unlock_file(filename3:string80);π procedure make_nodes;π procedure update_node;π procedure log_node;π procedure log_off_node;ππ implementationππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure timedate;π varπ ax1,ax2,ax3,ax4:word;π year,month,mil,day,hour,hour1,minute,second:string[20];π beginπ time1:=''; { 22:00:00 }π date1:=''; { 03/03/88 }π time2:=''; { 02:03am }π time3:=''; { 00:00 }π date2:=''; { wednesday, january 25th, 1988 }π gettime(ax1,{ hour } ax2,{ minute } ax3, { second }ax4); { milli-second }π str(ax1,hour);π if ax1<=12 then str(ax1,hour1) else str(ax1-12,hour1);π if length(hour1)=1 then insert('0',hour1,1);π str(ax2,minute);π str(ax3,second);π if length(minute)=1 then insert('0',minute,1);π if length(second)=1 then insert('0',second,1);π if length(hour)=1 then insert('0',hour,1);π time1:=hour+':'+minute+':'+second;π case ax1 ofπ 0..11:out1:='AM'π else out1:='PM';π end;π time2:=hour1+':'+minute+' '+out1;π time3:=hour1+':'+minute;π getdate(ax1, { year }ax2, { month }ax3, { day }ax4);{ day of week }π str(ax3,day);π if length(day)=1 then insert('0',day,1);π str(ax1,year);π str(ax2,month);π if length(month)=1 then insert('0',month,1);π date1:=month+'-'+day+'-'+copy(year,3,2);π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ function network_exist(filename1:string80):byte;π varπ net_file:file;π beginπ network_exist:=$0;π assign(net_file,filename1);π {$i-} reset(net_file) {$i+};π case ioresult ofπ 0:close(net_file);π 1:network_exist:=$1; { nothing }π 2:network_exist:=$2; { file not found }π 5:network_exist:=$5; { access denied }π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure node_status(filename1:string80);π varπ do_wait:boolean;π s_time,c_time:string[2];π d_timeout,d_wait,d_count:integer;π _retbyte:byte;π erfile:text;π beginπ filename1:=filename1+'.lck';π do_wait:=false;π timedate;π s_time:=copy(time1,7,2);π d_wait:=0;π d_timeout:=0;π while not do_wait doπ beginπ _retbyte:=network_exist('LOCK\'+filename1);π case _retbyte ofπ $0:write('.');π $5:write('.');π $1:do_wait:=true;π $2:do_wait:=true;π end;π if do_wait=true then d_timeout:=0;π timedate;π c_time:=copy(time1,7,2);π if c_time<>s_time thenπ beginπ s_time:=c_time;π d_count:=d_count+1;π d_timeout:=d_timeout+1;π end;π if d_timeout>max_timeout thenπ beginπ writeln('NETWORK TIMEOUT... NOTE_STATUS');π halt;π end;π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure lock_file(filename2:string80);π varπ fvar2:text;π beginπ if pos('.',filename2)>0 thenπ delete(filename2,pos('.',filename2),length(filename2));π filename2:=filename2+'.LCK';π node_status(filename2);π assign(fvar2,'LOCK\'+filename2);π rewrite(fvar2);π write(fvar2,'A');π close(fvar2);π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure unlock_file(filename3:string80);π varπ fvar3:text;π beginπ if pos('.',filename3)>0 thenπ delete(filename3,pos('.',filename3),length(filename3));π filename3:=filename3+'.LCK';π if network_exist('LOCK\'+filename3)=$0 thenπ beginπ assign(fvar3,'LOCK\'+filename3);π erase(fvar3);π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure make_nodes;π beginπ case network_exist('LOCK\'+'NETWORK.SYS') ofπ $2:beginπ lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π rewrite(netfile);π netdata.x_username:='';π netdata.x_active:=false;π for _retval:=0 to max_nodes doπ beginπ seek(netfile,_retval);π write(netfile,netdata);π end;π close(netfile);π unlock_file('NETWORK');π end;π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure update_node;π beginπ with netdata doπ beginπ x_username:='MSH';π x_active:=true;π end;π lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π {$i-} reset(netfile); {$i+}π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: UPDATE_NODE');π halt;π end;π seek(netfile,network_node);π write(netfile,netdata);π close(netfile);π unlock_file('NETWORK');π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure log_node;π beginπ network_node:=-1;π lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π {$i-} reset(netfile) {$i+};π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: LOG_NODE');π halt;π end;π for _retval:=filesize(netfile)-1 downto 0 doπ beginπ seek(netfile,_retval);π {$i-} read(netfile,netdata); {$i+}π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: LOG_NODE');π halt;π end;π if NOT netdata.x_active then network_node:=_retval;π end;π if network_node=-1 thenπ beginπ writeln('NETWORK ERROR: LOG_NODE');π halt;π end;π seek(netfile,network_node);π write(netfile,netdata);π close(netfile);π unlock_file('NETWORK');π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure log_off_node;π beginπ lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π {$i-} reset(netfile) {$i+};π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: LOG_OFF_NODE');π halt;π end;π netdata.x_username:='';π netdata.x_active:=false;π seek(netfile,network_node);π write(netfile,netdata);π close(netfile);π unlock_file('NETWORK');π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ END.π 28 08-25-9409:10ALL KEVIN R. PIERCE Novell Reading SWAG9408 Añ╡ 18 ,î Unit Litl_Nov;ππ(**********************************************************************)π(* by Kevin R. Pierce *)π(* December 29, 1991 *)π(* Kev1n@aol.com *)π(**********************************************************************)πinterfaceππtypeπ LoginTime = array[0..6] of byte;ππ ConnectionInfo = recordπ Object_ID : longint;π Object_Type : word;π Object_Name : array[1..48] of char;π Login_Time : LoginTime;π ApplicationNumber : word; {swap & display Hex}π end;ππ CnxnInfoREQUEST = recordπ ReqBuffLen : word; {always = 2}π Mask : byte; {always = 16h}π CnxnNo : byte; { >1 }π end;ππ CnxnInfoREPLY = recordπ RepBuffLen : word; {always = SIZEOF(ConnectionInfo) }π Data : ConnectionInfo;π end;πππfunction NOV_GetConnectionNumber:integer;πprocedure NOV_GetConnectionInformation(connection:byte; varπResult:ConnectionInfo);ππ(**********************************************************************)πimplementationππusesπ dos;ππfunction NOV_GetConnectionNumber:integer;π varπ buf : registers;π beginπ buf.AH:=$DC;π intr($21,buf);π NOV_GetConnectionNumber:=buf.AL;π end;ππprocedure NOV_GetConnectionInformation(connection:byte; varπResult:ConnectionInfo);π varπ buf : registers;π req : CnxnInfoREQUEST;π rep : CnxnInfoREPLY;π beginπ with buf doπ beginπ AH:=$E3;π DS:=seg(req);π SI:=ofs(req);π ES:=seg(rep);π DI:=ofs(rep);π end;π with req doπ beginπ ReqBuffLen := Sizeof(req)-2;π Mask := $16;π CnxnNo := Connection;π end;π fillchar(rep,sizeof(rep),0);π rep.RepBuffLen:=Sizeof(rep)-2;π intr($21,buf);π Result:=rep.data;π end;ππend.πππ
