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

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: Pridaňa

Program: Ipx.pas
Subor exe: Sendmess.exeRecmess.exe
Mušiš mac: Net_serv.pasRecmess.pasSendmess.pas

Rutiny chtore maju buc na pošilane baličkoch cez IPX protokol. IPX je gundža protokolov chtora še použiva vof operačnom systeme Novell NetWare. Toten mušice mac instalovany. Vecej možeš znac zos https://cs.wikipedia.org/wiki/IPX/SPX.
{ IPX.PAS                                                            }
{ Rutiny sluziace ku komunikacii IPX protokolom.                     }
{                                                                    }
{ Datum:20.02.2016                              http://www.trsek.com }
 
unit ipx;
 
interface
 
type
  nodeid=array[1..6]of byte;
  netwid=array[1..4]of byte;
  ipxaddress=record
	       network:netwid;
	       node:nodeid;
	       socket:word;
	     end;
  Tecb=record
	 link:array[1..2]of integer;
	 esr:pointer;
	 inuse:byte;
	 compcode:byte;
	 socketno:word;
	 ipxwspc:array[1..4]of byte;
	 drvwspc:array[1..12]of byte;
	 locnoad:nodeid;
	 fragcnt:array[1..2]of byte;
	 fragaddr:pointer;
	 fragsize:word;
       end;
  Tipxhead=record
	     case integer of
	     1:(
	       checksum:array[1..2]of byte;
	       len:word;
	       transctrl:byte;
	       packettyp:byte;
	       destnetw:netwid;
	       destnode:nodeid;
	       destsckt:word;
	       sournetw:netwid;
	       sournode:nodeid;
	       soursckt:word;
	       );
	     2:(
	       n_a:array[1..6]of byte;
	       dest:ipxaddress;
	       sour:ipxaddress;
	       );
	   end;
 
const
  shortlive=0;
  openstyle:byte=shortlive;
  lenheadpacket=30;
  maxlenpacket=576;
  unknown:netwid=(0,0,0,0);
  all:nodeid=($ff,$ff,$ff,$ff,$ff,$ff);
 
var
  neterror:byte;
 
procedure exittodos(msg:string;errcode:word);
procedure ipxinitialize;
procedure opensocket(socketno:word);
procedure closesocket(socketno:word);
procedure sendpacket(var ecb:tecb);
procedure receivepacket(var ecb:tecb);
procedure cancelevent(var ecb:tecb);
 
implementation
uses dos;
 
var
  notrunnetw:boolean;
  int7a:pointer;
  r:registers;
 
procedure exittodos(msg:string;errcode:word);
begin
  writeln(#13#10,msg);
  halt(errcode);
end;
 
procedure opensocket(socketno:word);
begin
  if notrunnetw then neterror:=$f0
  else begin
    r.bx:=0;
    r.al:=openstyle;
    r.dx:=socketno;
    intr($7a,r);
    neterror:=r.al;
  end;
end;
 
procedure closesocket(socketno:word);
begin
  if notrunnetw then neterror:=$f0
  else begin
    r.bx:=1;
    r.dx:=socketno;
    intr($7a,r);
    neterror:=0;
  end;
end;
 
procedure sendpacket(var ecb:tecb);
var
  len:word;
begin
  if notrunnetw then neterror:=$f0
  else begin
    r.bx:=3;
    r.es:=seg(ecb);
    r.si:=ofs(ecb);
    intr($7a,r);
    neterror:=r.al;
  end;
end;
 
procedure receivepacket(var ecb:tecb);
var
  len:word;
begin
  if notrunnetw then neterror:=$f0
  else begin
    r.bx:=4;
    r.es:=seg(ecb);
    r.si:=ofs(ecb);
    intr($7a,r);
    neterror:=r.al;
  end;
end;
 
procedure cancelevent(var ecb:tecb);
begin
  if notrunnetw then neterror:=$f0
  else begin
    r.bx:=6;
    r.es:=seg(ecb);
    r.si:=ofs(ecb);
    intr($7a,r);
    neterror:=r.al;
  end;
end;
 
procedure ipxinitialize;
begin
  getintvec($7a,int7a);
  notrunnetw:=ofs(int7a^)=0;
  if notrunnetw then neterror:=$f0
  else neterror:=0;
end;
 
begin
  ipxinitialize;
end.