Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Освободить из основной программы класс объявленный в коде FastScript / 5 сообщений из 5, страница 1 из 1
31.03.2021, 14:51
    #40058526
vdix
vdix
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Освободить из основной программы класс объявленный в коде FastScript
Имплементировал в серверном приложение FastScript, одна из функций должна возвращать структуру, но в виду того, что record не поддерживается фастскриптом, приходится создавать класс. Будь это клиентское приложение, особой проблемы не возникло бы, но на сервере обнаружилась неприятная ситуация: утечка памяти. Класс, созданный в коде FastScript, не освобождается, потому что является результатом функции фастскрипта, а передаётся он в код основной программы сервера.

Код в фастскрипте выглядит примерно так:
Код: pascal
1.
2.
3.
4.
5.
6.
function OnCheckRequest(ParamIn: variant): TMyRequestResponse;
begin
  Result := TMyRequestResponse.Create;
  Result.ParamOut1 := 'something';
  Result.ParamOut2 := True;
end;


Что я попытался реализовать в коде самого серверного приложения:
Код: pascal
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.
/// вызываю функцию фастскрипта и получаю результат в Х виде класса TMyRequestResponse
X := TMyRequestResponse(IntegerAScript.CallFunction1(fsScript, 'OnCheckRequest', ParamsVA)));
try
/// обработка результата всякое
/// ...

/// попытался найти и освободить инициализированную переменную класса TMyRequestResponse, но безуспешно:
{
    for I := 0 to Pred(fsScript.Count) do
    begin
      V := fsScript.Items[I];
      if V is TfsClassVariable then
        if TfsClassVariable(V).ClassRef.ClassName = 'TMyRequestResponse' then
        begin
          //if Integer(TfsClassVariable(V).ClassRef) = Integer(X) then // это никогда не происходит, видимо, в код Делфы передаётся копия класса, а не референс
          begin
            TfsClassVariable(V).Free;
            fsScript.Remove(V); // это сделать можно, но чуть попозже получим ошибку List index out of bounds. если не освобождать переменную строчкой выше - результат тот же
          end;
        end;
    end;
}
/// освобождаю локальную переменную, но утечку памяти это не исправляет
finally
  FreeAndNil(X);
end;


Если кто может предложить правильный вариант или альтернативное решение - буду весьма благодарен.
З.Ы. Возвращать результат через глобальную переменную/объект фастскрипта - не вариант, сервер работает в асинхронном режиме.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.03.2021, 15:58
    #40058582
DimaBr
DimaBr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Освободить из основной программы класс объявленный в коде FastScript
Тестовый пример, который проходит (у меня) без утечек
 
Код: pascal
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.
type
TMyObject = class(TComponent)
  private
    fParam: variant;
    procedure DoEvent;
  published
    property Param: Variant read fParam write fParam;
end;

TFunctions = class(TfsRTTIModule)
  constructor Create(AScript: TfsScript); override;
end;

{ TFunctions }

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited;
  AScript.AddClass(TMyObject,'TComponent')
end;

procedure TForm1.Button1Click(Sender: TObject);
var X: TMyObject;
    ParamsVA: Variant;
begin
  ParamsVA := VarArrayCreate([0,0],varVariant);
  ParamsVA[0] := 'Test';
  fsScript1.Lines.Clear;
  fsScript1.Lines.Add('function OnCheckRequest(ParamIn: variant): TMyObject;');
  fsScript1.Lines.Add('begin');
  fsScript1.Lines.Add('  Result := TMyObject.Create(nil);');
  fsScript1.Lines.Add('  Result.Param := ParamIn;');
  fsScript1.Lines.Add('end;');
  fsScript1.Lines.Add('begin');
  fsScript1.Lines.Add('end.');
  fsScript1.AddRTTI;
  fsScript1.Compile;
  X := TMyObject(integer(fsScript1.CallFunction1('OnCheckRequest', ParamsVA)));
  try
    X.DoEvent();
  finally
    X.Free;
  end;
end;

{ TMyObject }

procedure TMyObject.DoEvent;
begin
  ShowMessage(Param);
end;

initialization
  fsRTTIModules.Add(TFunctions);

finalization
  fsRTTIModules.Remove(TFunctions);

end.

...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.03.2021, 16:01
    #40058587
DimaBr
DimaBr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Освободить из основной программы класс объявленный в коде FastScript
и появляется утечка, если добавить (и не уничтожить) ещё один объект.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.03.2021, 16:33
    #40058602
L_argo
L_argo
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Освободить из основной программы класс объявленный в коде FastScript
Создайте процедуру для освобождения ресурса. Зарегистрируйте ее в ФР. Вызывайте ее в конце скрипта.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.03.2021, 17:15
    #40058622
Fr0sT-Brutal
Fr0sT-Brutal
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Освободить из основной программы класс объявленный в коде FastScript
За приведение к указателю через каст к integer еще не били кактусом по рукам?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Освободить из основной программы класс объявленный в коде FastScript / 5 сообщений из 5, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 450ms
Закрыть
start [/forum/topic.php?fid=58&mobile=1&tid=2037451]:
 0ms
get settings:
 11ms
get forum list:
 16ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 141ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 53ms
get tp. blocked users:
 1ms
others: 207ms
total:  450ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]