Rutiny chtore maju buc na pošilane baličkoch cez IPX protokol

{ 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.