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;

 

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

 

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

 

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

 

 

Для того, чтобы добавить в не-консольное приложение ввод/вывод из консоли, необходимо воспользоваться функциями AllocConsole и FreeConsole.

 Пример:

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

  s: string;

begin

AllocConsole;

try

   Write('Type here your words and press ENTER: ');

   Readln(s);

   ShowMessage(Format('You typed: "%s"', [s]));

finally

   FreeConsole;

end;

end;

 

 

Автор: Alex G. Fedorov 

Все настоящие программисты делятся на три категории: на тех, кто пишет программы, завершающиеся по нажатию F10, Alt-F4, Alt-X. Все остальные принципы деления надуманны. 

 Статья представляет собой изучение создания консольного приложения в Delphi. Прежде чем начать вникать в подробности, необходимо уточнить, что консольные приложения это особый вид Windows приложений - с одной стороны он имеет полный доступ к функциям Win API, с другой - не имеет графического интерфейса и выполняется в текстовом режиме.

 

 

Цвет Текста задается командой SetTextColor(Color), параметр Color - целое число от 0 до 15.

Вывод текста в указанном месте экрана задается командой GotoXY(X,Y,Text).

X,Y-координаты экрана.

Text - переменная типа String.

Ответ 3:

Вот текст модуля, напоминающего про наш любимый ДОС (CRT-like):

 

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

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

 

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.

 

{----------------------------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')

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

Все процессы получают сигналы CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT и CTRL_SHUTDOWN_EVENT. А делается это (грубо говоря :) так:

Code:

 

BOOL Ctrl_Handler( DWORD Ctrl )

{

if( (Ctrl == CTRL_SHUTDOWN_EVENT) || (Ctrl == CTRL_LOGOFF_EVENT) )

{

   // Вау! Юзер обламывает!

}

else

{

   // Тут что-от другое можно творить. А можно и не творить :-)

}

return TRUE;

}

 

 

 

Code:

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;

 

 

Нужно просто использовать GetConsoleScreenBufferInfo() для ввода нескольких пустых строк.

 

Code:

program Project1;

{$APPTYPE CONSOLE}

uses

Windows;

{$R *.RES}

var

sbi: TConsoleScreenBufferInfo;

i: integer;

begin

Writeln('A Console Applicaiton');

Writeln('Press Enter To Clear The Screen');

GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),

   sbi);

Readln;

GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),

   sbi);

for i := 0 to sbi.dwSize.y do

   writeln;

Writeln('Press Enter To End');

Readln;

end.