{ RECMESS.PAS } { Rutiny sluziace ku komunikacii IPX protokolom. } { } { Datum:20.02.2016 http://www.trsek.com } uses crt,dos,net_serv,ipx; const socket=$4000; namefmess='MESSAGE.TXT'; type tipx=record head:tipxhead; data:array[1..538]of byte; end; tmessproc=procedure; var ipxreceive:tipx; ecbreceive:tecb; r:registers; keyb:char; ckl:word; filemess:text; messproc:tmessproc; endprog:boolean; procedure writemess;far; var h,m,s,hund:word; y,mo,d,dow:word; tmp:string; begin gettime(h,m,s,hund); getdate(y,mo,d,dow); tmp:=doplnnuly(h,2)+':'+doplnnuly(m,2)+':'+doplnnuly(s,2); writeln(#13#10'Zprava prijata a ulozena do souboru '+namefmess+'('+tmp+')'); assign(filemess,namefmess); {$I-} append(filemess); if ioresult <> 0 then rewrite(filemess); writeln(filemess,#10#13+doplnnuly(d,2)+'/'+doplnnuly(mo,2)+'/'+doplnnuly(y,2)+#32#45#32+tmp); for ckl:=1 to ipxreceive.head.len - lenheadpacket do write(filemess,chr(ipxreceive.data[ckl])); writeln(filemess); close(filemess) {$I+} end; function anone(prompt:string):boolean; var ch:char; begin while keypressed do keyb:=readkey; write(prompt,'? [A/N]: '); ch:=readkey; if ord(ch)=0 then begin ch:=readkey; ch:='N'; end; if ch in ['a','A'] then anone:=true else begin anone:=false; ch:='N'; end; writeln(ch); while keypressed do keyb:=readkey; end; procedure _receivepacket(locwritemess:tmessproc); begin ecbreceive.esr:=nil; word(ecbreceive.socketno):=socket; ecbreceive.locnoad:=all; ecbreceive.fragcnt[1]:=1; ecbreceive.fragcnt[2]:=0; ecbreceive.fragaddr:=@(ipxreceive); ecbreceive.fragsize:=maxlenpacket; opensocket(socket); if neterror <> 0 then exittodos('nelze otevrit socket pro prijem zpravy !',1); receivepacket(ecbreceive); repeat until (ecbreceive.inuse = 0) or keypressed; if keypressed then endprog:=anone('Ukoncit program '+paramstr(0)); ipxreceive.head.len:=hi(ipxreceive.head.len)+256*lo(ipxreceive.head.len); if ecbreceive.inuse = 0 then locwritemess else cancelevent(ecbreceive); closesocket(socket); end; begin {main} endprog:=false; if neterror <> 0 then exittodos('Rozhrani IPX neni dostupne !',1); messproc:=writemess; repeat _receivepacket(writemess); until endprog; end.