Tipy a triky v Delphi, díl 23.

Dnešní díl bude opět po čase poněkud monotematický a znovu si ukážeme některé užitečné věci související s prací se soubory. Naučíme se vyhledávat v souboru požadovaný text, ukážeme si bezpečné smazání souboru a další zajímavosti.
Vyhledání řetězce v souboru

Už jsme si v našem seriálu ukazovali, jak se dá celkem snadno vyhledat soubor na disku. Nyní si ukážeme další užitečnou věc a tou je vyhledání požadovaného řetězce v daném souboru. Funkce nám vrátí pozici řetězce v souboru nebo -1 v případě, že řetězec nebyl v souboru nalezen. Parametrem funkce je prohledávaný soubor, dále hledaný řetězec a logická proměnná, určující zda má být hledání citlivé na rozlišování velkých či malých písmen.

function ScanFile( Const filename : String; Const forString : String; caseSensitive : Boolean ): LongInt;
Const
  BufferSize= $8001;

Var
  pBuf, pEnd, pScan, pPos : Pchar;
  filesize : LongInt;
  bytesRemaining : LongInt;
  bytesToRead : Integer;
  F : File;
  SearchFor : Pchar;
  oldMode : Word;
Begin
  Result := -1;
  If (Length(forString) = 0) or (Length(filename) = 0) Then Exit;
  SearchFor := Nil;
  pBuf := Nil;
  AssignFile( F, filename );
  oldMode := FileMode;
  FileMode := 0;
  Reset( F, 1 );
  FileMode := oldMode;
  try
    SearchFor := StrAlloc( Length( forString )+1 );
    StrPCopy( SearchFor, forString );
    if not caseSensitive then AnsiUpper(SearchFor);
    GetMem( pBuf, BufferSize );
    filesize := System.Filesize( F );
    bytesRemaining := filesize;
    pPos := Nil;
    while bytesRemaining > 0 do
    begin
      if bytesRemaining >= BufferSize then bytesToRead := Pred(BufferSize)
      else bytesToRead := bytesRemaining;
      BlockRead( F, pBuf^, bytesToRead, bytesToRead );
      pEnd := @pBuf[ bytesToRead ];
      pEnd^:= #0;
      pScan := pBuf;
      while pScan < pEnd do
        begin
        if not caseSensitive then AnsiUpper(pScan);
        pPos := StrPos( pScan, SearchFor );
        if pPos <> Nil then
          begin
          result := FileSize - bytesRemaining + LongInt( pPos ) - LongInt( pBuf );
          break;
          end;
        pScan := StrEnd( pScan );
        Inc( pScan );
        end;
      if pPos <> Nil then break;
      bytesRemaining := bytesRemaining - bytesToRead;
      if bytesRemaining > 0 then
        begin     
        seek( F, FilePos(F)-Length( forString ));
        bytesRemaining := bytesRemaining + Length( forString );
        end;
    end;
  finally
    CloseFile( F );
    If SearchFor <> Nil then StrDispose( SearchFor );
    If pBuf <> Nil then FreeMem( pBuf, BufferSize );
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var pozice : integer;
begin
pozice := ScanFile(`c:\soubor.txt`, Form1.Edit3.Text, true);
if pozice<>-1 then ShowMessage(`Pozice: `+IntToStr(pozice))
              else ShowMessage(`Nenalezeno`);
end;

Bezpečné smazání souboru

Pokud smažete soubor běžným způsobem, jistě dobře víte, že jej lze obnovit. Nemám teď na mysli pouze ten případ, kdy používáte Koš, ale soubor lze různými prostředky obnovit i když jej smažete rovnou. Ne že by to snad nějak vadilo (někdy spíše naopak), protože to může být někdy poslední záchrana jak zpět získat ztracená data. Ovšem v tom případě, že jsou data určitým způsobem citlivá a nechcete, aby se k nim dostal někdo cizí právě jejich obnovením po smazání, je třeba použít trošku jiný způsob mazání. Funkce, kterou si teď ukážeme, provede smazání poněkud bezpečnějším způsobem, protože nejprve soubor přepíše náhodnými daty a teprve poté jej smaže běžným způsobem. Když se jej někdo poté pokusí obnovit, podaří se mu to sice, ale dostane jen náhodná data.

procedure WipeFile(filename : String);
var
buffer : array [0..4095] of byte;
max, n : LongInt;
i : Integer;
fs : TFileStream;

procedure RandomizeBuffer;
var
  i: Integer;
begin
  for i:= Low(buffer) to High(buffer) do buffer[i] := Random(256);
end;

begin
fs := TFilestream.Create(filename, fmOpenReadWrite or fmShareExclusive);
try
  for i := 1 to 3 do
    begin
    RandomizeBuffer;
    max := fs.Size;
    fs.Position := 0;
    while max > 0 do
      begin
      if max > Sizeof(buffer) then n := sizeof(buffer)
      else n := max;
      fs.Write( Buffer, n );
      max := max - n;
      end;
    FlushFileBuffers(fs.handle);
    end;
finally
  fs.free;
end;
Deletefile(filename);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WipeFile(`c:\soubor.exe`);
end;

Zjištění aplikace přidružené k danému typu souboru

Pokud potřebujete zjistit jaká aplikace je přidružena k danému typu souboru (dokumentu), můžete to velmi snadno provést pomocí funkce FindExecutable. Ta je součástí knihovny ShellAPI a následující zdrojový kód ukazuje její použití:

procedure TForm1.Button1Click(Sender: TObject);
var app : PChar;
begin
GetMem(app, 255);
FindExecutable(`test.txt`,`c:\`, app);
Application.MessageBox(App, `Informace o souboru`, mb_ok + mb_iconinformation);
end;

Vytvoření unikátního názvu souboru pro složku TEMP

Často se ve svých aplikacích dostanete do situace, kdy je třeba si některá data dočasně odložit někam na disk, později se k nim vrátit, použít je a smazat. K podobným účelům jak jistě dobře víte slouží systémová složka TEMP. Zde však nastává "problém" s volbou vhodného názvu pro takový dočasný soubor. Jistě, nic nám nebrání si jej nazvat podle libosti třeba "můjdočasnýsoubor.tmp", ale není to příliš profesionální. Můžeme velice snadno využít následující funkci, která nám vytvoří unikátní název, takže nebude kolidovat s ostatními aplikacemi. Sice nebude tak hezký jako ten výše zmíněný, ale bude vypadat velmi profesionálně (jako například "~51a4.tmp" ). :)

function GetTempFile(const Extension: string): string;
var
Buffer: array[0..MAX_PATH] OF Char;
aFile : string;
begin
repeat
GetTempPath(Sizeof(Buffer)-1,Buffer);
GetTempFileName(Buffer,`~`,0,Buffer);
result := ChangeFileExt(Buffer,Extension);
until not FileExists(result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetTempFile(`.~tp`));
end;

A rada na úplný závěr dnešního dílu? Sice už se asi možná opakuji, ale nezapomínejte své dočasné soubory po sobě mazat.

Diskuze (2) Další článek: Diskuze: na co se nejvíce těšíte v roce 2002?

Témata článku: Software, Programování, Nota, DEL, Delete Fil, Unikátní název, TRI, Trik, Díl, Poslední záchrana, Podobný účel, Systémová složka, Filename


Určitě si přečtěte

Ubuntu 20.04: Zase vás chce přesvědčit, že je lepší než Windows

Ubuntu 20.04: Zase vás chce přesvědčit, že je lepší než Windows

** Britský Canonical před pár dny vydal novou verzi svého Ubuntu ** 20.04 LTS zapracovalo na grafickém desktopu, rychlosti i bezpečnosti ** V nitru tepe Linux 5.4 a volitelně i nový souborový systém

Jakub Čížek | 121

Z rozmazané šmouhy krásná fotka. Takhle kouzlí nová umělá inteligence MyHeritage

Z rozmazané šmouhy krásná fotka. Takhle kouzlí nová umělá inteligence MyHeritage

** MyHeritage slibuje nejlepší neuronovou síť pro vylepšování fotek ** Funguje tím líp, čím horší fotku upravuje ** Otestovali jsme desítky různých snímků

Marek Lutonský, Lukáš Václavík | 36

AR není ani po letech žádný trhák. Teď to zkusí Hybri, který svleče vaše kamarádky

AR není ani po letech žádný trhák. Teď to zkusí Hybri, který svleče vaše kamarádky

** Rozšířené realitě i po letech chybí praktické využití ** Selhaly mobilní aplikace i AR brýle ** Floridské studio to proto zkusí přes bizarní erotiku Hybri

Jakub Čížek | 18


Aktuální číslo časopisu Computer

Megatest SSD s kapacitou 1 TB

Srovnávací test robotických vysavačů

Vybíráme nejlepší telefony na trhu

Jak zlepšit zvuk televize