Unit IpxUnit;



Interface



uses dos;

const

     IPX_PACKET_TYPE    =   4;

type

    NetWrkAdr = record

                  NetworkNumber      : array [1..4] of byte;

                  NodeAddress        : array [1..6]    of byte;

                end;



    IpxHeader = record

                  CheckSum           : word;

                  Len                : word;

                  TransportControl   : byte;

                  PacketType         : byte;

                  Destination        : NetWrkAdr;

                  DestinationSocket  : word;

                  Source             : NetWrkAdr;

                  SourceSocket       : word;

                end;

    ConNbrArr = record

                  Len                : word;

                  Count              : byte;

                  Connections        : array [1..250] of byte;

                end;

    ftype     = record

                  Adr                : pointer;

                  Len                : word;

                end;

    Ecb       = record

                  LinkAddress        : pointer;

                  EventServiceRoutine: pointer;

                  StatusFlag         : byte;

                  CompletionCode     : byte;

                  SocketNumber       : word;

                  WorkSpace          : array [1..4]  of byte;

                  DriverWorkSpace    : array [1..12] of byte;

                  ImmediateAddress   : array [1..6]   of byte;

                  FragmentCount      : word;

                  FragmentDescriptor : array [1..2] of ftype;

                end;

    ConnInfo  = record

                  Len                : word;

                  ObjectID           : array [1..4]  of byte;

                  ObjectType         : word;

                  ObjectName         : array [1..48] of byte;

                  LoginTime          : array [1..7]  of byte;

                  Reserved           : word;

                end;

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

    NodType   = array [1..6]    of byte;

var

   regs           : registers;

   ipxrutofs,

   ipxrutseg      : word;

{-----------------------------------------------------------------------------}

function LeadingZero(w:word) : String;

function Time : String;

procedure WriteHexByte(b : byte);



function  IpxPresent : boolean;

procedure IpxServicesCall;

function  IpxCreateSocket (Socket : word) : boolean;

function  LocalConnectionNumber : byte;

procedure IpxDeleteSocket (Socket : word);

procedure GetInternetAddress (ConnectionNbr : byte; var NetNod : NetWrkAdr);

procedure UserInfo (ConnectionNumber: byte; var ConnInfoRec : ConnInfo);

procedure GetConnections (UserName: string; var ConNbrRec : ConNbrArr);

procedure GetLocalTarget(DestNet : NetWrkAdr;

                         DestSock : word; var LocalTarget : NodType );

procedure SendMessage(ConnectionNumber : byte; Message : String);

Procedure IpxSendPacket(var SendEcb : Ecb);

Procedure IpxReadPacket(var ReadEcb : Ecb);



Implementation



{----------------------------------------------------------------------------}

function LeadingZero;

var

   s : String;

begin

     Str(w:0,s);

     if Length(s) = 1 then

        s := '0' + s;

        LeadingZero := s;

end;

{----------------------------------------------------------------------------}

function Time;

var

    h, m, s, hund : Word;

begin

     GetTime(h,m,s,hund);

     Time:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s);

end;

{----------------------------------------------------------------------------}

procedure WriteHexByte;

const

     hexChars : array [0..$F] of Char =

                '0123456789ABCDEF';

begin

     Write(hexChars[b shr 4],

           hexChars[b and $F]);

end;



{----------------------------------------------------------------------------}

function IpxPresent;

const

     MULTIPLEXER  = $2F;

     IPXINSTALLED = $FF;

begin

     regs.ax:=$7A00;

     intr(MULTIPLEXER,regs);

     if (regs.al = IPXINSTALLED) then IpxPresent:=TRUE

                                 else IpxPresent:=FALSE;

end;

{----------------------------------------------------------------------------}

procedure IpxServicesCall;

begin

     intr($7a,regs);

end;

{----------------------------------------------------------------------------}

function IpxCreateSocket;

const

     IPX_CreateSocket = $00;

     PermanentSocket  = $FF;

     TemporarySocket  = $00;

var

   SwapSocket    : word;

begin

     SwapSocket:=swap(Socket);

     regs.al:=TemporarySocket;

     regs.bx:=IPX_CreateSocket;

     regs.dx:=SwapSocket;

     IpxServicesCall;

     if (regs.al = $00) then IpxCreateSocket:=TRUE

                        else IpxCreateSocket:=FALSE;

                        {0FEh Full Socket Table

                         0FFh Socket Already Opened}

end;

{----------------------------------------------------------------------------}

procedure IpxDeleteSocket;

const

     IPX_DeleteSocket             = $01;

var

     SwapSocket    : word;

begin

     SwapSocket:=swap(Socket);

     regs.bx:=IPX_DeleteSocket;

     regs.dx:=SwapSocket;

     IpxServicesCall;

end;

{----------------------------------------------------------------------------}

function LocalConnectionNumber;

const

     GET_CONNECTION_NUMBER = $DC;

begin

     regs.ah:=GET_CONNECTION_NUMBER;

     regs.al:=$00;

     msdos(regs);

     LocalConnectionNumber:=regs.al;

end;

{----------------------------------------------------------------------------}

procedure  GetInternetAddress;

const

     GET_INTERNET_ADDRESS = $13;

     NETWARE_SERVICE_E3   = $E3;



var

   ReqBlk   : record

                Len       :  word;

                ReqType   :  byte;

                ConnNbr   :  byte;

              end;

   ResBlk   : record

                Len       :  word;

                NetNod    :  NetWrkAdr;

                SrvSocket :  word;

              end;

begin

     with ReqBlk do

       begin

            Len:=sizeof(ReqBlk) - sizeof(Len);

            ReqType:=GET_INTERNET_ADDRESS;

            ConnNbr:=ConnectionNbr;

       end;



     with ResBlk do Len:=sizeof(ResBlk) - sizeof(Len);



     regs.ah:=NETWARE_SERVICE_E3;

     regs.ds:=seg(ReqBlk); regs.si:=ofs(ReqBlk);

     regs.es:=seg(ResBlk); regs.di:=ofs(ResBlk);

     msdos(regs);

     if regs.al <> $00 then writeln('Error GETINTERNETADDRESS...')

     else

       begin

            NetNod.NetworkNumber:=ResBlk.NetNod.NetworkNumber;

            NetNod.NodeAddress:=  ResBlk.NetNod.NodeAddress;

       end;

end;

{----------------------------------------------------------------------------}

procedure UserInfo;

const

     GET_CONNECTION_INFORMATION   = $16;

     NETWARE_SERVICE_E3           = $E3;

var

   ReqBlk   :  record

                Len    :  word;

                ReqType   :  byte;

                ConnNbr   :  byte;

               end;

begin

     with ReqBlk do

       begin

            Len :=sizeof(ReqBlk) - sizeof(Len);

            ReqType:=GET_CONNECTION_INFORMATION;

            ConnNbr:=ConnectionNumber;

       end;

     with ConnInfoRec do Len:=sizeof(ConnInfoRec) - sizeof(Len);

     regs.ah:=NETWARE_SERVICE_E3;

     regs.ds:=seg(ReqBlk);       regs.si:=ofs(ReqBlk);

     regs.es:=seg(ConnInfoRec);  regs.di:=ofs(ConnInfoRec);

     msdos(regs);

end;

{----------------------------------------------------------------------------}

procedure GetConnections;

const

     GET_OBJECT_CONNECTION_NUMBERS= $15;

     USER_BINDERY_OBJECT_TYPE     = $0001;

     NETWARE_SERVICE_E3           = $E3;

var

   ReqBlk    :  record

                  Len          : word;

                  RequestType     : byte;

                  ObjectType      : word;

                  NameLength      : byte;

                  Name            : array [1..48] of byte;

                end;

   swapbind  :  word;

   i         :  integer;

begin

     swapbind:=swap(USER_BINDERY_OBJECT_TYPE);

     with ReqBlk do

       begin

            Len:=sizeof(ReqBlk) - sizeof(Len);

            RequestType:=GET_OBJECT_CONNECTION_NUMBERS;

            ObjectType:=SwapBind;

       end;

     ReqBlk.NameLength:=Length(UserName);

     for i:=1 to ReqBlk.NameLength do ReqBlk.Name[i]:=ord(UserName[i]);



     with ConNbrRec do Len:=sizeof(ConNbrRec) - sizeof(Len);

     regs.ah:=NETWARE_SERVICE_E3;

     regs.ds:=seg(ReqBlk);    regs.si:=ofs(ReqBlk);

     regs.es:=seg(ConNbrRec); regs.di:=ofs(ConNbrRec);

     msdos(regs);

     if regs.al <> 0 then ConNbrRec.Count:=0;

end;

{----------------------------------------------------------------------------}

procedure GetLocalTarget;

const

     IPX_GetLocalTarget           = $02;

var

   ReqBlk     :  record

                  Dnetwork  : NetWrkAdr;

                  DSocket   : word;

                 end;

   ResBlk     :  record

                   Ltarget  : NodType;

                 end;

   swapsocket :  word;

begin

     swapsocket:=swap(DestSock);

     ReqBlk.Dnetwork:=DestNet;

     ReqBlk.DSocket :=swapsocket;



     regs.bx:=IPX_GetLocalTarget;

     regs.es:=seg(ReqBlk);

     regs.si:=ofs(ReqBlk);

     regs.di:=ofs(ResBlk);



     IpxServicesCall;



     if regs.al = $00 then LocalTarget:=ResBlk.Ltarget;

                  {0FAh No path to Destination}

end;

{----------------------------------------------------------------------------}

procedure SendMessage;

const

     USER_BINDERY_OBJECT_TYPE     = $0001;

     NETWARE_SERVICE_E1           = $E1;

var

   ReqBlk     :  record

                  Len       : word;

                  Bindery   : word;

                  ConnNbr   : byte;

                  Mlen      : byte;

                  Mens      : array [1..45] of byte;

                 end;

   ResBlk     :  record

                   Len      : word;

                   Filler   : array [1..100] of byte;

                 end;

   i          :  integer;

begin

     with ReqBlk do

        begin

          Bindery:=swap(USER_BINDERY_OBJECT_TYPE);

          ConnNbr:=ConnectionNumber;

          Mlen:=Length(Message);

          Len:=Mlen + 4;

          for i:=1 to Mlen do mens[i]:=ord(message[i]);

        end;



     ResBlk.Len:=$6400;



     regs.ah:=NETWARE_SERVICE_E1;

     regs.ds:=seg(ReqBlk);  regs.si:=ofs(ReqBlk);

     regs.es:=seg(ResBlk);  regs.di:=ofs(ResBlk);

     msdos(regs);

end;



{----------------------------------------------------------------------------}

Procedure IpxSendPacket;

const

     IPX_SendPacket               = $03;

begin

     regs.bx:=IPX_SendPacket;

     regs.es:=Seg(SendEcb);

     regs.si:=Ofs(SendEcb);

     IpxServicesCall;



     while (SendEcb.StatusFlag <> 0) do ;

end;

{----------------------------------------------------------------------------}

Procedure IpxReadPacket;

const

     IPX_ReceivePacket               = $04;

begin

     regs.bx:=IPX_ReceivePacket;

     regs.es:=Seg(ReadEcb);

     regs.si:=Ofs(ReadEcb);

     IpxServicesCall;

     if regs.al <> $00 then

       begin

          writeln('Error Read Packet ');

          WriteHexByte(Regs.al);

       end;

                  {0ffh NonExistant socket}

end;

{----------------------------------------------------------------------------}

{----------------------------------------------------------------------------}

begin

end.