Загрузка многих изображений и нехватка памяти при использовании NativeJpg

Question

Я создаю Picture Loader, который имеет две основные возможности: 1) Загрузка изображений в потоке и 2) Сохранение кэшированных изображений. Поскольку я реализовал NativeJpg 1,32 , я заметил, что TsdJpgGraphic использует примерно в 3 раза больше памяти, чем TJpegImage. Я не беспокоюсь о том, чтобы решить, сколько он резервирует, а скорее чтобы убедиться, что мои потоки правильно управляют памятью.

Технические характеристики

TPictureLoader является основным компонентом этой системы. Каждый раз, когда требуется загрузить изображение, создается поток, чтобы получить это изображение. Когда изображение доступно, запускается событие, предоставляющее это изображение в виде TBitmap. Компонент имеет очередь и ограничение на количество потоков, которые могут быть активны одновременно (через свойство ActiveThreads). Каждая запрошенная картинка немедленно создает поток - но поток не выполняется до тех пор, пока это не будет необходимо. ActiveThreads определяет, сколько из этих потоков может быть запущено одновременно (в противном случае, сколько картинок может быть загружено за один раз).

Задача

TJpegImage всегда загружает картинки без ошибок. Но, используя глобальные условия, я включаю использование NativeJpg (TsdJpgGraphic) и у меня возникают проблемы с памятью. Сообщение об ошибке Not enough storage is available to process this command. Эта ошибка возникает только внутренне (при отладке) и фактически не отображает никаких ошибок, когда приложение работает автономно. В моем коде он не идет ни к одной точке останова, а к блоку NativeJpg в строке 460: 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 поток на изображение. Предполагая, что у вас есть сотни или тысячи потоков, этот дизайн не может масштабироваться.

Для начала существуют значительные накладные расходы, связанные с созданием, запуском и завершением потоков. Вы не хотите снова и снова оплачивать эти накладные расходы.

Но более проблематичным является расход ресурсов для потока. Каждый поток имеет свое собственное пространство стека. Адресное пространство (1 МБ) для этого стека резервируется (но не фиксируется) при создании потока. При достаточном количестве потоков вы исчерпаете свое адресное пространство, даже если фактический уровень выделения памяти все еще низок.

Я настоятельно призываю вас отказаться от этого кода и начать заново. Вы должны использовать одну из установленных библиотек потоков. Потоки трудно сделать хорошо, и вам нужно много знаний и опыта, чтобы сделать это хорошо. Используйте OmniThreadLibrary или AsyncCall .

То, что вы ищете, это простой пул потоков с небольшим количеством потоков. Затем вы должны просто передать задачи (например, имена файлов изображений) в пул потоков и позволить ему управлять обработкой этих задач.