Out of system resources

@IPV_ · Регистрация: 13.07.2019

Студворк — интернет-сервис помощи студентам

Программа загружает модели и накладывает текстуры, которые берёт из файла .utx
После нескольких загрузок выходит сообщение Out of system resources
Я так понимаю это утечка памяти

initialization
ReportMemoryLeaksOnShutdown := True; //показал что виноваты TBitmap

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
procedure TMainForm1.RenderProc(rPath:String; ModelName:String);
var i, ii, a, m, s:   Integer;
    str, t, n, descr: String;
    fale:             TSearchRec;
    package:          TUTPackage;
begin
 
//загрузка текстур в GLMaterialLibrary1:
  ii:=0;
  Register2DClasses;
  //texturList.Clear;//все текстуры.
  GLMaterialLibrary1.Materials.Clear;
  a:=FindFirst(rPath + '*.u*', faAnyFile-faDirectory, fale);
  while a=0 do begin
    package:=TUTPackage.create;
    try
      package.initialize(rPath + fale.name);
      for i:=0 to package.ExportedCount-1 do begin
        //если текстура тогда читаем:
        if GetUTObjectClass(package.Exported[i].UTClassName).InheritsFrom(TUTObjectClassTexture) then begin
          package.Exported[i].UTObject.ReadObject;
          str:=LowerCase(package.Exported[i].UTObjectName) + '.BMP';
          //texturList.Add(str);//заполняем список скинов.
 
          try  //заполняем текстурами GLMaterialLibrary1.
            GLMaterialLibrary1.Materials.Add;
            GLMaterialLibrary1.Materials[ii].Name:=str;
            GLMaterialLibrary1.Materials[ii].Material.Texture.Disabled:=False;
            GLMaterialLibrary1.Materials[ii].Material.Texture.Image.Assign(
              TUTObjectClassTexture(package.Exported[i].UTObject).GoodMipMap[0].AsBitmap); //здесь ругается!
            package.Exported[i].UTObject.ReleaseObject;
          except
            ShowMessage('Textures were not loaded into the library!');
          end;
          Inc(ii);
        end;
      end;
    except
      ShowMessage('UTPackege not initialize!');
    end;
 
    package.free;
    a:=FindNext(fale);
  end;
  FindClose(fale);

Может кто-нибудь сталкивался с похожей проблемой. Можно ли написать процедуру которая очистит ненужные TBitmap.

@snake32 · 28.09.2020, 17:50

TUTObjectClassTexture(package.Exported[i].UTObject).GoodMipMap[0].AsBitmap
Случайно не создаёт объект TBitMap?
Может надо очищать после Assign?

Delphi
1
2
3
bmp := TUTObjectClassTexture(package.Exported[i].UTObject).GoodMipMap[0].AsBitmap;
GLMaterialLibrary1.Materials[ii].Material.Texture.Image.Assign( bmp );
FreeAndNIL(bmp);

@IPV_ · 28.09.2020, 18:44 **[ТС]**

Я так понимаю создаёт:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function TUTBitmap.AsBitmap: TBitmap;
var pe:array[0..255] of PALETTEENTRY;y:integer;
begin
     result:=TBitmap.create;
     case FBPP of
       32:result.pixelformat:=pf32bit;
       24:result.pixelformat:=pf24bit;
       8:begin
         result.pixelformat:=pf8bit;
         if FPalette<>0 then
           begin
             GetPaletteEntries (FPalette,0,256,pe);
             SetPaletteEntries (result.palette,0,256,pe);
             result.PaletteModified:=true;
           end;
         end;
     end;
     result.width:=FWidth;
     result.Height:=FHeight;
     for y:=0 to FHeight-1 do
       move (scanline[y]^,result.scanline[y]^,FWidth*(FBPP div 8));
end;

как тогда очистить этот битмап, попробовал так, всё равно вылет:

Delphi
1
2
3
4
5
6
7
8
9
10
          bmp:=TBitmap.Create;
          bmp:= TUTObjectClassTexture(package.Exported[i].UTObject).GoodMipMap[0].AsBitmap;
 
            GLMaterialLibrary1.Materials.Add;
            GLMaterialLibrary1.Materials[ii].Name:=str;
            GLMaterialLibrary1.Materials[ii].Material.Texture.Disabled:=False;
            GLMaterialLibrary1.Materials[ii].Material.Texture.Image.Assign(bmp);
            package.Exported[i].UTObject.ReleaseObject;
          Inc(ii);
          FreeAndNIL(bmp);

DenNik · 29.09.2020, 14:48

Сообщение от IPV_

bmp:=TBitmap.Create;

ты создаешь ОДИН битмап

Сообщение от IPV_

bmp:= TUTObjectClassTexture(package.Exported[i].UTObject).GoodMipMap[0].AsBitmap;

затем ты при помощи AsBitmap создаешь ВТОРОЙ битмап, заменяя им ссылку на первый.

Сообщение от IPV_

FreeAndNIL(bmp);

ты уничтожаешь ВТОРОЙ битмап. Вопрос: куда делся первый?

Добавлено через 36 секунд
УБРАТЬ!

Сообщение от IPV_

bmp:=TBitmap.Create;

@IPV_ · 29.09.2020, 17:57 **[ТС]**

Стало лучше, но всё равно появляются лишние битмапы, изначально я вообще так делал:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
package.initialize(rPath + fale.name);
      for i:=0 to package.ExportedCount-1 do begin
        if GetUTObjectClass(package.Exported[i].UTClassName).InheritsFrom(TUTObjectClassTexture) then begin
          package.Exported[i].UTObject.ReadObject;
            GLMaterialLibrary1.Materials.Add;
            GLMaterialLibrary1.Materials[ii].Name:=str;
            GLMaterialLibrary1.Materials[ii].Material.Texture.Disabled:=False;
            GLMaterialLibrary1.Materials[ii].Material.Texture.Image.Assign( 
               TUTObjectClassTexture(package.Exported[i].UTObject).GoodMipMap[0].AsBitmap);
            package.Exported[i].UTObject.ReleaseObject;
          Inc(ii);
        end;
      end;

то есть получается утечка где-то в Assign ?

@IPV_ · 13.10.2020, 17:05 **[ТС]**

Стало понятно, что "Out of system resources" вызывает библиотека ut_package, видимо неправильно очищает ресурсы после её применения.

Поэтому решил для обработки файлов запускать её в консольном приложении, чтобы после закрытия консоли ресурсы освободились.

Вывод имён внутренних файлов получается правильно, то есть всё работает, но мне нужны ещё изображения из файлов. Вопрос как мне передать битмапы из консольного приложения в главное, это возможно?

Процедура получения из консоли:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
function TMainForm1.GetDosOutput(const CommandLine, Parametrs:string): string;
const
   ReadBuffer = 2400;
var
  Security        : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start           : TStartUpInfo;
  ProcessInfo     : TProcessInformation;
  Buffer          : Pansichar;
  BytesRead       : DWord;
  Apprunning      : DWord;
  WasOK           : Boolean;
  Line               : String;
begin
  Screen.Cursor:=CrHourGlass;
 
  With Security do
  begin
    nlength              := SizeOf(TSecurityAttributes);
    binherithandle       := true;
    lpsecuritydescriptor := nil;
  end;
 
  if Createpipe (ReadPipe, WritePipe, @Security, 0) then begin
      Buffer  := AllocMem(ReadBuffer + 1);
      FillChar(Start,Sizeof(Start),#0);
 
      start.cb          := SizeOf(start);
      start.hStdOutput  := WritePipe;
      start.hStdInput   := ReadPipe;
      start.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
      start.wShowWindow := SW_HIDE;
 
      if CreateProcess(nil,
          PChar(CommandLine + ' ' + Parametrs),
          nil,//@Security,
          nil,//@Security,
          true,
          NORMAL_PRIORITY_CLASS,
          nil,
          nil,
          start,
          ProcessInfo)
    then begin
      CloseHandle(WritePipe);
      Apprunning := WaitForSingleObject (ProcessInfo.hProcess,100);
      try
        repeat
          WasOK:=ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);
          Buffer[BytesRead]:= #0;
          OemToAnsi(Buffer, Buffer);
          Line := Line + String(Buffer);   //получение имён текстур
 
          //Application.ProcessMessages;
        until (not WasOK) or ( BytesRead = 0 );
      finally
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread);
      end;
    end;
    result:=Line;
    FreeMem(Buffer);
    CloseHandle(ReadPipe);
  end;
  Screen.Cursor:=CrDefault;
end;

Запуск процедуры:

Delphi
1
  Memo1.Text:=GetDosOutput('"' + AppPath + 'UTUnpacker.exe"', '"' + rPath + '"');

Консольное приложение:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
uses
  System.SysUtils,
  System.Classes, 
  Vcl.Graphics,
  ut_packages;
 
var
    i, j, a:                            Integer;
    rPath, name, str:            String;
    find:                              TSearchRec;
    package:                        TUTPackage;
    bmp:                             TBitmap;
begin
  Register2DClasses;
  fileList:=TStringList.Create;
  rPath:=ParamStr(1);
 
  a:=FindFirst(rPath + '*.u*', faAnyFile-faDirectory, find);
  while a=0 do begin
    fileList.Add(find.Name);
    a:=FindNext(find);
  end;
  FindClose(find);
 
  for j:=0 to fileList.Count-1 do begin
    package:=TUTPackage.create;
    try
      package.initialize(rPath + fileList.Strings[j]);
      for i:=0 to package.ExportedCount-1 do begin
        if GetUTObjectClass(package.Exported[i].UTClassName).InheritsFrom(TUTObjectClassTexture) then begin
          package.Exported[i].UTObject.ReadObject;
          str:=LowerCase(package.Exported[i].UTObjectName);// имя текстуры
          name:=LowerCase(ChangeFileExt(fileList.Strings[j], '')) + '.' + str;// имя файла.имя тектсуры
          WriteLn(name);
          package.Exported[i].UTObject.ReleaseObject;
        end;
      end;
      package.Free;
    except
      WriteLn('Not initialize package!');
    end;
  end;
end.

Новые блоги и статьи Все статьи Все блоги /
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025	Расскажи мне о Мире, бродяга kumehtar 12.11.2025 — Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .