readme.doc

一个演示使用ipx协议在局域网来传递包的例子

{ Open a socket
  PARAMS:  longevity = $00 for open till close or terminate
                     = $ff for open till close  use for TSR

           socketNumber = 0 for dynamic allocation
                        = anything else

  RETURNS: completion code $00 = success
                           $fe = socket table full
                           $ff = socket already open }
function IPXopenSocket(longevity : byte; var socketNumber : word):byte;
var
  regs : registers;

begin
  regs.bx:=$0000;
  regs.al:=longevity;
  regs.dx:=swap(socketNumber);

  intr($7A,regs);

  if socketNumber=$0000 then
    socketNumber:=swap(regs.dx);

  IPXopenSocket:=regs.al;
end;

{ Close a socket
  PARMS:  socketNumber = a socket to close }
procedure IPXcloseSocket(socketNumber : word);
var
  regs : registers;

begin
  regs.bx:=$0001;
  regs.dx:=swap(socketNumber);

  intr($7A,regs);
end;

{ Get my address and put it into the local address array! }
procedure GetLocalAddress;
var
  regs : registers;

begin
  regs.bx:=$0009;
  regs.es:=seg(localAddr);
  regs.si:=ofs(localAddr);
  intr($7A,regs);
end;

{ Send an IPX packet
PARAMS:  var E = an initialized Event Control Block }
procedure IPXsendPacket(var E : ECBtype);
var
  regs : registers;

begin
  regs.bx:=$0003;
  regs.es:=seg(E);
  regs.SI:=ofs(E);

  intr($7A,regs);
end;

{ Listen for an IPX packet
PARAMS:  var E = an initialize Event Control Block

RETURNS: 0 for OK, nonzero for an error ????}
function IPXlistenForPacket(var E : ECBtype):byte;
var
  regs : registers;

begin
  regs.bx:=$0004;
  regs.es:=seg(E);
  regs.SI:=ofs(E);

  intr($7A,regs);

  IPXlistenForPacket:=regs.al;
end;

{ Tell the IPX driver that we aren't doing anything at the moment }
procedure ImIdle;
var
  regs : registers;

begin
  regs.bx:=$000A;

  intr($7A,regs);
end;

{ Set up the fields in a send IPX record }
procedure InitSendPacket(var ecb : ecbType; var ipx : ipxHeader; size,sock : word);
begin
  fillChar(ecb,sizeOf(ecb),#0);
  fillChar(ipx,sizeOf(ipx),#0);
  with ecb do
    begin
      socket:=swap(sock);               { Big endian socket number }
      fragCount:=1;                     { Fragment count }
      fragData[0]:=ofs(IPX);            { Pointer to data fragment }
      fragData[1]:=seg(IPX);
      fragSize:=sizeof(IPX)+size;       { Size of data fragment }
      immedAddr:=BROADCAST;             { Needs to be BROADCAST?? }
    end;

  with ipx do
    begin
      check:=$ffff;                     { NO CHECKSUM }
      ptype:=0;                         { Packet exchange packet }
      dest.net:=localAddr.net;          { Send to this network }
      dest.node:=BROADCAST;             { Send to everybody! }
      dest.socket:=swap(sock);          { Send to my socket }
      src.net:=localAddr.net;           { From this net }
      src.node:=localAddr.node;         { From ME }
      src.socket:=swap(sock);           { From my socket }
    end;
end;

{ Set up the fields in a recieve IPX record }
procedure InitReceivePacket(var ecb : ecbType; var ipx : ipxHeader; size,sock : word);
begin
  fillChar(ecb,sizeOf(ecb),#0);
  fillChar(ipx,sizeOf(ipx),#0);
  with ecb do
    begin
      inUse:=$1d;                               { ???? }
      socket:=swap(sock);                       { Big endian socket number }
      fragCount:=1;                             { Fragment count }
      fragData[0]:=ofs(IPX);                    { Pointer to data fragment }
      fragData[1]:=seg(IPX);
      fragSize:=sizeof(IPX)+size;               { Size of data fragment }
    end;

  if IPXlistenForPacket(ecb)<>0 then ;          { Tell IPX to listen }
end;

{ Set up IPX and get the local address }
procedure InitIPX;
var
  i    : integer;
  regs : registers;

begin
  regs.ax:=$7A00;
  intr($2f,regs);

  if regs.al<>255 then
    begin
      writeln('ERROR WHILE INITIALIZING IPX!');
      halt(1);
    end;

  getLocalAddress;
end;


begin
end.

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

    A    PPPPP  PPPPP  EEEEEE N       N DDDDDD  IIIII X     X      BBBBBB
   A A   P    P P    P E      NN      N D     D   I   X     X      B     B
  A   A  P    P P    P E      N N     N D     D   I   X     X      B     B
 A     A P    P P    P E      N  N    N D     D   I    X   X       B     B
 A     A P    P P    P E      N   N   N D     D   I     X X        B     B
 AAAAAAA PPPPP  PPPPP  EEEE   N    N  N D     D   I      X         BBBBBB
 A     A P      P      E      N     N N D     D   I     X X        B     B
 A     A P      P      E      N      NN D     D   I    X   X       B     B
 A     A P      P      E      N       N D     D   I   X     X      B     B
 A     A P      P      E      N       N D     D   I   X     X      B     B
 A     A P      P      EEEEEE N       N DDDDDD  IIIII X     X      BBBBBB

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

program CHAT;
uses CRT,IPX;

type
  Packet = record
             ecb  : ECBType;
             IPX  : IPXheader;
             data : string;
           end;

var
  send,receive : Packet;

procedure Main;
  
var
  line   : string;
  y      : integer;
  done   : boolean;
  k      : char;
  i      : integer;
  handle : string;

begin
  ClrScr;
  writeln('CHATER BOX v0.5 By Daniel Parnell  25th March 1994');
  writeln;
  write('Enter your handle :');
  readln(handle);

  window(1,1,80,23);
  textBackground(Blue);
  textColor(Yellow);
  clrScr;
  window(1,24,80,25);
  textBackground(Red);
  textColor(Yellow);
  clrScr;

  y:=1;
  line:='';
  done:=FALSE;

  repeat
    repeat
    until KeyPressed or (receive.ecb.inuse=0);

    if receive.ecb.inuse=0 then
      begin
        window(1,1,80,23);
        gotoXY(1,y);
        textBackground(Blue);
        textColor(Yellow);
        writeln(receive.data);
        y:=WhereY;
        if IPXlistenForPacket(receive.ecb)<>0 then
          begin
            writeln(#7,'ERROR TRYING TO receive A PACKET!');
            halt(2);
          end;

        window(1,24,80,25);
        GotoXY(1,length(line)+1);

      end;

    if KeyPressed then
      begin
        k:=ReadKey;
        case k of
          #13 : if line<>'' then
                  begin
                    send.data:='<<'+handle+'>>'+line;

                    with send.ecb do
                      for i:=1 to 6 do
                        ImmedAddr[i]:=$ff;

                    repeat
                    until send.ecb.inuse=0;

                    IPXsendPacket(send.ecb);
                    line:='';
                  end;
          #8  : if length(line)>0 then
                  line:=copy(line,1,length(line)-1);
          #0  : k:=ReadKey;
          #27 : done:=TRUE;
        else
          if length(line)<79 then
            line:=line+k
          else
            begin
              sound(1000);
              delay(100);
              noSound;
            end;
        end;

        window(1,24,80,25);
        textBackground(Red);
        textColor(Yellow);
        GotoXY(1,1); clreol; write(line);
      end;
  until done;
end;

begin
  if IPXopenSocket(0,MYSOCKET)=0 then
    begin
      InitIPX;

      with send do
        InitSendPacket(ecb,ipx,sizeof(String),MYSOCKET);
      with receive do
        InitReceivePacket(ecb,ipx,sizeof(String),MYSOCKET);

      Main;

      IPXcloseSocket(MYSOCKET);
    end;

  TextColor(LightGray);
  TextBackground(Black);
  window(1,1,80,25);
  clrScr;
end.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Daniel Parnell  -  Email to [e-mail] - AMIGA 500&600 1 MEG
 Second Year Applied Physics student at R.M.I.T. Melbourne Australia.   *:|()
   People who drink petrol shouldn't smoke.  AMOS 1.36 with Compiler and 3D
    Squaxx Dek Thargo from prog 579 - C64 Amiga Mac CCPM 6502 8086 - Forth