home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / chat / ipxunit.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-07-12  |  11.1 KB  |  357 lines
  1. Unit IpxUnit;
  2.  
  3. Interface
  4.  
  5. uses dos;
  6. const
  7.      IPX_PACKET_TYPE    =   4;
  8. type
  9.     NetWrkAdr = record
  10.                   NetworkNumber      : array [1..4] of byte;
  11.                   NodeAddress        : array [1..6]    of byte;
  12.                 end;
  13.  
  14.     IpxHeader = record
  15.                   CheckSum           : word;
  16.                   Len                : word;
  17.                   TransportControl   : byte;
  18.                   PacketType         : byte;
  19.                   Destination        : NetWrkAdr;
  20.                   DestinationSocket  : word;
  21.                   Source             : NetWrkAdr;
  22.                   SourceSocket       : word;
  23.                 end;
  24.     ConNbrArr = record
  25.                   Len                : word;
  26.                   Count              : byte;
  27.                   Connections        : array [1..250] of byte;
  28.                 end;
  29.     ftype     = record
  30.                   Adr                : pointer;
  31.                   Len                : word;
  32.                 end;
  33.     Ecb       = record
  34.                   LinkAddress        : pointer;
  35.                   EventServiceRoutine: pointer;
  36.                   StatusFlag         : byte;
  37.                   CompletionCode     : byte;
  38.                   SocketNumber       : word;
  39.                   WorkSpace          : array [1..4]  of byte;
  40.                   DriverWorkSpace    : array [1..12] of byte;
  41.                   ImmediateAddress   : array [1..6]   of byte;
  42.                   FragmentCount      : word;
  43.                   FragmentDescriptor : array [1..2] of ftype;
  44.                 end;
  45.     ConnInfo  = record
  46.                   Len                : word;
  47.                   ObjectID           : array [1..4]  of byte;
  48.                   ObjectType         : word;
  49.                   ObjectName         : array [1..48] of byte;
  50.                   LoginTime          : array [1..7]  of byte;
  51.                   Reserved           : word;
  52.                 end;
  53.     NetType   = array [1..4] of byte;
  54.     NodType   = array [1..6]    of byte;
  55. var
  56.    regs           : registers;
  57.    ipxrutofs,
  58.    ipxrutseg      : word;
  59. {-----------------------------------------------------------------------------}
  60. function LeadingZero(w:word) : String;
  61. function Time : String;
  62. procedure WriteHexByte(b : byte);
  63.  
  64. function  IpxPresent : boolean;
  65. procedure IpxServicesCall;
  66. function  IpxCreateSocket (Socket : word) : boolean;
  67. function  LocalConnectionNumber : byte;
  68. procedure IpxDeleteSocket (Socket : word);
  69. procedure GetInternetAddress (ConnectionNbr : byte; var NetNod : NetWrkAdr);
  70. procedure UserInfo (ConnectionNumber: byte; var ConnInfoRec : ConnInfo);
  71. procedure GetConnections (UserName: string; var ConNbrRec : ConNbrArr);
  72. procedure GetLocalTarget(DestNet : NetWrkAdr;
  73.                          DestSock : word; var LocalTarget : NodType );
  74. procedure SendMessage(ConnectionNumber : byte; Message : String);
  75. Procedure IpxSendPacket(var SendEcb : Ecb);
  76. Procedure IpxReadPacket(var ReadEcb : Ecb);
  77.  
  78. Implementation
  79.  
  80. {----------------------------------------------------------------------------}
  81. function LeadingZero;
  82. var
  83.    s : String;
  84. begin
  85.      Str(w:0,s);
  86.      if Length(s) = 1 then
  87.         s := '0' + s;
  88.         LeadingZero := s;
  89. end;
  90. {----------------------------------------------------------------------------}
  91. function Time;
  92. var
  93.     h, m, s, hund : Word;
  94. begin
  95.      GetTime(h,m,s,hund);
  96.      Time:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s);
  97. end;
  98. {----------------------------------------------------------------------------}
  99. procedure WriteHexByte;
  100. const
  101.      hexChars : array [0..$F] of Char =
  102.                 '0123456789ABCDEF';
  103. begin
  104.      Write(hexChars[b shr 4],
  105.            hexChars[b and $F]);
  106. end;
  107.  
  108. {----------------------------------------------------------------------------}
  109. function IpxPresent;
  110. const
  111.      MULTIPLEXER  = $2F;
  112.      IPXINSTALLED = $FF;
  113. begin
  114.      regs.ax:=$7A00;
  115.      intr(MULTIPLEXER,regs);
  116.      if (regs.al = IPXINSTALLED) then IpxPresent:=TRUE
  117.                                  else IpxPresent:=FALSE;
  118. end;
  119. {----------------------------------------------------------------------------}
  120. procedure IpxServicesCall;
  121. begin
  122.      intr($7a,regs);
  123. end;
  124. {----------------------------------------------------------------------------}
  125. function IpxCreateSocket;
  126. const
  127.      IPX_CreateSocket = $00;
  128.      PermanentSocket  = $FF;
  129.      TemporarySocket  = $00;
  130. var
  131.    SwapSocket    : word;
  132. begin
  133.      SwapSocket:=swap(Socket);
  134.      regs.al:=TemporarySocket;
  135.      regs.bx:=IPX_CreateSocket;
  136.      regs.dx:=SwapSocket;
  137.      IpxServicesCall;
  138.      if (regs.al = $00) then IpxCreateSocket:=TRUE
  139.                         else IpxCreateSocket:=FALSE;
  140.                         {0FEh Full Socket Table
  141.                          0FFh Socket Already Opened}
  142. end;
  143. {----------------------------------------------------------------------------}
  144. procedure IpxDeleteSocket;
  145. const
  146.      IPX_DeleteSocket             = $01;
  147. var
  148.      SwapSocket    : word;
  149. begin
  150.      SwapSocket:=swap(Socket);
  151.      regs.bx:=IPX_DeleteSocket;
  152.      regs.dx:=SwapSocket;
  153.      IpxServicesCall;
  154. end;
  155. {----------------------------------------------------------------------------}
  156. function LocalConnectionNumber;
  157. const
  158.      GET_CONNECTION_NUMBER = $DC;
  159. begin
  160.      regs.ah:=GET_CONNECTION_NUMBER;
  161.      regs.al:=$00;
  162.      msdos(regs);
  163.      LocalConnectionNumber:=regs.al;
  164. end;
  165. {----------------------------------------------------------------------------}
  166. procedure  GetInternetAddress;
  167. const
  168.      GET_INTERNET_ADDRESS = $13;
  169.      NETWARE_SERVICE_E3   = $E3;
  170.  
  171. var
  172.    ReqBlk   : record
  173.                 Len       :  word;
  174.                 ReqType   :  byte;
  175.                 ConnNbr   :  byte;
  176.               end;
  177.    ResBlk   : record
  178.                 Len       :  word;
  179.                 NetNod    :  NetWrkAdr;
  180.                 SrvSocket :  word;
  181.               end;
  182. begin
  183.      with ReqBlk do
  184.        begin
  185.             Len:=sizeof(ReqBlk) - sizeof(Len);
  186.             ReqType:=GET_INTERNET_ADDRESS;
  187.             ConnNbr:=ConnectionNbr;
  188.        end;
  189.  
  190.      with ResBlk do Len:=sizeof(ResBlk) - sizeof(Len);
  191.  
  192.      regs.ah:=NETWARE_SERVICE_E3;
  193.      regs.ds:=seg(ReqBlk); regs.si:=ofs(ReqBlk);
  194.      regs.es:=seg(ResBlk); regs.di:=ofs(ResBlk);
  195.      msdos(regs);
  196.      if regs.al <> $00 then writeln('Error GETINTERNETADDRESS...')
  197.      else
  198.        begin
  199.             NetNod.NetworkNumber:=ResBlk.NetNod.NetworkNumber;
  200.             NetNod.NodeAddress:=  ResBlk.NetNod.NodeAddress;
  201.        end;
  202. end;
  203. {----------------------------------------------------------------------------}
  204. procedure UserInfo;
  205. const
  206.      GET_CONNECTION_INFORMATION   = $16;
  207.      NETWARE_SERVICE_E3           = $E3;
  208. var
  209.    ReqBlk   :  record
  210.                 Len    :  word;
  211.                 ReqType   :  byte;
  212.                 ConnNbr   :  byte;
  213.                end;
  214. begin
  215.      with ReqBlk do
  216.        begin
  217.             Len :=sizeof(ReqBlk) - sizeof(Len);
  218.             ReqType:=GET_CONNECTION_INFORMATION;
  219.             ConnNbr:=ConnectionNumber;
  220.        end;
  221.      with ConnInfoRec do Len:=sizeof(ConnInfoRec) - sizeof(Len);
  222.      regs.ah:=NETWARE_SERVICE_E3;
  223.      regs.ds:=seg(ReqBlk);       regs.si:=ofs(ReqBlk);
  224.      regs.es:=seg(ConnInfoRec);  regs.di:=ofs(ConnInfoRec);
  225.      msdos(regs);
  226. end;
  227. {----------------------------------------------------------------------------}
  228. procedure GetConnections;
  229. const
  230.      GET_OBJECT_CONNECTION_NUMBERS= $15;
  231.      USER_BINDERY_OBJECT_TYPE     = $0001;
  232.      NETWARE_SERVICE_E3           = $E3;
  233. var
  234.    ReqBlk    :  record
  235.                   Len          : word;
  236.                   RequestType     : byte;
  237.                   ObjectType      : word;
  238.                   NameLength      : byte;
  239.                   Name            : array [1..48] of byte;
  240.                 end;
  241.    swapbind  :  word;
  242.    i         :  integer;
  243. begin
  244.      swapbind:=swap(USER_BINDERY_OBJECT_TYPE);
  245.      with ReqBlk do
  246.        begin
  247.             Len:=sizeof(ReqBlk) - sizeof(Len);
  248.             RequestType:=GET_OBJECT_CONNECTION_NUMBERS;
  249.             ObjectType:=SwapBind;
  250.        end;
  251.      ReqBlk.NameLength:=Length(UserName);
  252.      for i:=1 to ReqBlk.NameLength do ReqBlk.Name[i]:=ord(UserName[i]);
  253.  
  254.      with ConNbrRec do Len:=sizeof(ConNbrRec) - sizeof(Len);
  255.      regs.ah:=NETWARE_SERVICE_E3;
  256.      regs.ds:=seg(ReqBlk);    regs.si:=ofs(ReqBlk);
  257.      regs.es:=seg(ConNbrRec); regs.di:=ofs(ConNbrRec);
  258.      msdos(regs);
  259.      if regs.al <> 0 then ConNbrRec.Count:=0;
  260. end;
  261. {----------------------------------------------------------------------------}
  262. procedure GetLocalTarget;
  263. const
  264.      IPX_GetLocalTarget           = $02;
  265. var
  266.    ReqBlk     :  record
  267.                   Dnetwork  : NetWrkAdr;
  268.                   DSocket   : word;
  269.                  end;
  270.    ResBlk     :  record
  271.                    Ltarget  : NodType;
  272.                  end;
  273.    swapsocket :  word;
  274. begin
  275.      swapsocket:=swap(DestSock);
  276.      ReqBlk.Dnetwork:=DestNet;
  277.      ReqBlk.DSocket :=swapsocket;
  278.  
  279.      regs.bx:=IPX_GetLocalTarget;
  280.      regs.es:=seg(ReqBlk);
  281.      regs.si:=ofs(ReqBlk);
  282.      regs.di:=ofs(ResBlk);
  283.  
  284.      IpxServicesCall;
  285.  
  286.      if regs.al = $00 then LocalTarget:=ResBlk.Ltarget;
  287.                   {0FAh No path to Destination}
  288. end;
  289. {----------------------------------------------------------------------------}
  290. procedure SendMessage;
  291. const
  292.      USER_BINDERY_OBJECT_TYPE     = $0001;
  293.      NETWARE_SERVICE_E1           = $E1;
  294. var
  295.    ReqBlk     :  record
  296.                   Len       : word;
  297.                   Bindery   : word;
  298.                   ConnNbr   : byte;
  299.                   Mlen      : byte;
  300.                   Mens      : array [1..45] of byte;
  301.                  end;
  302.    ResBlk     :  record
  303.                    Len      : word;
  304.                    Filler   : array [1..100] of byte;
  305.                  end;
  306.    i          :  integer;
  307. begin
  308.      with ReqBlk do
  309.         begin
  310.           Bindery:=swap(USER_BINDERY_OBJECT_TYPE);
  311.           ConnNbr:=ConnectionNumber;
  312.           Mlen:=Length(Message);
  313.           Len:=Mlen + 4;
  314.           for i:=1 to Mlen do mens[i]:=ord(message[i]);
  315.         end;
  316.  
  317.      ResBlk.Len:=$6400;
  318.  
  319.      regs.ah:=NETWARE_SERVICE_E1;
  320.      regs.ds:=seg(ReqBlk);  regs.si:=ofs(ReqBlk);
  321.      regs.es:=seg(ResBlk);  regs.di:=ofs(ResBlk);
  322.      msdos(regs);
  323. end;
  324.  
  325. {----------------------------------------------------------------------------}
  326. Procedure IpxSendPacket;
  327. const
  328.      IPX_SendPacket               = $03;
  329. begin
  330.      regs.bx:=IPX_SendPacket;
  331.      regs.es:=Seg(SendEcb);
  332.      regs.si:=Ofs(SendEcb);
  333.      IpxServicesCall;
  334.  
  335.      while (SendEcb.StatusFlag <> 0) do ;
  336. end;
  337. {----------------------------------------------------------------------------}
  338. Procedure IpxReadPacket;
  339. const
  340.      IPX_ReceivePacket               = $04;
  341. begin
  342.      regs.bx:=IPX_ReceivePacket;
  343.      regs.es:=Seg(ReadEcb);
  344.      regs.si:=Ofs(ReadEcb);
  345.      IpxServicesCall;
  346.      if regs.al <> $00 then
  347.        begin
  348.           writeln('Error Read Packet ');
  349.           WriteHexByte(Regs.al);
  350.        end;
  351.                   {0ffh NonExistant socket}
  352. end;
  353. {----------------------------------------------------------------------------}
  354. {----------------------------------------------------------------------------}
  355. begin
  356. end.
  357.