Delphide yazdığım program (IDE) bir noktada batch dosya çağırıyor.
Batch dosya ise özel bir derleyiciyi çalıştırarak bir source programın otomatik olarak derlenmesini sağlıyor.
Eğer derleyici derleme aşamasında hata bulursa hata mesajları konsolda görülüyor. Ancak yukarılara doğru akıp gidiyor.
Amacım, ekranda akan bu mesajları "Delphi"deki programıma bir şekilde aktarabilmek.
Malesef "DOS"dan tanıdığımız > tipi redirection komutları işe yaramıyor.
Win98 ortamında konsola giden mesajları "Delphi"ye nasıl aktarırım?
File üzerinden okumaya bile razıyım.
Delphi'de WINAPI çagrilabiliyor mu? Hani visual basic'de windows DLL'lerini import edip, prototipleri yazinca WINAPI fonksyonlari çagrilabiliyor.
WINAPI'ler ile yapilir tahminimce. ShellExecuteEx veya CreateProcess API'lerine bakin.
Formda birer tane richedit ve buton olsun
function RunProg(Cmd, WorkDir: String): string;
var
tsi: TStartupInfo;
tpi: TProcessInformation;
nRead: DWORD;
aBuf: Array[0..101] of char;
sa: TSecurityAttributes;
hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead,
hInputWrite, hErrorWrite: THandle;
FOutput: String;
begin
FOutput := '';
sa.nLength := SizeOf(TSecurityAttributes);
sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := True;
CreatePipe(hOutputReadTmp, hOutputWrite, @sa, 0);
DuplicateHandle(GetCurrentProcess(), hOutputWrite, GetCurrentProcess(),
@hErrorWrite, 0, true, DUPLICATE_SAME_ACCESS);
CreatePipe(hInputRead, hInputWriteTmp, @sa, 0);
DuplicateHandle(GetCurrentProcess(), hOutputReadTmp, GetCurrentProcess(),
@hOutputRead, 0, false, DUPLICATE_SAME_ACCESS);
DuplicateHandle(GetCurrentProcess(), hInputWriteTmp, GetCurrentProcess(),
@hInputWrite, 0, false, DUPLICATE_SAME_ACCESS);
CloseHandle(hOutputReadTmp);
CloseHandle(hInputWriteTmp);
FillChar(tsi, SizeOf(TStartupInfo), 0);
tsi.cb := SizeOf(TStartupInfo);
tsi.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
tsi.hStdInput := hInputRead;
tsi.hStdOutput := hOutputWrite;
tsi.hStdError := hErrorWrite;
CreateProcess(nil, PChar(Cmd), @sa, @sa, true, 0, nil, PChar(WorkDir),
tsi, tpi);
CloseHandle(hOutputWrite);
CloseHandle(hInputRead );
CloseHandle(hErrorWrite);
Application.ProcessMessages;
repeat
if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then
begin
if GetLastError = ERROR_BROKEN_PIPE then Break
else MessageDlg('Pipe read error, could not execute file', mtError, [mbOK], 0);
end;
aBuf[nRead] := #0;
FOutput := FOutput + PChar(@aBuf[0]);
Application.ProcessMessages;
until False;
Result := FOutput;
//GetExitCodeProcess(tpi.hProcess, nRead) = True;
end;
kullanımı
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.Text:=RunProg('C:\java.exe','C:\');
end;
Bir tane de benden olsun. Bu da çalışma esnasında program kapanmasa da çıkışını memo ya aktarıyor...
procedure CaptureConsoleOutput(DosApp : string;AMemo : TMemo);
const
ReadBuffer = 1048576;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
TotalBytesRead,
BytesRead : DWORD;
Apprunning,n,
BytesLeftThisMessage,
TotalBytesAvail : integer;
terminateProcessExitCode: cardinal;
begin
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;
//Console application create ediliyor
if CreateProcess(nil ,PChar(DosApp),
@Security,@Security,
true ,CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
nil ,nil,
start ,ProcessInfo) then
begin
n:=0;
TotalBytesRead:=0;
repeat
Inc(n,1);
Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
Application.ProcessMessages;
if not PeekNamedPipe(ReadPipe ,@Buffer[TotalBytesRead],
ReadBuffer ,@BytesRead,
@TotalBytesAvail,@BytesLeftThisMessage) then break
else if BytesRead > 0 then
ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil);
TotalBytesRead:=TotalBytesRead+BytesRead;
Buffer[TotalBytesRead]:= #0;
OemToChar(Buffer,Buffer);
AMemo.Text := StrPas(Buffer);
until (Apprunning <> WAIT_TIMEOUT) or (n > 100); //n yerine zaman kontrolü de yapılabilir program kapanmıyorsa kapatmak için koyulmuştur
//until (Apprunning <> WAIT_TIMEOUT) //n kullanılmayabilir o zaman termişnate process i de kaldırmak lazım
if n > 100 then
TerminateProcess(ProcessInfo.hProcess, terminateProcessExitCode);
Buffer[TotalBytesRead]:= #0;
OemToChar(Buffer,Buffer);
AMemo.Text := AMemo.text + StrPas(Buffer);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;