Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 13.02.2013, 15:35
zxen zxen вне форума
Прохожий
 
Регистрация: 12.02.2013
Сообщения: 2
Версия Delphi: XE3
Репутация: 10
По умолчанию Программа консольного ввода/вывода

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

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
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 знаком всего пару недель ), на этом встал в тупик.

Вложения
Тип файла: rar Console.rar (2.3 Кбайт, 1 просмотров)

Последний раз редактировалось zxen, 13.02.2013 в 15:50.
Ответить с цитированием
  #2  
Старый 13.02.2013, 21:44
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Если уж переводить на AnsiChar, то нужно и структуры менять. К примеру, TStartupInfo меняется на TStartupInfoA.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #3  
Старый 24.02.2013, 10:31
zxen zxen вне форума
Прохожий
 
Регистрация: 12.02.2013
Сообщения: 2
Версия Delphi: XE3
Репутация: 10
По умолчанию

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

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
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.02.2013 в 11:14.
Ответить с цитированием
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:24.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025