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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
| program BDSWrapper;
uses
System.SysUtils,
Winapi.Windows;
{$R *.res}
type
TBDSWrapper = class(TObject)
private
class var FBDSProcessId: DWORD;
class var FAppBuilder: HWND;
class var FProgressForm: HWND;
class var FProgressFormCreated: Boolean;
class var FCancelBkgCompDlg: HWND;
class var FCancelBkgCompDlgClosed: Boolean;
class procedure WaitEvent(var AbortProcess: Boolean);
public
class function Run(const CmdDirectory, CmdName, CmdParam, CmdWorkDir: string; out ExitCode: Int64; Delay: Cardinal = INFINITE): Boolean;
end;
class function TBDSWrapper.Run(const CmdDirectory, CmdName, CmdParam, CmdWorkDir: string; out ExitCode: Int64; Delay: Cardinal = INFINITE): Boolean;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
CommandLine: string; // utile pour le débogage, ne pas confondre CommandLine avec SysUtils.CmdLine
SecurityAttr : TSecurityAttributes;
Terminated: Boolean;
AbortProcess: Boolean;
HandleFunctionProcess: Cardinal;
begin
FBDSProcessId := 0;
FAppBuilder := 0;
FProgressForm := 0;
FProgressFormCreated := False;
FCancelBkgCompDlg := 0;
FCancelBkgCompDlgClosed := False;
try
SecurityAttr.nLength := SizeOf(TSecurityAttributes);
SecurityAttr.lpSecurityDescriptor := nil;
SecurityAttr.bInheritHandle := True;
ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); // GetStartupInfo(StartupInfo);
StartupInfo.cb := SizeOf(StartupInfo);
ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
CommandLine := Format('"%s%s" %s', [IncludeTrailingPathDelimiter(CmdDirectory), CmdName, CmdParam]);
Result := CreateProcess(nil, PChar(CommandLine), @SecurityAttr, @SecurityAttr, True, 0, nil, PChar(CmdWorkDir), StartupInfo, ProcessInfo);
if Result then
begin
FBDSProcessId := ProcessInfo.dwProcessId;
try
Terminated := False;
AbortProcess := False;
while not Terminated do
begin
case WaitForSingleObject(ProcessInfo.hProcess, Delay) of
WAIT_OBJECT_0 :
begin
WaitEvent(AbortProcess);
Terminated := True;
end;
WAIT_ABANDONED : Terminated := True;
WAIT_TIMEOUT :
begin
WaitEvent(AbortProcess);
Terminated := Delay = INFINITE;
end;
WAIT_FAILED: Abort;
else
Terminated := True;
end;
if AbortProcess then
begin
HandleFunctionProcess := OpenProcess(PROCESS_TERMINATE, False, ProcessInfo.dwProcessId);
if HandleFunctionProcess > 0 then
begin
TerminateProcess(HandleFunctionProcess, 0);
CloseHandle(HandleFunctionProcess);
end;
end;
end;
ULARGE_INTEGER(ExitCode).HighPart := 0;
if not GetExitCodeProcess(ProcessInfo.hProcess, ULARGE_INTEGER(ExitCode).LowPart) then
ExitCode := -1;
finally
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess); // The handles for both the process and the main thread must be closed through calls to CloseHandle
FBDSProcessId := 0;
end;
end;
except
on E: Exception do
begin
OutputDebugString(PChar(Format('%s.Run - Error %s, Message : %s', [Self.ClassName(), E.ClassName(), E.Message])));
raise;
end;
end;
end;
class procedure TBDSWrapper.WaitEvent(var AbortProcess: Boolean);
function EnumWindowsCallBackProc(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
dwProcessId: DWORD;
WindowClassName: array[0..255] of Char;
begin
if GetWindowThreadProcessId(hWnd, @dwProcessId) <> 0 then
begin
if dwProcessId = FBDSProcessId then
begin
if GetClassName(hWnd, WindowClassName, SizeOf(WindowClassName)) > 0 then
begin
if SameText(WindowClassName, 'TProgressForm') then
begin
if FProgressForm = 0 then
FProgressFormCreated := True;
FProgressForm := hWnd;
end
else if SameText(WindowClassName, 'TCancelBkgCompDlg') then
FCancelBkgCompDlg := hWnd
else if SameText(WindowClassName, 'TAppBuilder') then
FAppBuilder := hWnd;
end;
end;
end;
// To continue enumeration, the callback function must return TRUE; to stop enumeration, it must return FALSE.
Result := (FAppBuilder = 0) or (FProgressForm = 0) or ((FCancelBkgCompDlg = 0) and not FCancelBkgCompDlgClosed);
end;
begin
FCancelBkgCompDlg := 0;
FProgressForm := 0;
EnumWindows(@EnumWindowsCallBackProc, 0);
// Si la fenêtre de progession n'est plus là, c'est donc la Fin
if FProgressForm = 0 then
if FProgressFormCreated then
AbortProcess := True;
// Si la fenêtre d'annulation de la compilation est là, il faut la fermer
if FCancelBkgCompDlg <> 0 then
begin
CloseWindow(FCancelBkgCompDlg);
FCancelBkgCompDlg := 0;
FCancelBkgCompDlgClosed := True;
end;
if FAppBuilder <> 0 then
ShowWindow(FAppBuilder, SW_MINIMIZE);
end;
var
BDSPath, ProjectName: string;
BDSExitCode: Int64;
begin
if FindCmdLineSwitch('bds', BDSPath) and FindCmdLineSwitch('p', ProjectName) then
begin
// bds.exe -ns -b Project.dproj
TBDSWrapper.Run(ExtractFileDir(BDSPath), ExtractFileName(BDSPath), '-b ' + ProjectName, ExtractFileDir(ProjectName), BDSExitCode, 100);
end;
end. |
DCC64 - F2046 Out of memory
Répondre avec citation
Envoyé par ShaiLeTroll
Partager