Code:

procedure TForm1.Button1Click(Sender: TObject);

var

h: HWND;

AIcon: TIcon;

begin

AllocConsole;

SetConsoleTitle(PChar('Console Title'));

Sleep(0);

h := FindWindow(nil, PChar('Console Title'));

AIcon := TIcon.Create;

ImageList1.GetIcon(0, AIcon);

SendMessage(h, WM_SETICON, 1, AIcon.Handle);

AIcon.Free;

end;

 

 

Это не документированные возможности создания полноэкранных консольных приложений. 

В данном случае использованы недокументированные функции SetConsoleDisplayMode и    GetConsoleDisplayMode.

{----------------------------CreateDOSProcessRedirected---------------------------

Description    : executes a (DOS!) app defined in the CommandLine parameter redirected

                 to take input from InputFile and give output to OutputFile

Result         : True on success

Parameters     :

                 CommandLine : the command line for the app, including its full path

                 InputFile   : the ascii file where from the app takes input

                 OutputFile  : the ascii file to which the app's output is redirected

                 ErrMsg      : additional error message string. Can be empty

Error checking : YES

Target         : Delphi 2, 3, 4

Author         : Theodoros Bebekis, email Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Notes          :

Example call   : CreateDOSProcessRedirected('C:\MyDOSApp.exe',

                                            'C:\InputPut.txt',

                                            'C:\OutPut.txt',

                                            'Please, record this message')

-----------------------------------------------------------------------------------}

  

Вообще - я программист молодой, стаж - всего 2 года. И я никак не ожидал, что в век GDI мне придется возится с консолью... Ан нет, пришлось.

 Начал писать "движок" для собственного сайта. А именно - "Apache 1.x shared module" (dll - линкуется к Апачу и обрабатывает определенные адреса).

 Написал. Всего три сотни строк. НО умеет кучу всяких полезностей, типа вставлять на страницы данные из файлов (файл в файл), строки и, главное, данные из БД. Все это прекрасно. НО не умеет вставлять результаты работы других файлов (типа как CGI). Ну, думаю, надо сделать.

 Ага, а как? Вот тут то все и началось...

 Итак,

 ЗАДАЧА:

 запустить процесс (некий файл), передать ему команды и получить от него результаты работы. Вставить полученные результаты на страницу сайта. Причем в целях совместимости механизмы передачи данных ДОЛЖНЫ быть стандартными - StdIn, StdOut, StdErr.

С периодичностью раз в месяц-полтора конференция RU.DELPHI оглашается стонами на тему “Консоль не поет по-русски”, за которыми стоит вывод текста в консольных приложениях в кодировке OEM (Delphi IDE, как и все GUI, работает в ANSI).

 

С точки зрения набора символов эти кодовых таблицы не совпадают: позиции символов кириллицы в них различны (отсюда и неприятные эффекты), кроме того, в ANSI присутствуют диакритические символы, которых нет в OEM, но в последней имеются символы псевдографики, незаменимые при изображении таблиц (интересно, это еще кем-то востребовано? На ум приходит только FAR). Впрочем, возможности для вывода текстовой информации у этих таблиц одинаковы, что в нашем случае позволяет говорить о взаимозаменяемости.

 

 

Code:

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.

 

Создание консольных приложений. (Об этом в советах немножко есть, но очень не конкретно)

 

Как уже отмечалось в совете [000092] (да и в Хелпе) в консольных приложениях в Delphi можно использовать в принципе весь дельфийский арсенал. Правда и работать они будут лишь под Windows. (Кстати этот способ можно применить для модернизации программ на Паскале под Windows).

 

Этот код был использован для вывода результатов работы программы проверки (неважно чего) чтобы не приходилось смотреть файл с результатами. Главная проблема была в том, что консоль (если запуск был из Windows) оставалась висеть позади формы до её закрытия. Вреда конечно никакого, но не приятно. Если же запуск из Нортона или т.п., то всё идёт нормально.

 

Каким образом организовать ожидание завершения DOS-задачи? Например, надо подождать, пока заархивируется файл, и далее обработать его.

 

Code:

uses Windows;

 

procedure RunRarAndWait;

var

si: TStartupInfo;

pi: TProcessInformation;

begin

//подготовливаем записи si и pi к использованию

FillChar(si, SizeOf(si));

si.cb := SizeOf(si);

FillChar(pi, SizeOf(pi));

//попытаемся запустить рар

if CreateProcess('rar.exe', 'parameters',

nil, nil, //безопасность по умолчанию

false,    //не наследовать хэндлов

0,        //флаги создания по умолчанию

nil,      //переменные среды по умолчанию

nil,      //текущая директория по умолчанию

si,       //стартовая информация

pi)       //а в эту запись получим информацию о созданом процессе

then

begin

   //удалось запустить рар

   //подождем пока рар работает

   WaitForSingleObject(pi.hProcess, INFINITE);

   //убираем мусор

   CloseHandle(pi.hProcess);

   CloseHandle(pi.hThread);

end

else

   //выдаем сообщение об ощибке

   MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOK], 0);

end;