Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ NET_SERV.PAS                                                       }
{ Rutiny sluziace ku komunikacii IPX protokolom.                     }
{                                                                    }
{ Datum:20.02.2016                              http://www.trsek.com }
 
unit net_serv;
interface
 
var
  username:string;
 
function doplnnuly(num:word;newlen:byte):string;
function _username:string;
function _existspoj:boolean;
 
implementation
uses dos;
 
var
  r: registers;
 
function doplnnuly(num:word;newlen:byte):string;
var
  tmpstr:string;
  ckl:byte;
begin
  str(num:0,tmpstr);
  if length(tmpstr) < newlen then for ckl:=newlen-length(tmpstr) to newlen do tmpstr:='0'+tmpstr;
  doplnnuly:=tmpstr;
end;
 
function _username:string;
const
  lennetwname=15;
var
  bufusername:array[1..lennetwname]of byte;
  bufusernamestr:string[lennetwname];
begin
  fillchar(bufusername,sizeof(bufusername),0);
  fillchar(bufusernamestr,sizeof(bufusernamestr),#0);
  r.ah:=$5e;
  r.al:=0;
  r.ds:=seg(bufusername);
  r.dx:=ofs(bufusername);
  intr($21,r);
  if r.flags and fcarry = fcarry then _username:=''
  else begin
    move(bufusername,ptr(seg(bufusernamestr),ofs(bufusernamestr)+1)^,lennetwname);
    bufusernamestr[0]:=chr(lennetwname);
    _username:=bufusernamestr;
  end;
end;
 
function _existspoj:boolean;
begin
  r.ah:=$dc;
  intr($21,r);
  if (r.al=0) and (r.cl=0) and (r.ch=0) then _existspoj:=false
  else _existspoj:=true;
end;
 
begin
  if _existspoj then username:=_username
  else username:='';
end.