Tipy a triky v Delphi, díl 33.

Ukážeme si další funkci, která patří do okruhu práce se soubory a složkami. Naučíme se, jak zjistit velikost souborů nejen v daném adresáři, ale též celkový součet i včetně všech podadresářů. Poslouží nám k tomu velmi jednoduchá funkce, která vrací velikost adresáře (či adresářů) v bytech. Parametrem je pochopitelně adresář, jehož velikost nás zajímá a také logická proměnná, určující zda se mají do výpočtu zahrnout též podadresáře.

function GetDirSize (dir: string; subdir: boolean): longint;
var
  rec : TSearchRec;
  found : integer;
begin
  result := 0;
  if dir[length(dir)] <> `\` then dir := dir+`\`;
  found := findfirst(dir+`*.*`, faAnyFile, rec);
  while found=0 do
  begin
    inc(result, rec.size);
    if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> `.`) and (subdir = true) then inc(result, getdirsize(dir+rec.Name, true));
    found := findnext(rec);
  end;
  findclose(rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(GetDirSize(`c:\windows`, false)) + ` B`+#13+IntToStr(GetDirSize(`c:\windows`, true)) + ` B`);
end;

Příklad vypíše velikost adresáře Windows a to jak samotného, tak včetně podadresářů.

Následující dvě ukázky mají podobný základ. Ta první má za úkol vypsat disky požadovaných typů (viz. dále) do připraveného ComboBoxu, úkolem druhé funkce je zase zjistit typ daného disku. V obou případech je typem disku myšleno to, zda se jedná o lokální disk, síťový disk, jednotku CDROM atd.. Typy těchto disků jsou uvedeny jako konstanty.

Následující procedura tedy do předem připraveného ComboBoxu vypíše všechny pevné lokální disky instalované v systému. Pokud budete chtít vypsat jiné typy jednotek (nebo všechny), není nic jednoduššího než upravit příslušnou konstantu v podmínce (zde DRIVE_FIXED) na požadovaný typ disku.

procedure List_Drives;
const
  DRIVE_UNKNOWN = 0;
  DRIVE_NO_ROOT_DIR = 1;
  DRIVE_REMOVABLE = 2;
  DRIVE_FIXED = 3;
  DRIVE_REMOTE = 4;
  DRIVE_CDROM = 5;
  DRIVE_RAMDISK = 6;
var
  r : LongWord;
  Drives : array[0..128] of char;
  pDrive : pchar;
begin
  r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
  if r = 0 then exit;
  if r > sizeof(Drives) then
    raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
  pDrive := Drives;
  while pDrive^ <> #0 do
  begin
    if GetDriveType(pDrive) = DRIVE_FIXED then Form1.ComboBox1.Items.Add(pDrive);
    inc(pDrive, 4);
  end;
end;

Z prvního příkladu si hned odvodíme další funkci. Jejím úkolem bude vypsat typ parametrem zadané jednotky. Konstanty budou stejné.

function DriveType(Drive: String): String;
const
  DRIVE_UNKNOWN = 0;
  DRIVE_NO_ROOT_DIR = 1;
  DRIVE_REMOVABLE = 2;
  DRIVE_FIXED = 3;
  DRIVE_REMOTE = 4;
  DRIVE_CDROM = 5;
  DRIVE_RAMDISK = 6;
var
    {strDriveType : String;}
    intDriveType : Integer;
begin
    if Drive[Length(Drive)] <> `\` then Drive := Drive + `:\`;
    intDriveType := GetDriveType(PChar(Drive));
    Case intDriveType of
        DRIVE_UNKNOWN : DriveType := `Neznámý typ disku`;
        DRIVE_NO_ROOT_DIR : DriveType := `Disk není naformátován`;
        DRIVE_REMOVABLE : DriveType := `Výměnný disk`;
        DRIVE_FIXED : DriveType := `Lokální disk`;
        DRIVE_REMOTE : DriveType := `Síťový disk`;
        DRIVE_CDROM : DriveType := `CD ROM`;
        DRIVE_RAMDISK : DriveType := `RAM disk`;
    end;
end;

Jak vidíte, v tomto případě použití konstant celou funkci spíše zbytečně prodlužuje a není to opravdu nutné. Příklad je napsán takto spíše pro názornost a přehlednost, pouhá čísla by docela postačila.

I další z dnešních tipů souvisí s prací s disky, tedy konkrétně s disketami. Naučíme se, jak je zformátovat. Přesněji řečeno, nebude se jednat o přímý fyzický přístup k disketě (sektor po sektoru), ale využijeme funkce systémové knihovny shell32.dll a tím pádem se po požadavku o formátování zobrazí známý systémový dialog, kde lze měnit další parametry. Jak uvidíte přímo v naší ukázce, lze tyto parametry předem nastavit.

Zdrojový kód tedy vypadá takto (pozor na umístění deklarace funkce SHFormatDrive):

.
.
.
private
  { Private declarations }

public
  { Public declarations }
end;
.
.
.

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external `shell32.dll` name `SHFormatDrive`

.
.
.

procedure TForm1.Button1Click(Sender: TObject);

const
    SHFMT_ID_DEFAULT = $FFFF;
    SHFMT_OPT_QUICKFORMAT = $0000;
    SHFMT_OPT_FULL = $0001;
    SHFMT_OPT_SYSONLY = $0002;
    SHFMT_ERROR = $FFFFFFFF;
    SHFMT_CANCEL = $FFFFFFFE;
    SHFMT_NOFORMAT = $FFFFFFFD;
var
    retCode: LongInt;
begin
    retCode := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
    if retCode < 0 then ShowMessage(`Disk nebyl zformátován !`);
end;

Úpravou parametrů (viz. konstanty) docílíte toho, že ve formátovacím dialogu, který se objeví, budou předem navoleny dané možnosti.

Jistě dobře znáte tuto užitečnou funkci z některého souborového manažeru (opět musím zmínit oblíbený Windows Commander). Pokud je potřeba velký soubor přenést například po disketách (používá je dnes ještě vůbec někdo?) či poslat poštou, často jej musíme vhodně rozdělit na několik souborů menších. Obvykle se k tomu také používá komprimačních programů.

Co tedy přesně dělají naše dvě funkce? Ta první rozdělí soubor specifikovaný parametrem na soubory požadované velikosti (v bytech, rovněž součástí parametrů) a taktéž vytvoří kontrolní soubor, obsahující původní název souboru před rozdělením, jeho původní velikost a taktéž CRC. Kvůli zjednodušení a zkrácení příkladu je však výpočet CRC vynechán. Funkci na jeho výpočet můžete nalézt ve 14. dílu našeho seriálu a do naší ukázky si ji snadno doplníte sami. Soubor je rozdělen, přičemž přípony souborů jsou číslovány automaticky.

Druhá část, funkce na sloučení souboru, celkem logicky provádí opačný postup. Po specifikování prvního souboru jsou jednotlivé soubory spojeny a je provedena kontrola na základě kontrolního souboru (kontrola CRC je opět vynechána).

Procedura na rozdělení souboru s ukázkou následného použití tedy vypadá takto:

procedure Rozdelit(FileName: String; part:integer);
var
    Source, Target : TFileStream;
    Fname, Ext : String;
    Count, Rest,
    Size : Integer;
    F : TextFile;
begin
    Source := TFileStream.Create(FileName, fmOpenRead);
    Fname := copy(FileName,1,Length(FileName) - 4);
    Count := 0;
    Size := Source.Size;
    if Source.Size <= Part then
    begin
        ShowMessageFmt(`Vybraný soubor je menší než %d bajtů. Není třeba jej dělit.`,[Part]);
        Exit;
    end;
    repeat
        Rest := 0;
        Inc(Count);
        Ext := copy(`000`, 1, 3 - Length(IntToStr(count))) + IntToStr(Count);
        Target := TFilestream.Create(Fname + `.` + Ext, fmCreate);
        try
            if (count * Part) <= Size then Rest := Target.CopyFrom(Source, Part)
            else Rest := Target.CopyFrom(Source,Size mod Part);
        except
        end;
        Target.Free;
    until Rest <> Part;
    AssignFile(f, Fname + `.crc`);
    Rewrite(f);
    WriteLn(f,`filename=`+ExtractFileName(FileName));
    WriteLn(f,`size=`+IntToStr(Size));
    WriteLn(f,`crc32=`);
    CloseFile(f);
    Source.Free;
    ShowMessageFmt(`Soubor byl rozdělen na %d souborů`,[count]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.OpenDialog1.Execute;
Rozdelit(Form1.Opendialog1.FileName, 307200);
end;

Jak vidíte, je využit dialog na otevření souboru a je tedy třeba jej přidat na formulář. Specifikovaný soubor bude rozdělen na soubory o velikosti 300 kB.

Následuje funkce pro sloučení souborů. V parametru stačí specifikovat první z množiny souborů a jako výstupní parametr funkce dostanete zprávu o úspěšném provedení sloučení s kontrolou (v případě, že existuje kontrolní soubor), bez kontroly (pokud kontrolní soubor není k dispozici) či chybové hlášení, pokud součty nesouhlasí. Jak bylo již řečeno, kontrolu CRC musíte doplnit sami.

function Sloucit(FileName: String): String;
var
    Source, Target : TFileStream;
    Count : Integer;
    Rect : LongInt;
    Line, FName, AName, Size, CRC, CRC32, Dir, Files : String;
    F : textFile;
begin
    CRC := copy(FileName,1,Length(FileName)-3)+`crc`;
    Dir := ExtractFilePath(FileName);
    Files := ExtractFileName(FileName);
    Count := 0;
    if FileExists(CRC) then
    begin
        AssignFile(F, CRC);
        Reset(F);
        while not EOF(F) do
        begin
            ReadLn(F, Line);
            if copy(Line, 1, 8) = `filename` then FName := copy(Line,10,Length(Line));
            if copy(Line, 1, 4) = `size` then Size := copy(Line, 6, Length(Line));
            if copy(Line, 1, 5) = `crc32` then CRC32 := copy(Line, 7, Length(Line));
        end;
        CloseFile(F);
    end
    else
      begin
        FName := copy(Files, 1, length(Files)-3) + `out`;
        Size := `0`;
        CRC32 := `0`;
      end;
    Target := TFileStream.Create(Dir + FName, fmCreate);
    Rect := 0;
    repeat
        inc(Count);
        AName := copy(Files, 1, length(Files)- 3);
        AName := AName + copy(`000`,1,3-Length(IntToStr(Count)))+IntTostr(Count);
        Source := TFileStream.Create(Dir + AName, fmOpenRead);
        try
            Rect := rect + Target.CopyFrom(Source, Source.Size);
        except
            Result := Format(`Chyba při čtení svazku %s.`,[FName]);
            Source.Free;
            Target.Free;
            Exit;
        end;
        Source.Free;
        AName := copy(Files, 1, length(Files)- 3);
        AName := AName + copy(`000`,1,3-Length(IntToStr(Count+1)))+IntTostr(Count+1);
    until not(FileExists(Dir + AName));
    Target.Free;
    if Rect = StrToInt(Size) then Result := `Soubory byly úspěšně sloučeny (CRC souhlasí).`
    else
    begin
        if (Size > `0`) then Result := `Chybná velikost sloučeného souboru.`
        else Result := `Soubory byly úspěšně sloučeny (bez CRC kontroly).`;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.OpenDialog1.Execute;
ShowMessage(Sloucit(Form1.Opendialog1.FileName));
end;