Rutiny slúžiace ku komunikácii IPX protokolom

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória:

Program: Ipx.pas
Súbor exe: Sendmess.exeRecmess.exe
Potrebné: Net_serv.pasRecmess.pasSendmess.pas

Rutiny slúžiace ku komunikácii IPX protokolom. Posielanie a prijímanie dát. IPX je sada protokolov používaná sieťovým operačným systémom Novell NetWare ktorý musíte mať nainštalovaný. Viac informácií na 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.