mars-nweadmin/NWTP/XIPX/M_PEP.PAS

{$X+,V-,B-}
program M_PEP; { Master / Sender }

{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }

{ Sents a single packet, waits for acknowledgement }

uses crt,nwMisc,nwBindry,nwConn,nwIPX,nwPEP;

CONST IOSocket=$5678;           { socket to transmit/receive on }

Var ListenECB     :Tecb;        { ECB and header, to listen for acknowledgement }
    ListenPepHdr  :TpepHeader;

    SendECB       :Tecb;        { ECB and header, used to send the data }
    SendPepHdr    :TpepHeader;

    socket        :word;

    buf           :array[1..546] of byte; { buffer for data to be sent }

    AckReceived   :boolean;     { set to true within the ListenForAckESR }

    SendTransId   :LongInt;     { transactionID. This uniquely identifies
                                  the packet. The slave/receiver has to
                                  reply with the same transactionID in the
                                  header of the acknowledgement. Only if
                                  this number is the same as the transactioID
                                  of the sent packet, the pavket is considered
                                  successfully delivered. }

    NewStack:array[1..1024] of word;  { !! used by ESR }
    StackBottom:word;                 { !! used by ESR }


{$F+}
Procedure ListenForAckHandler(Var p:TPecb);
 { Interrupts are turned off -and should remain turned off- }
begin
IF (ListenECB.CompletionCode<>0)                      { packet must be suucessfully received.. }
 or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE) { of type PEP.. }
 or (ListenPepHdr.ClientType<>$EA)                    { of client type $EA }
 or (ListenPepHdr.TransactionID<>SendTransId)         { with a correct clientID (of the packet the master sent) }
  then IPXListenForPacket(ListenECB)   { Invalid packet => listen again   }
  else AckReceived:=true;              { valid packet   => ACK received ! }
end;
{$F-}

{$F+}
Procedure ListenForAckESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
    { interrupts are turned off -and should remain turned off- }
    mov dx, seg stackbottom
    mov ds, dx

    mov dx,ss  { setup of a new local stack }
    mov bx,sp  { ss:sp copied to dx:bx}
    mov ax,ds
    mov ss,ax
    mov sp,offset stackbottom
    push dx    { push old ss:sp on new stack }
    push bx

    push es    { push es:si on stack as local vars }
    push si
    mov  di,sp

    push ss    { push address of local ptr on stack }
    push di
    CALL ListenForAckHandler

    add sp,4   { skip stack ptr-copy }
    pop bx     { restore ss:sp from new stack }
    pop dx
    mov sp,bx
    mov ss,dx
end;
{$F-}


Var dest:TinternetworkAddress;
    ticks,ticks2:word;
    retries     :word;

    Uname:string;
    NbrOfConn:byte;
    connList:TconnectionList;

begin
If paramcount<>1
 then begin
      writeln('Usage: M_PEP <username>');
      writeln('-a test pep packet will be sent to the workstation of this user.');
      writeln('-run S_PEP on that workstation to receive the packet.');
      halt(1);
      end;
Uname:=ParamStr(1);
UpString(Uname);
NbrOfConn:=0;
IF (NOT GetObjectConnectionNumbers(Uname,OT_USER,NbrOfConn,connList))
   or (NbrOfConn=0)
 then begin
      writeln('Error: can''t locate user ',Uname);
      halt(1);
      end;
IF NbrOfConn>1
 then begin
      writeln('The specified user has multiple connections.');
      writeln('This demonstation program doesn''t support multiple connections.');
      halt(1);
      end;
IF NOT GetInternetAddress(connList[1],dest)
 then begin
      writeln('Error: can''t find the address of user ',Uname);
      halt(1);
      end;


IF NOT IpxInitialize
 then begin
      writeln('Ipx needs to be installed.');
      halt(1);
      end;
socket:=IOSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
 then begin
      writeln('IPXopenSocket returned error# ',nwIPX.result);
      halt(1);
      end;


{ setup listening for ack }
AckReceived:=False;
FillChar(buf,546,#0);
{ Setup ECB and IPX header }
PEPsetupListenECB(Addr(ListenForAckESR),IOsocket,@buf,546,
                  ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);

{ send packet }

dest.socket:=IOsocket;
buf[1]:=ord('s');buf[2]:=ord('m');
PEPsetupSendECB(NIL,IOsocket,dest,@buf[1],2,
                SendPepHdr,SendECB);
SendTransID:=1;
SendPepHdr.TransactionId:=SendTransId;
SendPepHdr.ClientType:=$EA;
IPXsendPacket(SendECB);
writeln('Packet was sent.');
while sendECB.InuseFlag<>0 do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);

{ wait for acknowledgement or timeout }
retries:=0;

REPEAT
  IPXrelinquishcontrol;
  IPXGetIntervalMarker(ticks2);
  if (ticks2-ticks)>4
   then begin
        inc(retries);
        writeln('Timeout: resending');
        IPXsendPacket(SendECB);
        while sendECB.InuseFlag<>0 do IPXrelinquishControl;
        IPXGetIntervalMarker(ticks);
        end;
UNTIL AckReceived or Keypressed or (retries>50);

if AckReceived
 then writeln('Ack was received.');

IF NOT IPXcloseSocket(IOsocket)
 then writeln('IPXcloseSocket returned error# ',nwIPX.result);

end.