Home > Back-end >  Delphi support, coding problem
Delphi support, coding problem

Time:09-24

 

Delphi support, the default Delphi 7 ANSI code can be compiled, higher Unicode compile successfully run error
The implementation of Dos command
The original address: http://download.csdn.net/detail/racelf/2824788#comment
OemToAnsi
Not for PAnsiChar
Code:

The unit ufmMain;

Interface

USES the
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls ComCtrls, ExtCtrls StrUtils;

Type
TForm1=class (TForm)
CbCMD: TComboBox;
For: TButton;
RichEdit1: TRichEdit;
Timer1: TTimer;
Procedure Timer1Timer (Sender: TObject);
Procedure FormShow (Sender: TObject);
Procedure FormClose (Sender: TObject; Var Action: TCloseAction);
Procedure Button1Click (Sender: TObject);
Procedure cbCMDKeyDown (Sender: TObject; Var Key Word;
Shift: TShiftState);
Private
{Private declarations}
ReadOut, WriteOut: THandle;
ReadIn, WriteIn: THandle;
ProcessInfo: TProcessInformation;
Cl: integer;
Procedure InitConsole;
The function ReadFromPipe (Pipe: THandle) : string;
Procedure WriteToPipe (Pipe: THandle; Value: string);
Procedure CloseConsole;
Public
{Public declarations}
end;

Var
Form1: TForm1;

Const
ReadBuffer=2400;

Implementation

{$R *. DFM}

Procedure TForm1. InitConsole;
Var
Security: TSecurityAttributes;
Start: TStartUpInfo;
The begin
With the Security do begin
Nlength:=SizeOf (TSecurityAttributes);
Binherithandle:=true;
The lpsecuritydescriptor:=nil;
end;

The Createpipe (ReadOut, WriteOut, @ Security, 0).
The Createpipe (ReadIn WriteIn, @ Security, 0).

With the Security do begin
Nlength:=SizeOf (TSecurityAttributes);
Binherithandle:=true;
The lpsecuritydescriptor:=nil;
end;

FillChar (Start, Sizeof (Start), # 0);
Start. Cb:=SizeOf (start);
Start. HStdOutput:=WriteOut;
Start. HStdInput:=ReadIn;
Start. HStdError:=WriteOut;
Start. DwFlags:=STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
Start. WShowWindow:=SW_HIDE;

CreateProcess (nil,
PChar (' CMD '),
@ Security,
@ Security,
True,
NORMAL_PRIORITY_CLASS,
Nil,
Nil,
Start,
ProcessInfo)
end;

The function TForm1. ReadFromPipe (Pipe: THandle) : string;
Var
Buffer: PChar;
BytesRead: DWord;
The begin
Result:=';
If GetFileSize (Pipe, nil)=0 then the Exit;

Buffer:=AllocMem (ReadBuffer + 1);
Repeat
BytesRead:=0;
ReadFile (Pipe, Buffer [0], ReadBuffer, BytesRead, nil);
If BytesRead & gt; 0 then the begin
Buffer: [BytesRead]=# 0;
OemToAnsi (Buffer, Buffer);
The Result: string=(Buffer);
end;
Until (BytesRead & lt; ReadBuffer);
FreeMem (Buffer);
end;

Procedure TForm1. WriteToPipe (Pipe: THandle; Value: string);
Var
Len: integer;
BytesWrite: DWord;
Buffer: PChar;
The begin
Len:=Length (Value) + 1;
Buffer:=PChar (Value + # 10);
WriteFile (Pipe, Buffer [0], len, BytesWrite, nil);
end;

Procedure TForm1. CloseConsole;
The begin
The CloseHandle (ProcessInfo. HProcess);
The CloseHandle (ProcessInfo. HThread);

The CloseHandle (ReadIn);
The CloseHandle (WriteIn);

The CloseHandle (ReadOut);
The CloseHandle (WriteOut);
end;

Procedure TForm1. Timer1Timer (Sender: TObject);
Var
S: a string;
The begin
S:=ReadFromPipe (ReadOut);
If the s & lt;> 'then the begin
RichEdit1. SelAttributes. Color:=cl;//you can also change through the returned string color
RichEdit1. Lines. The Add (s);
end;
end;

Procedure TForm1. FormShow (Sender: TObject);
The begin
Self. OnShow:=nil;
CbCmd. The Clear;
CbCmd. SetFocus;

InitConsole;

Timer1. Enabled:=True;
end;

Procedure TForm1. FormClose (Sender: TObject; Var Action: TCloseAction);
The begin
Timer1. Enabled:=False;
CloseConsole;
end;

Procedure TForm1. Button1Click (Sender: TObject);
Var
S: a string;
The begin
S:=Trim (cbCmd. Text);
If (length (s) & gt;=3) and (s='[') [1] and [3] (s='] ') and (s [2] & gt;='0') and (s [2] <='4') then
The begin
Case StrToInt [2] (s) of
Zero: cl:=clBlack;
1: cl:=clBlue;
2: cl:=clGreen;
3: cl:=clRed;
4: cl:=clYellow;
end;
S:=RightStr (s, length (s) - (3);
The end;
If s<> 'then the begin
WriteToPipe (WriteIn, s);
If cbCMD. ItemIndex & gt; 1 then
CbCMD. Items. The Delete (cbCMD ItemIndex);
CBCMD. Items. Insert (0, CBCMD. Text);
CbCmd. Text:=' ';
end;
end;

Procedure TForm1. CbCMDKeyDown (Sender: TObject; nullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnull
  • Related