Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 29. - Zjištění, zda je koš prázdný; Vyprázdnění koše; Smazání souboru do koše; Načtení a uložení dat z ListView do souboru

Jan Šindelář - 13.2.2002

Zjištění, zda je koš prázdný

"Koš", či chcete-li "Recycle Bin", je pro některé uživatele jistě užitečná pomůcka v případě, že se jim "povede" vymazat z disku něco, co nechtěli. My se teď naučíme zjistit, zda je koš prázdný nebo ne, což se nám může v mnoha případech hodit. Poslouží nám k tomu následující funkce, která vrací True nebo False (prázdný nebo plný koš), a využijeme k tomu knihoven Activex, ShlObj a ComObj.

.
.
.
uses Activex, ShlObj, ComObj;
.
.
.

function KosJePrazdny : Boolean;
const
  CLSID_IRecycleBin: TGUID = (D1: $645FF040; D2: $5081; D3: $101B; D4: ($9F, $08, $00, $AA, $00, $2F, $95, $4E));
var
  EnumIDList : IEnumIDList;
  FileItemIDList : PItemIDList;
  ItemCount : ULONG;
  RecycleBin : IShellFolder;
begin
  CoInitialize(nil);
  OleCheck(CoCreateInstance(CLSID_IRecycleBin, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IID_IShellFolder, RecycleBin));
  RecycleBin.EnumObjects(0,
    SHCONTF_FOLDERS or
    SHCONTF_NONFOLDERS or
    SHCONTF_INCLUDEHIDDEN,
    EnumIDList);
  Result := EnumIDList.Next(1, FileItemIDList, ItemCount) <> NOERROR;
  CoUninitialize;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if KosJePrazdny then ShowMessage(`Koš je prázdný.`)
                else ShowMessage(`Koš obsahuje smazaná data.`);
end;

Vyprázdnění koše

Když už jsme se naučili, jak zjistit, zda je koš prázdný či ne, ukažme si teď postup, jak jej vyprázdnit a definitivně tak soubory smazat.

procedure TForm1.Button1Click(Sender: TObject);

const
  SHERB_NOCONFIRMATION = $00000001;
  SHERB_NOPROGRESSUI  = $00000002;
  SHERB_NOSOUND        = $00000004;

type TSHEmptyRecycleBin = function(Wnd: HWND; LPCTSTR: PChar; DWord: Word): Integer; stdcall;

var
  SHEmptyRecycleBin : TSHEmptyRecycleBin;
  LibHandle : THandle;

begin
  LibHandle := LoadLibrary(PChar(`Shell32.dll`));
  if LibHandle <> 0 then @SHEmptyRecycleBin := GetProcAddress(LibHandle, `SHEmptyRecycleBinA`)
  else
  begin
    ShowMessage(`Chyba při přístupu ke knihovně Shell32.dll`);
    Exit;
  end;
  if @SHEmptyRecycleBin <> nil then
    begin
    SHEmptyRecycleBin(Application.Handle, ``, SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
    ShowMessage(`Koš vysypán!`);
    end;
  FreeLibrary(LibHandle);
  @SHEmptyRecycleBin := nil;
end;

Smazání souboru do koše

A zbývá nám už jen naučit se, jak soubor přesunout právě do koše. Zde je tedy příslušná funkce, která využívá pro změnu zase ShellApi.

function SmazDoKose(sFileName: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  FillChar(fos, SizeOf(fos), 0);
  with fos do
  begin
    wFunc  := FO_DELETE;
    pFrom  := PChar(sFileName);
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
  end;
  Result := (0 = ShFileOperation(fos));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if SmazDoKose(`c:\soubor.txt`) then ShowMessage(`Soubor přesunut do koše`)
                              else ShowMessage(`Došlo k chybě !`);
end;

Načtení a uložení dat z ListView do souboru

ListView (či TreeView) jsou dvě velmi oblíbené komponenty pro zobrazování dat, protože práce s nimi je poměrně jednoduchá a zobrazení dat přehledné. I když je naplňování ListView daty poměrně snadná záležitost, práci si můžeme velice zjednodušit tím, že je načteme ze souboru (a poté případně opět uložíme). Menší "problém" je ten, jak poznat, zda soubor obsahuje data pro náš ListView. To je v našem příkladě vyřešeno poněkud zjednodušeně tím, že si prostě do souboru uložíme vlastní "značku" (proměnná MySignature). Uznávám, že postup je poněkud primitivní, ale svůj účel splní. Pokud budeme ukládání do souboru používat interně v programu bez zásahu uživatele, pak bych v tom neviděl problém. Jestliže však bude moci přímo uživatel rozhodovat o tom, který soubor má být načten, bylo by dobré tuto kontrolu více propracovat, protože jako správný programátor(ka) musíme vždy počítat s tím, že uživatel je zlomyslný (nebo naivní) a bude se pokoušet načíst kde co.

const
  Msg1 = `Soubor "%s" neexistuje !`;
  Msg2 = `"%s" není soubor s ListView daty !`;

procedure TForm1.SaveListViewToFile(AListView: TListView; sFileName: string);
var
  idxItem, idxSub, IdxImage : integer;
  F : TFileStream;
  pText :    PChar;
  sText : string;
  W, ItemCount, SubCount : word;
  MySignature : array [0..2] of char;
begin
  with AListView do
  begin
    ItemCount := 0;
    SubCount := 0;
    MySignature := `LVF`;
    F := TFileStream.Create(sFileName, fmCreate or fmOpenWrite);
    F.Write(MySignature, sizeof(MySignature));
    if Items.Count = 0 then ItemCount := 0
    else ItemCount := Items.Count;
    F.Write(ItemCount, Sizeof(ItemCount));
    if Items.Count > 0 then
    begin
      for idxItem := 1 to ItemCount do
      begin
        with items[idxItem - 1] do
        begin
          if SubItems.Count = 0 then SubCount := 0
          else SubCount := Subitems.Count;
          F.Write(SubCount, Sizeof(SubCount));
          IdxImage := ImageIndex;
          F.Write(IdxImage, Sizeof(IdxImage));
          sText := Caption;
          w := length(sText);
          pText := StrAlloc(Length(sText) + 1);
          StrPLCopy(pText, sText, Length(sText));
          F.Write(w, sizeof(w));
          F.Write(pText^, w);
          StrDispose(pText);
          if SubCount > 0 then
          begin
            for idxSub := 0 to SubItems.Count - 1 do
            begin
              sText := SubItems[idxSub];
              w := length(sText);
              pText := StrAlloc(Length(sText) + 1);
              StrPLCopy(pText, sText, Length(sText));
              F.Write(w, sizeof(w));
              F.Write(pText^, w);
              StrDispose(pText);
            end;
          end;
        end;
      end;
    end;
    F.Free;
  end;
end;

procedure TForm1.LoadListViewToFile(AListView: TListView; sFileName: string);
var
  F : TFileStream;
  IdxItem, IdxSubItem, IdxImage : integer;
  W, ItemCount, SubCount : word;
  pText : PChar;
  PTemp : PChar;
  MySignature : array [0..2] of char;
  sExeName :    string;
begin
  with AListView do
  begin
    ItemCount := 0;
    SubCount := 0;
    sExeName := ExtractFileName(sFileName);
    if not FileExists(sFileName) then
    begin
      MessageBox(Handle, PChar(format(Msg1, [sExeName])), `I/O Error`, MB_ICONERROR);
      Exit;
    end;
    F := TFileStream.Create(sFileName, fmOpenRead);
    F.Read(MySignature, sizeof(MySignature));
    if MySignature <> `LVF` then
    begin
      MessageBox(Handle, PChar(format(Msg2, [sExeName])), `I/O Error`, MB_ICONERROR);
      Exit;
    end;
    F.Read(ItemCount, sizeof(ItemCount));
    Items.Clear;
    for idxItem := 1 to ItemCount do
    begin
      with Items.Add do
      begin
        F.Read(SubCount, sizeof(SubCount));
        F.Read(IdxImage, sizeof(IdxImage));
        ImageIndex := IdxImage;
        F.Read(w, SizeOf(w));
        pText := StrAlloc(w + 1);
        pTemp := StrAlloc(w + 1);
        F.Read(pTemp^, W);
        StrLCopy(pText, pTemp, W);
        Caption := StrPas(pText);
        StrDispose(pTemp);
        StrDispose(pText);
        if SubCount > 0 then
        begin
          for idxSubItem := 1 to SubCount do
          begin
            F.Read(w, SizeOf(w));
            pText := StrAlloc(w + 1);
            pTemp := StrAlloc(w + 1);
            F.Read(pTemp^, W);
            StrLCopy(pText, pTemp, W);
            Items[idxItem - 1].SubItems.Add(StrPas(pText));
            StrDispose(pTemp);
            StrDispose(pText);
          end;
        end;
      end;
    end;
    F.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SaveListViewToFile(ListView1, `Data.sav`);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
LoadListViewToFile(ListView1, `Data.sav`);
end;