home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / doscalls.pas < prev    next >
Pascal/Delphi Source File  |  1986-08-04  |  9KB  |  478 lines
  1. {Turbo/PC&MSDOS/IBM&clones - Assorted DOS & ROM BIOS Calls - Jim
  2. Keohane}
  3.  
  4. type intregs = record
  5.                 case integer of
  6.                 0:(ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
  7.                 1:(al,ah,bl,bh,cl,ch,dl,dh:byte)
  8.                end;
  9.      anystring = string[255];
  10.      anypointer = ^ anypointer;
  11.      fileinfo = record
  12.                  ign1:string[20];
  13.                  attr:byte;
  14.                  time,date,sizehi,sizelo:integer;
  15.                  fname:array[0..12] of char
  16.                 end;
  17.  
  18. const readonlyfile:byte=$01; {used in create file & find first}
  19.       hiddenfile:byte=$02;
  20.       systemfile:byte=$04;
  21.       volumelabel:byte=$08;
  22.       subdirectory:byte=$10;
  23.       modifiedfile:byte=$20;
  24.       iostat:byte=0;
  25.  
  26. function asciiz2s(var asciiz):anystring;
  27. var a:array[0..255] of char absolute asciiz;
  28.     i:integer;
  29.     s:anystring;
  30. begin
  31.  i:=0;
  32.  while a[i]<>chr(0) do i:=succ(i);
  33.  {$r-}
  34.  s[0]:=chr(i);
  35.  move(a,s[1],i);
  36.  {$r+}
  37.  asciiz2s:=s
  38. end;
  39.  
  40. procedure getdta(var p);
  41. var r:intregs;
  42.     pp:anypointer absolute p;
  43. begin
  44.  r.ah:=$2f;
  45.  msdos(r);
  46.  pp:=ptr(r.es,r.bx)
  47. end;
  48.  
  49. procedure setdta(p:anypointer);
  50. var r:intregs;
  51. begin
  52.  r.ah:=$1a;
  53.  r.ds:=seg(p^);
  54.  r.dx:=ofs(p^);
  55.  msdos(r)
  56. end;
  57.  
  58. function findfirst(filename:anystring;attr:integer;var info:fileinfo):boolean;
  59. var r:intregs;
  60.     sv:anypointer;
  61.  begin
  62.  getdta(sv);
  63.  setdta(addr(info));
  64.  r.ah:=$4e;
  65.  r.ds:=sseg;
  66.  r.dx:=ofs(filename)+1;
  67.  filename:=filename+#0;
  68.  r.cx:=attr;
  69.  msdos(r);
  70.  findfirst:=r.flags and $01 = 0;
  71.  setdta(sv)
  72. end;
  73.  
  74. function findnext(var info:fileinfo):boolean;
  75. var r:intregs;
  76.     sv:anypointer;
  77. begin
  78.  getdta(sv);
  79.  setdta(addr(info));
  80.  r.ah:=$4f;
  81.  msdos(r);
  82.  findnext:=r.flags and $01 = 0;
  83.  setdta(sv)
  84. end;
  85.  
  86. function country:anystring;
  87. var r:intregs;
  88.     p:record
  89.       which:integer;
  90.       currency,ign1,
  91.       thousands,ign2,
  92.       decimal,ign3:char;
  93.       ign4:string[23]
  94.      end;
  95.     s:char;
  96. begin
  97.  r.ax:=$3800;
  98.  r.ds:=sseg;
  99.  r.dx:=ofs(p);
  100.  msdos(r);
  101.  if p.which=0 then s:='U' else if p.which=1 then s:='E' else s:='J';
  102.  country:=s+p.currency+P.thousands+p.decimal
  103. end;
  104.  
  105. procedure date(var year,month,day,dow:integer);
  106. var r:intregs;
  107. begin
  108.  r.ah:=$2a;
  109.  msdos(r);
  110.  year:=r.cx;
  111.  month:=r.dh;
  112.  day:=r.dl;
  113.  dow:=r.al
  114. end;
  115.  
  116. function setdate(year,month,day:integer):boolean;
  117. var r:intregs;
  118. begin
  119.  r.ah:=$2b;
  120.  r.cx:=year;
  121.  r.dh:=month;
  122.  r.dl:=day;
  123.  msdos(r);
  124.  setdate:=r.al=0
  125. end;
  126.  
  127. procedure time(var hours,minutes,seconds,hundredths:integer);
  128. var r:intregs;
  129. begin
  130.  r.ah:=$2c;
  131.  msdos(r);
  132.  hours:=r.ch;
  133.  minutes:=r.cl;
  134.  seconds:=r.dh;
  135.  hundredths:=r.dl
  136. end;
  137.  
  138. function settime(hours,minutes,seconds,hundredths:integer):boolean;
  139. var r:intregs;
  140. begin
  141.  r.ah:=$2d;
  142.  r.ch:=hours;
  143.  r.cl:=minutes;
  144.  r.dh:=seconds;
  145.  r.dl:=hundredths;
  146.  msdos(r);
  147.  settime:=r.al=0
  148. end;
  149.  
  150.  
  151.  
  152. procedure run(programname:anystring);
  153. var r:intregs;
  154.     params:array[0..6] of integer;
  155.     localstring:anystring;
  156. begin
  157.  r.ax:=$4b00;
  158.  localstring:=programname+#0;
  159.  r.ds:=sseg;
  160.  r.dx:=ofs(localstring)+1;
  161.  r.es:=sseg;
  162.  r.bx:=ofs(params);
  163.  params[0]:=memw[cseg:$2c];
  164.  params[1]:=$80;params[2]:=cseg;
  165.  params[3]:=$5c;params[4]:=cseg;
  166.  params[5]:=$6c;params[6]:=cseg;
  167.  msdos(r)
  168. end;
  169.  
  170. function dosavail:integer;
  171. var r:intregs;
  172. begin
  173.  r.ax:=$4800;
  174.  r.bx:=$ffff;
  175.  msdos(r);
  176.  dosavail:=r.bx
  177. end;
  178.  
  179. procedure getvec(vecno:integer;var dest);
  180. var r:intregs;
  181.     p:^char absolute dest;
  182. begin
  183.  r.ax:=$3500+vecno;
  184.  msdos(r);
  185.  p:=ptr(r.es,r.bx)
  186. end;
  187.  
  188. procedure setvec(vecno:integer;source:anypointer);
  189. var r:intregs;
  190. begin
  191.  r.ax:=$2500+vecno;
  192.  r.ds:=seg(source^);
  193.  r.dx:=ofs(source^);
  194.  msdos(r)
  195. end;
  196.  
  197. function drive:char;
  198. var r:intregs;
  199. begin
  200.  r.ah:=$19;
  201.  msdos(r);
  202.  drive:=chr(r.al+65)
  203. end;
  204.  
  205. function diskavail(drive:char):integer;
  206. var r:intregs;
  207.     a:real;
  208. begin
  209.  r.ax:=$3600;
  210.  if drive=' ' then r.dx:=0 else r.dx:=ord(drive)-64;
  211.  msdos(r);
  212.  if r.ax=$ffff then diskavail:=0 else
  213.   begin
  214.    a:=r.cx; a:=a*r.bx; a:=a*r.ax; diskavail:=trunc(a/1024)
  215.   end
  216. end;
  217.  
  218. procedure verify(on:boolean);
  219. var r:intregs;
  220. begin
  221.  if on then r.ax:=$2e01 else r.ax:=$2e00;
  222.  r.dl:=0;
  223.  msdos(r)
  224. end;
  225.  
  226. function verifying:boolean;
  227. var r:intregs;
  228. begin
  229.  r.ah:=$54;
  230.  msdos(r);
  231.  verifying:=r.al=1
  232. end;
  233.  
  234. function version:integer;
  235. var r:intregs;
  236. begin
  237.  r.ah:=$30;
  238.  msdos(r);
  239.  version:=r.al*100+r.ah
  240. end;
  241.  
  242. procedure break(on:boolean);
  243. var r:intregs;
  244. begin
  245.  r.ax:=$3301;
  246.  if on then r.dl:=1 else r.dl:=0;
  247.  msdos(r)
  248. end;
  249.  
  250. function breaking:boolean;
  251. var r:intregs;
  252. begin
  253.  r.ax:=$3300;
  254.  msdos(r);
  255.  breaking:=r.dl=1
  256. end;
  257.  
  258. function newfile(filename:anystring;attributes:integer):integer;
  259. var r:intregs;
  260. begin
  261.  filename:=filename+#0;
  262.  r.ah:=$3c;
  263.  r.ds:=sseg;
  264.  r.dx:=ofs(filename)+1;
  265.  r.cx:=attributes;
  266.  msdos(r);
  267.  newfile:=r.ax;
  268.  if r.flags and $01 = 0 then iostat:=0 else iostat:=r.ax
  269. end;
  270.  
  271. function readfile(handle,bytes:integer;var into):integer;
  272. var r:intregs;
  273. begin
  274.  r.ah:=$3f;
  275.  r.bx:=handle;
  276.  r.ds:=seg(into);
  277.  r.dx:=ofs(into);
  278.  r.cx:=bytes;
  279.  msdos(r);
  280.  readfile:=r.ax;
  281.  if r.flags and $01 = 0 then iostat:=0 else iostat:=r.ax
  282. end;
  283.  
  284. function writefile(handle,bytes:integer;var outof):integer;
  285. var r:intregs;
  286. begin
  287.  r.ah:=$40;
  288.  r.bx:=handle;
  289.  r.ds:=seg(outof);
  290.  r.dx:=ofs(outof);
  291.  r.cx:=bytes;
  292.  msdos(r);
  293.  writefile:=r.ax;
  294.  iostat:=bytes-r.ax
  295. end;
  296.  
  297. procedure fileseek(handle,hiword,loword,option:integer);
  298. var r:intregs;
  299. begin
  300.  r.ax:=$4200+option;
  301.  r.bx:=handle;
  302.  r.cx:=hiword;
  303.  r.dx:=loword;
  304.  msdos(r);
  305.  if r.flags and $01=0 then iostat:=0 else iostat:=r.ax
  306. end;
  307.  
  308. procedure rewind(handle:integer);
  309. begin
  310.  fileseek(handle,0,0,0)
  311. end;
  312.  
  313. function filelength(handle:integer):real;
  314. var r:intregs;
  315.     a:real;
  316. begin
  317.  r.ax:=$4202;
  318.  r.bx:=handle;
  319.  r.cx:=0;
  320.  r.dx:=0;
  321.  msdos(r);
  322.  a:=65536.0*r.dx+r.ax;
  323.  if r.flags and $01 = 1 then filelength:=0 else
  324.  if r.ax>=0 then filelength:=a else filelength:=a+65536.0
  325. end;
  326.  
  327.  
  328. function fileattr(filename:anystring;var attr:integer):boolean;
  329. var r:intregs;
  330. begin
  331.  r.ax:=$4300;
  332.  filename:=filename+#0;
  333.  r.ds:=sseg;
  334.  r.dx:=ofs(filename)+1;
  335.  msdos(r);
  336.  attr:=r.cx;
  337.  fileattr:=r.flags and $01 = 0
  338. end;
  339.  
  340. function setfileattr(filename:anystring;attr:integer):boolean;
  341. var r:intregs;
  342. begin
  343.  r.ax:=$4301;
  344.  filename:=filename+#0;
  345.  r.ds:=sseg;
  346.  r.dx:=ofs(filename)+1;
  347.  r.cx:=attr;
  348.  msdos(r);
  349.  setfileattr:=r.flags and $01 = 0
  350. end;
  351.  
  352. function openfile(fname:anystring;access:integer):integer;
  353. var r:intregs;
  354. begin
  355.  r.ax:=$3d00+access;
  356.  fname:=fname+#0;
  357.  r.ds:=seg(fname);
  358.  r.dx:=ofs(fname)+1;
  359.  msdos(r);
  360.  if r.flags and $01 = 0 then
  361.   begin
  362.    openfile:=r.ax;
  363.    iostat:=0
  364.   end
  365.  else
  366.   begin
  367.    openfile:=0;
  368.    iostat:=r.ax
  369.   end
  370. end;
  371.  
  372. procedure closefile(handle:integer);
  373. var r:intregs;
  374. begin
  375.  r.ah:=$3e;
  376.  r.bx:=handle;
  377.  msdos(r);
  378.  if r.flags and $01 = 0 then iostat:=0 else iostat:=r.ax
  379. end;
  380.  
  381. function erasefile(fname:anystring):boolean;
  382. var r:intregs;
  383. begin
  384.  r.ah:=$41;
  385.  fname:=fname+#0;
  386.  r.ds:=seg(fname);
  387.  r.dx:=ofs(fname)+1;
  388.  msdos(r);
  389.  erasefile:=r.flags and $01 = 0
  390. end;
  391.  
  392. function renamefile(oldname,newname:anystring):boolean;
  393. var r:intregs;
  394. begin
  395.  r.ah:=$56;
  396.  oldname:=oldname+#0;
  397.  newname:=newname+#0;
  398.  r.ds:=seg(oldname);
  399.  r.dx:=ofs(oldname)+1;
  400.  r.es:=seg(newname);
  401.  r.di:=ofs(newname)+1;
  402.  msdos(r);
  403.  renamefile:=r.flags and $01 = 0
  404. end;
  405.  
  406. function equipment:integer;
  407. var r:intregs;
  408. begin
  409.  r.es:=0;
  410.  r.ds:=0;
  411.  intr(17,r);
  412.  equipment:=r.ax
  413. end;
  414.  
  415. function drives:integer;
  416. var i:integer;
  417. begin
  418.  i:=equipment;
  419.  if i and $01 = 0 then drives:=0 else drives := (i shr 6) and $03 + 1
  420. end;
  421.  
  422. function printers:integer;
  423. begin
  424.  printers:=equipment shr 14
  425. end;
  426.  
  427. function serials:integer;
  428. begin
  429.  serials:=(equipment shr 9) and $03
  430. end;
  431.  
  432. function mono:boolean;
  433. begin
  434.  mono:=equipment and $30 = $30
  435. end;
  436.  
  437. function memoryK:integer;
  438. var r:intregs;
  439. begin
  440.  r.es:=0;
  441.  r.ds:=0;
  442.  intr(18,r);
  443.  memoryk:=r.ax
  444. end;
  445.  
  446. function pcat:boolean;
  447. begin
  448.  pcat:=mem[$f000:$fffe]=$fc
  449. end;
  450.  
  451. function dosalloc(pages:integer;var segment:integer):boolean;
  452. var r:intregs;
  453. begin
  454.  r.ah:=$48;
  455.  r.bx:=pages;
  456.  msdos(r);
  457.  segment:=r.ax;
  458.  dosalloc:=r.flags and $01=0
  459. end;
  460.  
  461. function dosfree(segment:integer):boolean;
  462. var r:intregs;
  463. begin
  464.  r.ah:=$49;
  465.  msdos(r);
  466.  dosfree:=r.flags and $01 = 0
  467. end;
  468.  
  469. function dosgrow(segment,newpages:integer):boolean;
  470. var r:intregs;
  471. begin
  472.  r.ah:=$4a;
  473.  r.es:=segment;
  474.  r.bx:=newpages;
  475.  msdos(r);
  476.  dosgrow:=r.flags and $01 = 0
  477. end;
  478.