Mega Code Archive
Delphi ile konsol uygulamasını çalıştırmak ve çıktısını almak
<![CDATA[
function RunProg(const Cmd, WorkDir: String; var FOutput: string): DWord;
var
tsi: TStartupInfo;
tpi: TProcessInformation;
nRead: DWORD;
aBuf: Array[0..101] of char;
sa: TSecurityAttributes;
hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead,
hInputWrite, hErrorWrite: THandle;
AWorkDir: LPCTSTR;
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;
if WorkDir > '' then
AWorkDir := PChar(WorkDir)
else AWorkDir := nil;
Result := 0;
if not CreateProcess(nil, PChar(Cmd), @sa, @sa, true, 0, nil,AWorkDir, tsi, tpi) then
begin
Result := GetLastError;
end;
CloseHandle(hOutputWrite);
CloseHandle(hInputRead );
CloseHandle(hErrorWrite);
Application.ProcessMessages;
if Result = 0 then
repeat
if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then
begin
if GetLastError = ERROR_BROKEN_PIPE then Break
else Result := GetLastError;
end;
aBuf[nRead] := #0;
FOutput := FOutput + PChar(@aBuf[0]);
Application.ProcessMessages;
until False;
if Result = 0 then
GetExitCodeProcess(tpi.hProcess, Result);
end;
//Örneğin:
procedure TForm1.Button1Click(Sender: TObject);
var S: string;
Res: Dword;
begin
// Windows 95/98/ME için Res := RunProg('command /c dir', 'c:\', S);
Res := RunProg('cmd /c dir', 'c:\', S);
if Res <> 0 then
ShowMessage(Format('Uygulama çalıştırılamadı veya hata döndürdü. Hata kodu: %d, Açıklama: %s', [Res, SysErrorMessage(Res)]));
Memo1.Lines.Text := S;
end;
]]>