使用 NativeJpg 时加载许多图像并耗尽内存

Question

我正在构建一个具有两个主要功能的图片加载器：1）在线程中加载图片，以及 2）保存缓存的图像。自从我实现了NativeJpg 1.32，我注意到TsdJpgGraphic 使用的内存大约是TJpegImage 的3 倍。我不关心解决它保留多少，而是确保我的线程正确管理内存。

规格

TPictureLoader 是该系统的主要组件。每次需要加载图片时，都会产生一个线程来获取该图像。当图像可用时，会触发一个事件，以TBitmap 的形式提供此图像。组件有一个队列，并且一次可以激活多少个线程（通过ActiveThreads 属性）。请求的每张图片都会立即创建一个线程 - 但直到必要时才会执行该线程。 ActiveThreads 决定一次可以运行多少个这些线程（否则一次可以加载多少张图片）。

问题

TJpegImage 始终可以正常加载图片而没有错误。但是，使用全局条件，我启用了 NativeJpg (TsdJpgGraphic) 并且我有内存问题。错误消息是Not enough storage is available to process this command。此错误仅在内部（在调试中）引发，并且在应用程序独立运行时实际上不会显示任何错误。它不会在我的代码中进入任何断点，而是在第 460 行的 NativeJpg 单元中：FBitmap := SetBitmapFromIterator(AIterator);

使用标准的TJpegImage，我从来没有遇到过内存问题。无论是加载一次图片然后将其从内存中清除，还是加载一次图片并将其保存在内存中的某个位置，这两种方式似乎都没有区别。 奇怪的是，使用TJpegImage 时我的记忆力几乎达到极限，但从未引发任何错误，但在使用TsdJpgGraphic 时，内存几乎没有微动，它已经开始吐出这些错误。

在分析内存使用情况时，我看到了这个......

问题

在任何情况下如何避免此错误？该系统将在许多环境中使用，其中许多将是非常缓慢的计算机。特别是因为我在这里使用多线程，内存使用很关键。

源代码

unit PictureLoader;

interface

{$DEFINE USE_JPG}
  {$DEFINE USE_NATIVEJPG} //<---
{$DEFINE USE_PNG} 
{ $DEFINE USE_TPICTURE} 

uses
  Winapi.Windows, System.Classes, System.SysUtils, System.StrUtils,
  Vcl.Graphics, Vcl.Controls, Vcl.ExtCtrls, SHFolder, Math
{$IFDEF USE_PNG}
  , PngImage
{$ENDIF USE_PNG}
{$IFDEF USE_JPG}
  , Vcl.Imaging.Jpeg
  {$IFDEF USE_NATIVEJPG}
  , NativeJpg
  {$ENDIF USE_NATIVEJPG}
{$ENDIF USE_JPG}   
  ;

const
  ERR_BASE =   -100;
  ERR_NOERROR =     ERR_BASE;
  ERR_UNKNOWN =     ERR_BASE - 1;
  ERR_NOFILE =      ERR_BASE - 2;
  ERR_INVALIDFILE = ERR_BASE - 3;
  ERR_UNSUPPORTED = ERR_BASE - 4;
  ERR_THREAD =      ERR_BASE - 5;

  DEF_ACTIVETHREADS =   8;
  DEF_CACHESIZE =       500;

  CACHE_DT_FORMAT = 'mm/dd/yy hh:nn:ss.zzz';

type
  TPictureLoader = class;
  TPictureLoaderThread = class;

{$IFDEF USE_JPG}
  {$IFDEF USE_NATIVEJPG}
  TJpegImage = class(TsdJpegGraphic);
  {$ENDIF USE_NATIVEJPG}
{$ENDIF USE_JPG}

  TImageType = (itUnknown, itBmp
{$IFDEF USE_JPG}
    , itJpeg  
{$ENDIF USE_JPG} 
{$IFDEF USE_PNG}
    , itPng   
{$ENDIF USE_PNG}    
  );

  TActiveThreadRange = 1..99;
  TThreadMsg = (tmStart, tmReady, tmError, tmTerm);
  TCacheType = (ctNone, ctThumbs, ctOriginals, ctBoth);
  TCacheEventType = (ceError, ceGotOriginal, ceGotCached, ceGotThumb,
    ceSaveCache, ceSaveThumb);
  TCacheEvents = set of TCacheEventType;
  TImgSrc = (isOriginal, isThumbnail);
  TLoadOpt = (loNormal, loOriginal, loThumb, loCacheThumb);
  TLoadOpts = set of TLoadOpt;
  TPictureEvent = 
    procedure(Sender: TObject; Thread: TPictureLoaderThread) of object;  
  TPictureErrorEvent = 
    procedure(Sender: TObject; Thread: TPictureLoaderThread;
    var ErrCode: Integer; var ErrMsg: String) of object;                   
  TCacheEvent = 
    procedure(Sender: TObject; Thread: TPictureLoaderThread; 
    const Events: TCacheEvents) of object;

  TPictureLoader = class(TComponent)
  private
    FTimer: TTimer;
    FThreads: TList;
    FBusy: Bool;
    FLastID: Integer;
    FCacheSize: Integer;
    FCacheType: TCacheType;
    FCacheDir: String;
    FActiveThreads: TActiveThreadRange;
    FOnPictureError: TPictureErrorEvent;
    FOnPictureReady: TPictureEvent;
    FOnTerm: TPictureEvent;
    FOnStart: TPictureEvent;
    function NewID: Integer;
    procedure TimerExec(Sender: TObject);
    function NewThread(const Filename: String; 
      const Options: TLoadOpts): TPictureLoaderThread;
    procedure ThreadStart(Sender: TObject; Thread: TPictureLoaderThread);
    procedure ThreadReady(Sender: TObject; Thread: TPictureLoaderThread);
    procedure ThreadTerm(Sender: TObject; Thread: TPictureLoaderThread);
    procedure ThreadError(Sender: TObject; Thread: TPictureLoaderThread;
      var ErrCode: Integer; var ErrMsg: String);    
    procedure DoEvent(const Msg: TThreadMsg; var Thread: TPictureLoaderThread);
    procedure DoError(var Code: Integer; var Msg: String;
      var Thread: TPictureLoaderThread);    
    procedure SetLastID(const Value: Integer);
    function GetThread(Index: Integer): TPictureLoaderThread;
    procedure SetCacheDir(const Value: String);
    procedure SetCacheSize(const Value: Integer);
    procedure SetActiveThreads(const Value: TActiveThreadRange);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadImage(const Filename: String; const Options: TLoadOpts);
    property Threads[Index: Integer]: TPictureLoaderThread read GetThread;   
    function OriginalInCache(const Filename: String): Bool;       
    function ThumbnailInCache(const Filename: String): Bool;
  published
    property LastID: Integer read FLastID write SetLastID;
    property CacheType: TCacheType read FCacheType write FCacheType;
    property CacheDir: String read FCacheDir write SetCacheDir;
    property CacheSize: Integer read FCacheSize write SetCacheSize;
    property ActiveThreads: TActiveThreadRange
      read FActiveThreads write SetActiveThreads;    
    property OnStart: TPictureEvent read FOnStart write FOnStart;
    property OnTerm: TPictureEvent read FOnTerm write FOnTerm;
    property OnPictureReady: TPictureEvent
      read FOnPictureReady write FOnPictureReady;
    property OnPictureError: TPictureErrorEvent
      read FOnPictureError write FOnPictureError;
  end;

  TPictureLoaderThread = class(TThread)
  private
    FHasTriggered: Bool;
    FPictureReady: Bool;
    FPicture: TBitmap;
    FFilename: String;
    FID: Integer;
    FErrCode: Integer;
    FErrMsg: String;
    FMsg: TThreadMsg;   
    FActive: Bool;
    FTerminated: Bool;
    FCacheDir: String;
    FOnPictureError: TPictureErrorEvent;
    FOnPictureReady: TPictureEvent;
    FOnTerm: TPictureEvent;
    FOnStart: TPictureEvent;
    FOptions: TLoadOpts;
    FBusy: Bool;
    function GetAsBitmap: TBitmap;
    procedure CleanupThread(Sender: TObject);
    procedure SYNC_ExecMsg;
    procedure ExecuteMessage(const Msg: TThreadMsg);
    function LoadImage(const Filename: String; var Bitmap: TBitmap): Bool;
    procedure SaveImage(const Dst: TImgSrc);
    function MakeThumb(var B: TBitmap): Bool;
  protected
    procedure Execute; override;
  public
    constructor Create(const AID: Integer; const AFilename, ACacheDir: String;
      const Options: TLoadOpts);
    property AsBitmap: TBitmap read GetAsBitmap;
    property ID: Integer read FID;
    property Filename: String read FFilename;
    property CacheDir: String read FCacheDir;
    property Active: Bool read FActive;
    property Options: TLoadOpts read FOptions;
    property Busy: Bool read FBusy;
  published
    property OnStart: TPictureEvent read FOnStart write FOnStart;
    property OnTerm: TPictureEvent read FOnTerm write FOnTerm;
    property OnPictureReady: TPictureEvent
      read FOnPictureReady write FOnPictureReady;
    property OnPictureError: TPictureErrorEvent
      read FOnPictureError write FOnPictureError;
  end;

function ImageType(const AFilename: String): TImageType;
function PathToFilename(const S: String; const ImgSrc: TImgSrc): String;
function FilenameToPath(const S: String): String;

implementation

//Cache Translation - Original Path to Local Filename
function PathToFilename(const S: String; const ImgSrc: TImgSrc): String;
begin
  Result:= LowerCase(S);
  if ImgSrc = isThumbnail then Result:= '_THM_' + Result;
  Result:= StringReplace(Result, '\', '_BSL_', [rfReplaceAll]);
  Result:= StringReplace(Result, '/', '_FSL_', [rfReplaceAll]);
  Result:= StringReplace(Result, ':', '_CLN_', [rfReplaceAll]);
  Result:= StringReplace(Result, '.', '_DOT_', [rfReplaceAll]);
  Result:= StringReplace(Result, '-', '_DAS_', [rfReplaceAll]);
  Result:= Result + '.jpg';
end;

//Cache Translation - Local Filename to Original Path
function FilenameToPath(const S: String): String;
begin
  Result:= LowerCase(S);
  Result:= StringReplace(Result, '_THM_', '',  [rfReplaceAll]);
  Result:= StringReplace(Result, '.jpg',  '',  [rfReplaceAll]);
  Result:= StringReplace(Result, '_BSL_', '\', [rfReplaceAll]);
  Result:= StringReplace(Result, '_FSL_', '/', [rfReplaceAll]);
  Result:= StringReplace(Result, '_CLN_', ':', [rfReplaceAll]);
  Result:= StringReplace(Result, '_DOT_', '.', [rfReplaceAll]);
  Result:= StringReplace(Result, '_DAS_', '-', [rfReplaceAll]);
end;

function ImageType(const AFilename: String): TImageType;
var
  S: String;
begin
  Result:= itUnknown;
  S:= LowerCase(StringReplace(ExtractFileExt(AFilename), '.', '', [rfReplaceAll]));
  if (S = 'bmp') then begin
    Result:= itBmp;
  end else
{$IFDEF USE_JPG}
  if (S = 'jpg') or (S = 'jpeg') then begin
    Result:= itJpeg;
  end else
{$ENDIF USE_JPG}
{$IFDEF USE_PNG}
  if (S = 'png') then begin
    Result:= itPng;
  end else
{$ENDIF USE_PNG}
  begin
    Result:= itUnknown;
  end;
end;

{ TPictureLoader }

constructor TPictureLoaderThread.Create(const AID: Integer;
  const AFilename, ACacheDir: String; const Options: TLoadOpts);
begin
  inherited Create(True);
  FreeOnTerminate:= True;
  OnTerminate:= CleanupThread;
  FPicture:= TBitmap.Create;
  FHasTriggered:= False;
  FActive:= False;
  FID:= AID;
  FFilename:= AFilename;
  FCacheDir:= ACacheDir;
  FOptions:= Options;
  FTerminated:= False;
  FBusy:= False;
end;

procedure TPictureLoaderThread.CleanupThread(Sender: TObject);
begin
  FPicture.Free;
end;

function TPictureLoaderThread.MakeThumb(var B: TBitmap): Bool;
begin
  Result:= False;
  try

    Result:= True;
  except
    on e: exception do begin
      Result:= False;
    end;
  end;
end;

procedure TPictureLoaderThread.SaveImage(const Dst: TImgSrc);
var
  B: TBitmap;
  J: Vcl.Imaging.Jpeg.TJPEGImage;
begin
  J:= Vcl.Imaging.Jpeg.TJPEGImage.Create;
  try
    case Dst of
      isOriginal: begin
        J.Assign(FPicture);
        J.SaveToFile(PathToFilename(FFilename, isOriginal));
      end;
      isThumbnail: begin
        B:= TBitmap.Create;
        try
          B.Assign(FPicture);
          if MakeThumb(B) then begin          
            J.Assign(B);
            J.SaveToFile(PathToFilename(FFilename, isThumbnail));
          end;
        finally
          B.Free;
        end;
      end;
    end;
  finally
    J.Free;
  end;
end;

procedure TPictureLoaderThread.Execute;
var
  E: String;
begin                             
  try
    FActive:= True;
    FBusy:= True;
    FErrCode:= 0;
    FErrMsg:= '';
    ExecuteMessage(tmStart);
    if FileExists(FFilename) then begin
      if loNormal in FOptions then begin
        if FileExists(FCacheDir + PathToFilename(FFilename, isOriginal)) then begin
          if LoadImage(FCacheDir + PathToFilename(FFilename, isOriginal), FPicture) then
            ExecuteMessage(tmReady);
        end else begin
          if LoadImage(FFilename, FPicture) then
            ExecuteMessage(tmReady);
        end;
      end;
      if loOriginal in FOptions then begin
        if LoadImage(FFilename, FPicture) then
          ExecuteMessage(tmReady);
      end;
      if loThumb in FOptions then begin
        if FileExists(FCacheDir + PathToFilename(FFilename, isThumbnail)) then begin
          if LoadImage(FCacheDir + PathToFilename(FFilename, isThumbnail), FPicture) then
            ExecuteMessage(tmReady);
        end else begin
          if FileExists(FCacheDir + PathToFilename(FFilename, isOriginal)) then begin
            if LoadImage(FCacheDir + PathToFilename(FFilename, isOriginal), FPicture) then
              ExecuteMessage(tmReady);
          end else begin
            if LoadImage(FFilename, FPicture) then
              ExecuteMessage(tmReady);
          end;
        end;
      end;
    end else begin
      FErrCode:= ERR_NOFILE;
      FErrMsg:= 'Original image file not found "'+FFilename+'"';
      ExecuteMessage(tmError);
    end;
  except
    on E: Exception do begin
      FErrCode:= GetLastError;
      FErrMsg:= E.Message;
      ExecuteMessage(tmError);
    end;
  end;   
  while not FHasTriggered do
    Sleep(10);
  ExecuteMessage(tmTerm);
  FBusy:= False;
  FTerminated:= True;
  Terminate;
end;

procedure TPictureLoaderThread.ExecuteMessage(const Msg: TThreadMsg);
begin
  FMsg:= Msg;
  Synchronize(SYNC_ExecMsg);
  FHasTriggered:= True;
end;

function TPictureLoaderThread.GetAsBitmap: TBitmap;
begin
  Result:= FPicture;
end;

procedure TPictureLoaderThread.SYNC_ExecMsg;
begin
  case FMsg of
    tmStart: begin
      if assigned(FOnStart) then FOnStart(Self, Self);
    end;
    tmReady: begin
      if assigned(FOnPictureReady) then FOnPictureReady(Self, Self);
    end;
    tmTerm: begin
      if assigned(FOnTerm) then FOnTerm(Self, Self);
    end;
    tmError: begin
      if assigned(FOnPictureError) then begin
        FOnPictureError(Self, Self, FErrCode, FErrMsg);
        if FErrCode <> 0 then begin
          raise Exception.Create(FErrMsg+' Code '+IntToStr(FErrCode));
        end;
        FErrCode:= 0;
        FErrMsg:= '';
      end;
    end;
  end;
end;

function TPictureLoaderThread.LoadImage(const Filename: String;
  var Bitmap: TBitmap): Bool;
var
  T: TImageType;
//NOTE: If USE_JPG + USE_NATIVEJPG are defined then TJpegImage is actually TsdJpgGraphic
{$IFDEF USE_JPG}
  J: TJpegImage;
{$ENDIF USE_JPG}
{$IFDEF USE_PNG}
  P: TPngObject;
{$ENDIF USE_PNG} 
begin
  Result:= False;
  Bitmap.Assign(nil);  
  if FileExists(Filename) then begin
    if Assigned(Bitmap) then begin
      T:= ImageType(ExtractFileExt(Filename));
      case T of
        itBmp: begin
          Bitmap.LoadFromFile(Filename); 
          if FTerminated then Exit; 
          Result:= True;
        end;
{$IFDEF USE_JPG}
        itJpeg: begin
          J:= TJpegImage.Create;
          try
            J.LoadFromFile(Filename);
            if not FTerminated then begin          
              Bitmap.Assign(J);
              Result:= True;
            end;
          finally
            J.Free;
          end;
        end;
{$ENDIF USE_JPG}
{$IFDEF USE_PNG}
        itPng: begin
          P:= TPngObject.Create;
          try
            P.LoadFromFile(Filename);
            if not FTerminated then begin
              Bitmap.Assign(P);
              Result:= True;
            end;
          finally
            P.Free;
          end;
        end;
{$ENDIF USE_PNG}
      end;
    end;
  end;
end;

{ TPictureLoader }

constructor TPictureLoader.Create(AOwner: TComponent);
begin
  inherited;
  FThreads:= TList.Create;
  FTimer:= TTimer.Create(nil);
  FTimer.Interval:= 10;
  FTimer.OnTimer:= TimerExec;
  FTimer.Enabled:= True;
  FActiveThreads:= DEF_ACTIVETHREADS;
  FCacheDir:= '';
  FCacheSize:= DEF_CACHESIZE;
  FCacheType:= ctNone;
  FBusy:= False;
end;

destructor TPictureLoader.Destroy;
var
  X: Integer;
  T: TPictureLoaderThread;
begin
  FTimer.Enabled:= False;
  FTimer.Free;
  for X := 0 to FThreads.Count - 1 do begin
    T:= TPictureLoaderThread(FThreads[X]);
    if assigned(T) then begin
      T.Terminate;
    end;
  end;
  FThreads.Free;
  inherited;
end;

procedure TPictureLoader.DoError(var Code: Integer; var Msg: String;
  var Thread: TPictureLoaderThread);
begin
  if assigned(FOnPictureError) then begin
    FOnPictureError(Self, Thread, Code, Msg);
  end;
end;

procedure TPictureLoader.DoEvent(const Msg: TThreadMsg;
  var Thread: TPictureLoaderThread);
begin
  case Msg of
    tmStart: begin
      if assigned(FOnStart) then FOnStart(Self, Thread);
    end;
    tmReady: begin
      if assigned(FOnPictureReady) then FOnPictureReady(Self, Thread);
    end;
    tmTerm: begin
      if assigned(FOnTerm) then FOnTerm(Self, Thread);
    end;
  end;
end;

function TPictureLoader.GetThread(Index: Integer): TPictureLoaderThread;
begin
  if (Index >= 0) and (Index < FThreads.Count) then begin
    Result:= TPictureLoaderThread(FThreads[Index]);
  end else begin
    Result:= nil;
  end;
end;

function TPictureLoader.NewThread(const Filename: String; 
  const Options: TLoadOpts): TPictureLoaderThread;
begin
  Result:= TPictureLoaderThread.Create(NewID, Filename, FCacheDir, Options);
  Result.OnStart:= ThreadStart;
  Result.OnTerm:= ThreadTerm;
  Result.OnPictureReady:= ThreadReady;
  Result.OnPictureError:= ThreadError;
  FThreads.Add(Result);
end;

//  MASTER PROCEDURE TO LOAD IMAGES
procedure TPictureLoader.LoadImage(const Filename: String; 
  const Options: TLoadOpts);
var
  T: TPictureLoaderThread;         
begin        
  if FileExists(Filename) then begin  
    T:= NewThread(Filename, Options);
  end;
end;

function TPictureLoader.NewID: Integer;
begin
  //FIRST CHECK IF NEW ID EXISTS OR NOT
  Inc(FLastID);
  Result:= FLastID;
end;

procedure TPictureLoader.SetActiveThreads(const Value: TActiveThreadRange);
begin
  FActiveThreads := Value;
end;

procedure TPictureLoader.SetCacheDir(const Value: String);
begin
  FCacheDir := Value;
end;

procedure TPictureLoader.SetCacheSize(const Value: Integer);
begin
  FCacheSize := Value;
end;

procedure TPictureLoader.SetLastID(const Value: Integer);
begin
  //FIRST CHECK IF NEW ID EXISTS OR NOT
  FLastID := Value;
end;

procedure TPictureLoader.TimerExec(Sender: TObject);
var
  X: Integer;
  T: TPictureLoaderThread;
  C: Integer;
begin
  if not FBusy then begin
    FBusy:= True;
    try
      C:= 0;
      for X := 0 to FThreads.Count - 1 do begin
        T:= Threads[X];
        if Assigned(T) then begin
          if T.Active then begin
            if T.Busy then begin
              Inc(C);
            end;
          end else begin
            if not T.Terminated then begin    
              Inc(C); 
              T.Resume;
            end;
          end;
        end;
        if C >= FActiveThreads then Break;
      end;
    finally
      FBusy:= False;
    end;
  end;
end;

function TPictureLoader.OriginalInCache(const Filename: String): Bool;
begin
  Result:= FileExists(FCacheDir + PathToFilename(Filename, isOriginal));
end;

function TPictureLoader.ThumbnailInCache(const Filename: String): Bool;
begin
  Result:= FileExists(FCacheDir + PathToFilename(Filename, isThumbnail));
end;

procedure TPictureLoader.ThreadError(Sender: TObject;
  Thread: TPictureLoaderThread; var ErrCode: Integer; var ErrMsg: String);
begin
  DoError(ErrCode, ErrMsg, Thread);
end;

procedure TPictureLoader.ThreadReady(Sender: TObject;
  Thread: TPictureLoaderThread);
begin
  DoEvent(tmReady, Thread);
end;

procedure TPictureLoader.ThreadStart(Sender: TObject;
  Thread: TPictureLoaderThread);
begin
  DoEvent(tmStart, Thread);
end;

procedure TPictureLoader.ThreadTerm(Sender: TObject;
  Thread: TPictureLoaderThread);
begin
  FThreads.Delete(FThreads.IndexOf(Thread));
  DoEvent(tmTerm, Thread);
end;

end.

请原谅这个系统尚未完全正常运行。

组件工作正常，能够识别此问题。

Answer 1

我不确定这是否是您的问题，但您当前的代码存在巨大的设计缺陷。您正在为每个图像创建 1 个线程。假设您有数百或数千个线程，此设计无法扩展。

首先，与创建、启动和终止线程相关的开销很大。您不想一次又一次地支付这些开销。

但更成问题的是线程的资源开销。每个线程都有自己的私有堆栈空间。创建线程时，该堆栈的地址空间 (1MB) 被保留（但未提交）。有了足够多的线程，您将耗尽您的地址空间，即使您的实际内存提交级别仍然很低。

我强烈建议您放弃该代码并重新开始。您应该使用已建立的线程库之一。线程很难做好，你需要大量的知识和专业知识才能做好。使用OmniThreadLibrary 或AsyncCall。

您正在寻找的是一个具有少量线程的简单线程池。然后，您应该简单地将任务（即图像文件名）提供给线程池并让它管理这些任务的处理。