VPF::Программа консольного ввода/вывода (D7 => XE3)

zxen

Дата 13.2.2013, 15:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 2.2.2013

Репутация: нет
Всего: нет

Помогите пожалуйста переделать код под Delphi XE3, проект взят отсюда http://www.delphisources.ru/forum/sh...ad.php?p=79065. Написан видимо в D7.
Программа представляет собой оболочку cmd. В Edit вводишь команду, в Memo получаешь ответ.

Код


unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TReadThread = class(TThread)
  private
    buf: array [0..255] of AnsiChar;
    dummy: Cardinal;
    procedure UpdateForm;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;
 
  TFormMain = class(TForm)
    MemoConsole: TMemo;
    EditText: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure EditTextKeyPress(Sender: TObject; var Key: Char);
  private
    hPipeInputRead: THandle;
    hPipeInputWrite: THandle;
    hPipeOutputRead: THandle;
    hPipeOutputWrite: THandle;
    hProcess: THandle;
    readthread: TReadThread;
  public
  end;
 
var
  FormMain: TFormMain;
 
implementation
 
{$R *.dfm}
 
procedure TFormMain.FormCreate(Sender: TObject);
var
  securityattributes: TSecurityAttributes;
  startupinfo: TStartupInfo;
  processinformation: TProcessInformation;
begin
  securityattributes.nLength:=SizeOf(TSecurityAttributes);
  securityattributes.lpSecurityDescriptor:=nil;
  securityattributes.bInheritHandle:=True;
  CreatePipe(hPipeInputRead, hPipeInputWrite, @securityattributes, 0);
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @securityattributes, 0);
  ZeroMemory(@startupinfo, SizeOf(TStartupInfo));
  ZeroMemory(@processinformation, SizeOf(TProcessInformation));
  startupinfo.cb:=SizeOf(TStartupInfo);
  startupinfo.dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  startupinfo.wShowWindow:=SW_HIDE;
  startupinfo.hStdInput:=hPipeInputRead;
  startupinfo.hStdOutput:=hPipeOutputWrite;
  startupinfo.hStdError:=hPipeOutputWrite;
  CreateProcess(nil, PChar('cmd'), nil, nil, True, CREATE_NEW_CONSOLE, nil, nil, startupinfo, processinformation); 
  hProcess:=processinformation.hProcess;
  readthread:=TReadThread.Create;
end;
 
procedure TFormMain.FormDestroy(Sender: TObject);
begin
  TerminateProcess(hProcess, 255);
  WaitForSingleObject(hProcess, INFINITE);
  CloseHandle(hProcess);
  readthread.Terminate;
  CloseHandle(hPipeInputWrite);
  CloseHandle(hPipeInputRead);
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeOutputRead);
  readthread.WaitFor;
  readthread.Free;
end;
 
procedure TFormMain.EditTextKeyPress(Sender: TObject; var Key: Char);
var
  buf: array [0..255] of AnsiChar;
  dummy: Cardinal;
begin
  if Key=#13 then
  begin
    MemoConsole.Clear;
    StrPCopy(buf, EditText.Text+#13#10);
    WriteFile(hPipeInputWrite, buf, Length(EditText.Text)+2, dummy, nil);
    EditText.Clear;
  end;
end;
 
{ TReadThread }
 
constructor TReadThread.Create;
begin
  inherited Create(False);
  FreeOnTerminate:=False;
end;
 
destructor TReadThread.Destroy;
begin
  inherited Destroy;
end;
 
procedure TReadThread.Execute;
begin
  while not Terminated do
    if ReadFile(FormMain.hPipeOutputRead, buf, Length(buf), dummy, nil) then Synchronize(UpdateForm);
end;
 
procedure TReadThread.UpdateForm;
begin
  OemToAnsiBuff(buf, buf, dummy);
  FormMain.MemoConsole.Text:=FormMain.MemoConsole.Text+Copy(buf, 1, dummy);
end;
 
end.

Сам переделал пару мест, поменял of Char, на of AnsiChar (стр.12, 85). Ошибки в коде исчезли, но теперь при компиляции вылазит это:
Так как с delphi знаком всего пару недель ), на этом встал в тупик.

Присоединённый файл ( Кол-во скачиваний: 1 )

Console.rar 2,32 Kb

Leklerk

Дата 13.2.2013, 17:17 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 200
Регистрация: 31.7.2009
Где: Санкт-Петербург

Репутация: нет
Всего: нет

Access Violation в деталях

bems

Дата 14.2.2013, 10:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 18
Всего: 88

в CreateProcessW имя программы должно быть доступно на запись (в отличие от CreateProcessA которая стоит за CreateProcess в старых делфях)
и да, код гoвнo

--------------------

Обижено школьников: 8

zxen

Дата 24.2.2013, 09:18 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 2.2.2013

Репутация: нет
Всего: нет

Нарыл и приспособил немножко другой код.. Есть небольшая проблемка, когда программа запускает например пинг. ехе, во время обработки пргрпмму невозжожно закрыть крестиком, вставил паузу (стр. 116) программа не виснет , но крестик все равно не нажимается. И как можно закрывать порограммы, запущенные CreateProcess'om.. тасккил по имени как то тупо..
И еще, как бы сделать так, чтоб текст вывода консоли добавлялся к уже существующему в мемо, а не стирался с каждым новым выводом. Memo1.Text:= Memo1.Text + DosToWin(getcmdval) не работает, выполняется первая команда, дальше вообще ничего в мемо не пишется.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winapi.ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);

  private
       function GetDosOutput(const CommandLine:string): string;
  public


  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

var stopfunc: Integer;

function DosToWin(ASource: AnsiString): AnsiString;
 var
   Ch: PAnsiChar;
 begin
   Ch := AnsiStrAlloc(Length(ASource) + 1);
   OemToAnsi(PAnsiChar(ASource), Ch);
   Result := StrPas(Ch);
   StrDispose(Ch);
 end;


function TForm1.GetDosOutput(const CommandLine:string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfoA;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir, Line: String;
  i:Integer;
begin
stopfunc:=0;
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;

  CreatePipe(StdOutPipeRead,
             StdOutPipeWrite,
             @SA,
             0
             );
  try

    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:=CreateProcessa(nil, PAnsiChar(AnsiString(CommandLine)), nil, nil, True, 0, nil, PAnsiChar('C:\WINDOWS\system32\'), SI, PI);
    //WasOK := CreateProcess(nil, PChar('C:\WINDOWS\system32\cmd.exe'), 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

        Line := '';
        repeat

          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then

          begin

            Buffer[BytesRead] := #0;
            Line := Line + Buffer;
            if (Copy(Form1.Edit1.text,1,4) = 'ping') then begin 

             Form1.Memo1.text := DosToWin(Line); // конвертим вывод в мемо, с ОЕМ в Анси
              Memo1.Perform(EM_LINESCROLL,0,Memo1.Lines.Count-1); // автопрокрутка мемо вниз
               //////////////////////////  пауза, чтоб не висло окно при пинге и множественных выводов консоли

              i := 0;
               while i<100 do begin
              sleep(12);
              Application.ProcessMessages;
              inc(i);
              end;
                //// убиваем процессы
              if stopfunc = 1 then
               begin
               CloseHandle(PI.hThread);
               CloseHandle(PI.hProcess);
               shellexecute(0,'Open',Pchar('taskkill'),'/im cmd.exe /f',0,SW_HIDE);
               shellexecute(0,'Open',Pchar('taskkill'),'/im ping.exe /f',0,SW_HIDE);
              Exit;
             end;
            end;


          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;
  //// выполняем команду CMD
procedure TForm1.Button1Click(Sender: TObject);
 var cmdinput, getcmdval, memotxt: string;

begin

   Edit1.Text:= Trim(Edit1.Text); // удаляем пробелы в начале и в конце в строке ввода
   cmdinput:= 'cmd.exe /c ' + Edit1.Text; // текст посылаемый в функцию

    memotxt:= Memo1.Text;
    getcmdval:= GetDosOutput(cmdinput);


    Memo1.Text:=  DosToWin(getcmdval);
end;
      /// останавливаем выполнение CMD
procedure TForm1.Button2Click(Sender: TObject);
begin
stopfunc:=1;
end;

end.

Это сообщение отредактировал(а) zxen - 24.2.2013, 09:43

bems

Дата 24.2.2013, 17:06 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 18
Всего: 88

TerminateProcess
учись, не передирай

--------------------

Обижено школьников: 8

zxen

Дата 27.2.2013, 15:28 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 2.2.2013

Репутация: нет
Всего: нет

Цитата(bems @ 24.2.2013, 17:06)

TerminateProcess
учись, не передирай

Спасибо конечно, но не совсем то, что я имел ввиду.. Нужно чтоб программа могла закрывать свои запущенные дочерние процессы а не процессы именам, так как они могут быть всякие разные. Вопрос в том, как к ним можно обратиться.

Чучмек

Дата 27.2.2013, 16:54 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 7
Всего: 41

Функция TerminateProcess

Цитата

Функция TerminateProcess завершает работу заданного процесса и всех его потоков.

Цитата

hProcess

[in] Дескриптор процесса, который завершает работу.

Цитата(zxen @ 27.2.2013, 15:28

)

процессы именам

Это сообщение отредактировал(а) Чучмек - 27.2.2013, 16:55

--------------------

умную мысль держи при себе, а дурной - поделись с другими

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »