this slowpoke moves

Execute Console in Form

Dies sind Beispiele, wie die Windows Console (CMD) aus einem externen Programm gesteuert werden kann.

Es ist nicht 100 % alles möglich, doch die meisten Konsolenbefehle werden ausgeführt. 

Für ältere Compiler Versionen :
function ExecConsole(const ACommand: String;
var AOutput, AErrors: String; var AExitCode: Cardinal): Boolean;
var  StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation; 
    SecurityAttr: TSecurityAttributes;
    PipeOutputRead, PipeOutputWrite, PipeErrorsRead, PipeErrorsWrite: THandle;
procedure ReadPipeToString(const hPipe: THandle; var Result: String);
const MEM_CHUNK_SIZE = 8192;
var  
	umberOfBytesRead,  NumberOfBytesTotal: Cardinal;
	begin  Result := '';  NumberOfBytesTotal := 0; repeat
      SetLength(Result,Length(Result) +MEM_CHUNK_SIZE);
      if ReadFile(hPipe,(@Result[1+NumberOfBytesTotal])^,MEM_CHUNK_SIZE,
                  NumberOfBytesRead,NIL) then
        Inc(NumberOfBytesTotal,NumberOfBytesRead);
      SetLength(Result,NumberOfBytesTotal);  until (NumberOfBytesRead = 0);
   end;
begin
  FillChar(ProcessInfo,SizeOf(TProcessInformation),0);
  FillChar(SecurityAttr,SizeOf(TSecurityAttributes),0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := TRUE;
  SecurityAttr.lpSecurityDescriptor := NIL;
  CreatePipe(PipeOutputRead,PipeOutputWrite,@SecurityAttr,0);
  CreatePipe(PipeErrorsRead,PipeErrorsWrite,@SecurityAttr,0);
  FillChar(StartupInfo,SizeOf(TStartupInfo),0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  Result := CreateProcess(NIL,PChar(ACommand),NIL,NIL,TRUE,
                          CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE
  or NORMAL_PRIORITY_CLASS, NIL,NIL,StartupInfo,ProcessInfo);
  CloseHandle(PipeOutputWrite); CloseHandle(PipeErrorsWrite);
  if (Result) then begin
    ReadPipeToString(PipeOutputRead,AOutput);
    ReadPipeToString(PipeErrorsRead,AErrors);
    WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,AExitCode);
    CloseHandle(ProcessInfo.hProcess);
  end;  CloseHandle(PipeOutputRead); CloseHandle(PipeErrorsRead);
end;
Beispiel :
procedure TForm1.Button2Click(Sender: TObject);
var Output, Errors: String; RC: Cardinal; tmp: TStringList;
begin  
	tmp := TStringList.Create; try
    if ExecConsole(Edit1.Text,Output,Errors,RC) then begin
      Memo1.Lines.Add('Return-Code des Programms: ' + IntToStr(RC));
      if (Output <> '') then begin
        OemToCharBuffA(PChar(Output),PChar(Output),Length(Output));
        Memo1.Lines.Add('---Output---'); 
        tmp.Text :=  Output;
        Memo1.Lines.AddStrings(tmp);
      end; 
      if (Errors <> '') then begin
        OemToCharBuffA(PChar(Errors),PChar(Errors),Length(Errors));
        Memo1.Lines.Add('---Errors---'); 
        tmp.Text := Errors;
        Memo1.Lines.AddStrings(tmp); end; end 
        else
      Memo1.Lines.Add('Befehl konnte nicht ausgeführt werden: '+Edit2.Text);
  finally 
  tmp.Free; 
  end; Memo1.Lines.Add('');
end;
Für Höhere Compiler Versionen :
procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
 const
   CReadBuffer = 2400;
 var
   saSecurity: TSecurityAttributes;
   hRead: THandle;
   hWrite: THandle;
   suiStartup: TStartupInfo;
   piProcess: TProcessInformation;
   pBuffer: array[0..CReadBuffer] of AnsiChar;
   dRead: DWord;
   dRunning: DWord;
 begin
   saSecurity.nLength := SizeOf(TSecurityAttributes);
   saSecurity.bInheritHandle := True;
   saSecurity.lpSecurityDescriptor := nil;

   if CreatePipe(hRead, hWrite, @saSecurity, 0) then
   begin
     FillChar(suiStartup, SizeOf(TStartupInfo), #0);
     suiStartup.cb := SizeOf(TStartupInfo);
     suiStartup.hStdInput := hRead;
     suiStartup.hStdOutput := hWrite;
     suiStartup.hStdError := hWrite;
     suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
     suiStartup.wShowWindow := SW_HIDE;

     if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity,
       @saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess)
       then
     begin
       repeat
         dRunning := WaitForSingleObject(piProcess.hProcess, 100);
         Application.ProcessMessages();
         repeat
           dRead := 0;
           ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
           pBuffer[dRead] := #0;

           OemToAnsi(pBuffer, pBuffer);
           AMemo.Lines.Add(String(pBuffer));
         until (dRead < CReadBuffer);
       until (dRunning <> WAIT_TIMEOUT);
       CloseHandle(piProcess.hProcess);
       CloseHandle(piProcess.hThread);
     end;

     CloseHandle(hRead);
     CloseHandle(hWrite);
   end;
end;
Beispiel :
procedure TForm1.Button2Click(Sender: TObject);
begin
  CaptureConsoleOutput('cmd /c', 'dir', Memo1);
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate