Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Filekiller (https://www.delphipraxis.net/56820-filekiller.html)

A-M-X 11. Nov 2005 19:07


Filekiller
 
Huhu!!

Habe folgenden Code gefunden und habe 2 Fragen:

1. Wie geht es , dass er während des Fileüberschreibens (also ned am Ende beim Löschen) in einem Label1.caption ausgibt , bei der wievielten Überschreibung er ist (also bei 1 , 2 , 3 ...)
2. Wie stelle ich den Fortschritt in einer Gauge da?

Delphi-Quellcode:
function FileGetSize(const FileName: string): Integer;
var
  SearchRec: TSearchRec;
{$IFDEF MSWINDOWS}
  OldMode: Cardinal;
{$ENDIF MSWINDOWS}
begin
  Result := -1;
{$IFDEF MSWINDOWS}
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
{$ENDIF MSWINDOWS}
    if FindFirst(FileName, faAnyFile, SearchRec) = 0 then
    begin
      Result := SearchRec.Size;
      SysUtils.FindClose(SearchRec);
    end;
{$IFDEF MSWINDOWS}
  finally
    SetErrorMode(OldMode);
  end;
{$ENDIF MSWINDOWS}
end;

procedure ShredFil(const FileName: string; Times: Integer);
const
  BUFSIZE  = 4096;
  ODD_FILL = $C1;
  EVEN_FILL = $3E;
var
  Fs: TFileStream;
  Size: Integer;
  N: Integer;
  ContentPtr: Pointer;
begin
  Size := FileGetSize(FileName);
  if Size > 0 then
  begin
    if Times < 0 then
      Times := 2
    else
      Times := Times * 2;
    ContentPtr := nil;
    Fs := TFileStream.Create(FileName, fmOpenReadWrite);
    try
      GetMem(ContentPtr, BUFSIZE);
      while Times > 0 do
      begin
        if Times mod 2 = 0 then
          FillMemory(ContentPtr, BUFSIZE, EVEN_FILL)
        else
          FillMemory(ContentPtr, BUFSIZE, ODD_FILL);
        Fs.Seek(0, soFromBeginning);
        N := Size div BUFSIZE;
        while N > 0 do
        begin
          Fs.Write(ContentPtr^, BUFSIZE);
          Dec(N);
        end;
        N := Size mod BUFSIZE;
        if N > 0 then
          Fs.Write(ContentPtr^, N);
        FlushFileBuffers(Fs.Handle);
        Dec(Times);
      end;
    finally
      if ContentPtr <> nil then
        FreeMem(ContentPtr, Size);
      Fs.Free;
      DeleteFile(FileName);
    end;
  end
  else
    DeleteFile(FileName);
end;
:bouncing4: :bounce1: :thumb: thx schonma für die antworten

Phistev 11. Nov 2005 19:35

Re: Filekiller
 
Nach Dec(Times); eine (selbstgeschriebene) Funktion aufrufen, die die Ausgabe übernimmt.

A-M-X 11. Nov 2005 19:36

Re: Filekiller
 
hm bin n anfänger , wie sieht das in der praxis aus?

Phistev 11. Nov 2005 20:04

Re: Filekiller
 
So:
Delphi-Quellcode:
procedure ShredFil(const FileName: string; Times: Integer);
const
  BUFSIZE  = 4096;
  ODD_FILL = $C1;
  EVEN_FILL = $3E;
var
  Fs: TFileStream;
  Size: Integer;
  N: Integer;
  OldTimes: Integer;
  ContentPtr: Pointer;
begin
  Size := FileGetSize(FileName);
  if Size > 0 then
  begin
    if Times < 0 then
      Times := 2
    else
      Times := Times * 2;
    OldTimes:= Times;
    ContentPtr := nil;
    Fs := TFileStream.Create(FileName, fmOpenReadWrite);
    try
      GetMem(ContentPtr, BUFSIZE);
      while Times > 0 do
      begin
        if Times mod 2 = 0 then
          FillMemory(ContentPtr, BUFSIZE, EVEN_FILL)
        else
          FillMemory(ContentPtr, BUFSIZE, ODD_FILL);
        Fs.Seek(0, soFromBeginning);
        N := Size div BUFSIZE;
        while N > 0 do
        begin
          Fs.Write(ContentPtr^, BUFSIZE);
          Dec(N);
        end;
        N := Size mod BUFSIZE;
        if N > 0 then
          Fs.Write(ContentPtr^, N);
        FlushFileBuffers(Fs.Handle);
        Dec(Times);
        Form1.display(ceil((oldtimes - times + 1)/2), trunc(oldtimes/2)); //Anzeigen
        Application.ProcessMessages;
      end;
    finally
      if ContentPtr <> nil then
        FreeMem(ContentPtr, Size);
      Fs.Free;
    end;
  end;
  DeleteFile(FileName);
end;
{...}
procedure TForm1.display(laeufe, gesamt: integer);
begin
  label4.Caption:= IntToStr(laeufe) + ' Durchgänge abgehakt';
  Gauge1.Progress:= round(laeufe*100/gesamt);
end;
/edit: nicht ganz mein Tag heute...


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:07 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz