Power-Programmierung/CD1.mdf/pascal/library/dos/bix/doscalls.pas

Pascal/Delphi Source File | 1986-08-04 | 8.4 KB | 478 lines

{Turbo/PC&MSDOS/IBM&clones - Assorted DOS & ROM BIOS Calls - Jim
Keohane}

type intregs = record
                case integer of
                0:(ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
                1:(al,ah,bl,bh,cl,ch,dl,dh:byte)
               end;
     anystring = string[255];
     anypointer = ^ anypointer;
     fileinfo = record
                 ign1:string[20];
                 attr:byte;
                 time,date,sizehi,sizelo:integer;
                 fname:array[0..12] of char
                end;

const readonlyfile:byte=$01; {used in create file & find first}
      hiddenfile:byte=$02;
      systemfile:byte=$04;
      volumelabel:byte=$08;
      subdirectory:byte=$10;
      modifiedfile:byte=$20;
      iostat:byte=0;

function asciiz2s(var asciiz):anystring;
var a:array[0..255] of char absolute asciiz;
    i:integer;
    s:anystring;
begin
 i:=0;
 while a[i]<>chr(0) do i:=succ(i);
 {$r-}
 s[0]:=chr(i);
 move(a,s[1],i);
 {$r+}
 asciiz2s:=s
end;

procedure getdta(var p);
var r:intregs;
    pp:anypointer absolute p;
begin
 r.ah:=$2f;
 msdos(r);
 pp:=ptr(r.es,r.bx)
end;

procedure setdta(p:anypointer);
var r:intregs;
begin
 r.ah:=$1a;
 r.ds:=seg(p^);
 r.dx:=ofs(p^);
 msdos(r)
end;

function findfirst(filename:anystring;attr:integer;var info:fileinfo):boolean;
var r:intregs;
    sv:anypointer;
 begin
 getdta(sv);
 setdta(addr(info));
 r.ah:=$4e;
 r.ds:=sseg;
 r.dx:=ofs(filename)+1;
 filename:=filename+#0;
 r.cx:=attr;
 msdos(r);
 findfirst:=r.flags and $01 = 0;
 setdta(sv)
end;

function findnext(var info:fileinfo):boolean;
var r:intregs;
    sv:anypointer;
begin
 getdta(sv);
 setdta(addr(info));
 r.ah:=$4f;
 msdos(r);
 findnext:=r.flags and $01 = 0;
 setdta(sv)
end;

function country:anystring;
var r:intregs;
    p:record
      which:integer;
      currency,ign1,
      thousands,ign2,
      decimal,ign3:char;
      ign4:string[23]
     end;
    s:char;
begin
 r.ax:=$3800;
 r.ds:=sseg;
 r.dx:=ofs(p);
 msdos(r);
 if p.which=0 then s:='U' else if p.which=1 then s:='E' else s:='J';
 country:=s+p.currency+P.thousands+p.decimal
end;

procedure date(var year,month,day,dow:integer);
var r:intregs;
begin
 r.ah:=$2a;
 msdos(r);
 year:=r.cx;
 month:=r.dh;
 day:=r.dl;
 dow:=r.al
end;

function setdate(year,month,day:integer):boolean;
var r:intregs;
begin
 r.ah:=$2b;
 r.cx:=year;
 r.dh:=month;
 r.dl:=day;
 msdos(r);
 setdate:=r.al=0
end;

procedure time(var hours,minutes,seconds,hundredths:integer);
var r:intregs;
begin
 r.ah:=$2c;
 msdos(r);
 hours:=r.ch;
 minutes:=r.cl;
 seconds:=r.dh;
 hundredths:=r.dl
end;

function settime(hours,minutes,seconds,hundredths:integer):boolean;
var r:intregs;
begin
 r.ah:=$2d;
 r.ch:=hours;
 r.cl:=minutes;
 r.dh:=seconds;
 r.dl:=hundredths;
 msdos(r);
 settime:=r.al=0
end;



procedure run(programname:anystring);
var r:intregs;
    params:array[0..6] of integer;
    localstring:anystring;
begin
 r.ax:=$4b00;
 localstring:=programname+#0;
 r.ds:=sseg;
 r.dx:=ofs(localstring)+1;
 r.es:=sseg;
 r.bx:=ofs(params);
 params[0]:=memw[cseg:$2c];
 params[1]:=$80;params[2]:=cseg;
 params[3]:=$5c;params[4]:=cseg;
 params[5]:=$6c;params[6]:=cseg;
 msdos(r)
end;

function dosavail:integer;
var r:intregs;
begin
 r.ax:=$4800;
 r.bx:=$ffff;
 msdos(r);
 dosavail:=r.bx
end;

procedure getvec(vecno:integer;var dest);
var r:intregs;
    p:^char absolute dest;
begin
 r.ax:=$3500+vecno;
 msdos(r);
 p:=ptr(r.es,r.bx)
end;

procedure setvec(vecno:integer;source:anypointer);
var r:intregs;
begin
 r.ax:=$2500+vecno;
 r.ds:=seg(source^);
 r.dx:=ofs(source^);
 msdos(r)
end;

function drive:char;
var r:intregs;
begin
 r.ah:=$19;
 msdos(r);
 drive:=chr(r.al+65)
end;

function diskavail(drive:char):integer;
var r:intregs;
    a:real;
begin
 r.ax:=$3600;
 if drive=' ' then r.dx:=0 else r.dx:=ord(drive)-64;
 msdos(r);
 if r.ax=$ffff then diskavail:=0 else
  begin
   a:=r.cx; a:=a*r.bx; a:=a*r.ax; diskavail:=trunc(a/1024)
  end
end;

procedure verify(on:boolean);
var r:intregs;
begin
 if on then r.ax:=$2e01 else r.ax:=$2e00;
 r.dl:=0;
 msdos(r)
end;

function verifying:boolean;
var r:intregs;
begin
 r.ah:=$54;
 msdos(r);
 verifying:=r.al=1
end;

function version:integer;
var r:intregs;
begin
 r.ah:=$30;
 msdos(r);
 version:=r.al*100+r.ah
end;

procedure break(on:boolean);
var r:intregs;
begin
 r.ax:=$3301;
 if on then r.dl:=1 else r.dl:=0;
 msdos(r)
end;

function breaking:boolean;
var r:intregs;
begin
 r.ax:=$3300;
 msdos(r);
 breaking:=r.dl=1
end;

function newfile(filename:anystring;attributes:integer):integer;
var r:intregs;
begin
 filename:=filename+#0;
 r.ah:=$3c;
 r.ds:=sseg;
 r.dx:=ofs(filename)+1;
 r.cx:=attributes;
 msdos(r);
 newfile:=r.ax;
 if r.flags and $01 = 0 then iostat:=0 else iostat:=r.ax
end;

function readfile(handle,bytes:integer;var into):integer;
var r:intregs;
begin
 r.ah:=$3f;
 r.bx:=handle;
 r.ds:=seg(into);
 r.dx:=ofs(into);
 r.cx:=bytes;
 msdos(r);
 readfile:=r.ax;
 if r.flags and $01 = 0 then iostat:=0 else iostat:=r.ax
end;

function writefile(handle,bytes:integer;var outof):integer;
var r:intregs;
begin
 r.ah:=$40;
 r.bx:=handle;
 r.ds:=seg(outof);
 r.dx:=ofs(outof);
 r.cx:=bytes;
 msdos(r);
 writefile:=r.ax;
 iostat:=bytes-r.ax
end;

procedure fileseek(handle,hiword,loword,option:integer);
var r:intregs;
begin
 r.ax:=$4200+option;
 r.bx:=handle;
 r.cx:=hiword;
 r.dx:=loword;
 msdos(r);
 if r.flags and $01=0 then iostat:=0 else iostat:=r.ax
end;

procedure rewind(handle:integer);
begin
 fileseek(handle,0,0,0)
end;

function filelength(handle:integer):real;
var r:intregs;
    a:real;
begin
 r.ax:=$4202;
 r.bx:=handle;
 r.cx:=0;
 r.dx:=0;
 msdos(r);
 a:=65536.0*r.dx+r.ax;
 if r.flags and $01 = 1 then filelength:=0 else
 if r.ax>=0 then filelength:=a else filelength:=a+65536.0
end;


function fileattr(filename:anystring;var attr:integer):boolean;
var r:intregs;
begin
 r.ax:=$4300;
 filename:=filename+#0;
 r.ds:=sseg;
 r.dx:=ofs(filename)+1;
 msdos(r);
 attr:=r.cx;
 fileattr:=r.flags and $01 = 0
end;

function setfileattr(filename:anystring;attr:integer):boolean;
var r:intregs;
begin
 r.ax:=$4301;
 filename:=filename+#0;
 r.ds:=sseg;
 r.dx:=ofs(filename)+1;
 r.cx:=attr;
 msdos(r);
 setfileattr:=r.flags and $01 = 0
end;

function openfile(fname:anystring;access:integer):integer;
var r:intregs;
begin
 r.ax:=$3d00+access;
 fname:=fname+#0;
 r.ds:=seg(fname);
 r.dx:=ofs(fname)+1;
 msdos(r);
 if r.flags and $01 = 0 then
  begin
   openfile:=r.ax;
   iostat:=0
  end
 else
  begin
   openfile:=0;
   iostat:=r.ax
  end
end;

procedure closefile(handle:integer);
var r:intregs;
begin
 r.ah:=$3e;
 r.bx:=handle;
 msdos(r);
 if r.flags and $01 = 0 then iostat:=0 else iostat:=r.ax
end;

function erasefile(fname:anystring):boolean;
var r:intregs;
begin
 r.ah:=$41;
 fname:=fname+#0;
 r.ds:=seg(fname);
 r.dx:=ofs(fname)+1;
 msdos(r);
 erasefile:=r.flags and $01 = 0
end;

function renamefile(oldname,newname:anystring):boolean;
var r:intregs;
begin
 r.ah:=$56;
 oldname:=oldname+#0;
 newname:=newname+#0;
 r.ds:=seg(oldname);
 r.dx:=ofs(oldname)+1;
 r.es:=seg(newname);
 r.di:=ofs(newname)+1;
 msdos(r);
 renamefile:=r.flags and $01 = 0
end;

function equipment:integer;
var r:intregs;
begin
 r.es:=0;
 r.ds:=0;
 intr(17,r);
 equipment:=r.ax
end;

function drives:integer;
var i:integer;
begin
 i:=equipment;
 if i and $01 = 0 then drives:=0 else drives := (i shr 6) and $03 + 1
end;

function printers:integer;
begin
 printers:=equipment shr 14
end;

function serials:integer;
begin
 serials:=(equipment shr 9) and $03
end;

function mono:boolean;
begin
 mono:=equipment and $30 = $30
end;

function memoryK:integer;
var r:intregs;
begin
 r.es:=0;
 r.ds:=0;
 intr(18,r);
 memoryk:=r.ax
end;

function pcat:boolean;
begin
 pcat:=mem[$f000:$fffe]=$fc
end;

function dosalloc(pages:integer;var segment:integer):boolean;
var r:intregs;
begin
 r.ah:=$48;
 r.bx:=pages;
 msdos(r);
 segment:=r.ax;
 dosalloc:=r.flags and $01=0
end;

function dosfree(segment:integer):boolean;
var r:intregs;
begin
 r.ah:=$49;
 msdos(r);
 dosfree:=r.flags and $01 = 0
end;

function dosgrow(segment,newpages:integer):boolean;
var r:intregs;
begin
 r.ah:=$4a;
 r.es:=segment;
 r.bx:=newpages;
 msdos(r);
 dosgrow:=r.flags and $01 = 0
end;