Einzelnen Beitrag anzeigen

Benutzerbild von FriFra
FriFra

Registriert seit: 19. Apr 2003
1.291 Beiträge
 
Delphi 2005 Professional
 
#3

Re: Warum ist die Datei "gesperrt"?

  Alt 12. Jul 2005, 23:33
Ich habs gefunden
Delphi-Quellcode:
// V 1.0 By Obbschtkuche

unit Packer;

interface

uses Classes, Windows, SysUtils;

procedure CompressFile(FileName: string); overload;
procedure CompressFile(sfrom, sto: string); overload;
procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer);
  overload;
procedure DeCompressFile(FileName: string); overload;
procedure DeCompressFile(sfrom, sto: string); overload;
function DeCompressFile(filename: string; var pout: Pointer): integer; overload;

procedure CompressStream(sIn, sOut: TStream);
procedure DeCompressStream(sIn, sOut: TStream);

implementation

uses ZLib;

function DeCompressFile(filename: string; var pout: Pointer): integer;
var
  f: file of byte;
  pIn: Pointer;
  sizeRead, sizeWrite: integer;
begin
  pIn := nil;
  pOut := nil;
  assignfile(f, FileName);
  reset(f);
  try
    getmem(pIn, FileSize(f));
    BlockRead(f, pIn^, FileSize(f), sizeRead);
    DeCompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
    result := sizeWrite;
  finally
    if pIn <> nil then
      freemem(pIn);
    CloseFile(f);
  end;
end;

procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer);
var
  f: file of byte;
  pOut: Pointer;
  sizeWrite: integer;
begin
  pOut := nil;
  assignfile(f, FileName);
  try
    CompressBuf(pIn, pinsize, pOut, sizeWrite);
    ReWrite(f);
    BlockWrite(f, pOut^, sizeWrite);
  finally
    if pOut <> nil then
      freemem(pOut);
    CloseFile(f);
  end;
end;

procedure CompressFile(FileName: string); overload;
var
  f: file of byte;
  pIn, pOut: Pointer;
  sizeRead, sizeWrite: integer;
begin
  pIn := nil;
  pOut := nil;
  assignfile(f, FileName);
  reset(f);
  try
    getmem(pIn, FileSize(f));
    BlockRead(f, pIn^, FileSize(f), sizeRead);
    CompressBuf(pIn, sizeRead, pOut, sizeWrite);
    ReWrite(f);
    BlockWrite(f, pOut^, sizeWrite);
  finally
    if pIn <> nil then
      freemem(pIn);
    if pOut <> nil then
      freemem(pOut);
    CloseFile(f);
  end;
end;

procedure DeCompressFile(FileName: string); overload;
var
  f: file of byte;
  pIn, pOut: Pointer;
  sizeRead, sizeWrite: integer;
begin
  pIn := nil;
  pOut := nil;
  assignfile(f, FileName);
  reset(f);
  try
    getmem(pIn, FileSize(f));
    BlockRead(f, pIn^, FileSize(f), sizeRead);
    DeCompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
    ReWrite(f);
    BlockWrite(f, pOut^, sizeWrite);

    { Das hier muss aus dem finally raus!!!
      Wenn die Datei nicht komrimiert ist
      kommt es sonst zum Crash. }

    if pOut <> nil then
      freemem(pOut);
  finally
    if pIn <> nil then
      freemem(pIn);
    CloseFile(f);
  end;
end;

procedure CompressFile(sfrom, sto: string); overload;
begin
  if FileExists(sto) then
    DeleteFile(pchar(sto));
  CopyFile(pchar(sfrom), pchar(sto), true);
  CompressFile(sto);
end;

procedure DeCompressFile(sfrom, sto: string); overload;
begin
  if FileExists(sto) then
    DeleteFile(pchar(sto));
  CopyFile(pchar(sfrom), pchar(sto), true);
  DeCompressFile(sto);
end;

procedure CompressStream(sIn, sOut: TStream);
var
  pIn, pOut: Pointer;
  sizeRead, sizeWrite: integer;
begin
  pIn := nil;
  pOut := nil;
  try
    getmem(pIn, sIn.size);
    sIn.Position := 0;
    sizeRead := sIn.Read(pIn^, sIn.Size);
    CompressBuf(pIn, sizeRead, pOut, sizeWrite);
    sOut.Write(pOut^, sizeWrite);
  finally
    if pIn <> nil then
      freemem(pIn);
    if pOut <> nil then
      freemem(pOut);
  end;
end;

procedure DeCompressStream(sIn, sOut: TStream);
var
  pIn, pOut: Pointer;
  sizeRead, sizeWrite: integer;
begin
  pIn := nil;
  pOut := nil;
  try
    getmem(pIn, sIn.size);
    sIn.Position := 0;
    sizeRead := sIn.Read(pIn^, sIn.Size);
    DecompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
    sOut.Write(pOut^, sizeWrite);
    
    { Das hier muss aus dem finally raus!!!
      Wenn die Datei nicht komrimiert ist
      kommt es sonst zum Crash. }

    if pOut <> nil then
      freemem(pOut);

  finally
    if pIn <> nil then
      freemem(pIn);
  end;
end;

end.
[mod="Christian S."]Code- durch Delphi-Tags ersetzt.[/mod]
Elektronische Bauelemente funktionieren mit Rauch. Kommt der Rauch raus, geht das Bauteil nicht mehr.
  Mit Zitat antworten Zitat