mars-nweadmin/NWTP/XIPX/FGET.PAS

{$X+,V-,B-,I-}
program Fget; { Listening Process / receiver / Slave }

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

{$DEFINE noTRACE}

uses crt,nwMisc,nwIPX,nwPEP;

Var ListenECB     :Tecb;       { used to listen for packets }
    ListenPepHdr  :TpepHeader;

    SendECB       :Tecb;       { used to send acknowledgements }
    SendPepHdr    :TpepHeader;

    IOsocket      :word;
    DataBuffer    :array[1..546] of byte;
    SendDataBuffer:byte;

    PacketReceived   :Boolean;
    LastTransactionID:LongInt;

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

Procedure CheckError(err:boolean; errNbr:word);
begin
if err
 then begin
      CASE errNbr of
       $0100:writeln('IPX needs to be installed.');
       $0101:writeln('ERROR: Connection not established. A Timeout occured');
       $0102:writeln('ERROR: The transfer is aborted; A timeout occured.');
       $0108:writeln('Transfer aborted.');
       $0300:writeln('The supplied path doesn'' exist / no write rights in directory.');
       $0301:writeln('Error writing to file / no write rights in directory.');
       $10FE:writeln('Error opening socket: Socket Table Is Full.');
       $10FF:writeln('Error opening socket: Socket is already open.');
       else writeln('Unspecified error.');
      end; {case}
      IPXcloseSocket(IOsocket);
      halt(1);
      end;
end;

Function TimeOut(t1,t2:word;n:byte):boolean;
{ ticks t2 - ticks t1 > n seconds ? }
Var lt1,lt2:LongInt;
begin
lt2:=t2;
if t1>t2 then lt2:=lt2+$FFFF;
TimeOut:=(lt2-t1)>(n*18);
end;

{$F+}
Procedure ListenAndAckHandler;
begin
If (ListenECB.CompletionCode<>0)
 or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE)
 or (ListenPepHdr.clienttype<>$EA)
 or (ListenPepHdr.TransactionID<LastTransactionID) { discard dupe old packet }
  then IPXlistenForPacket(ListenECB)
  else begin
       PacketReceived:=(ListenPepHdr.transactionID>LastTransactionID); { new packet received }

       { Acknowledge new packets and duplicates of the latest packet, }
       { as the original acknowledgement may have been lost. }
       LastTransactionID:=ListenPepHdr.TransactionID;

       { Setup acknowledgement ECB and PEPheader, and send it. }
       if SendECB.InUseFlag=0
        then begin
             ListenPepHdr.IPXhdr.source.socket:=swap(ListenPepHdr.IPXhdr.source.socket);
             { socket is hi-lo in IPX/PEPHeaders. SetupSendECB expects lo-hi }
             PEPsetupSendECB(NIL,IOsocket,ListenPepHdr.IPXhdr.source,
                             @SendDataBuffer,0,
                             SendPepHdr,SendECB);
             SendPepHdr.TransactionId:=LastTransactionID;
             SendPepHdr.ClientType:=$EA;
             IPXsendPacket(SendECB);
             end;
       end;
end;
{$F-}

{$F+}
Procedure ListenAndAckESR; assembler;
asm
    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
    CALL ListenAndAckHandler
    pop bx     { restore ss:sp from new stack }
    pop dx
    mov sp,bx
    mov ss,dx
end;
{$F-}

Var ticks,ticks2 :word;
    FileName:string;
    FileSize:LongInt;
    DirName:string;
    f:file;
    BytesToWrite,BytesWritten:word;

begin
IpxInitialize;
CheckError(nwIPX.result>0,$100);

If (pos('?',ParamStr(1))>0) or (paramcount>1)
 then begin
      writeln('Usage: FGET <directory>');
      writeln('-The File sent by FSEND on another workstation');
      writeln('will be copied to the supplied directory.');
      halt(1);
      end;
If paramcount=1
 then DirName:=ParamStr(1)
 else DirName:='.';

IF NOT (DirName[ord(dirName[0])] IN [':','\'])
 then DirName:=DirName+'\';
assign(f,DirName+'temp.$$$');
rewrite(f,1);
CheckError(IOresult<>0,$0300);
close(f);

IOSocket:=$5678;
IPXopenSocket(IOsocket,SHORT_LIVED_SOCKET);
CheckError(nwIPX.result>0,$1000+nwIPX.result);

{ Setup of ECB and PepHeader, start listening for incoming packets. }
LastTransactionID:=0;
PacketReceived:=False;
PEPSetupListenECB(Addr(ListenAndAckESR),IOsocket,@DataBuffer,546,
                  ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
writeln('Waiting for FSEND to start sending.. (any key to abort)');

IPXGetIntervalMarker(ticks);
REPEAT
 IPXrelinquishControl;
 IPXGetIntervalMarker(ticks2);
 CheckError(TimeOut(ticks,ticks2,130),$101);{ error if a timeout occurred }
 CheckError(Keypressed,$108);
UNTIL PacketReceived;

writeln('Handshaking.. Initiating transfer process.');
{$IFDEF TRACE}
writeln('Received PacketID:',LastTransactionID);
{$ENDIF}

{ do something with DataBuffer: the data that was just received. }
{ the first packet contains the filename and filesize }
Move(DataBuffer[1],FileName[0],15);
Move(DataBuffer[16],FileSize,4);
writeln('Receiving file ',FileName,', size: ',FileSize);

assign(f,DirName+filename);
rewrite(f,1);
BytesToWrite:=512;

REPEAT { Listen for remaining packets  }
 Packetreceived:=false;

 While SendECB.InuseFlag<>0
  do IPXrelinquishControl;

 IPXListenForPacket(ListenECB);
 IPXGetIntervalMarker(ticks);
 Repeat
  IPXrelinquishControl;
  IPXGetIntervalMarker(ticks2);
  CheckError(TimeOut(ticks,ticks2,10),$102); { error if Timeout occurred }
  CheckError(Keypressed,$108);
 until PacketReceived;
 {$IFDEF TRACE}
 writeln('Received packet#:',LastTransactionID);
 {$ENDIF}

 { Write DataBuffer to disk. }
 IF FileSize<512
  then BytesToWrite:=FileSize;
 BlockWrite(f,DataBuffer,BytesToWrite,BytesWritten);
 CheckError(BytesToWrite<>BytesWritten,$0301);

 FileSize:=FileSize-512;
UNTIL (FileSize<=0); { entire file received }

writeln('Transfer complete.');
IPXcloseSocket(IOsocket);
close(f);
end.