z okienka to nie wiem, raczej ciezko bedize.
ale wystarczylo troche poszukac i...:
http://www.google.pl/search?hl=pl&lr=&safe=off&ei=f30SS6afNJ6wnQPczfXUAg&sa=X&oi=spell&resnum=0&ct=result&cd=1&ved=0CAYQBSgA&q=delphi+command+prompt&spell=1
...masz gotowy komponent. Do tego z obsluga polskich znakow i co najwazniejsze - nie zawiesza Twojego programu na czas dzialania polecenia np "pause" pod "dosem"!
moze wstawie od razu kod zrodlowy gdyby cos kiedys nie chodzilo:
unit UnitedCMD;
{
*********************************************************
TUnitedCMD Component v.0.1
Copyright: (C) 2006 by Wojass
URL: http://unitedcrew.pl & http://wojass.net
*********************************************************
*********************************************************
Software License Agreement (The MIT License)
Permission is hereby granted, free of charge, to any
person obtaining a copy of this software and associated
documentation files (the "Software"), to deal in
the Software without restriction, including without
limitation the rights to use, copy, modify, merge,
publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software
is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice
shall be included in all copies or substantial portions of
the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR
A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT
SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
IN THE SOFTWARE.
*********************************************************
}
{$D 'TUnitedCMD'}
interface
uses Windows,Classes;
type
TOnDataEvent = procedure(Sender: TObject; CMD_Data:string) of object;
type
TReadThread = class;
TUnitedCMD = class(TComponent)
private
FOnData : TOnDataEvent;
FActive : Boolean;
FRefresh: integer;
ReadThread: TReadThread;
Buff: array [0..32767] of byte;
Buff2: array [0..32767] of byte;
BWrite, BRead, ExitCMD : Dword;
hReadOut, hWriteIn:THandle;
ProcInfo: TProcessInformation;
procedure UpdateCmd;
procedure SetActiv(Value: Boolean);
function KodujPL_OUT(Ogonek:Char):Char;
function KodujPL_IN(Ogonek:Char):Char;
function BuffCMDToAscii(Buffer: pointer; Length: Word): string;
procedure BindCMD(Process: pchar);
published
property Activ : Boolean read FActive write SetActiv default False;
property Refresh : Integer read FRefresh write FRefresh default 500;
property OnData : TOnDataEvent read FOnData write FOnData;
public
constructor Create(AOwner:TComponent); override;
procedure SendCommand(Command: String);
protected
procedure OnDataEv(CMD_Data: string); dynamic;
end;
TReadThread = class(TThread)
private
ComTWTime: TUnitedCMD;
protected
constructor Create(AComTWTime: TUnitedCMD);
procedure Execute; override;
end;
const
MAX_BUFF: dword = 32767;
CMD_APP = 'cmd.exe';
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('UnitedCrew', [TUnitedCMD]);
end;
constructor TUnitedCMD.Create(AOwner: TComponent);
begin
FRefresh:=500;
inherited;
end;
constructor TReadThread.Create(aComTWTime: TUnitedCMD);
begin
ComTWTime := aComTWTime;
inherited Create(true);
end;
procedure TUnitedCMD.OnDataEv(CMD_Data: string);
begin
if Assigned(FOnData)
then FOnData(Self, CMD_Data);
end;
procedure TUnitedCMD.UpdateCmd;
begin
if FActive and Assigned(FOnData) then
begin
BindCMD(CMD_APP);
ReadThread := TReadThread.Create(Self);
ReadThread.FreeOnTerminate:=True;
ReadThread.Resume;
end else ReadThread.Terminate;
end;
procedure TUnitedCMD.SetActiv(Value: Boolean);
begin
if Value <> FActive then
begin
FActive := Value;
UpdateCmd;
end;
end;
procedure TUnitedCMD.SendCommand(Command: String);
var
CMDChr,CMDLength:integer;
begin
if FActive and (Length(Command)<>0) then
begin
CMDLength:=Length(Command);
if CMDLength>0 then
begin
for CMDChr:=0 to (CMDLength-1) do
begin
Command[CMDCHr+1]:=KodujPL_IN(Command[CMDChr+1]);
Buff2[CMDChr]:=Ord(Command[CMDChr+1]);
end;
Buff2[CMDLength] :=13;
Buff2[CMDLength+1]:=10;
WriteFile(hWriteIn, Buff2, (CMDLength+2), BWrite, nil);
end;
end;
end;
procedure TReadThread.Execute;
begin
while not Terminated do
begin
Sleep(ComTWTime.FRefresh);
GetExitCodeProcess(ComTWTime.ProcInfo.hProcess, ComTWTime.ExitCMD);
if ComTWTime.ExitCMD <> STILL_ACTIVE then
begin
Terminate;
Break;
end;
repeat
ReadFile(ComTWTime.hReadOut, ComTWTime.Buff, MAX_BUFF, ComTWTime.BRead, nil);
if ComTWTime.BRead > 0 then
ComTWTime.OnDataEv(string(ComTWTime.BuffCMDToAscii(@ComTWTime.Buff,ComTWTime.BRead)));
until ComTWTime.BRead < MAX_BUFF;
end;
if ComTWTime.ExitCMD = STILL_ACTIVE then TerminateProcess(ComTWTime.ProcInfo.hProcess, 0);
CloseHandle(ComTWTime.hReadOut);
CloseHandle(ComTWTime.hWriteIn);
ComTWTime.FActive:=false;
end;
procedure TUnitedCMD.BindCMD(Process: pchar);
var
SecurAttrib: SECURITY_ATTRIBUTES;
hReadIn, hWriteOut: THandle;
StartInfo: TSTARTUPINFO;
Pipe1: dword;
begin
SecurAttrib.nLength := SizeOf(SECURITY_ATTRIBUTES);
SecurAttrib.lpSecurityDescriptor := nil;
SecurAttrib.bInheritHandle := True;
CreatePipe(hReadIn, hWriteIn, @SecurAttrib, 0);
CreatePipe(hReadOut, hWriteOut, @SecurAttrib, 0);
GetStartupInfo(StartInfo);
StartInfo.hStdOutput := hWriteOut;
StartInfo.hStdError := hWriteOut;
StartInfo.hStdInput := hReadIn;
StartInfo.dwFlags := STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES;
StartInfo.wShowWindow := SW_HIDE;
CreateProcess(nil, Process, nil, nil, True, CREATE_NEW_CONSOLE, nil, nil, StartInfo, ProcInfo);
CloseHandle(hWriteOut);
CloseHandle(hReadIn);
Pipe1 := PIPE_NOWAIT;
SetNamedPipeHandleState(hReadOut, Pipe1 , nil, nil);
end;
function TUnitedCMD.KodujPL_OUT(Ogonek:Char):Char;
begin
case Ogonek of
#165: Result:=#185;
#134: Result:=#230;
#169: Result:=#234;
#136: Result:=#179;
#228: Result:=#241;
#162: Result:=#243;
#152: Result:=#156;
#171: Result:=#159;
#190: Result:=#191;
#164: Result:=#165;
#143: Result:=#198;
#168: Result:=#202;
#157: Result:=#163;
#227: Result:=#209;
#224: Result:=#211;
#151: Result:=#140;
#141: Result:=#143;
#189: Result:=#175;
else Result:=Ogonek;
end;
end;
function TUnitedCMD.KodujPL_IN(Ogonek:Char):Char;
begin
case Ogonek of
#185: Result:=#165;
#230: Result:=#134;
#234: Result:=#169;
#179: Result:=#136;
#241: Result:=#228;
#243: Result:=#162;
#156: Result:=#152;
#159: Result:=#171;
#191: Result:=#190;
#165: Result:=#164;
#198: Result:=#143;
#202: Result:=#168;
#163: Result:=#157;
#209: Result:=#227;
#211: Result:=#224;
#140: Result:=#151;
#143: Result:=#141;
#175: Result:=#189;
else Result:=Ogonek;
end;
end;
function TUnitedCMD.BuffCMDToAscii(Buffer: pointer; Length: Word): string;
var
Loop: integer;
AsciiBuff: string;
begin
AsciiBuff := '';
for Loop := 0 to Length - 1 do
begin
if char(pointer(integer(Buffer) + Loop)^) in [#1..#255] then
AsciiBuff := AsciiBuff + KodujPL_OUT(char(pointer(integer(Buffer) + Loop)^));
end;
Result := AsciiBuff;
end;
end.