|
![]() |
|
Registriert seit: 1. Nov 2007 33 Beiträge |
#1
Ich habe Apollonius' Code in eine Komponente umgeschrieben. Die CreateNoWindow Flag gibt an, ob das externe Programm in einem eigenen Fenster gestartet werden soll oder nicht. Über das OnProgress Ereignis kann man beim Einlesen der Were den Stand des internen Streams auswerten, wobei man über die ProcessInfo Variable erfährt, mit welchem Prozeß man es zu tun hat. Zum Starten und Einlesen der Rückgabewerte muß man ExecuteA() bzw. ExecuteW() aufrufen (es handelt sich um die AnsiString- und die WideString-Version von im Prinzip derselben Funktion).
Delphi-Quellcode:
interface
uses Windows, Classes, SysUtils; type TAppLauncherProgressEvent = procedure(Sender: TObject; ProcessInfo: PROCESS_INFORMATION; Position: Int64) of object; TAppLauncher = class(TComponent) private FCreateNoWindow: Boolean; FOnProgress: TAppLauncherProgressEvent; FSecurityAttributes: SECURITY_ATTRIBUTES; FSecurityDescriptor: SECURITY_DESCRIPTOR; function CentralLoop(const ProcessInfo: PROCESS_INFORMATION; const ReadHandle: THandle; const OutputStream: TStream): DWord; inline; protected procedure DoProgress(ProcessInfo: PROCESS_INFORMATION; Position: Int64); virtual; procedure PreparePipe(out ReadHandle, WriteHandle: THandle); virtual; function PrepareStartupInfoA(const StdOutput: THandle): STARTUPINFOA; virtual; function PrepareStartupInfoW(const StdOutput: THandle): STARTUPINFOW; virtual; property SecurityAttributes: SECURITY_ATTRIBUTES read FSecurityAttributes; property SecurityDescriptor: SECURITY_DESCRIPTOR read FSecurityDescriptor; public constructor Create(AOwner: TComponent); override; function ExecuteA(const Path, CmdLine: AnsiString; out Output: TBytes): DWORD; function ExecuteW(const Path, CmdLine: WideString; out Output: TBytes): DWORD; published property CreateNoWindow: Boolean read FCreateNoWindow write FCreateNoWindow default false; property OnProgress: TAppLauncherProgressEvent read FOnProgress write FOnProgress; end; implementation uses TeCanvas, Forms; { TAppLauncher } constructor TAppLauncher.Create(AOwner: TComponent); begin inherited; FCreateNoWindow := false; ZeroMemory(@FSecurityAttributes, SizeOf(FSecurityAttributes)); if IsWindowsNT then begin InitializeSecurityDescriptor(@FSecurityDescriptor, SECURITY_DESCRIPTOR_REVISION); SetSecurityDescriptorDacl(@FSecurityDescriptor, True, nil, False); FSecurityAttributes.lpSecurityDescriptor := @FSecurityDescriptor; end else FSecurityAttributes.lpSecurityDescriptor := nil; FSecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES); FSecurityAttributes.bInheritHandle := True; end; procedure TAppLauncher.DoProgress(ProcessInfo: PROCESS_INFORMATION; Position: Int64); begin if Assigned(FOnProgress) then FOnProgress(Self, ProcessInfo, Position); end; procedure TAppLauncher.PreparePipe(out ReadHandle, WriteHandle: THandle); var PipeName: string; begin PipeName := '\\.\pipe\' + IntToHex(Random(MaxInt), 8) + IntToHex(GetCurrentProcessId, 8) + IntToHex(Random(MaxInt), 8); ReadHandle := CreateNamedPipe(PChar(PipeName), PIPE_ACCESS_INBOUND or FILE_FLAG_OVERLAPPED, 0, 1, 1024, 1024, 0, nil); if ReadHandle = INVALID_HANDLE_VALUE then RaiseLastOSError; try WriteHandle := CreateFile(PChar(PipeName), GENERIC_WRITE, FILE_SHARE_READ, @SecurityAttributes, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if WriteHandle = INVALID_HANDLE_VALUE then RaiseLastOSError; except CloseHandle(ReadHandle); end; end; function TAppLauncher.PrepareStartupInfoA(const StdOutput: THandle): STARTUPINFOA; begin ZeroMemory(@Result, SizeOf(Result)); Result.cb := SizeOf(Result); Result.dwFlags := STARTF_USESTDHANDLES; Result.hStdInput := GetStdHandle(STD_INPUT_HANDLE); Result.hStdOutput := StdOutput; Result.hStdError := StdOutput; end; function TAppLauncher.PrepareStartupInfoW(const StdOutput: THandle): STARTUPINFOW; begin ZeroMemory(@Result, SizeOf(Result)); Result.cb := SizeOf(Result); Result.dwFlags := STARTF_USESTDHANDLES; Result.hStdInput := GetStdHandle(STD_INPUT_HANDLE); Result.hStdOutput := StdOutput; Result.hStdError := StdOutput; end; function TAppLauncher.CentralLoop(const ProcessInfo: PROCESS_INFORMATION; const ReadHandle: THandle; const OutputStream: TStream): DWord; const BUFFER_SIZE = 512; var OvLapped: OVERLAPPED; BytesRead: Cardinal; Buffer: array[0..BUFFER_SIZE - 1] of Byte; HandleArray: array[0..1] of THandle; begin ZeroMemory(@OvLapped, SizeOf(OvLapped)); OvLapped.hEvent := CreateEvent(nil, True, False, nil); try HandleArray[0] := ProcessInfo.hProcess; HandleArray[1] := OvLapped.hEvent; if not ReadFile(ReadHandle, Buffer, BUFFER_SIZE, BytesRead, @OvLapped) and (GetLastError <> ERROR_IO_PENDING) then RaiseLastOSError; while WaitForMultipleObjects(2, @HandleArray, False, INFINITE) = WAIT_OBJECT_0 + 1 do begin if not GetOverlappedResult(ReadHandle, OvLapped, BytesRead, False) then RaiseLastOSError; OutputStream.Write(Buffer, BytesRead); ResetEvent(OvLapped.hEvent); if not ReadFile(ReadHandle, Buffer, BUFFER_SIZE, BytesRead, @OvLapped) and (GetLastError <> ERROR_IO_PENDING) then RaiseLastOSError; DoProgress(ProcessInfo, OutputStream.Position); end; GetExitCodeProcess(ProcessInfo.hProcess, Result); finally CloseHandle(OvLapped.hEvent); end; end; function TAppLauncher.ExecuteA(const Path, CmdLine: AnsiString; out Output: TBytes): DWORD; var lpPath, lpCmdLine: PAnsiChar; StartupInf: STARTUPINFOA; ProcessInfo: PROCESS_INFORMATION; WriteHandle, ReadHandle: THandle; dwCreationFlags: Cardinal; BytesStream: TBytesStream; begin PreparePipe(ReadHandle, WriteHandle); try try StartupInf := PrepareStartupInfoA(WriteHandle); if CreateNoWindow then dwCreationFlags := CREATE_NO_WINDOW else dwCreationFlags := 0; if Path = '' then lpPath := nil else lpPath := PAnsiChar(Path); if CmdLine = '' then lpCmdLine := nil else begin lpCmdLine := PAnsiChar(CmdLine); end; if not CreateProcessA(lpPath, lpCmdLine, nil, nil, True, dwCreationFlags, nil, nil, StartupInf, ProcessInfo) then RaiseLastOSError; try CloseHandle(ProcessInfo.hThread); BytesStream := TBytesStream.Create(nil); try Result := CentralLoop(ProcessInfo, ReadHandle, BytesStream); Output := BytesStream.Bytes; finally BytesStream.Free; end; finally CloseHandle(ProcessInfo.hProcess); end; finally CloseHandle(WriteHandle); end; finally CloseHandle(ReadHandle); end; end; function TAppLauncher.ExecuteW(const Path, CmdLine: WideString; out Output: TBytes): DWORD; var lpPath, lpCmdLine: PWideChar; StartupInf: STARTUPINFOW; ProcessInfo: PROCESS_INFORMATION; WriteHandle, ReadHandle: THandle; dwCreationFlags: Cardinal; BytesStream: TBytesStream; CmdLineCopy: WideString; begin PreparePipe(ReadHandle, WriteHandle); try try StartupInf := PrepareStartupInfoW(WriteHandle); if CreateNoWindow then dwCreationFlags := CREATE_NO_WINDOW else dwCreationFlags := 0; if Path = '' then lpPath := nil else lpPath := PWideChar(Path); if CmdLine = '' then lpCmdLine := nil else begin // We need to work with a copy of CmdLine. Cf. the Microsoft // documentation on the CreateProcess method: "The Unicode version of // this function, CreateProcessW, can modify the contents of this // string. Therefore, this parameter cannot be a pointer to read-only // memory (such as a const variable or a literal string). If this // parameter is a constant string, the function may cause an access // violation. CmdLineCopy := CmdLine; UniqueString(CmdLineCopy); lpCmdLine := PWideChar(CmdLineCopy); end; if not CreateProcessW(lpPath, lpCmdLine, nil, nil, True, dwCreationFlags, nil, nil, StartupInf, ProcessInfo) then RaiseLastOSError; try CloseHandle(ProcessInfo.hThread); BytesStream := TBytesStream.Create(nil); try Result := CentralLoop(ProcessInfo, ReadHandle, BytesStream); Output := BytesStream.Bytes; finally BytesStream.Free; end; finally CloseHandle(ProcessInfo.hProcess); end; finally CloseHandle(WriteHandle); end; finally CloseHandle(ReadHandle); end; end; |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |