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

{ SENDMESS.PAS                                                       }
{ Rutiny sluziace ku komunikacii IPX protokolom.                     }
{                                                                    }
{ Datum:20.02.2016                              http://www.trsek.com }
 
uses ipx,net_serv,dos,crt;
const
  socket=$4000;
type
  tipx=record
         head:tipxhead;
         data:array[1..538]of byte;
       end;
var
  ipxsend:tipx;
  ecbsend:tecb;
  r:registers;
  endofsending:boolean;
 
function getstring(prompt:string):string;
var
  tmpstr:string;
begin
  write(prompt,' ');
  readln(tmpstr);
  getstring:=tmpstr;
end;
 
function waitsendpacket(infinity:word):boolean;
var
  ckl:word;
begin
  ckl:=0;
  if infinity < 1 then while ecbsend.inuse <> 0 do begin end
  else repeat
    ckl:=ckl+1;
    delay(1000);
  until (ckl=infinity) or (ecbsend.inuse=0);
  waitsendpacket:=ecbsend.inuse = 0;
end;
 
procedure nulcontrlstruct;
begin
  fillchar(ipxsend,sizeof(ipxsend),0);
  fillchar(ecbsend,sizeof(ecbsend),0);
  fillchar(ipxsend.head.checksum,sizeof(ipxsend.head.checksum),0);
  ipxsend.head.transctrl:=0;
  ipxsend.head.packettyp:=16;
  ipxsend.head.destnetw:=unknown;
  ipxsend.head.destnode:=all;
  word(ipxsend.head.destsckt):=socket;
end;
 
procedure subsendpacket(msg:string);
var
  len:word;
begin
  nulcontrlstruct;
  move(ptr(seg(msg),ofs(msg)+1)^,ipxsend.data,ord(msg[0]));
  len:=lenheadpacket+length(msg);
  ecbsend.esr:=nil;
  word(ecbsend.socketno):=socket;
  ecbsend.locnoad:=all;
  ecbsend.fragcnt[1]:=1;
  ecbsend.fragcnt[2]:=0;
  ecbsend.fragaddr:=@(ipxsend);
  ecbsend.fragsize:=len;
  opensocket(socket);
  sendpacket(ecbsend);
  if waitsendpacket(0) then writeln('Zprava odeslana ...')
  else writeln('Zpravu se nepodarilo odeslat !');
  closesocket(socket);
end;
 
procedure _sendpacket;
var
  msg:string;
begin
  msg:=getstring('Piste zpravu (ENTER = konec): ');
  if msg <> '' then begin
    if length(msg) < 255 - (length(username)+1) then msg:=msg+':'+username;
    subsendpacket(msg);
  end else endofsending:=true;
end;
 
begin {main}
  if neterror <> 0 then exittodos('Rozhrani IPX neni dostupne !',1);
  endofsending:=false;
  repeat
    _sendpacket;
  until endofsending;
end.