Консольные приложения и приложения DOS

CreateProcess, который возвращает консольный вывод

2017-11-12T04:29:07+07:00

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;

CRT для консольного приложения

2017-11-12T04:49:23+07:00

Code:

$IfDef VER130}

{$Define NEW_STYLES}

{$EndIf}

{$IfDef VER140}

{$Define NEW_STYLES}

{$EndIf}

{..$Define HARD_CRT} {Redirect STD_...}

{..$Define CRT_EVENT} {CTRL-C,...}

{$Define MOUSE_IS_USED} {Handle mouse or not}

{..$Define OneByOne} {Block or byte style write}

unit CRT32;

Interface

{$IfDef Win32}

Const

{ CRT modes of original CRT unit }

BW40 = 0; { 40x25 B/W on Color Adapter }

CO40 = 1; { 40x25 Color on Color Adapter }

BW80 = 2; { 80x25 B/W on Color Adapter }

CO80 = 3; { 80x25 Color on Color Adapter }

Mono = 7; { 80x25 on Monochrome Adapter }

Font8x8 = 256;{ Add-in for ROM font }

{ Mode constants for 3.0 compatibility of original CRT unit }

C40 = CO40;

C80 = CO80;

{ Foreground and background color constants of original CRT unit }

Black = 0;

Blue = 1;

Green = 2;

Cyan = 3;

Red = 4;

Magenta = 5;

Brown 6;

LightGray = 7;

{ Foreground color constants of original CRT unit }

DarkGray = 8;

LightBlue = 9;

LightGreen = 10;

LightCyan = 11;

LightRed = 12;

LightMagenta = 13;

Yellow = 14;

White = 15;

{ Add-in for blinking of original CRT unit }

Blink = 128;

{ }

{ New constans there are not in original CRT unit }

{ }

MouseLeftButton = 1;

MouseRightButton = 2;

MouseCenterButton = 4;

var

{ Interface variables of original CRT unit }

CheckBreak: Boolean; { Enable Ctrl-Break }

CheckEOF: Boolean; { Enable Ctrl-Z }

DirectVideo: Boolean; { Enable direct video addressing }

CheckSnow: Boolean; { Enable snow filtering }

LastMode: Word; { Current text mode }

TextAttr: Byte; { Current text attribute }

WindMin: Word; { Window upper left coordinates }

WindMax: Word; { Window lower right coordinates }

{ }

{ New variables there are not in original CRT unit }

{ }

MouseInstalled: boolean;

MousePressedButtons: word;

{ Interface functions & procedures of original CRT unit }

procedure AssignCrt(var F: Text);

function KeyPressed: Boolean;

function ReadKey: char;

procedure TextMode(Mode: Integer);

procedure Window(X1, Y1, X2, Y2: Byte);

procedure GotoXY(X, Y: Byte);

function WhereX: Byte;

function WhereY: Byte;

procedure ClrScr;

procedure ClrEol;

procedure InsLine;

procedure DelLine;

procedure TextColor(Color: Byte);

procedure TextBackground(Color: Byte);

procedure LowVideo;

procedure HighVideo;

procedure NormVideo;

procedure Delay(MS: Word);

procedure Sound(Hz: Word);

procedure NoSound;

{ New functions & procedures there are not in original CRT unit }

procedure FillerScreen(FillChar: Char);

procedure FlushInputBuffer;

function GetCursor: Word;

procedure SetCursor(NewCursor: Word);

function MouseKeyPressed: Boolean;

procedure MouseGotoXY(X, Y: Integer);

function MouseWhereY: Integer;

function MouseWhereX: Integer;

procedure MouseShowCursor;

procedure MouseHideCursor;

{ These functions & procedures are for inside use only }

function MouseReset: Boolean;

procedure WriteChrXY(X, Y: Byte; Chr: char);

procedure WriteStrXY(X, Y: Byte; Str: PChar; dwSize: Integer);

procedure OverwriteChrXY(X, Y: Byte; Chr: char);

{$EndIf Win32}

implementation

{$IfDef Win32}

uses Windows, SysUtils;

type

POpenText = ^TOpenText;

TOpenText = function(var F: Text; Mode: Word): Integer; far;

var

IsWinNT: boolean;

PtrOpenText: POpenText;

hConsoleInput: THandle;

hConsoleOutput: THandle;

ConsoleScreenRect: TSmallRect;

StartAttr: word;

LastX, LastY: byte;

SoundDuration: integer;

SoundFrequency: integer;

OldCP: integer;

MouseRowWidth, MouseColWidth: word;

MousePosX, MousePosY: smallInt;

MouseButtonPressed: boolean;

MouseEventTime: TDateTime;

{ }

{ This function handles the Write and WriteLn commands }

{ }

function TextOut(var F: Text): Integer; far;

{$IfDef OneByOne}

var

dwSize: DWORD;

{$EndIf}

begin

with TTExtRec(F) do

begin

if BufPos > 0 then

begin

LastX := WhereX;

LastY := WhereY;

{$IfDef OneByOne}

dwSize := 0;

while (dwSize < BufPos) do

begin

WriteChrXY(LastX, LastY, BufPtr[dwSize]);

Inc(dwSize);

end;

{$Else}

WriteStrXY(LastX, LastY, BufPtr, BufPos);

FillChar(BufPtr^, BufPos + 1, #0);

{$EndIf}

BufPos := 0;

end;

Result := 0;

end;

{ }

{ This function handles the exchanging of Input or Output }

{ }

function OpenText(var F: Text; Mode: Word): Integer; far;

var

OpenResult: integer;

begin

OpenResult := 102; { Text not assigned }

if Assigned(PtrOpenText) then

begin

TTextRec(F).OpenFunc := PtrOpenText;

OpenResult := PtrOpenText^(F, Mode);

if OpenResult = 0 then

begin

if Mode = fmInput then

hConsoleInput := TTextRec(F).Handle

else

begin

hConsoleOutput := TTextRec(F).Handle;

TTextRec(Output).InOutFunc := @TextOut;

TTextRec(Output).FlushFunc := @TextOut;

end;

Result := OpenResult;

end;

{ }

{ Fills the current window with special character }

{ }

procedure FillerScreen(FillChar: Char);

var

Coord: TCoord;

dwSize, dwCount: DWORD;

Y: integer;

begin

Coord.X := ConsoleScreenRect.Left;

dwSize := ConsoleScreenRect.Right - ConsoleScreenRect.Left + 1;

for Y := ConsoleScreenRect.Top to ConsoleScreenRect.Bottom do

begin

Coord.Y := Y;

FillConsoleOutputAttribute(hConsoleOutput, TextAttr, dwSize, Coord, dwCount);

FillConsoleOutputCharacter(hConsoleOutput, FillChar, dwSize, Coord, dwCount);

end;

GotoXY(1,1);

end;

{ }

{ Write one character at the X,Y position }

{ }

procedure WriteChrXY(X, Y: Byte; Chr: char);

var

Coord: TCoord;

dwSize, dwCount: DWORD;

begin

LastX := X;

LastY := Y;

case Chr of

#13: LastX := 1;

#10:

begin

LastX := 1;

Inc(LastY);

end;

else

begin

Coord.X := LastX - 1 + ConsoleScreenRect.Left;

Coord.Y := LastY - 1 + ConsoleScreenRect.Top;

dwSize := 1;

FillConsoleOutputAttribute(hConsoleOutput, TextAttr, dwSize, Coord, dwCount);

FillConsoleOutputCharacter(hConsoleOutput, Chr, dwSize, Coord, dwCount);

Inc(LastX);

end;

if (LastX + ConsoleScreenRect.Left) > (ConsoleScreenRect.Right + 1) then

begin

LastX := 1;

Inc(LastY);

end;

if (LastY + ConsoleScreenRect.Top) > (ConsoleScreenRect.Bottom + 1) then

begin

Dec(LastY);

GotoXY(1,1);

DelLine;

end;

GotoXY(LastX, LastY);

end;

{ }

{ Write string into the X,Y position }

{ }

(* !!! The WriteConsoleOutput does not write into the last line !!!

Procedure WriteStrXY(X,Y: byte; Str: PChar; dwSize: integer );

{$IfDef OneByOne}

Var

dwCount: integer;

{$Else}

Type

PBuffer= ^TBuffer;

TBUffer= packed array [0..16384] of TCharInfo;

Var

I: integer;

dwCount: DWORD;

WidthHeight,Coord: TCoord;

hTempConsoleOutput: THandle;

SecurityAttributes: TSecurityAttributes;

Buffer: PBuffer;

DestinationScreenRect,SourceScreenRect: TSmallRect;

{$EndIf}

Begin

If dwSize>0 Then Begin

{$IfDef OneByOne}

LastX:=X;

LastY:=Y;

dwCount:=0;

While dwCount < dwSize Do Begin

WriteChrXY(LastX,LastY,Str[dwCount]);

Inc(dwCount);

End;

{$Else}

SecurityAttributes.nLength:=SizeOf(SecurityAttributes)-SizeOf(DWORD);

SecurityAttributes.lpSecurityDescriptor:=NIL;

SecurityAttributes.bInheritHandle:=TRUE;

hTempConsoleOutput:=CreateConsoleScreenBuffer(

GENERIC_READ OR GENERIC_WRITE,

FILE_SHARE_READ OR FILE_SHARE_WRITE,

@SecurityAttributes,

CONSOLE_TEXTMODE_BUFFER,

NIL

);

If dwSize<=(ConsoleScreenRect.Right-ConsoleScreenRect.Left+1) Then Begin

WidthHeight.X:=dwSize;

WidthHeight.Y:=1;

End Else Begin

WidthHeight.X:=ConsoleScreenRect.Right-ConsoleScreenRect.Left+1;

WidthHeight.Y:=dwSize DIV WidthHeight.X;

If (dwSize MOD WidthHeight.X) > 0 Then Inc(WidthHeight.Y);

End;

SetConsoleScreenBufferSize(hTempConsoleOutput,WidthHeight);

DestinationScreenRect.Left:=0;

DestinationScreenRect.Top:=0;

DestinationScreenRect.Right:=WidthHeight.X-1;

DestinationScreenRect.Bottom:=WidthHeight.Y-1;

SetConsoleWindowInfo(hTempConsoleOutput,FALSE,DestinationScreenRect);

Coord.X:=0;

For I:=1 To WidthHeight.Y Do Begin

Coord.Y:=I-0;

FillConsoleOutputAttribute(hTempConsoleOutput,TextAttr,WidthHeight.X,Coord,dwCount);

FillConsoleOutputCharacter(hTempConsoleOutput,' ' ,WidthHeight.X,Coord,dwCount);

End;

WriteConsole(hTempConsoleOutput,Str,dwSize,dwCount,NIL);

{ }

New(Buffer);

Coord.X:= 0;

Coord.Y:= 0;

SourceScreenRect.Left:=0;

SourceScreenRect.Top:=0;

SourceScreenRect.Right:=WidthHeight.X-1;

SourceScreenRect.Bottom:=WidthHeight.Y-1;

ReadConsoleOutputA(hTempConsoleOutput,Buffer,WidthHeight,Coord,SourceScreenRect);

Coord.X:=X-1;

Coord.Y:=Y-1;

DestinationScreenRect:=ConsoleScreenRect;

WriteConsoleOutputA(hConsoleOutput,Buffer,WidthHeight,Coord,DestinationScreenRect);

GotoXY((dwSize MOD WidthHeight.X)-1,WidthHeight.Y+1);

Dispose(Buffer);

{ }

CloseHandle(hTempConsoleOutput);

{$EndIf}

End;

procedure WriteStrXY(X, Y: Byte; Str: PChar; dwSize: Integer);

{$IfDef OneByOne}

var

dwCount: integer;

{$Else}

var

I: integer;

LineSize, dwCharCount, dwCount, dwWait: DWORD;

WidthHeight: TCoord;

OneLine: packed array [0..131] of char;

Line, TempStr: PChar;

procedure NewLine;

begin

LastX := 1;

Inc(LastY);

if (LastY + ConsoleScreenRect.Top) > (ConsoleScreenRect.Bottom + 1) then

begin

Dec(LastY);

GotoXY(1,1);

DelLine;

end;

GotoXY(LastX, LastY);

end;

{$EndIf}

begin

if dwSize > 0 then

begin

{$IfDef OneByOne}

LastX := X;

LastY := Y;

dwCount := 0;

while dwCount < dwSize do

begin

WriteChrXY(LastX, LastY, Str[dwCount]);

Inc(dwCount);

end;

{$Else}

LastX := X;

LastY := Y;

GotoXY(LastX, LastY);

dwWait := dwSize;

TempStr := Str;

while (dwWait > 0) and (Pos(#13#10, StrPas(TempStr)) = 1) do

begin

Dec(dwWait, 2);

Inc(TempStr, 2);

NewLine;

end;

while (dwWait > 0) and (Pos(#10, StrPas(TempStr)) = 1) do

begin

Dec(dwWait);

Inc(TempStr);

NewLine;

end;

if dwWait > 0 then

begin

if dwSize <= (ConsoleScreenRect.Right - ConsoleScreenRect.Left - LastX + 1) then

begin

WidthHeight.X := dwSize + LastX - 1;

WidthHeight.Y := 1;

end

else

begin

WidthHeight.X := ConsoleScreenRect.Right - ConsoleScreenRect.Left + 1;

WidthHeight.Y := dwSize div WidthHeight.X;

if (dwSize mod WidthHeight.X) > 0 then Inc(WidthHeight.Y);

end;

for I := 1 to WidthHeight.Y do

begin

FillChar(OneLine, SizeOf(OneLine), #0);

Line := @OneLine;

LineSize := WidthHeight.X - LastX + 1;

if LineSize > dwWait then LineSize := dwWait;

Dec(dwWait, LineSize);

StrLCopy(Line, TempStr, LineSize);

Inc(TempStr, LineSize);

dwCharCount := Pos(#13#10, StrPas(Line));

if dwCharCount > 0 then

begin

OneLine[dwCharCount - 1] := #0;

OneLine[dwCharCount] := #0;

WriteConsole(hConsoleOutput, Line, dwCharCount - 1,dwCount, nil);

Inc(Line, dwCharCount + 1);

NewLine;

LineSize := LineSize - (dwCharCount + 1);

end

else

begin

dwCharCount := Pos(#10, StrPas(Line));

if dwCharCount > 0 then

begin

OneLine[dwCharCount - 1] := #0;

WriteConsole(hConsoleOutput, Line, dwCharCount - 1,dwCount, nil);

Inc(Line, dwCharCount);

NewLine;

LineSize := LineSize - dwCharCount;

end;

if LineSize <> 0 then

begin

WriteConsole(hConsoleOutput, Line, LineSize, dwCount, nil);

end;

if dwWait > 0 then

begin

NewLine;

end;

{$EndIf}

end;

{ }

{ Empty the buffer }

{ }

procedure FlushInputBuffer;

begin

FlushConsoleInputBuffer(hConsoleInput);

end;

{ }

{ Get size of current cursor }

{ }

function GetCursor: Word;

var

CCI: TConsoleCursorInfo;

begin

GetConsoleCursorInfo(hConsoleOutput, CCI);

GetCursor := CCI.dwSize;

end;

{ }

{ Set size of current cursor }

{ }

procedure SetCursor(NewCursor: Word);

var

CCI: TConsoleCursorInfo;

begin

if NewCursor = $0000 then

begin

CCI.dwSize := GetCursor;

CCI.bVisible := False;

end

else

begin

CCI.dwSize := NewCursor;

CCI.bVisible := True;

end;

SetConsoleCursorInfo(hConsoleOutput, CCI);

end;

{ }

{ --- Begin of Interface functions & procedures of original CRT unit --- }

procedure AssignCrt(var F: Text);

begin

Assign(F, '');

TTextRec(F).OpenFunc := @OpenText;

end;

function KeyPressed: Boolean;

var

NumberOfEvents: DWORD;

NumRead: DWORD;

InputRec: TInputRecord;

Pressed: boolean;

begin

Pressed := False;

GetNumberOfConsoleInputEvents(hConsoleInput, NumberOfEvents);

if NumberOfEvents > 0 then

begin

if PeekConsoleInput(hConsoleInput, InputRec, 1,NumRead) then

begin

if (InputRec.EventType = KEY_EVENT) and

(InputRec{$IfDef NEW_STYLES}.Event{$EndIf}.KeyEvent.bKeyDown) then

begin

Pressed := True;

{$IfDef MOUSE_IS_USED}

MouseButtonPressed := False;

{$EndIf}

end

else

begin

{$IfDef MOUSE_IS_USED}

if (InputRec.EventType = _MOUSE_EVENT) then

begin

with InputRec{$IfDef NEW_STYLES}.Event{$EndIf}.MouseEvent do

begin

MousePosX := dwMousePosition.X;

MousePosY := dwMousePosition.Y;

if dwButtonState = FROM_LEFT_1ST_BUTTON_PRESSED then

begin

MouseEventTime := Now;

MouseButtonPressed := True;

{If (dwEventFlags AND DOUBLE_CLICK)<>0 Then Begin}

{End;}

end;

ReadConsoleInput(hConsoleInput, InputRec, 1,NumRead);

{$Else}

ReadConsoleInput(hConsoleInput, InputRec, 1,NumRead);

{$EndIf}

end;

Result := Pressed;

end;

function ReadKey: char;

var

NumRead: DWORD;

InputRec: TInputRecord;

begin

repeat

until KeyPressed;

ReadConsoleInput(hConsoleInput, InputRec, 1,NumRead);

until InputRec{$IfDef NEW_STYLES}.Event{$EndIf}.KeyEvent.AsciiChar > #0;

Result := InputRec{$IfDef NEW_STYLES}.Event{$EndIf}.KeyEvent.AsciiChar;

end;

procedure TextMode(Mode: Integer);

begin

end;

procedure Window(X1, Y1, X2, Y2: Byte);

begin

ConsoleScreenRect.Left := X1 - 1;

ConsoleScreenRect.Top := Y1 - 1;

ConsoleScreenRect.Right := X2 - 1;

ConsoleScreenRect.Bottom := Y2 - 1;

WindMin := (ConsoleScreenRect.Top shl 8) or ConsoleScreenRect.Left;

WindMax := (ConsoleScreenRect.Bottom shl 8) or ConsoleScreenRect.Right;

{$IfDef WindowFrameToo}

SetConsoleWindowInfo(hConsoleOutput, True, ConsoleScreenRect);

{$EndIf}

GotoXY(1,1);

end;

procedure GotoXY(X, Y: Byte);

var

Coord: TCoord;

begin

Coord.X := X - 1 + ConsoleScreenRect.Left;

Coord.Y := Y - 1 + ConsoleScreenRect.Top;

if not SetConsoleCursorPosition(hConsoleOutput, Coord) then

begin

GotoXY(1, 1);

DelLine;

end;

function WhereX: Byte;

var

CBI: TConsoleScreenBufferInfo;

begin

GetConsoleScreenBufferInfo(hConsoleOutput, CBI);

Result := TCoord(CBI.dwCursorPosition).X + 1 - ConsoleScreenRect.Left;

end;

function WhereY: Byte;

var

CBI: TConsoleScreenBufferInfo;

begin

GetConsoleScreenBufferInfo(hConsoleOutput, CBI);

Result := TCoord(CBI.dwCursorPosition).Y + 1 - ConsoleScreenRect.Top;

end;

procedure ClrScr;

begin

FillerScreen(' ');

end;

procedure ClrEol;

var

Coord: TCoord;

dwSize, dwCount: DWORD;

begin

Coord.X := WhereX - 1 + ConsoleScreenRect.Left;

Coord.Y := WhereY - 1 + ConsoleScreenRect.Top;

dwSize := ConsoleScreenRect.Right - Coord.X + 1;

FillConsoleOutputAttribute(hConsoleOutput, TextAttr, dwSize, Coord, dwCount);

FillConsoleOutputCharacter(hConsoleOutput, ' ', dwSize, Coord, dwCount);

end;

procedure InsLine;

var

SourceScreenRect: TSmallRect;

Coord: TCoord;

CI: TCharInfo;

dwSize, dwCount: DWORD;

begin

SourceScreenRect := ConsoleScreenRect;

SourceScreenRect.Top := WhereY - 1 + ConsoleScreenRect.Top;

SourceScreenRect.Bottom := ConsoleScreenRect.Bottom - 1;

CI.AsciiChar := ' ';

CI.Attributes := TextAttr;

Coord.X := SourceScreenRect.Left;

Coord.Y := SourceScreenRect.Top + 1;

dwSize := SourceScreenRect.Right - SourceScreenRect.Left + 1;

ScrollConsoleScreenBuffer(hConsoleOutput, SourceScreenRect, nil, Coord, CI);

Dec(Coord.Y);

FillConsoleOutputAttribute(hConsoleOutput, TextAttr, dwSize, Coord, dwCount);

end;

procedure DelLine;

var

SourceScreenRect: TSmallRect;

Coord: TCoord;

CI: TCharinfo;

dwSize, dwCount: DWORD;

begin

SourceScreenRect := ConsoleScreenRect;

SourceScreenRect.Top := WhereY + ConsoleScreenRect.Top;

CI.AsciiChar := ' ';

CI.Attributes := TextAttr;

Coord.X := SourceScreenRect.Left;

Coord.Y := SourceScreenRect.Top - 1;

dwSize := SourceScreenRect.Right - SourceScreenRect.Left + 1;

ScrollConsoleScreenBuffer(hConsoleOutput, SourceScreenRect, nil, Coord, CI);

FillConsoleOutputAttribute(hConsoleOutput, TextAttr, dwSize, Coord, dwCount);

end;

procedure TextColor(Color: Byte);

begin

LastMode := TextAttr;

TextAttr := (Color and $0F) or (TextAttr and $F0);

SetConsoleTextAttribute(hConsoleOutput, TextAttr);

end;

procedure TextBackground(Color: Byte);

begin

LastMode := TextAttr;

TextAttr := (Color shl 4) or (TextAttr and $0F);

SetConsoleTextAttribute(hConsoleOutput, TextAttr);

end;

procedure LowVideo;

begin

LastMode := TextAttr;

TextAttr := TextAttr and $F7;

SetConsoleTextAttribute(hConsoleOutput, TextAttr);

end;

procedure HighVideo;

begin

LastMode := TextAttr;

TextAttr := TextAttr or $08;

SetConsoleTextAttribute(hConsoleOutput, TextAttr);

end;

procedure NormVideo;

begin

LastMode := TextAttr;

TextAttr := StartAttr;

SetConsoleTextAttribute(hConsoleOutput, TextAttr);

end;

procedure Delay(MS: Word);

{

Const

Magic= $80000000;

var

StartMS,CurMS,DeltaMS: DWORD;

}

begin

Windows.SleepEx(MS, False); // Windows.Sleep(MS);

{

StartMS:= GetTickCount;

Repeat

CurMS:= GetTickCount;

If CurMS >= StartMS Then

DeltaMS:= CurMS - StartMS

Else DeltaMS := (CurMS + Magic) - (StartMS - Magic);

Until MS<DeltaMS;

}

end;

procedure Sound(Hz: Word);

begin

{SetSoundIOPermissionMap(LocalIOPermission_ON);}

SoundFrequency := Hz;

if IsWinNT then

begin

Windows.Beep(SoundFrequency, SoundDuration)

end

else

begin

asm

mov BX,Hz

cmp BX,0

jz @2

mov AX,$34DD

mov DX,$0012

cmp DX,BX

jnb @2

div BX

mov BX,AX

{ Sound is On ? }

in Al,$61

test Al,$03

jnz @1

{ Set Sound On }

or Al,03

out $61,Al

{ Timer Command }

mov Al,$B6

out $43,Al

{ Set Frequency }

@1: mov Al,Bl

out $42,Al

mov Al,Bh

out $42,Al

@2:

end;

procedure NoSound;

begin

if IsWinNT then

begin

Windows.Beep(SoundFrequency, 0);

end

else

begin

asm

{ Set Sound On }

in Al,$61

and Al,$FC

out $61,Al

end;

{SetSoundIOPermissionMap(LocalIOPermission_OFF);}

end;

{ --- End of Interface functions & procedures of original CRT unit --- }

{ }

procedure OverwriteChrXY(X, Y: Byte; Chr: char);

var

Coord: TCoord;

dwSize, dwCount: DWORD;

begin

LastX := X;

LastY := Y;

Coord.X := LastX - 1 + ConsoleScreenRect.Left;

Coord.Y := LastY - 1 + ConsoleScreenRect.Top;

dwSize := 1;

FillConsoleOutputAttribute(hConsoleOutput, TextAttr, dwSize, Coord, dwCount);

FillConsoleOutputCharacter(hConsoleOutput, Chr, dwSize, Coord, dwCount);

GotoXY(LastX, LastY);

end;

{ -------------------------------------------------- }

{ Console Event Handler }

{ }

{$IfDef CRT_EVENT}

function ConsoleEventProc(CtrlType: DWORD): Bool; stdcall; far;

var

S: {$IfDef Win32}ShortString{$Else}String{$EndIf};

Message: PChar;

begin

case CtrlType of

CTRL_C_EVENT: S := 'CTRL_C_EVENT';

CTRL_BREAK_EVENT: S := 'CTRL_BREAK_EVENT';

CTRL_CLOSE_EVENT: S := 'CTRL_CLOSE_EVENT';

CTRL_LOGOFF_EVENT: S := 'CTRL_LOGOFF_EVENT';

CTRL_SHUTDOWN_EVENT: S := 'CTRL_SHUTDOWN_EVENT';

else

S := 'UNKNOWN_EVENT';

end;

S := S + ' detected, but not handled.';

Message := @S;

Inc(Message);

MessageBox(0, Message, 'Win32 Console', MB_OK);

Result := True;

end;

{$EndIf}

function MouseReset: Boolean;

begin

MouseColWidth := 1;

MouseRowWidth := 1;

Result := True;

end;

procedure MouseShowCursor;

const

ShowMouseConsoleMode = ENABLE_MOUSE_INPUT;

var

cMode: DWORD;

begin

GetConsoleMode(hConsoleInput, cMode);

if (cMode and ShowMouseConsoleMode) <> ShowMouseConsoleMode then

begin

cMode := cMode or ShowMouseConsoleMode;

SetConsoleMode(hConsoleInput, cMode);

end;

procedure MouseHideCursor;

const

ShowMouseConsoleMode = ENABLE_MOUSE_INPUT;

var

cMode: DWORD;

begin

GetConsoleMode(hConsoleInput, cMode);

if (cMode and ShowMouseConsoleMode) = ShowMouseConsoleMode then

begin

cMode := cMode and ($FFFFFFFF xor ShowMouseConsoleMode);

SetConsoleMode(hConsoleInput, cMode);

end;

function MouseKeyPressed: Boolean;

{$IfDef MOUSE_IS_USED}

const

MouseDeltaTime = 200;

var

ActualTime: TDateTime;

HourA, HourM, MinA, MinM, SecA, SecM, MSecA, MSecM: word;

MSecTimeA, MSecTimeM: longInt;

MSecDelta: longInt;

{$EndIf}

begin

MousePressedButtons := 0;

{$IfDef MOUSE_IS_USED}

Result := False;

if MouseButtonPressed then

begin

ActualTime := NOW;

DecodeTime(ActualTime, HourA, MinA, SecA, MSecA);

DecodeTime(MouseEventTime, HourM, MinM, SecM, MSecM);

MSecTimeA := (3600 * HourA + 60 * MinA + SecA) * 100 + MSecA;

MSecTimeM := (3600 * HourM + 60 * MinM + SecM) * 100 + MSecM;

MSecDelta := Abs(MSecTimeM - MSecTimeA);

if (MSecDelta < MouseDeltaTime) or (MSecDelta > (8784000 - MouseDeltaTime)) then

begin

MousePressedButtons := MouseLeftButton;

MouseButtonPressed := False;

Result := True;

end;

{$Else}

Result := False;

{$EndIf}

end;

procedure MouseGotoXY(X, Y: Integer);

begin

{$IfDef MOUSE_IS_USED}

mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE,

X - 1,Y - 1,WHEEL_DELTA, GetMessageExtraInfo());

MousePosY := (Y - 1) * MouseRowWidth;

MousePosX := (X - 1) * MouseColWidth;

{$EndIf}

end;

function MouseWhereY: Integer;

{$IfDef MOUSE_IS_USED}

{Var

lppt, lpptBuf: TMouseMovePoint;}

{$EndIf}

begin

{$IfDef MOUSE_IS_USED}

{GetMouseMovePoints(

SizeOf(TMouseMovePoint), lppt, lpptBuf,

7,GMMP_USE_DRIVER_POINTS

);

Result:=lpptBuf.Y DIV MouseRowWidth;}

Result := (MousePosY div MouseRowWidth) + 1;

{$Else}

Result := -1;

{$EndIf}

end;

function MouseWhereX: Integer;

{$IfDef MOUSE_IS_USED}

{Var

lppt, lpptBuf: TMouseMovePoint;}

{$EndIf}

begin

{$IfDef MOUSE_IS_USED}

{GetMouseMovePoints(

SizeOf(TMouseMovePoint), lppt, lpptBuf,

7,GMMP_USE_DRIVER_POINTS

);

Result:=lpptBuf.X DIV MouseColWidth;}

Result := (MousePosX div MouseColWidth) + 1;

{$Else}

Result := -1;

{$EndIf}

end;

{ }

procedure Init;

const

ExtInpConsoleMode = ENABLE_WINDOW_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_MOUSE_INPUT;

ExtOutConsoleMode = ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT;

var

cMode: DWORD;

Coord: TCoord;

OSVersion: TOSVersionInfo;

CBI: TConsoleScreenBufferInfo;

begin

OSVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

GetVersionEx(OSVersion);

if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then

IsWinNT := True

else

IsWinNT := False;

PtrOpenText := TTextRec(Output).OpenFunc;

{$IfDef HARD_CRT}

AllocConsole;

Reset(Input);

hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);

TTextRec(Input).Handle := hConsoleInput;

ReWrite(Output);

hConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);

TTextRec(Output).Handle := hConsoleOutput;

{$Else}

Reset(Input);

hConsoleInput := TTextRec(Input).Handle;

ReWrite(Output);

hConsoleOutput := TTextRec(Output).Handle;

{$EndIf}

GetConsoleMode(hConsoleInput, cMode);

if (cMode and ExtInpConsoleMode) <> ExtInpConsoleMode then

begin

cMode := cMode or ExtInpConsoleMode;

SetConsoleMode(hConsoleInput, cMode);

end;

TTextRec(Output).InOutFunc := @TextOut;

TTextRec(Output).FlushFunc := @TextOut;

GetConsoleScreenBufferInfo(hConsoleOutput, CBI);

GetConsoleMode(hConsoleOutput, cMode);

if (cMode and ExtOutConsoleMode) <> ExtOutConsoleMode then

begin

cMode := cMode or ExtOutConsoleMode;

SetConsoleMode(hConsoleOutput, cMode);

end;

TextAttr := CBI.wAttributes;

StartAttr := CBI.wAttributes;

LastMode := CBI.wAttributes;

Coord.X := CBI.srWindow.Left;

Coord.Y := CBI.srWindow.Top;

WindMin := (Coord.Y shl 8) or Coord.X;

Coord.X := CBI.srWindow.Right;

Coord.Y := CBI.srWindow.Bottom;

WindMax := (Coord.Y shl 8) or Coord.X;

ConsoleScreenRect := CBI.srWindow;

SoundDuration := -1;

OldCp := GetConsoleOutputCP;

SetConsoleOutputCP(1250);

{$IfDef CRT_EVENT}

SetConsoleCtrlHandler(@ConsoleEventProc, True);

{$EndIf}

{$IfDef MOUSE_IS_USED}

SetCapture(hConsoleInput);

KeyPressed;

{$EndIf}

MouseInstalled := MouseReset;

Window(1,1,80,25);

ClrScr;

end;

{ }

procedure Done;

begin

{$IfDef CRT_EVENT}

SetConsoleCtrlHandler(@ConsoleEventProc, False);

{$EndIf}

SetConsoleOutputCP(OldCP);

TextAttr := StartAttr;

SetConsoleTextAttribute(hConsoleOutput, TextAttr);

ClrScr;

FlushInputBuffer;

{$IfDef HARD_CRT}

TTextRec(Input).Mode := fmClosed;

TTextRec(Output).Mode := fmClosed;

FreeConsole;

{$Else}

Close(Input);

Close(Output);

{$EndIf}

end;

initialization

Init;

finalization

Done;

{$Endif win32}

end.

Имитация ввода с клавиатуры для консоли

2017-11-12T04:58:20+07:00

Code:

const

ExtendedKeys: set of Byte = [ // incomplete list

VK_INSERT, VK_DELETE, VK_HOME, VK_END, VK_PRIOR, VK_NEXT,

VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN, VK_NUMLOCK

];

procedure SimulateKeyDown(Key: byte);

var

flags: DWORD;

begin

if Key in ExtendedKeys then

flags := KEYEVENTF_EXTENDEDKEY

else

flags := 0;

keybd_event(Key, MapVirtualKey(Key, 0), flags, 0);

end;

procedure SimulateKeyUp(Key: byte);

var

flags: DWORD;

begin

if Key in ExtendedKeys then

flags := KEYEVENTF_EXTENDEDKEY

else

flags := 0;

keybd_event(Key, MapVirtualKey(Key, 0), KEYEVENTF_KEYUP or flags, 0);

end;

procedure SimulateKeystroke(Key: byte);

var

flags: DWORD;

scancode: BYTE;

begin

if Key in ExtendedKeys then

flags := KEYEVENTF_EXTENDEDKEY

else

flags := 0;

scancode := MapVirtualKey(Key, 0);

keybd_event(Key,

scancode,

flags,

0);

keybd_event(Key,

scancode,

KEYEVENTF_KEYUP or flags,

0);

end;

Как в консольном приложении можно задать цвет текста?

2017-11-12T04:33:51+07:00

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

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

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

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

Ответ 3:

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

Подробнее...

Как использовать консоль в не-консольном приложении?

2017-11-12T04:31:02+07:00

Для того, чтобы добавить в не-консольное приложение ввод/вывод из консоли, необходимо воспользоваться функциями 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;

Подробнее...

Как консольное приложение может узнать, что Винды завершаются?

2017-11-12T04:46:12+07:00

Все процессы получают сигналы 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;

}

Подробнее...

Как определить закрытие командного окна в консольном приложении

2017-11-12T04:50:33+07:00

Консольные приложения Win32 запускаются в командном окне. Для того, чтобы консольное приложение могло определить когда консоль закрывается, надо зарегистрировать консольный обработчик управления и в выражении case искать следующие значения:

CTRL_CLOSE_EVENT Пользователь закрывает консоль

CTRL_LOGOFF_EVENT Пользователь завершает сеанс работы (log off)

CTRL_SHUTDOWN_EVENT Пользователь выключает систему (shut down)

Как это делается, можно посмотреть в примере CONSOLE. Более подробную информацию можно посмотреть в руководстве Win32 application programming interface (API) в разделе SetConsoleCtrlhandler().

Как очистить экран в консольном приложении?

2017-11-12T04:47:32+07:00

Нужно просто использовать 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.

Подробнее...

Как переназначить вывод в файл для консольной программы

2017-11-12T04:55:53+07:00

Я не профи в Win API, просто у меня возникла именно такая проблема. Я нашел решение устраивающее меня. И к тому же решил, поделился с вами. Если кому-то требуется что-то другое - дерзайте, я с удовольствием прочту на "Королевстве" что и как у вас получилось. Handle = Хэндл = Рукоятка :)

Хочу предложить 2 способа:

1) Простой, с использованием command.com /c имя_консольной_проги > имя_файла_куда_переназначить_StdOut

2) С использованием Win API (2 штуки)

Вы уж сами выберите, что вам подходит больше. Я использую способ № 2.2.

Рассмотрим их более подробно на примерах.

Подробнее...

Как писать консольные приложения в Delphi?

2017-11-12T04:14:22+07:00

Автор: Alex G. Fedorov

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

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

Подробнее...

Как получить дескриптор окна консоли

2017-11-12T04:52:29+07:00

В следуещем примере используется функция Windows API FindWindow(). Обратите внимание, что WndClass консольного окна отличаются для Windows 95 и Window NT и заголовок окна может содержать полный путь под Windows NT.

Подробнее...

Как поменять иконку и стpокy в заголовке консольного окна?

2017-11-12T03:55:16+07:00

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;

Переключение консольного приложения в полный экран

2017-11-12T04:19:35+07:00

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

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

Подробнее...

Перенаправление стандартного ввода и вывода

2017-11-12T05:15:16+07:00

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

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

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

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

Итак,

ЗАДАЧА:

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

Подробнее...

Перехват вывода консоли

2017-11-12T04:37:01+07:00

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.

Подробнее...

Подождать завершения DOS-задачи

2017-11-12T05:00:20+07:00

Каким образом организовать ожидание завершения 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;

Подробнее...

Получить выходные данные DOS приложения

2017-11-12T04:27:52+07:00

{----------------------------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 bebekis@otenet.gr

Notes :

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

'C:\InputPut.txt',

'C:\OutPut.txt',

'Please, record this message')

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

Подробнее...

Русификация консольных приложений в Delphi

2017-11-12T05:10:36+07:00

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

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

Подробнее...

Создание консольных приложений

2017-11-12T04:07:30+07:00

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

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

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

Подробнее...