unit command;
{$mode objfpc}{$H+}
interface
uses
Windows, Messages, Variants, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls;
type
{ TForm11 }
TForm11 =
class(TForm)
//Items (Button, Labels, etc.)
//Prozeduren (Click, Create, etc.)
private
fInputPipeRead,
fInputPipeWrite,
fOutputPipeRead,
fOutputPipeWrite: Cardinal;
fProcess: Cardinal;
procedure FClbProc(Sender: TObject;
const ABuffer:
String; ABufSize: Cardinal);
procedure FOpenProcess;
procedure FCloseProcess;
procedure FWriteToStdIn(
const AText:
String);
{ private declarations }
public
{ public declarations }
end;
TPipeClbProc =
procedure (Sender: TObject;
const ABuffer:
String; ABufSize: Cardinal)
of Object;
TPipeReadThread =
class(TThread)
private
fBuffer:
String;
fBytesRead: Cardinal;
fClbProc: TPipeClbProc;
fPipeOutput: Cardinal;
procedure FSyncProc;
protected
procedure Execute;
override;
constructor Create(AClbProc: TPipeClbProc; APipeOutput: Cardinal);
end;
var
Form11: TForm11;
implementation
{ TForm11 }
constructor TPipeReadThread.Create(AClbProc: TPipeClbProc; APipeOutput: Cardinal);
begin
inherited Create(True);
fClbProc := AClbProc;
fPipeOutput := APipeOutput;
SetLength(fBuffer,5000);
FreeOnTerminate := True;
Resume;
end;
{===========================================================================}
procedure TPipeReadThread.Execute;
var LBufSize: Cardinal;
LRes: Boolean;
begin
LBufSize := Length(fBuffer);
repeat
LRes := ReadFile(fPipeOutput,fBuffer[1], LBufSize, fBytesRead,
nil);
Synchronize(fSyncProc);
//87.23
until not (LRes)
or Terminated;
end;
{===========================================================================}
procedure TPipeReadThread.FSyncProc;
begin
fClbProc(Self, fBuffer, fBytesRead);
end;
{===========================================================================}
procedure TForm11.FClbProc(Sender: TObject;
const ABuffer:
String; ABufSize: Cardinal);
//100.19
var LNew :
String;
LPos : Integer;
begin
LNew := copy(ABuffer, 1, ABufSize);
LPos := pos(#$C, LNew);
if (LPos > 0)
then
begin
Console.Text:='
';
LNew := copy(LNew, LPos + 1, Length(LNew));
end;
Console.Text := Console.Text + LNew;
PostMessage(Console.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
{===========================================================================}
procedure TForm11.FOpenProcess;
var
LStartupInfo : TStartupInfo;
LProcessInfo : TProcessInformation;
LSecurityAttr: TSECURITYATTRIBUTES;
LSecurityDesc: TSecurityDescriptor;
begin
FillChar(LSecurityDesc, SizeOf(LSecurityDesc),0);
//124.27
InitializeSecurityDescription(@LSecurityDesc, SECURITY_DESCRIPTOR_REVISION);
//125.34
SetSecurityDescriptorDacl(@LSecurityDesc, True,
nil, False);
LSecurityAttr.nLength := SizeOf(LSecurityAttr);
LSecurityAttr.lpSecurityDescriptor:= @LSecurityDesc;
LSecurityAttr.bInheritHandle := True;
fProcess := 0;
if CreatePipe(fInputPipeRead, fInputPipeWrite, @LSecurityAttr, 0)
then
begin
if CreatePipe(fOutputPipeRead, fOutputPipeWrite, @LSecurityAttr, 0)
then
begin
FillChar(LStartupInfo, SizeOf(LStartupInfo), 0);
//137.26
FillChar(LStartupInfo, SizeOf(LProcessInfo), 0);
LStartupInfo.cb := SizeOf(LStartupInfo);
LStartupInfo.hStdOutput := fOutputPipeWrite;
LStartupInfo.hStdInput := fInputPipeRead;
LStartupInfo.hStdError := fOutputPipeWrite;
LStartupInfo.dwFlags := STARTF_USESTDHANDLES
or STARTF_USESHOWINDOW;
LStartupInfo.wShowWindow := SW_HIDE;
if CreateProcess(
nil, '
cmd', @LSecurityAttr,
nil, True, 0,
nil,
nil LStartupInfo, LProcessInfo)
//145.100
then begin
fProcess := LProcessInfo.hProcess;
TPipeReadThread.Create(FClbProc, fOutputPipeRead);
//148.37
end else begin
CloseHandle(fInputPipeRead);
CloseHandle(fInputPipeWrite);
CloseHandle(fOutputPipeRead);
CloseHandle(fOutputPipeWrite);
end;
end else begin
CloseHandle(fInputPipeRead);
CloseHandle(fInputPipeWrite);
end;
end
end;
{===========================================================================}
procedure TForm11.FCloseProcess;
begin
if (fProcess <> 0)
then
begin
CloseHandle(fInputPipeRead);
CloseHandle(fInputPipeWrite);
CloseHandle(fOutputPipeRead);
CloseHandle(fOutputPipeWrite);
TerminateProcess(fProcess, 0);
fProcess := 0;
end;
end;
{===========================================================================}
procedure TForm11.FWriteToStdIn(
const AText:
String);
var LPos,
LWritten: Cardinal;
LRes : Boolean;
begin
LPos := 1;
repeat
LWritten := 0;
LRes := WriteFile(fInputPipeWrite, AText[LPos], Cardinal(Length(AText)) - LPos + 1, LWritten,
nil);
inc(LPos,LWritten);
until not(LRes)
or (LPos > Cardinal(Length(AText)));
end;
{===========================================================================}
procedure TForm11.FormCreate(Sender: TObject);
var rgn: HRGN;
begin
fProcess := 0;
FOpenProcess;
begin
rgn := CreateRoundRectRgn(0,
0,
ClientWidth,
ClientHight,
40,
40);
SetWindowRgn(
Handle, rgn, True);
end;
end;
procedure TForm11.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
FCloseProcess;
end;
procedure TForm11.Button2Click(Sender: TObject);
begin
Form11.close;
end;
procedure TForm11.Button1Click(Sender: TObject);
begin
FWriteToStdIn(EdCmd.Text + #13#10);
// 222.22
EdCmd.Text := '
';
// 223.8
end;
procedure TForm11.(Sender : TObject;
var Key: Char);
//226.19
begin
if Key = #13
then
begin
Key : = #0;
BtnWriteCmdClick(
nil);
end;
end;
initialization
{$I command.lrs}
end.