YuRockВ чем проблема? Напиши тест - кусочек твоей программы - после проверки выход. И из другой программы запусти этот тест 100000 раз. Можешь до ExitCode=1, чтоб тест прекратить в случае 1-й же ошибки.
Я делал простой тест. Правда запускал его вручную. Проблема то же проскакивала.
hvladTimer1 как-то связан с events ?
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.
procedure TDM.Timer1Timer(Sender: TObject);
Var
A: string;
AR: String;
LogFilePath: String;
begin
if FDADEventAlerter.Active then
A := 'FDADEventAlerter.Active = TRUE'
else
A := 'FDADEventAlerter.Active = FALSE';
if FDADEventAlerter.Options.AutoRegister then
AR := 'FDADEventAlerter.Options.AutoRegister = TRUE'
else
AR := 'FDADEventAlerter.Options.AutoRegister = FALSE';
ShowError('Не включен обработчик событий. Необходимо перезапустить программу!'+CRLF+
A+CRLF+
AR+CRLF+
FDADEventAlerter.Names.Text);
LogFilePath := ExtractFilePath(ParamStr(0))+'EventError.log';
SaveToFile(LogFilePath, FormatDateTime('dd-mm-yyyy hh:mm:ss - Не включен обработчик событий [' + WTCRMUSERNAME + '] - ['+WTCRMSTATIONNAME+'] ', Now));
EventAlertFunction;
{ FDDB.Close;
FDDB.Open;
if FDADEventAlerter.Active then
FDADEventAlerter.Active := False
else
FDADEventAlerter.Active := True;
EventAlertFunction;}
end;
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.
function TDM.EventAlertFunction: boolean;
var
tmp: String;
begin
if not DSet_UnitTest.Active then
DSet_UnitTest.Open;
UnitTestWriteTransaction.StartTransaction;
try
Timer1.Enabled := True;
tmp := 'DSet_UnitTest.Append';
DSet_UnitTest.Append;
tmp := 'DSet_UnitTest.Post';
DSet_UnitTest.Post;
tmp := 'UnitTestWrite.Commit';
UnitTestWriteTransaction.Commit;
except
on E:Exception do
begin
ShowMessage(Format('Ошибка добавления [%s]',[tmp])+#10#13+E.Message);
UnitTestWriteTransaction.Rollback;
DSet_UnitTest.Cancel;
end;
end;
end;
