[createprocess] cmd.exe liefert exitcode 1 ohne Debugger?!

[alleinherrscher]

Hi@all!

Ich benutze den unten angehängten Code, um cmd-eingaben in mein programm umzuleiten. Der Code stammt ausm Internet, allerdings hab ich ihn dahingehend umgeschrieben, alsdass beim beenden der cmd.exe alle childprocesses mitgeschlossen werden.)

Wenn ich mein Programm mit Delphi 2005 starte (mit Debugger) läuft es ohne Probleme, der Prozess cmd.exe wird erstellt und die ausgabe in mein programm umgeleitet. Zum Schluss (z.B. bei eingabe von "exit") terminiert die cmd.exe mit exitcode 0. Also alles perfekt.

Wenn ich dann jedoch das Programm ohne den Debugger aus windows starte, erzeugt createprocess wie gewünscht die cmd.exe, diese beendet sich aber dann sofort mit Exitcode 1.
MSDN sagt dazu: "Partial success; this means at least something, or possibly everything, failed to succeed."

Jemand den Hauch einer Ahnung, woran das liegen kann???

Delphi-Quellcode:

/////////////////////////////////////////////////////
//                                                 //
//   UNiT REDiRECT CONSOLE by SONiC                //
//                                                 //
//   Console input/output redirection with pipes   //
//   Last revision: 02/SEPT/02                     //
//                                                 //
//   Bugs/comments to: [email][e-mail][/email]           //
//   Home page: [url]http://sonic.rulestheweb.com[/url]       //
//                                                 //
//   Freeware                                      //
//                                                 //
/////////////////////////////////////////////////////

unit RedirectConsole;

interface

uses Windows, Messages, SysUtils, StdCtrls,Forms,TlHelp32,Dialogs;

const
  CRLF=#13#10;

var
  RC_SendBuf: string;
  RC_End: Boolean;
  RC_ExitCode: Cardinal;
  ExeName:string;
procedure RC_Run(Command: string);
procedure RC_LineIn(s: string);
var       RC_LineOut: procedure(s: string)of object;

implementation

//uses Windows, Forms;


function KillChildProcesses(ProcessID:Cardinal;NameFilter:string): boolean;
var
  p: TProcessEntry32;
  h: THandle;
begin
  Result := false;
  p.dwSize := SizeOf(p);
  h := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0);
  try
    if Process32First(h, p) then
      repeat

       if p.th32ParentProcessID=ProcessID then
       begin
        if (NameFilter='') or (AnsiLowerCase(p.szExeFile) = AnsiLowerCase(trim(NameFilter))) then
        begin
          KillChildProcesses(p.th32ProcessID,'');
          Result := TerminateProcess(OpenProcess(Process_Terminate,false,p.th32ProcessID),0);
        end;
       end;
      until (not Process32Next(h, p));
  finally
    CloseHandle(h);
  end;
end;


procedure RC_LineIn(s: string);
begin

  if uppercase(s)='EXIT' then
    killchildprocesses(GetCurrentProcessId,ExeName)
  else
    RC_SendBuf:=RC_SendBuf+s+CRLF;
end; // RC_LineIn;

function IsWinNT: Boolean;
var osv: tOSVERSIONINFO;
begin
  osv.dwOSVersionInfoSize:=sizeof(osv);
  GetVersionEx(osv);
  result:=osv.dwPlatformID=VER_PLATFORM_WIN32_NT;
end; // IsWinNT

procedure SplitLines(s: string);
var t: string;
begin
  while pos(CRLF, s)<>0 do begin
    t:=copy(s, 1, pos(CRLF, s)-1);
    RC_LineOut(t);
    delete(s, 1, pos(CRLF, s)+1);
  end;
  if length(s)>0 then RC_LineOut(s);
end; // SplitLines

procedure RC_Run(Command: string);
const bufsize=1024; // 1KByte buffer
var
  buf: array [0..bufsize-1] of char;
  si: tSTARTUPINFO;
  sa: tSECURITYATTRIBUTES;
  sd: tSECURITYDESCRIPTOR;
  pi: tPROCESSINFORMATION;
  newstdin, newstdout, read_stdout, write_stdin: tHandle;
  bread, avail: dword;
begin
  // Configuraciones de seguridad para WinNT
  if IsWinNT then begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, false);
    sa.lpSecurityDescriptor:=@sd;
  end else sa.lpSecurityDescriptor:=nil;
  // Creamos Pipe A
  if not CreatePipe(newstdin, write_stdin, @sa, 0) then begin
    RC_LineOut('Error creating Pipe A');
    exit;
  end;
  // Creamos Pipe B
  if not CreatePipe(read_stdout, newstdout, @sa, 0) then begin
    RC_LineOut('Error creating Pipe B');
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
    exit;
  end;
  // Configuramos si
  GetStartupInfo(si);

  si.dwFlags:= STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow:=SW_HIDE;
  si.hStdOutput:=newstdout;
  si.hStdError:=newstdout;
  si.hStdInput:=newstdin;
  // Creamos proceso
  ExeName:=extractfilename(command);
  application.processmessages;
  if not CreateProcess(pchar(command), nil,nil, nil, true,
    CREATE_NEW_CONSOLE, nil, nil, si, pi) then begin
    RC_LineOut('Error creating process: '+command);
    CloseHandle(newstdin);
    CloseHandle(newstdout);
    CloseHandle(read_stdout);
    CloseHandle(write_stdin);
    exit;
  end;


  // Loop principal
  fillchar(buf, sizeof(buf), 0);
  RC_End:=false;
  RC_SendBuf:='';
  repeat
     application.ProcessMessages;
     sleep(50);
   // Application.HandleMessage;
    GetExitCodeProcess(pi.hProcess, RC_ExitCode);
    if (RC_ExitCode<>STILL_ACTIVE) then RC_End:=True;
    PeekNamedPipe(read_stdout, @buf, bufsize, @bread, @avail, nil);
    // Comprobamos texto de salida
    if (bread<>0) then begin
      fillchar(buf, bufsize, 0);
      if (avail>bufsize) then
        while (bread>=bufsize) do begin
          ReadFile(read_stdout, buf, bufsize, bread, nil);
          SplitLines(buf);
          fillchar(buf, bufsize, 0);
        end
      else begin
        ReadFile(read_stdout, buf, bufsize, bread, nil);
        SplitLines(buf);
      end;
    end;
    // Comprobamos texto de entrada
    while (Length(RC_SendBuf)>0) do begin
      WriteFile(write_stdin, RC_SendBuf[1], 1, bread, nil);
      Delete(RC_SendBuf, 1, 1);
    end;
  until RC_End;
  // Cerramos las cosas
   Showmessage(inttostr(RC_ExitCode));
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(newstdin);
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
  CloseHandle(write_stdin);
end; // RC_Run

end.