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

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

{$DEFINE noTRACE}

uses dos,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;

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

    ListenDataBuffer:array[1..8] of byte;

    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:file;


Procedure CheckError(err:boolean; errNbr:word);
begin
if err
 then begin
      writeln;
      CASE errNbr of
       $0100:writeln('IPX needs to be installed.');
       $0200:writeln('Error: can''t locate the spcified username.');
       $0201:begin
              writeln('The specified user has multiple connections.');
              writeln('This demonstation program doesn''t support multiple connections.');
              end;
       $0202:writeln('Error: can''t find the address of the supplied username.');
       $0204:writeln('Transfer aborted after 50 retries.');
       $0205:writeln('Key pressed: Transfer aborted.');
       $0206:writeln('The supplied file couldn''t be found. Please supply full path.');
       $0300:writeln('Error reading file.');
       $10FE:writeln('Error opening socket: Socket Table Is Full.');
       $10FF:writeln('Error opening socket: Socket is already open.');
      end; {case}
      IPXcloseSocket(IOsocket);
      close(f);
      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 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,Fname:string;
    NbrOfConn:byte;
    connList:TconnectionList;

    p:byte;
    FileInfo:searchrec;
    FileSize:LongInt;
    BytesRead:word;

    TransferStartTicks,TransferEndTicks:word;
    OriginalFileSize:LongInt;

begin
If paramcount<>2
 then begin
      writeln('Usage: FSEND <username> <filename>');
      writeln('-The file will be sent to the workstation of the supplied username.');
      writeln('-Run FGET on that workstation to receive the file.');
      halt(1);
      end;
Uname:=ParamStr(1);
UpString(Uname);
NbrOfConn:=0;
GetObjectConnectionNumbers(Uname,OT_USER,NbrOfConn,connList);
CheckError((nwConn.result>0) or (NbrOfConn=0),$200);
CheckError(NbrOfConn>1,$0201);

GetInternetAddress(connList[1],dest);
CheckError(nwconn.result>0,$0202);
dest.socket:=IOsocket;

Fname:=ParamStr(2);
Assign(f,Fname);
Reset(f,1);
CheckError(IOresult<>0,$0206);


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

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

{ setup listening for ack }
AckReceived:=False;

PEPsetupListenECB(Addr(ListenForAckESR),IOsocket,@ListenDataBuffer,8,
                  ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);

{ send initial packet with the name and size of the file to be sent. }
findfirst(Fname,$FF,FileInfo);
Move(FileInfo.size,SendDataBuffer[16],4);
FileSize:=Fileinfo.size;
p:=length(Fname);
while (p>0) and (Fname[p]<>':') and (Fname[p]<>'\')
 do dec(p);
If p>0
 then delete (Fname,1,p);
Move(Fname[0],SendDataBuffer[1],15);

PEPsetupSendECB(NIL,IOsocket,dest,@SendDataBuffer[1],512,
                SendPepHdr,SendECB);
SendTransID:=1;
SendPepHdr.ClientType:=$EA;

OriginalFileSize:=FileSize;
FileSize:=FileSize+512; { compensate length for information header }

writeln('FSEND waiting for remote handshake. (any key to abort)');

While Filesize>0
 do begin
    ackreceived:=false;
    SendPepHdr.TransactionId:=SendTransId;
    IPXsendPacket(SendECB);
    {$IFDEF TRACE}
    write('Packet#',SendTransID,' sent.');
    {$ENDIF}
    while sendECB.InuseFlag<>0
     do IPXrelinquishControl;

    IPXGetIntervalMarker(ticks);
    retries:=0;
    REPEAT
      IPXrelinquishcontrol;
      IPXGetIntervalMarker(ticks2);
      if (ticks2-ticks)>2
       then begin
            inc(retries);
            {$IFDEF TRACE}
            writeln;
            write('Timeout: resending packet#',SendTransID);
            {$ENDIF}
            IPXsendPacket(SendECB);
            while sendECB.InuseFlag<>0
             do IPXrelinquishControl;
            IPXGetIntervalMarker(ticks);
            end;
      CheckError(retries>50,$0204);
      CheckError(Keypressed,$0205);
    UNTIL AckReceived;
    if SendTransID=1
     then begin
          writeln('Handshake received. Starting file transfer.');
          IPXGetIntervalMarker(TransferStartTicks);
          end;
    {$IFDEF TRACE}
    writeln(' Ackn.#',ListenPepHdr.TransactionID,' received.');
    {$ENDIF}
    FileSize:=FileSize-512;

    { fill buffer with next block of data }
    IF FileSize>0
     then begin
          BlockRead(f,SendDataBuffer,512,bytesread);
          CheckError((bytesread<512) and (filesize<>bytesread),$0300);
          end;

    inc(SendTransID);
    IPXListenForPacket(ListenECB); { start listening for acks again }
    end;
IPXGetIntervalMarker(TransferEndTicks);
IPXcancelEvent(ListenECB);
Writeln('Transfer completed.');
writeln('Throughput: ', 18*OriginalFileSize/(TransferEndTicks-TransferStartTicks):4:2,' bps');
IPXcloseSocket(IOsocket);
close(f);

end.