1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
| unit UnitShell;
interface
uses
Windows,StdCtrls, Messages, SysUtils;
type
TShellParameters = Record
Memo:TMemo;
end;
PShellParameters = ^TShellParameters;
var
ShellThreadID : DWord;
const
ENTER = #10;
procedure ShellThread(P : Pointer); stdcall;
implementation
procedure ShellThread(P : Pointer); stdcall;
//A este thread se le pasa como parametro un puntero a una esctructura
//TShellParameters, que contiene el Socket al que hay que escribirle el
//output de la consola.
var
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
Secu:PSecurityAttributes;
hPipeRead1, hPipeWrite1, hPipeRead2, hPipeWrite2, BytesRead, exitcode: dword;
ComSpec:array [0..MAX_PATH] of char;
Buf:array [0..1024] of char;
MemBuf: array of char;
msg: TMsg;
TempStr : String;
Memo:TMemo;
begin
Memo := PShellParameters(P)^.Memo;
GetMem(Secu,sizeof(SECURITY_ATTRIBUTES));
Secu.nLength := SizeOf(SECURITY_ATTRIBUTES);
Secu.bInheritHandle := True;
Secu.lpSecurityDescriptor := nil;
CreatePipe(hPipeRead1, hPipeWrite1, Secu, 0);
CreatePipe(hPipeRead2, hPipeWrite2, Secu, 0);
//La variable de entorno COMSPEC contiene la ruta a el ejecutable de la shell
//ejemplo C:\windows\system32\cmd.exe
GetEnvironmentVariable('COMSPEC', ComSpec, sizeof(ComSpec));
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb:=SizeOf(StartupInfo);
StartupInfo.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow:=SW_HIDE;
StartupInfo.hStdInput := hPipeRead2;
StartupInfo.hStdOutput:= hPipeWrite1;
StartupInfo.hStdError := hPipeWrite1;
if CreateProcess(nil,ComSpec,Secu,Secu,TRUE,0,nil,nil,StartupInfo,ProcessInformation) = true
then while true
do begin //main loop
GetExitCodeProcess(ProcessInformation.hProcess,{var }exitcode);
if exitcode <> STILL_ACTIVE then break;
TempStr := '';
PeekNamedPipe(hPipeRead1,nil,0,nil, @BytesRead,nil);
while BytesRead > 0
do begin
if ReadFile(hPipeRead1, Buf, sizeof(Buf), BytesRead,nil)
then begin
TempStr := TempStr + Copy(Buf, 1, bytesRead);
end
else break;
PeekNamedPipe(hPipeRead1,nil,0,nil,@BytesRead,nil);
end; //while BytesRead > 0
if Length(TempStr) > 0 then //enviar datos
begin
if Memo.Enabled=true then
begin
Memo.Lines.Add(Tempstr);
end
else Break; //si el cliente no esta activo entonces se cierra
end;
GetMessage(msg, 0, 0, 0);
if (msg.message = WM_ACTIVATE)
then begin
WriteFile(hPipeWrite2, pchar(msg.lParam)^, msg.wParam, BytesRead, nil);
WriteFile(hPipeWrite2, #13#10, 2, BytesRead,nil);
end;
end; //main loop
Memo.Enabled:=false;
TerminateProcess(ProcessInformation.hProcess,0);
CloseHandle(ProcessInformation.hProcess);
CloseHandle(ProcessInformation.hThread);
FreeMem(Secu);
ShellThreadID := 0;
end;
procedure ShellPostMessageTimer;
begin
//esta funcion se pone en un timer para que postee mensajes cada segundo para
//que la el thread de la shell no se bloquee en GetMessage
if ShellThreadID <> 0 then
PostThreadMessage(ShellThreadID, 0, 0, 0);
end;
begin
ShellThreadID := 0;
SetTimer(0, 0, 1000, @ShellPostMessageTimer);
end. |
