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.
