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. |
Partager