This program detect the extent and the capacity availablein the accessible discs

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: Source in Pascal

Program: Diskinfo.pas
File exe: Diskinfo.exe
File ubuntu: Diskinfo

This program detect the extent and the capacity availablein the accessible discs. The result of the search is displayed, or stored in the Disks.tab file. Look at the ways it finds out whether the disc is hard or the network one, because this trick works even today. As far as the investigation about the capacity of disks is concerned, I must admit it needed more thorough elaboration.
{ 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.