На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Как выполнить команду DOS, и вывести результат в Memo?
      Код взят из http://www.torry.net/memos.htm


      ExpandedWrap disabled
        procedure Dos2Win(CmdLine:String; OutMemo:TMemo);
        const BUFSIZE = 2000;
        var SecAttr    : TSecurityAttributes;
            hReadPipe,
            hWritePipe : THandle;
            StartupInfo: TStartUpInfo;
            ProcessInfo: TProcessInformation;
            Buffer     : Pchar;
            WaitReason,
            BytesRead  : DWord;
        begin
         
         with SecAttr do
         begin
           nlength              := SizeOf(TSecurityAttributes);
           binherithandle       := true;
           lpsecuritydescriptor := nil;
         end;
         // Creazione della pipe
         if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then
         begin
           Buffer  := AllocMem(BUFSIZE + 1);    // Allochiamo un buffer di dimensioni BUFSIZE+1
           FillChar(StartupInfo, Sizeof(StartupInfo), #0);
           StartupInfo.cb          := SizeOf(StartupInfo);
           StartupInfo.hStdOutput  := hWritePipe;
           StartupInfo.hStdInput   := hReadPipe;
           StartupInfo.dwFlags     := STARTF_USESTDHANDLES +
                                      STARTF_USESHOWWINDOW;
           StartupInfo.wShowWindow := SW_HIDE;
         
           if CreateProcess(nil,
              PChar(CmdLine),
              @SecAttr,
              @SecAttr,
              true,
              NORMAL_PRIORITY_CLASS,
              nil,
              nil,
              StartupInfo,
              ProcessInfo) then
             begin
               // Attendiamo la fine dell'esecuzione del processo
               repeat
                 WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100);
                 Application.ProcessMessages;
               until (WaitReason <> WAIT_TIMEOUT);
               // Leggiamo la pipe
               Repeat
                 BytesRead := 0;
                 // Leggiamo "BUFSIZE" bytes dalla pipe
                 ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);
                 // Convertiamo in una stringa "\0 terminated"
                 Buffer[BytesRead]:= #0;
                 // Convertiamo i caratteri da DOS ad ANSI
                 OemToAnsi(Buffer,Buffer);
                 // Scriviamo nell' "OutMemo" l'output ricevuto tramite pipe
                 OutMemo.Text := OutMemo.text + String(Buffer);
               until (BytesRead < BUFSIZE);
             end;
           FreeMem(Buffer);
           CloseHandle(ProcessInfo.hProcess);
           CloseHandle(ProcessInfo.hThread);
           CloseHandle(hReadPipe);
           CloseHandle(hWritePipe);
         end;
        end;



      А это исправленный Song'ом вариант для обеспечения вывода текста в real-time:

      ExpandedWrap disabled
        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('ping -t 192.168.28.200',Memo1);  
        end;
        В примере Сонга - прога виснит, после выполнения команды в консоли. Зависает она в цикле repeat - until, и дальнейшие команды по освобождению памяти не выполняются. Сравнивая этот пример с вот этим: Запуск консольного приложения и получение результатов работы обнаружил, что пример Сонга начинает работать, если команду CloseHandle(WritePipe); вынести вперед цикла...

        Но почему оно начало работать - пока не понимаю, и самому интересно. ВОт что у меня вышло:
        ExpandedWrap disabled
          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;
            WasOK           : Boolean;
          begin
            Screen.Cursor:=CrHourGlass;
           
            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),
                    nil,//@Security,
                    nil,//@Security,
                    true,
                    NORMAL_PRIORITY_CLASS,
                    nil,
                    nil,
                    start,
                    ProcessInfo)
                then
                begin
                  CloseHandle(WritePipe);
                  Apprunning := WaitForSingleObject (ProcessInfo.hProcess,100);
           
                  try
                    repeat
                      WasOK:=ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);
                      Buffer[BytesRead]:= #0;
                      OemToAnsi(Buffer,Buffer);
                      AMemo.Text := AMemo.text + String(Buffer);
           
                      Application.ProcessMessages;
                    until (not WasOK) or ( BytesRead = 0 );
                  finally
                    CloseHandle(ProcessInfo.hProcess);
                    CloseHandle(ProcessInfo.hThread);
                  end;
              end;
           
              FreeMem(Buffer);
              CloseHandle(ReadPipe);
            end;
            Screen.Cursor:=CrDefault;
           
          end;
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0266 ]   [ 17 queries used ]   [ Generated: 28.03.24, 18:48 GMT ]