DP Tool Club 15/CD_ASCQ_15_070894.iso/maj/swag/network.swg

Text File | 1994-05-26 | 167KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00022         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:  [phone] [work]              519-473-3618 [home]             }π{                                                                           }π{  Bitnet: [e-mail]     Packet: ve3pzr @ ve3gyq         }π{                                                                           }π{  Anonymous FTP Server Internet Address: 129.100.22.100                    }π{                                                                           }π{---------------------------------------------------------------------------}ππ{ Any other Novell UNITS gladly accepted. }πππ{πmods February 1 1991, Ross Lazarus ([e-mail])π     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.