Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Warum ist die Datei "gesperrt"? [erledigt] (https://www.delphipraxis.net/49548-warum-ist-die-datei-gesperrt-%5Berledigt%5D.html)

FriFra 12. Jul 2005 21:25
Warum ist die Datei "gesperrt"? [erledigt]
 
Ich verwende eine unit aus dem Delphi-Forum zum Packen/Entpacken von Dateien.
Delphi-Quellcode:
// V 1.0 By Obbschtkuche

 
unit Packer;

 
interface

 
uses Classes, Windows;

 
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);

 
function FileExists(const FileName: string): Boolean;

 
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;

 
function FileExists(const FileName: string): Boolean;
var
  f: TWin32FindData;
  handle: THandle;
begin
  handle := FindFirstFile(pChar(FileName), f);
  result := (handle <> INVALID_HANDLE_VALUE);
  FindClose(Handle);
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);
 finally
  if pIn <> nil then freemem(pIn);
  if pOut <> nil then freemem(pOut);
  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);
 finally
  if pIn <> nil then freemem(pIn);
  if pOut <> nil then freemem(pOut);
 end;
end;

 
end.
Merkwürdigerweise ist eine Datei nachdem man DecompressFile aufgerufen hat nicht frei, sondern beim Veruch in diese zu schreiben kommt folgende Fehlermeldung:
Der Prozess kann nicht auf die Datei zugreifen, da sie von einem anderen Prozess verwendet wird.

Kommentiere ich das Dekomprimieren aus, dann funktioniert der Zugriff, es liegt also definitiv am Code der Unit.

FriFra 12. Jul 2005 22:22
Re: Warum ist die Datei "gesperrt"?
 
Kleine Ergänzung...

Das Problem tritt anscheinend nur auf, wenn die betreffende Datei nicht gepackt ist.

FriFra 12. Jul 2005 23:33
Re: Warum ist die Datei "gesperrt"?
 
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]


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:52 Uhr.

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