home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 5
/
ctrom5b.zip
/
ctrom5b
/
PROGRAM
/
PASCAL
/
NWTP06
/
M1_PEP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-03-01
|
7KB
|
230 lines
{$X+,V-,B-,I-}
program M1_PEP; { Master / Sender }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
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
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.');
$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;
begin
If paramcount<>2
then begin
writeln('Usage: M1_PEP <username> <filename>');
writeln('-The file will be sent to the workstation of the supplied username.');
writeln('-Run S1_PEP 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);
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;
FileSize:=FileSize+512; { compensate length for information header }
While Filesize>0
do begin
ackreceived:=false;
SendPepHdr.TransactionId:=SendTransId;
IPXsendPacket(SendECB);
writeln('Packet#',SendTransID,' was sent.');
while sendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
retries:=0;
REPEAT
IPXrelinquishcontrol;
IPXGetIntervalMarker(ticks2);
if (ticks2-ticks)>2
then begin
inc(retries);
writeln('Timeout: resending pkt#',SendTransID);
PEPsetupSendECB(NIL,IOsocket,dest,@SendDataBuffer[1],512,
SendPepHdr,SendECB);
SendPepHdr.ClientType:=$EA;
SendPepHdr.TransactionId:=SendTransId;
IPXsendPacket(SendECB);
while sendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXGetIntervalMarker(ticks);
end;
CheckError(retries>50,$0204);
CheckError(Keypressed,$0205);
UNTIL AckReceived;
writeln('Ack ',ListenPepHdr.TransactionID,' was received.');
FileSize:=FileSize-512;
inc(SendTransID);
{XXX fill buffer met volgende fileblock }
IPXListenForPacket(ListenECB); { start listening for acks again }
end;
IPXcloseSocket(IOsocket);
close(f);
end.