Umiestnenie súboru www.TrSek.com/pas/diskinfo.pas{ DISKINFO.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Program vypise do suboru, ci na obrazovku (parameter /h) }
{ velkosti jednotlivych diskov, ktore su dostupne na PC }
{ spolu s ich charkteristikov : }
{ F - Floppy disk }
{ L - Hard disk, ci iny fyzicky paskvil na PC }
{ N - Net disk }
{ }
{ Datum:30.01.1998 http://www.trsek.com }
program zisti_disky;
uses crt,dos;
const open_vyluc='disk.no'; { subor obsahuje vymenovane subory }
{ ktore nema testovat }
sub_res='disks.tab'; { subor obsahuje velkosti jednotlivych diskov }
var i:integer;
dis:array[0..26] of boolean;
poc_dis:byte;
help:boolean;
f:text;
devka:string;
function typ_disku(disk:byte):char; { Aky typ disku }
{ F - floppy }
{ L - hard disk, ci ine v PC }
{ N - netdisk, sietovy disk }
var reg:registers;
begin
if not (disk in [1,2]) then begin { Ak to nie je disketa }
Reg.Ah:=$44;
Reg.Al:=$0F;
Reg.Bl:=disk;
Intr($21,Reg); { Zisti ci sa disk da citat }
if Reg.Ah<>0 then dis[disk-1]:=false
else begin
Reg.Ah:=$44;
Reg.Al:=$09;
Reg.Bl:=disk;
Intr($21,Reg); { Je to sietovy disk ? }
if (Reg.DX and $1000)=$1000 then typ_disku:='N'
else typ_disku:='L';
end;
end
else typ_disku:='F'; { Je to floppy disk ! velmi sa s tym nebabrem }
end;
procedure diskety; { Kolko ma disketovych mechanik }
var Reg:registers;
begin
Intr($11,Reg);
if (Reg.AX and $c0)=0 then dis[1]:=false; { Ma len jednu mechaniku takze nema B ... asi ! }
if (Reg.AX and 1)=0 then dis[0]:=false; { Nema ziadnu mechaniku, takze nema A ... asi ! }
end;
procedure vylucit; { V subore open_vyluc vymenovane }
var f:text; { disky, ktore nema testovat }
ch:char;
begin
Assign(f,open_vyluc);
{$I-}
ReSet(f);
{$I+}
if IOResult=0 then begin
repeat
Read(f,ch);
ch:=UpCase(ch);
if (ch in ['A'..'Z']) then dis[ord(ch)-ord('A')]:=false;
until (eof(f));
close(f);
end;
end;
function sstr( cislo:longint; kolko:byte ):string; { sprav z cisla retazec. Joj Pascal }
var pret:string;
begin
str(cislo:kolko,pret);
sstr:=pret;
end;
procedure fWriteLn( tex:string ); { vypise na obrazovku, alebo do suboru }
begin
if help then WriteLn(tex)
else WriteLn(f,tex);
end;
begin
for i:=0 to ord('z')-ord('a')+1 do dis[i]:=true;
poc_dis:=0;help:=false;
diskety; { ake su diskety ??? }
vylucit; { ake disky netestovat ? }
if ParamCount>0 then begin
devka:=ParamStr(1);
if devka[2] in ['?','h','H'] then help:=true;
end;
{ prejdi ci mozes testovat ! }
for i:=1 to ord('z')-ord('a') do begin
if dis[i] then
if DiskSize(i+1)<0 then dis[i]:=false
else inc(poc_dis);
end;
if not(help) then begin
Assign(f,sub_res);
{$I-}
ReWrite(f);
{$I+}
if IOResult<>0 then halt(4);
end;
{ Urob result svojej prace }
fWriteLn(sstr(poc_dis,0)+' disks [ Size ] [ Free ]');
for i:=0 to ord('z')-ord('a') do begin
if dis[i] then
if DiskSize(i+1)>-1 then begin
fWriteLn( chr(ord('A')+i) + ': ' + typ_disku(i+1) + sstr(DiskSize(i+1),14) +' '+ sstr(DiskFree(i+1),14) )
end
else begin
if i=0 then
fWriteLn( chr(ord('A')+i) + ': ' + typ_disku(i+1) + sstr(1440000,14) +' '+ sstr(0,14) )
end;
end;
fWriteLn('');
fWriteLn('Software by TRSEK alias Zdeno Sekerak, Trnkov 18, Presov, 082 12');
fWriteLn('V subore '+open_vyluc+' mozno vymenovat disky ktore nema testovat.');
if not(help) then close(f);
end.