Форум программистов [Powered by Invision Power Board]

Цитата(MSDN)

Note This function is provided only for compatibility with 16-bit Windows. Applications should use the CreateProcess function.

Цитата(Ksen @ 16.2.2007, 10:49

)

но эта программа должна возвращать мне некий ID

Код


procedure RunDosInMemo(CmdLine:String;AMemo:TMemo);
const  
  ReadBuffer = 2400;  
var
 Security       : TSecurityAttributes;  
 ReadPipe,WritePipe  : THandle;  
 start        : TStartUpInfo;
 ProcessInfo     : TProcessInformation;  
 Buffer        : Pchar;  
 BytesRead      : DWord;
 Apprunning      : DWord;  
begin  
 Screen.Cursor:=CrHourGlass;
 Form1.Button1.Enabled:=False;  
 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;  
 
 if CreateProcess(nil,
     PChar(CmdLine),  
     @Security,  
     @Security,
     true,  
     NORMAL_PRIORITY_CLASS,  
     nil,
     nil,  
     start,  
     ProcessInfo)
 then  
 begin  
  repeat
  Apprunning := WaitForSingleObject  
         (ProcessInfo.hProcess,100);  
   ReadFile(ReadPipe,Buffer[0],
      ReadBuffer,BytesRead,nil);  
   Buffer[BytesRead]:= #0;  
   OemToAnsi(Buffer,Buffer);
   AMemo.Text := AMemo.text + String(Buffer);  
 
  Application.ProcessMessages;
  until (Apprunning <> WAIT_TIMEOUT);  
 end;
 FreeMem(Buffer);
 CloseHandle(ProcessInfo.hProcess);
 CloseHandle(ProcessInfo.hThread);
 CloseHandle(ReadPipe);
 CloseHandle(WritePipe);
 end;
 Screen.Cursor:=CrDefault;
 Form1.Button1.Enabled:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
RunDosInMemo('trigadm.exe /Request:AddTrigger /Name:Trig01 /Queue:kolesnikovcomp\private$\isq_in',Memo1);
end;

Код


procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
  TStringList);
var
  sa: TSECURITYATTRIBUTES;
  si: TSTARTUPINFO;
  pi: TPROCESSINFORMATION;
  hPipeOutputRead: THANDLE;
  hPipeOutputWrite: THANDLE;
  hPipeErrorsRead: THANDLE;
  hPipeErrorsWrite: THANDLE;
  Res, bTest: Boolean;
  env: array[0..100] of Char;
  szBuffer: array[0..256] of Char;
  dwNumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := true;
  sa.lpSecurityDescriptor := nil;
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
  CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
  ZeroMemory(@env, SizeOf(env));
  ZeroMemory(@si, SizeOf(si));
  ZeroMemory(@pi, SizeOf(pi));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;
  si.hStdOutput := hPipeOutputWrite;
  si.hStdError := hPipeErrorsWrite;

  (* Remember that if you want to execute an app with no parameters you nil the
     second parameter and use the first, you can also leave it as is with no
     problems.                                                                 *)
  Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  // Procedure will exit if CreateProcess fail
  if not Res then
  begin
    CloseHandle(hPipeOutputRead);
    CloseHandle(hPipeOutputWrite);
    CloseHandle(hPipeErrorsRead);
    CloseHandle(hPipeErrorsWrite);
    Exit;
  end;
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorsWrite);

  //Read output pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Output.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  //Read error pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);
      if not bTest then
      begin
        break;
      end;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Errors.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(pi.hProcess);
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorsRead);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  OutP: TStringList;
  ErrorP: TStringList;
  a:string;
begin
  OutP := TStringList.Create;
  ErrorP := TstringList.Create;

  ExecConsoleApp('ping 192.168.0.212', OutP, ErrorP);
  Memo1.Lines.Assign(OutP);

  OutP.Free;
  ErrorP.Free;
end;