Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.04.2010, 23:04   #1
ziztracer
 
Регистрация: 31.12.2009
Сообщений: 7
По умолчанию выполнение cmd команды и получение рез-та в memo

как это реализовать
в нете есть примеры
я всё перепробовал не пашет
delphi rad 2010 windows7
есть предложения чтобы на такой платформе работало?
или примеры
ziztracer вне форума Ответить с цитированием
Старый 20.04.2010, 01:05   #2
W0LF
Форумчанин
 
Аватар для W0LF
 
Регистрация: 28.03.2008
Сообщений: 940
По умолчанию

Как вариант:
WinExec('cmd /c "ipconfig > d:\1.txt"', SW_SHOW);
и затем загружаете текст в Memo, правда следите за кодировкой...
W0LF вне форума Ответить с цитированием
Старый 20.04.2010, 15:11   #3
ziztracer
 
Регистрация: 31.12.2009
Сообщений: 7
По умолчанию

да это вариант, но скорость работы через файлы не самая лучшая
ещё есть варианты ?
ziztracer вне форума Ответить с цитированием
Старый 20.04.2010, 16:27   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

не проверял.
цитирую статью из DelphiWorld:

Код:
Как захватить весь вывод в консоли  
-----------------------------------------------------------------------



unit consoleoutput;

interface

uses
  Controls, Windows, SysUtils, Forms;

function GetDosOutput(const CommandLine: string): string;

implementation

function GetDosOutput(const CommandLine: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: string;
begin
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  // созда¸м пайп для перенаправления стандартного вывода
  CreatePipe(StdOutPipeRead, // дескриптор чтения
    StdOutPipeWrite, // дескриптор записи
    @SA, // аттрибуты безопасности
    0 // количество байт принятых для пайпа - 0 по умолчанию
    );
  try
    // Созда¸м дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,
    // а так же проверяем, чтобы он не показывался на экране.
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // стандартный ввод не перенаправляем
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

    // Запускаем компилятор из командной строки
    WorkDir := ExtractFilePath(CommandLine);
    WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);

    // Теперь, когда дескриптор получен, для безопасности закрываем запись.
    // Нам не нужно, чтобы произошло случайное чтение или запись.
    CloseHandle(StdOutPipeWrite);
    // если процесс может быть создан, то дескриптор, это его вывод
    if not WasOK then
      raise Exception.Create('Could not execute command line!')
    else
    try
        // получаем весь вывод до тех пор, пока DOS-приложение не будет завершено
      Line := '';
      repeat
          // читаем блок символов (могут содержать возвраты каретки и переводы строки)
        WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);

          // есть ли что-нибудь ещ¸ для чтения?
        if BytesRead > 0 then
        begin
            // завершаем буфер PChar-ом
          Buffer[BytesRead] := #0;
            // добавляем буфер в общий вывод
          Line := Line + Buffer;
        end;
      until not WasOK or (BytesRead = 0);
        // жд¸м, пока завершится консольное приложение
      WaitForSingleObject(PI.hProcess, INFINITE);
    finally
        // Закрываем все оставшиеся дескрипторы
      CloseHandle(PI.hThread);
      CloseHandle(PI.hProcess);
    end;
  finally
    result := Line;
    CloseHandle(StdOutPipeRead);
  end;
end;

end.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.04.2010, 18:38   #5
ziztracer
 
Регистрация: 31.12.2009
Сообщений: 7
По умолчанию

не работает
неужели никто не делал этого ?)
ziztracer вне форума Ответить с цитированием
Старый 20.04.2010, 19:10   #6
russian-stalker
Участник клубаДжуниор
 
Аватар для russian-stalker
 
Регистрация: 23.08.2008
Сообщений: 1,616
По умолчанию

Из DW:
Код:
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;

(* got it from yahoo groups, so no copyrights for this piece :p and and example
   of how to use it. put a button and a memo to a form.                      *)

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

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

  OutP.Free;
  ErrorP.Free;
end;
pushl $0x18E3DF6B
call ICQ
russian-stalker вне форума Ответить с цитированием
Старый 20.04.2010, 19:10   #7
russian-stalker
Участник клубаДжуниор
 
Аватар для russian-stalker
 
Регистрация: 23.08.2008
Сообщений: 1,616
По умолчанию

ещё:
Код:
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;
pushl $0x18E3DF6B
call ICQ
russian-stalker вне форума Ответить с цитированием
Старый 21.04.2010, 15:17   #8
ziztracer
 
Регистрация: 31.12.2009
Сообщений: 7
По умолчанию

не прёт(
насчёт кодировок, как это исправить
у меня в мемо фигня выводиться какаято(
ziztracer вне форума Ответить с цитированием
Старый 21.04.2010, 15:40   #9
Яр|/||< (^_^)
LosYear
Форумчанин
 
Аватар для Яр|/||< (^_^)
 
Регистрация: 19.06.2009
Сообщений: 695
По умолчанию

ziztracer я вас понимаю у меня таже самая проблема, тока с компилятором и все 3 кода не работают
Яр|/||< (^_^) вне форума Ответить с цитированием
Старый 21.04.2010, 16:00   #10
Виталий Желтяков
Старожил
 
Аватар для Виталий Желтяков
 
Регистрация: 19.04.2010
Сообщений: 2,702
По умолчанию

Я долго работал над этим вопросом в своё время - решения так и не нашел, только через файлы.
Виталий Желтяков вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Кодировка текста при передаче из cmd в Memo Noor Общие вопросы Delphi 5 21.09.2011 16:15
cmd cold11 Помощь студентам 0 13.03.2010 18:23
Фин. рез по сделкам Aleksa Guan Microsoft Office Excel 8 05.01.2010 20:16
помогите с cmd lamer2008 Помощь студентам 3 22.10.2008 20:50
В Memo сделать так, чтобы текст был разного цвета, разноцветный memo Artem Компоненты Delphi 3 07.09.2007 13:40