UNIT IPX;
Interface

Const
 MaxUsers = 10;                                { Maximum players }

Type
 PFullAddress  = ^TFullAddress;
 TFullAddress  = Record
   NetAddress  : Array[0..3] of Byte;          { LAN address (reversed) }
   Node        : Array[0..5] of Byte;          { Node address (reversed), i.e. this computer number }
   Socket      : Word                          { Socket number (reversed) }
 End;
 PIPXHeader = ^TIPXHeader;
 TIPXHeader = Record
   Checksum,                                   { ? }
   Length        : Word;                       { Size of this header + data size }
   TransportCtrl,                              { ? }
   PacketType    : Byte;                       { 4 = IPX }
   Destination,                                { Receiver address }
   Source        : TFullAddress                { Sender address }
 End;
 PECB = ^TECB;
 TECB = Record
   LinkAddr,                                   { ? }
   ESRAddr         : Pointer;                  { ? }
   InUse,                                      { name says :) }
   CompletionCode  : Byte;                     { name says :) }
   Socket          : Word;                     { Socket number (reveersed) }
   IPXWorkSpace    : Array[0..3] of Byte;      { ? }
   DriverWorkSpace : Array[0..11] of Byte;     { ? }
   ImmediateAddr   : Array[0..5] of Byte;      { Receiver/Sender }
   FragmentCount   : Word;                     { 2 for our program }
   Fragment1Addr   : Pointer;                  { IPX header address }
   Fragment1Size   : Word;                     { IPX header size }
   Fragment2Addr   : Pointer;                  { Data address }
   Fragment2Size   : Word                      { Data size }
 End;
 PIOBuf =^TIOBuf;
 TIOBuf = Record
   IPXHeader : TIPXHeader;
   ECB       : TECB;
   Data      : Array [0..511] of Byte          { Fixed size !!! }
 End;

Var
 _Addr : TFullAddress;                         { This computer's net addr }

Function AllocRMBufs : Boolean;
{ Called automatically on startup }

Function FreeRMBufs : Boolean;
{ You should it call before "End." }

Function Is_IPX_Installed : Boolean;
{ Guess what it does :) }

Procedure IPX_Get_Full_Address (Var Addr : TFullAddress);
{ Returns your full network address }

Function IPX_Open_Socket (CloseByCall : Boolean; Var Socket : Word) : Byte;
{ Opens the "Socket" socket }

Procedure IPX_Close_Socket (Socket : Word);
{ Closes the "Socket" socket }

Procedure IPX_Relinquish_Control;
{ You have to call it once per each game cycle in order to make }
{ IPX driver working correctly }

Procedure IPX_Send_Data (Var Data; Var ToNode);
{ Sends 512-bytes data block to the "ToNode" node (6 bytes) }
{ In order to do a broadcast sending, "ToNode" should be filled }
{ with $FFFFFFFFFFFF }

Procedure IPX_Prepare_For_Receiving (UserFirst, UserLast : Word);
{ Prepears receiving of (UserLast-UserFirst+1) data blocks }
{ Note: UserFirst <= UserLast < MaxUsers }

Function IPX_Receive_Data (UserNo : Word; Var Data; Var FromNode) : Boolean;
{ Returns True, if receives a 512-bytes data block }
{ Note: UserNo should be within UserFirst...UserLast range (see above) }
{ Sender node is returned in "FromNode" var (6 bytes) }

Implementation

{$IFDEF DPMI}

Uses DOS, WinAPI;

Type
 PRegs = ^TRegs;
 TRegs = Record
    EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX : LongInt;
    Flags, ES, DS, FS, GS, IP, CS, SP, SS : Word;
 End;

Var
 PRMFullAddress : PFullAddress;
 PRMECB         : PECB;
 RMFullAddressHandle,
 RMFullAddressSeg,
 RMECBHandle,
 RMECBSeg       : LongInt;
 RMIOBufHandle,
 RMIOBufSeg     : LongInt;

{$ELSE}

Uses DOS;

{$ENDIF}

Var
 PRMIOBuf : PIOBuf;                            { I/O Buffers }

(*************** DPMI Support functions ***************)

Function AllocRMBufs : Boolean;
Begin
{$IFDEF DPMI}
 RMFullAddressHandle := GlobalDOSAlloc (SizeOf(TFullAddress));
 RMFullAddressSeg := RMFullAddressHandle shr 16;
 PRMFullAddress := Ptr (RMFullAddressHandle and $FFFF, 0);

 RMECBHandle := GlobalDOSAlloc (SizeOf(TECB));
 RMECBSeg := RMECBHandle shr 16;
 PRMECB := Ptr (RMECBHandle and $FFFF, 0);

 RMIOBufHandle := GlobalDOSAlloc (SizeOf(TIOBuf)*(MaxUsers+1));
 RMIOBufSeg := RMIOBufHandle shr 16;
 PRMIOBuf := Ptr (RMIOBufHandle and $FFFF, 0);
{$ELSE}
 GetMem (PRMIOBuf, SizeOf(TIOBuf)*(MaxUsers+1));
{$ENDIF}
 AllocRMBufs := True
End;

Function FreeRMBufs : Boolean;
Begin
{$IFDEF DPMI}
 GlobalDOSFree (RMFullAddressHandle);
 GlobalDOSFree (RMECBHandle);
 GlobalDOSFree (RMIOBufHandle);
{$ELSE}
 FreeMem (PRMIOBuf, SizeOf(TIOBuf)*(MaxUsers+1));
{$ENDIF}
 FreeRMBufs := True
End;

{$IFDEF DPMI}
Function RealIntr (Int : Byte; Var RMR : Registers) : Boolean;
Var
 R : Registers;
 Regs : TRegs;
Begin
 With RMR, Regs do Begin
   EAX := AX;
   EBX := BX;
   ECX := CX;
   EDX := DX;
   EBP := BP;
   ESI := SI;
   EDI := DI;
   Regs.Flags := RMR.Flags;
   Regs.DS := RMR.DS;
   Regs.ES := RMR.ES;
   SP := 0;
   SS := 0
 End;
 R.AX := $300;
 R.BL := Int;
 R.BH := 0;
 R.CX := 0;
 R.ES := Seg (Regs);
 R.DI := Ofs (Regs);
 Intr ($31, R);
 If R.Flags and FCarry <> 0 then RealIntr := False;
 With RMR, Regs do Begin
   AX := EAX;
   BX := EBX;
   CX := ECX;
   DX := EDX;
   BP := EBP;
   SI := ESI;
   DI := EDI;
   RMR.Flags := Regs.Flags;
   RMR.DS := Regs.DS;
   RMR.ES := Regs.ES
 End;
 RealIntr := True
End;
{$ENDIF}

(*************** DPMI Support functions ***************)

                          (* IPX ROUTINES *)

Function Is_IPX_Installed : Boolean; Assembler;
Asm
 Mov   AX, 7A00h
 Int   2Fh
 And   AL, 1
End;

Function IPX_Max_Packet_Size : Word;
Var R : Registers;
Begin
{$IFDEF DPMI}
 R.BX := $1A;
 RealIntr ($7A, R);
 IPX_Max_Packet_Size := R.AX
{$ELSE}
 R.BX := $1A;
 Intr ($7A, R);
 IPX_Max_Packet_Size := R.AX
{$ENDIF}
End;

Procedure IPX_Get_Full_Address (Var Addr : TFullAddress);
Var R : Registers;
Begin
{$IFDEF DPMI}
 R.BX := 9;
 R.ES := RMFullAddressSeg;
 R.SI := 0;
 RealIntr ($7A, R);
 Move (PRMFullAddress^, Addr, SizeOf(TFullAddress));
{$ELSE}
 R.BX := 9;
 R.ES := Seg(Addr);
 R.SI := Ofs(Addr);
 Intr ($7A, R);
{$ENDIF}
End;

Function IPX_Open_Socket (CloseByCall : Boolean; Var Socket : Word) : Byte;
Var R : Registers;
Begin
{$IFDEF DPMI}
 R.BX := 0;
 R.AL := Byte (CloseByCall);
 R.DX := ((Socket and $FF) shl 8) or (Socket shr 8);
 RealIntr ($7A, R);
 Socket := ((R.DX and $FF) shl 8) or (R.DX shr 8);
 IPX_Open_Socket := R.AL
{$ELSE}
 R.BX := 0;
 R.AL := Byte (CloseByCall);
 R.DX := ((Socket and $FF) shl 8) or (Socket shr 8);
 Intr ($7A, R);
 Socket := ((R.DX and $FF) shl 8) or (R.DX shr 8);
 IPX_Open_Socket := R.AL
{$ENDIF}
End;

Procedure IPX_Close_Socket (Socket : Word);
Var R : Registers;
Begin
{$IFDEF DPMI}
 R.BX := 1;
 R.DX := ((Socket and $FF) shl 8) or (Socket shr 8);
 RealIntr ($7A, R);
{$ELSE}
 R.BX := 1;
 R.DX := ((Socket and $FF) shl 8) or (Socket shr 8);
 Intr ($7A, R);
{$ENDIF}
End;

Procedure IPX_Send_Packet (Var ECBS : TECB);
Var R : Registers;
Begin
{$IFDEF DPMI}
 Move (ECBS, PRMECB^, SizeOf(TECB));
 R.BX := 3;
 R.ES := RMECBSeg;
 R.SI := 0;
 RealIntr ($7A, R);
{$ELSE}
 R.BX := 3;
 R.ES := Seg(ECBS);
 R.SI := Ofs(ECBS);
 Intr ($7A, R);
{$ENDIF}
End;

Function IPX_Listen_For_Packet (Var ECBR : TECB) : Byte;
Var R : Registers;
Begin
{$IFDEF DPMI}
 R.BX := 4;
 R.ES := RMIOBufSeg;
 R.SI := Ofs(ECBR);
 RealIntr ($7A, R);
 IPX_Listen_For_Packet := R.AL
{$ELSE}
 R.BX := 4;
 R.ES := Seg(ECBR);
 R.SI := Ofs(ECBR);
 Intr ($7A, R);
 IPX_Listen_For_Packet := R.AL
{$ENDIF}
End;

Procedure IPX_Relinquish_Control;
Var R : Registers;
Begin
{$IFDEF DPMI}
 R.BX := $A;
 RealIntr ($7A, R);
{$ELSE}
 R.BX := $A;
 Intr ($7A, R);
{$ENDIF}
End;

Procedure IPX_Send_Data (Var Data; Var ToNode);
Var P : PIOBuf;
Begin
 P := PRMIOBuf;
 Inc (Word(P), MaxUsers*SizeOf(TIOBuf));
 with P^.IPXHeader do Begin
   Checksum := 0;                                      { ? }
   Length := SizeOf(TIPXHeader)+512;                   { Length of packet }
   TransportCtrl := 0;                                 { ? }
   PacketType := 4;                                    { IPX }
   Destination.NetAddress := _Addr.NetAddress;         { Our LAN }
   Move (ToNode, Destination.Node, SizeOf(_Addr.Node));{ Broadcast/Certain recipient }
   Destination.Socket := _Addr.Socket;                 { Current socket }
   Move (_Addr, Source, SizeOf(TFullAddress))          { Sender - this computer }
 End;
 with P^.ECB do Begin
   LinkAddr := Nil;                                    { ? }
   ESRAddr := Nil;                                     { ? }
   Socket := _Addr.Socket;                             { Current socket }
   FillChar (IPXWorkSpace, 4, 0);                      { ? }
   FillChar (DriverWorkSpace, 12, 0);                  { ? }
   Move (ToNode, ImmediateAddr, SizeOf(_Addr.Node));   { Broadcast/Certain recipient }
   FragmentCount := 2;                                 { 2 information blocks }
{$IFDEF DPMI}
   Fragment1Addr := Ptr (RMIOBufSeg, Word(P));
{$ELSE}
   Fragment1Addr := @P^.IPXHeader;                     { 1st block is }
{$ENDIF}
   Fragment1Size := SizeOf(TIPXHeader);                { IPX header }
{$IFDEF DPMI}
   Fragment2Addr := Ptr (RMIOBufSeg, Word(P)+SizeOf(TIPXHeader)+SizeOf(TECB));
{$ELSE}
   Fragment2Addr := @P^.Data;                          { 2nd block is }
{$ENDIF}
   Fragment2Size := 512;                               { data block we send }
 End;
 Move (Data, P^.Data, 512);
 IPX_Send_Packet (P^.ECB)                              { Send packet }
End;

Procedure IPX_Prepare_For_Receiving (UserFirst, UserLast : Word);
Var
 P : PIOBuf;
 I : Word;
Begin
 If (UserFirst > UserLast) or (UserLast >= MaxUsers) then Exit;
 P := PRMIOBuf;
 Inc (Word(P), UserFirst*SizeOf(TIOBuf));
 For I := UserFirst to UserLast do Begin
   with P^.ECB do Begin
     LinkAddr := Nil;                                    { ? }
     ESRAddr := Nil;                                     { ? }
     Socket := _Addr.Socket;                             { Current socket }
     FillChar (IPXWorkSpace, 4, 0);                      { ? }
     FillChar (DriverWorkSpace, 12, 0);                  { ? }
     FillChar (ImmediateAddr, 6, $FF);                   { Broadcast }
     FragmentCount := 2;                                 { 2 information blocks }
{$IFDEF DPMI}
     Fragment1Addr := Ptr (RMIOBufSeg, Word(P));
{$ELSE}
     Fragment1Addr := @P^.IPXHeader;                     { 1st block is }
{$ENDIF}
     Fragment1Size := SizeOf(TIPXHeader);                { IPX header }
{$IFDEF DPMI}
     Fragment2Addr := Ptr (RMIOBufSeg, Word(P)+SizeOf(TIPXHeader)+SizeOf(TECB));
{$ELSE}
     Fragment2Addr := @P^.Data;                          { 2nd block is }
{$ENDIF}
     Fragment2Size := 512;                               { data block we send }
   End;
   IPX_Listen_For_Packet (P^.ECB);                       { Listen for packet }
   Inc (Word(P), SizeOf(TIOBuf))
 End
End;

Function IPX_Receive_Data (UserNo : Word; Var Data; Var FromNode) : Boolean;
Var
 P : PIOBuf;
 I : Word;
Begin
 P := PRMIOBuf;
 Inc (Word(P), UserNo*SizeOf(TIOBuf));
 If P^.ECB.InUse = 0 then Begin
   Move (P^.Data, Data, 512);
   Move (P^.ECB.ImmediateAddr, FromNode, SizeOf(_Addr.Node));
   IPX_Prepare_For_Receiving (UserNo, UserNo);
   IPX_Receive_Data := True
 End
 Else
   IPX_Receive_Data := False
End;

Begin
 AllocRMBufs;
End.

Uses IPX, CRT;

                        (* GENERAL CONSTANTS *)

Const
 DefaultSocket = $5000;                        { Default socket for the program }
 DoomSocket    = $869C;                        { Official Doom socket :) }
 ChatID        = 'IPX_CHAT_MSG';               { Chat message ID }
 MaxMessages   = 20;                           { Max messages at the screen }

                (* 512-BYTES DATA BLOCK TYPE DEFINITION *)

Type
 TData = Record
   Typ : Byte;
   Msg : String;
   Res : Array[0..254] of Byte
 End;

                              (* VARIABLES *)

Var
 { Chat socket number }
 ChatSocket : Word;                            { Not reversed!!! }

 Msgs : Array[0..MaxMessages-1] of String;     { Received messages }
 MsgCnt,                                       { Received messages number }

 I : Integer;
 Res : Byte;
 Key : Char;                                   { Character from keyboard }
 Msg : String;                                 { Own message }
 GotMsg : Boolean;                             { Flag of available msg(s) }
 DataBlock : Array[0..MaxUsers-1] of TData;    { 512-bytes data blocks }
 FromNode : Array[0..MaxUsers-1] of Array [0..5] of Byte; { Senders that sent mesg(s) }

                   (* STRING HANDLING FUNCTIONS *)

Function HexB (B : Byte) : String;
Const
 HC : Array [0..15] of Char = '0123456789ABCDEF';
Begin
 HexB := HC[B shr 4] + HC[B and 15]
End;

Function ToHex (Var Buf; Count : Integer) : String;
Var
 X : Array[0..255] of Byte Absolute Buf;
 I : Byte;
 S : String;
Begin
 S := '';
 For I := 0 to Count-1 do
   S := S + HexB(X[I]);
 ToHex := S
End;

                     (* SENDING/RECEIVING ROUTINES *)

Procedure Send_Message (Message : String);
Var
 Data : TData;
 ToNode : Array [0..5] of Byte;
Begin
 Data.Typ := 1;
 Data.Msg := ChatID+Message;
 FillChar (ToNode, 6, $FF);
 IPX_Send_Data (Data, ToNode)
End;
                 (* MESSAGES/SCREEN HANDLING ROUTINES *)

Procedure Clear_Messages;
Var
 I : Integer;
Begin
 For I := 0 to MaxMessages-1 do
   Msgs[I] := '';
 MsgCnt := 0
End;

Procedure Add_Message (Msg : String);
Var I : Integer;
Begin
 If MsgCnt < MaxMessages then Begin
   Msgs[MsgCnt] := Msg;
   Inc (MsgCnt)
 End
 Else Begin
   For I := 0 to MaxMessages-2 do
     Msgs[I] := Msgs[I+1];
   Msgs[MaxMessages-1] := Msg
 End
End;

Procedure Display_Messages;
Var I : Integer;
Begin
 For I := 0 to MaxMessages-1 do Begin
   GotoXY (1, 2+I); Write (Msgs[I]); ClrEol
 End
End;

Procedure Display_Own_Message;
Begin
 GotoXY (1, MaxMessages+3);
 ClrEol;
 Write ('>',Msg)
End;

                            (* MAIN PROGRAN *)

Label LEnd;

Begin
 WriteLn ('IPX Chat v1.0 by Alexei A. Frounze (c) 1999');
 If ParamCount <> 0 then Begin
   If ParamStr(1) = '/?' then Begin
     WriteLn ('Usage:  IPX_CHAT.EXE  [SOCKET_NUMBER]   <ДЩ');
     WriteLn ('Default socket number is 20480 (5000h).');
     WriteLn ('You can also ask IPX-driver for available socket number, ');
     WriteLn ('sipmly type: IPX_CHAT.EXE 0 <ДЩ');
     Goto LEnd
   End;
   Val (ParamStr(1), ChatSocket, I);
   If I <> 0 then Begin
     WriteLn ('You didn''t enter a number.');
     Goto LEnd
   End
 End
 Else ChatSocket := DefaultSocket;

 If not Is_IPX_Installed then Begin
   WriteLn ('IPX protocol is not installed.');
   Goto LEnd
 End;

 WriteLn (#13#10'IPX protocol is installed.');

 IPX_Get_Full_Address (_Addr);
 WriteLn (#13#10'Local area network address is: ', ToHex(_Addr.NetAddress,4));
 WriteLn ('Node is: ', ToHex(_Addr.Node,6));

 WriteLn (#13#10'Trying to open ', ChatSocket, ' socket...');
 { gives free socket ($4000...$4FFF) by socket=0 request }
 Res := IPX_Open_Socket (False, ChatSocket);             { Openning socket }
 If Res <> 0 then Begin
   WriteLn ('Couldn''t open desired socket.');
   Goto LEnd
 End;
 WriteLn ('Successfully. Socket ', ChatSocket, ' is open.');
 _Addr.Socket := ((ChatSocket and $FF) shl 8) + (ChatSocket shr 8); { Reversed!!! }
 WriteLn ('Be sure other users enter the chat using this socket.');

 WriteLn (#13#10'You should at least see "',ToHex(_Addr.Node,6),
                '> On-line" message in the chat window.');

 Write (#13#10'Hit any key to enter the chat...');
 While not KeyPressed do; While KeyPressed do ReadKey;

 ClrScr;
 For I := 1 to 80 do Begin
   GotoXY (I, 1); Write ('-');
   GotoXY (I, MaxMessages+2); Write ('-');
 End;
 Msg := '';
 Display_Own_Message;

 IPX_Prepare_For_Receiving (0, MaxUsers-1);    { Listen for IPX packets }

 Send_Message ('On-line');             { We should recive this msg too! }

                               (* MAIN LOOP *)

 Repeat
   IPX_Relinquish_Control;             { Let IPX driver do some work }
   GotMsg := False;
   For I := 0 to MaxUsers-1 do
     If IPX_Receive_Data (I, DataBlock[I], FromNode[I]) then Begin
       If Pos(ChatID,DataBlock[I].Msg)=1 then Begin         { Got new msg }
         Delete (DataBlock[I].Msg, 1, Length(ChatID));
         Add_Message (ToHex(FromNode[I],6)+'> '+DataBlock[I].Msg);
         GotMsg := True
       End
     End;
   If GotMsg then Begin
     Display_Messages;                                 { Displaying it }
     Display_Own_Message                               { Your input string }
   End;

   If KeyPressed then Key := ReadKey
   Else Key := #$FF;
   Case Key of
     #0  : Begin ReadKey; Key := #$FF End;
     #27 : Break;
     #13 : Begin If Msg <> '' then Send_Message (Msg); Msg := '' End;
     #8  : If Msg <> '' then Dec(Msg[0]);
     #32..#254 : If Length(Msg) < 66 then Msg := Msg + Key
   End;
   If Key in [#8,#13,#32..#254] then
     Display_Own_Message
 Until False;

 Send_Message ('Off-line');                            { Say "goodbye" }
 IPX_Relinquish_Control;

 IPX_Close_Socket (ChatSocket);                        { Closing socket }
 ClrScr;
LEnd:
 FreeRMBufs;                                           { Freeing buffers }
End.