资源中有一个文件较大 可否用进度条显示释放进度?

Question

资源中有一个文件较大 可否用进度条显示释放进度?
我写了个资源释放的  单独一个资源 可能达到150M
释放完后 EXE内存也到了150M  而且中间出现假死 我用free把资源变量 释放掉了 但是内存还是没有降低
如果用一个线程释放我想应该不会死我看有些安装程序释放的时候就占点CPU 内存站用不了多少
不知道怎么写的

Answer 1

不如弄个界面当释放开始的时候show出来当释放完毕hide，通常加载大的文件的时候比较慢，没听说过释放的时候会出现假死

Answer 2

建议使用文件内核对象技术，你可以看看CreateFileMapping，MapViewOfFile等函数的文档，速度超快！

Answer 3

function ExtractRes(ResType, ResName, ResNewName: String): boolean;  //释放资源函数
var
  Res : TResourceStream;
begin
  try
    Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
    try
      Res.SaveToFile(ResNewName);
      Result := true;
    finally
     // Res.Destroy ;
      Res.Free;
    end;
  except
    Result := false;
  end;
我用的这个函数释放的资源 比如ExtractRes('au31','t008',Patch+'data\008.acv');  008这个文件可能达到150M 
释放的时候我看进程的内存一直彪升到150 M以上 才过去 ,在那期间程序类似挂起 
CreateFileMapping，MapViewOfFile  大概看了下 映射完了 怎么读取资源部分 然后写入到文件中呢. 

Answer 4

呵呵，其实你应该把上面的代码放在另外一个线程里面来执行，而不是放在主线程里面，否则程序就可能不会响应。e.g.TExtractResourceThread = class(TThread)
private
  fResourceName: string; 
  //...
protected
  procedure Execute; override;
end;procedure TExtractResourceThread.Execute;
begin
  //...
end;如果你想这个线程运行的更快，就不要用TResourceStream了。你可以参考它的源代码，用FindResource和LoadResource找到资源的Handle，然后在看看能不能用CreateFileMapping等函数来完成资源的释放。

Answer 5

咱们先实行基本的需求：
1. 界面能保持响应 （创建多线程）
2. 能显示进度     （将资源分多次写入文件）
// 1. 在主线程里面创建释放资源线程
procedure ExtractResource(const resourceName, resourceType, fileName: string);
var
  t: TExtractResourceThread;
begin
  t := TExtractResourceThread.Create(resourceName, resourceType, fileName);
  // 连接事件等
  t.Resume;
end;type
  TExtractResourceEvent = procedure(sender: TObject; progress: Integer);  TExtractResourceThread = class(TThread)
  private
    fResourceName: string;
    fResourceType: string;
    fFileName: string;
    fResource: TStream;
    fFile: TStream;
    fProgress: Integer;
    fResourceSize: Integer;
    fOnProgress: TExtractResourceEvent;
  protected
    procedure CallOnProgress;
    procedure Initialize;
    procedure Execute; override;
  public
    constructor Create(const resourceName, resourceType, fileName: string);
    destructor Destroy; override;
    property OnProgress: TExtractResourceEvent read fOnProgress write fOnProgress;
  end;{ TExtractResourceThread }constructor TExtractResourceThread.Create(const resourceName, resourceType,
  fileName: string);
begin
  inherited Create(True);
  fResourceName := resourceName;
  fResourceType := resourceType;
  fFileName := fileName;
end;destructor TExtractResourceThread.Destroy;
begin
  fResource.Free;
  fFile.Free;
  inherited Destroy;
end;procedure TExtractResourceThread.CallOnProgress;
begin
  if Assigned(fOnProgress) then
  begin
    fOnProgress(Self, fProgress);
  end;
end;procedure TExtractResourceThread.Initialize;
begin
  fResource := TResourceStream.Create(HInstance, fResourceName, PChar(fResourceType));
  fFile := TFileStream.Create(fFileName, fmOpenWrite or fmShareExclusive);
  fResourceSize := fResource.Size;
end;procedure TExtractResourceThread.Execute;
const
  bufferSize = 1024 * 32;  // 32 KB
var
  bytesLeft: Integer;
  bytesRead: Integer;
begin
  try
    Initialize;
    bytesLeft := fResourceSize;
    while not Terminated and (bytesLeft > 0) do
    begin
      bytesRead := fFile.CopyFrom(fResource, bufferSize);
      bytesLeft := bytesLeft - bytesRead;
      Synchronize(CallOnProgress);
    end;  
  except
    { TODO: Handle exception }
  end;
end;
P.S. 上面的代码没有调试，你再试试

Answer 6

unit Unit2;interfaceuses
  sysutils, classes;
type
  TExtractResourceEvent = procedure(sender: TObject; progress: Integer);  TExtractResourceThread = class(TThread)
  private
    fResourceName: string;
    fResourceType: string;
    fFileName: string;
    fResource: TStream;
    fFile: TStream;
    fProgress: Integer;
    fResourceSize: Integer;
    fOnProgress: TExtractResourceEvent;
  protected
    procedure CallOnProgress;
    procedure Initialize;
    procedure Execute; override;
  public
    constructor Create(const resourceName, resourceType, fileName: string);
    destructor Destroy; override;
    property OnProgress: TExtractResourceEvent read fOnProgress write fOnProgress;
  end;{ TExtractResourceThread }implementationuses
  Unit1 ;
constructor TExtractResourceThread.Create(const resourceName, resourceType,
  fileName: string);
begin
  inherited Create(True);
  fResourceName := resourceName;
  fResourceType := resourceType;
  fFileName := fileName;
end;destructor TExtractResourceThread.Destroy;
begin
  fResource.Free;
  fFile.Free;
  inherited Destroy;
end;procedure TExtractResourceThread.CallOnProgress;
begin
  if Assigned(fOnProgress) then
  begin
    fOnProgress(Self, fProgress);
  end;
end;procedure TExtractResourceThread.Initialize;
begin
  fResource := TResourceStream.Create(HInstance, fResourceName, PChar(fResourceType));
  fFile := TFileStream.Create(fFileName, fmOpenWrite or fmShareExclusive);
  fResourceSize := fResource.Size;
end;procedure TExtractResourceThread.Execute;
const
  bufferSize = 1024 * 32;  // 32 KB
var
  bytesLeft: Integer;
  bytesRead: Integer;
begin
  try
    Initialize;
    bytesLeft := fResourceSize;
    while not Terminated and (bytesLeft > 0) do
    begin
      bytesLeft := bytesLeft - bytesRead;
      if bytesLeft=0 then Destroy;
      if bytesLeft < bytesRead then
        begin
          bytesRead := fFile.CopyFrom(fResource, bytesLeft);
          bytesLeft:=bytesLeft-bytesLeft;        end else
      bytesRead := fFile.CopyFrom(fResource, bufferSize);
       Form1.Edit1.Text := IntToStr(bytesLeft)+'-'+inttostr(bufferSize);
       Form1.p.Text := IntToStr(StrToInt (Form1.p.Text)+ 1);
      Synchronize(CallOnProgress);
    end;
  except
    { TODO: Handle exception }
  end;
end;
end.
代码我稍稍改进了下,但是还有点问题,如果连续执行2次ExtractResource('a','a','a1.rar'); 就会出错 而且释放完毕后 内存好象没有释放掉 我的资源是26M 释放完毕后 运行的EXE 内存占用也达到了26M 

Answer 7

修改之后的代码有一些很严重的问题：
  if bytesLeft=0   then   Destroy;   Form1.Edit1.Text   :=   IntToStr(bytesLeft)+'-'+inttostr(bufferSize); 
  Form1.p.Text   :=   IntToStr(StrToInt   (Form1.p.Text)+   1); 
1. 线程的释放有两种方法
*) 手工（调用Free方法）
  在适当的时候调用fThread.Free;
**) 自动（设置FreeOnTerminate属性）
  fThread := TExtractResourceThread.Create(...);
  fThread.FreeOnTerminate := True;
  fThread.OnProgress := DoProgress; // 连接事件，详见2
  fThread.Resume;
  
2. 不要在线程的执行代码中直接引用主线程中的资源（如Form1），这可能会造成未知的程序错误。
你可以连接TExtractResourceThread.OnProgress事件。// TExtractResourceEvent = procedure(sender: TObject; progress: Integer) of object; procedure TForm1.DoProgress(sender:   TObject;   progress:   Integer);
begin
  // show current progress
end;

Answer 8

unit Unit2;interfaceuses
  sysutils, classes;
type
  TExtractResourceEvent = procedure(sender: TObject; progress: Integer) of object;
  TExtractResourceThread = class(TThread)
  private
    fResourceName: string;
    fResourceType: string;
    fFileName: string;
    fResource: TStream;
    fFile: TStream;
    fProgress: Integer;
    fResourceSize: Integer;
    fOnProgress: TExtractResourceEvent;
  protected
    procedure CallOnProgress;
    procedure Initialize;
    procedure Execute; override;
  public
    constructor Create(const resourceName, resourceType, fileName: string);
    destructor Destroy; override;
    property OnProgress: TExtractResourceEvent read fOnProgress write fOnProgress;
  end;{ TExtractResourceThread }implementationuses
  Unit1 ;
constructor TExtractResourceThread.Create(const resourceName, resourceType,
  fileName: string);
begin
  inherited Create(True);
  fResourceName := resourceName;
  fResourceType := resourceType;
  fFileName := fileName;
end;destructor TExtractResourceThread.Destroy;
begin
  fResource.Free;
  fFile.Free;
  inherited Destroy;
end;procedure TExtractResourceThread.CallOnProgress;
begin
  if Assigned(fOnProgress) then
  begin
    fOnProgress(Self, fProgress);
  end;
end;procedure TExtractResourceThread.Initialize;
begin
  fResource := TResourceStream.Create(HInstance, fResourceName, PChar(fResourceType));
  fFile := TFileStream.Create(fFileName, fmOpenWrite or fmShareExclusive);
  fResourceSize := fResource.Size;
end;procedure TExtractResourceThread.Execute;
const
  bufferSize = 1024 * 32;  // 32 KB
var
  bytesLeft: Integer;
  bytesRead: Integer;
begin
  try
    Initialize;
    bytesLeft := fResourceSize;
    while not Terminated and (bytesLeft > 0) do
    begin
      bytesLeft := bytesLeft - bytesRead;
      if bytesLeft=0 then exit;
      if bytesLeft < bytesRead then
        begin
          bytesRead := fFile.CopyFrom(fResource, bytesLeft);
          bytesLeft:=bytesLeft-bytesLeft;        end else
      bytesRead := fFile.CopyFrom(fResource, bufferSize);
      Synchronize(CallOnProgress);
    end;
  except
    { TODO: Handle exception }
  end;
end;
end.unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Unit2, ComCtrls ;type
  TForm1 = class(TForm)
    Button1: TButton;
    p: TEdit;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure ExtractResource(const resourceName, resourceType, fileName: string);
    procedure DoProgress(sender:   TObject;   progress:   Integer);
  public  end;
var
  Form1: TForm1;implementation{$R *.dfm}
{$R 1.res}procedure TForm1.Button1Click(Sender: TObject);
begin
ExtractResource('a','a','a1.rar');end;procedure TForm1.ExtractResource(const resourceName, resourceType,
  fileName: string);
var
  t: TExtractResourceThread;
begin
  t := TExtractResourceThread.Create(resourceName, resourceType, fileName);
  t.FreeOnTerminate   :=   True;
  t.OnProgress   :=   DoProgress;   //   连接事件，详见2
  t.Resume;end;procedure TForm1.Button2Click(Sender: TObject);
begin
ExtractResource('a','a','a2.rar');
end;procedure TForm1.DoProgress(sender: TObject; progress: Integer);
begin
   Form1.p.Text   :=  inttostr(progress);
end;end.
Form1.p.Text   :=  inttostr(progress);
 不显示数值 没反映

Answer 9

unit Unit2;interfaceuses
  sysutils, classes;
type
  TExtractResourceEvent = procedure(sender: TObject; progress,fProgressCount: Integer) of object;
  TExtractResourceThread = class(TThread)
  private
    fResourceName: string;
    fResourceType: string;
    fFileName: string;
    fResource: TStream;
    fFile: TStream;
    fProgress: Integer;
    fProgressCount: Integer;
    fResourceSize: Integer;
    fOnProgress: TExtractResourceEvent;
  protected
    procedure CallOnProgress;
    procedure Initialize;
    procedure Execute; override;
  public
    constructor Create(const resourceName, resourceType, fileName: string);
    destructor Destroy; override;
    property OnProgress: TExtractResourceEvent read fOnProgress write fOnProgress;
  end;{ TExtractResourceThread }implementationuses
  Unit1 ;
constructor TExtractResourceThread.Create(const resourceName, resourceType,
  fileName: string);
begin
  inherited Create(True);
  fResourceName := resourceName;
  fResourceType := resourceType;
  fFileName := fileName;
end;destructor TExtractResourceThread.Destroy;
begin
  fResource.Free;
  fFile.Free;
  inherited Destroy;
end;procedure TExtractResourceThread.CallOnProgress;
begin
  if Assigned(fOnProgress) then
  begin
    fOnProgress(Self, fProgress,fProgressCount);
  end;
end;procedure TExtractResourceThread.Initialize;
begin
  fResource := TResourceStream.Create(HInstance, fResourceName, PChar(fResourceType));
  fFile := TFileStream.Create(fFileName, fmOpenWrite or fmShareExclusive);
  fResourceSize := fResource.Size;
end;procedure TExtractResourceThread.Execute;
const
  bufferSize = 1024 * 32;  // 32 KB
var
  bytesLeft: Integer;
  bytesRead: Integer;
begin
  try
    Initialize;
    bytesLeft := fResourceSize;
    fProgressCount:= fResourceSize div bufferSize;
    if (fResourceSize mod bufferSize)>0 then
       fProgressCount:=fProgressCount+1;
    while not Terminated and (bytesLeft > 0) do
    begin
      bytesLeft := bytesLeft - bytesRead;
      if bytesLeft=0 then exit;
      if bytesLeft < bytesRead then
        begin
          bytesRead := fFile.CopyFrom(fResource, bytesLeft);
          bytesLeft:=bytesLeft-bytesLeft;        end else
      bytesRead := fFile.CopyFrom(fResource, bufferSize);
      fProgress:=fProgress+1;
      Synchronize(CallOnProgress);
    end;
  except
    { TODO: Handle exception }
  end;
end;
end.
我会了...  但是 还有一个问题 每次释放文件 都要先建立一个0 K的文件 然后才能释放
还有如果我需要连续运行2次
ExtractResource('a','a','a2.rar');
ExtractResource('a','a','a2.rar');
我想顺序释放 一个释放完毕后 再释放另一个 如果用事件的话 进度条貌似同时释放2个文件 一前一退

Answer 10

constructor TExtractResourceThread.Create(const resourceName, resourceType,
  fileName: string);
begin
  inherited Create(True);
  fResourceName := resourceName;
  fResourceType := resourceType;
  fFileName := fileName;
  CloseHandle(FileCreate(fFileName));//再次改进 可以创建个文件了
end;
一个释放完毕后   再释放另一个 不知道怎么写

Answer 11

ExtractResource('a','a','a2.rar');
ExtractResource('a','a','a2.rar'); 这样写会同时创建两个线程，“同时”运行，而你要的是顺序执行。方法有很多，比如修改ExtractResource：//...
fThread.Resume;
while not fThread.Terminated
begin
  Application.ProcessMessages;
end;你可以根据自己的需求重写