program DCC32_Dummy;
{$APPTYPE CONSOLE}
// Ersatz für DCC32.exe in Delphi Installation um BuildSkripts zu analysieren
// z.B. DevExpress
// Diese Version ruft (falls vorhanden) *_org.exe mit den übergebenen Parametern auf.
uses
SysUtils, Windows, Classes;
const
Filename = '
C:\TEMP\DCC32.LOG';
var
Programmstart: Integer;
Zeile: integer = 0;
function GetConsoleOutput(
const Command :
string;
Output, Errors : TStringList) : Boolean;
var
Buffer :
array[0..255]
of Char;
CreationFlags : DWORD;
NumberOfBytesRead : DWORD;
PipeErrorsRead : THandle;
PipeErrorsWrite : THandle;
PipeOutputRead : THandle;
PipeOutputWrite : THandle;
ProcessInfo : TProcessInformation;
SecurityAttr : TSecurityAttributes;
StartupInfo : TStartupInfo;
Stream : TMemoryStream;
sCmd :
string;
begin
//Initialisierung ProcessInfo
FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
//Initialisierung SecurityAttr
FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
SecurityAttr.nLength := SizeOf(TSecurityAttributes);
SecurityAttr.bInheritHandle := True;
SecurityAttr.lpSecurityDescriptor :=
nil;
//Pipes erzeugen
CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);
//Initialisierung StartupInfo
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
StartupInfo.cb := SizeOf(TStartupInfo);
StartupInfo.hStdInput := 0;
StartupInfo.hStdOutput := PipeOutputWrite;
StartupInfo.hStdError := PipeErrorsWrite;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.dwFlags := STARTF_USESHOWWINDOW
or STARTF_USESTDHANDLES;
CreationFlags := CREATE_DEFAULT_ERROR_MODE
or
CREATE_NEW_CONSOLE
or
NORMAL_PRIORITY_CLASS;
sCmd:=Command;
UniqueString(sCmd);
if CreateProcess(
nil,
(PChar(sCmd)),
nil,
nil,
True,
CreationFlags,
nil,
PChar(GetCurrentDir),
StartupInfo,
ProcessInfo)
then
begin
Result := True;
//Write-Pipes schließen
CloseHandle(PipeOutputWrite);
CloseHandle(PipeErrorsWrite);
//Ausgabe Read-Pipe auslesen
Stream := TMemoryStream.Create;
try
while ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead,
nil)
do
begin
Stream.
Write(Buffer, NumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;
CloseHandle(PipeOutputRead);
//Fehler Read-Pipe auslesen
Stream := TMemoryStream.Create;
try
while ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead,
nil)
do
begin
Stream.
Write(Buffer, NumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;
CloseHandle(PipeErrorsRead);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
CloseHandle(ProcessInfo.hProcess);
end
else
begin
Result := False;
CloseHandle(PipeOutputRead);
CloseHandle(PipeOutputWrite);
CloseHandle(PipeErrorsRead);
CloseHandle(PipeErrorsWrite);
end;
end;
{ TMyLog }
type
TMyLog =
class(TObject)
private
Log: TextFile;
public
constructor Create;
destructor Destroy;
override;
procedure Add(
const s:
string);
end;
constructor TMyLog.Create;
begin
inherited;
ForceDirectories(ExtractFilePath(Filename));
AssignFile(Log, Filename);
if FileExists(Filename)
then
begin
Append(Log);
end
else
begin
ReWrite(Log);
end;
end;
destructor TMyLog.Destroy;
begin
CloseFile(Log);
inherited;
end;
procedure TMyLog.Add(
const s:
string);
begin
Inc(Zeile);
WriteLn(Log, Format('
%.8d-%.4d: %s', [ProgrammStart, Zeile, s]));
Flush(Log);
end;
var
i, j: Integer;
App, Params:
string;
sl1, sl2: TStringList;
MyLog: TMyLog;
begin
Programmstart := DateTimeToTimeStamp(now).Time;
try
MyLog := TMyLog.Create;
try
MyLog.Add('
rem cd /d '+GetCurrentDir);
MyLog.Add(CmdLine);
finally
MyLog.Free;
end;
// Wenn *_org.exe da ist, dann diese mit Parametern starten
App := ChangeFileExt(ParamStr(0), '
_org.exe');
// WriteLn(App);
if FileExists(App)
then
begin
for i := 1
to ParamCount
do Params := Params + #32 + ParamStr(i);
// WriteLn(Params);
sl1 := TStringList.Create;
sl2 := TStringList.Create;
try
GetconsoleOutPut(App + '
' + Params, sl1, sl2);
MyLog := TMyLog.Create;
try
for j := 0
to sl1.Count-1
do
begin
MyLog.Add('
rem ' + sl1[j]);
WriteLn(sl1[j]);
end;
for j := 0
to sl2.Count-1
do
begin
MyLog.Add('
rem ERROR:' + sl2[j]);
WriteLn(sl1[j]);
end;
finally
MyLog.Free;
end;
finally
sl1.Free;
sl2.Free;
end;
end;
except
on E:
Exception do
Writeln('
Es ist ein Fehler aufgetreten:',#13#10,E.ClassName, '
: ', E.
Message);
end;
end.