Форум: "WinAPI";
Текущий архив: 2004.02.25;
Скачать: [xml.tar.bz2];
ВнизPIPE Найти похожие ветки
← →
Deimos (2003-12-14 12:24) [0]кто использовал анонимные пайпы в приложениях?
поделитесь опытом пожалуйста. Необходимо перенаправить вывод из консльного приложения в поле edit-a.
Смотрел borland-овскую справку по api но там пример пайпа между двумя консолями, и в данном случае не работает.
← →
Alekc (2003-12-17 22:01) [1]Ща наспамлю... :)
Кусок кода из проги, запускает командный процессор и направляет ввод/вывод из/в сокет... не совсем то что надо, но я думаю можно разобраться что к чему...
// Обработка ввода/вывода данных командным процессором
procedure ProcessFlow(hSocket: TSocket; hReadPipe, hWritePipe: THandle);
var
FDSet: TFDSet;
TimeVal: TTimeVal;
Buffer: Array [0..$FF] of Char;
DSize: Integer;
Result: Cardinal;
begin
// Таймаут = 0 (только проверка наличия данных)
FillChar(TimeVal, SizeOf(TimeVal), 0);
// "Вечный" цикл обработки (выход из цикла только по ошибке,
// которая также произойдет в случае закрытия канала)
While True do begin
// Проверяем есть ли что-нибудь в канале
If not PeekNamedPipe(hReadPipe, nil, 0, nil, @Result, nil) then Break;
// Размер буфера ограничен 256-ю байтами
Result := Min(Result, 256);
If Result > 0 then begin
// Если в канале есть данные, то читаем их
If not ReadFile(hReadPipe, Buffer, Result, Result, nil) then Break;
// удаляем запрещенные символы (255) -> эти символы вызывают глюки
// в программе "telnet.exe" от Windows XP SP1 (на других не проверял).
// Походу она воспринимает их как какие-то свои управляющие символы...
CheckBuffer(Buffer, Result);
// и отправляем данные telnet-клиенту
If send(hSocket, Buffer, Result, 0) <= 0 then Break;
end;
// Сокет для проверки наличия данных
FD_ZERO(FDSet);
FD_SET(hSocket, FDSet);
// Если от клиента пришли какие-нибудь данные
Case select(0, @FDSet, nil, nil, @TimeVal) of
SOCKET_ERROR: Break;
0: {TimeOut - do nothing}
else
// то получаем их размер
If ioctlsocket(hSocket, FIONREAD, DSize) <> 0 then Break;
// Размер буфера ограничен 256-ю байтами
DSize := Min(DSize, 256);
// читаем данные от клиента
DSize := recv(hSocket, Buffer, DSize, 0);
// и отправляем их командному процессору
If (DSize <= 0) or not WriteFile(hWritePipe, Buffer, DSize, Result, nil) then Break;
end;
end;
end;
// Запускает командный процессор с удаленным управлением
procedure StartTelnetServer(hSocket: TSocket);
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
SecurityAttributes: TSecurityAttributes;
hTmpReadPipe: THandle;
hReadPipe: THandle;
hw9xReadPipe: THandle;
hTmpWritePipe: THandle;
hWritePipe: THandle;
hw9xWritePipe: THandle;
CmdShell: String;
WindowsNT: Boolean;
begin
// Определяем версию Windows
WindowsNT := WinVer in [wvNT, wvY2k, wvXP];
// Атрибуты для созания канала
with SecurityAttributes do begin
nLength := Sizeof(SecurityAttributes);
bInheritHandle := True; // реально нужен только этот пункт
lpSecurityDescriptor := nil;
end;
// Создаем канал SHELL -> SOCKET
If not CreatePipe(hReadPipe, hTmpWritePipe, @SecurityAttributes, 0) then Exit;
try
// Не нужно наследовать Хэндл чтения из канала
If WindowsNT then begin
If not SetHandleInformation(hReadPipe, HANDLE_FLAG_INHERIT, 0) then Exit;
end else begin
DuplicateHandle(GetCurrentProcess, hReadPipe, GetCurrentProcess, @hw9xReadPipe,
0, FALSE, DUPLICATE_SAME_ACCESS or DUPLICATE_CLOSE_SOURCE);
hReadPipe := hw9xReadPipe;
end;
// Создаем канал SOCKET -> SHELL
If not CreatePipe(hTmpReadPipe, hWritePipe, @SecurityAttributes, 0) then Exit;
try
// Не нужно наследовать Хэндл записи в канал
If WindowsNT then begin
If not SetHandleInformation(hWritePipe, HANDLE_FLAG_INHERIT, 0) then Exit;
end else begin
DuplicateHandle(GetCurrentProcess, hWritePipe, GetCurrentProcess, @hw9xWritePipe,
0, FALSE, DUPLICATE_SAME_ACCESS or DUPLICATE_CLOSE_SOURCE);
hWritePipe := hw9xWritePipe;
end;
// Данные для запуска командного процессора
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
with StartupInfo do begin
cb := SizeOf(StartupInfo);
// Использовать каналы и не выводить окно
dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;
// Перенаправление ввода-вывода в наши каналы
hStdOutput := hTmpWritePipe;
hStdInput := hTmpReadPipe;
hStdError := hTmpWritePipe;
end;
// Выюор процессора в зависимости от типа ОС
If WindowsNT then CmdShell := "cmd.exe"
else CmdShell := "command.com";
// Создаем процесс (SHELL)
If not CreateProcess(nil, PChar(CmdShell), nil, nil, True,
CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then Exit;
// Хэндлы процесса и потока нас совершенно не интересуют
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
// Уничтожаем унаследованные ком. процессором хендлы
CloseHandle(hTmpWritePipe);
CloseHandle(hTmpReadPipe);
// Идет обработка входящих и исходящих данных
ProcessFlow(hSocket, hReadPipe, hWritePipe);
finally
// Закрываем хэндлы канала SOCKET -> SHELL
CloseHandle(hTmpWritePipe);
Closehandle(hWritePipe);
end;
finally
// Закрываем хэндлы канала SHELL -> SOCKET
CloseHandle(hReadPipe);
Closehandle(hTmpReadPipe);
end;
end;
← →
Yury Sidorov (2003-12-18 10:31) [2]Могу тоже поделиться:
function ExecAppRedirectIO(const CmdLine, InStr: string; var OutStr: string; WaitTime: cardinal = 0; ShowCmd: integer = SW_SHOWNORMAL): cardinal;
var
runinfo: TStartupInfo;
procinfo: TProcessInformation;
sa:TSecurityAttributes;
s: string;
ChildStdInWr, ChildStdoutRd, ChildStdoutWr, ChildStdInRd, Tmp1, Tmp2:THandle;
StartTime: cardinal;
Done: boolean;
Buf: array[0..1024] of byte;
sz: integer;
begin
sa.nLength:=sizeof(TSecurityAttributes);
sa.bInheritHandle:=True;
sa.lpSecurityDescriptor:=nil;
ChildStdoutRd:=0;
ChildStdoutWr:=0;
ChildStdinRd:=0;
ChildStdinWr:=0;
Tmp1:=0;
Tmp2:=0;
try
if not CreatePipe(ChildStdoutRd, ChildStdoutWr, @sa, 0) then
RaiseLastWin32Error;
if not CreatePipe(ChildStdinRd, ChildStdinWr, @sa, 0) then
RaiseLastWin32Error;
if not DuplicateHandle(GetCurrentProcess(), ChildStdoutRd, GetCurrentProcess(), @Tmp1, 0, False, DUPLICATE_SAME_ACCESS) then
RaiseLastWin32Error;
if not DuplicateHandle(GetCurrentProcess(), ChildStdinWr, GetCurrentProcess(), @Tmp2, 0, False, DUPLICATE_SAME_ACCESS) then
RaiseLastWin32Error;
CloseHandle(ChildStdoutRd);
CloseHandle(ChildStdinWr);
ChildStdoutRd:=Tmp1;
ChildStdinWr:=Tmp2;
Tmp1:=0;
Tmp2:=0;
FillChar(runinfo, SizeOf(TStartupInfo), 0);
with runinfo do begin
cb := SizeOf(TStartupInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := ShowCmd;
hStdInput:=ChildStdInRd;
hStdOutput:=ChildStdOutWr;
hStdError:=ChildStdOutWr;
end;
s:=ExtractFilePath(ParamStr(0));
if not CreateProcess(
nil, // app filename
PChar(CmdLine), // cmd line
nil, // process security attributes
nil, // thread security attributes
True, // handle inheritance flag
CREATE_NEW_CONSOLE, // creation flags
nil, // new environment block
PChar(s), // current directory name
runinfo, // STARTUPINFO
procinfo // PROCESS_INFORMATION
)
then
raise Exception.CreateFmt(SCantStartApp, [CmdLine, SysErrorMessage(GetLastError)]);
try
CloseHandle(procinfo.hThread);
StartTime:=GetTickCount;
if InStr <> "" then
FileWrite(ChildStdInWr, InStr[1], Length(InStr));
OutStr:="";
if WaitTime <> 0 then begin
repeat
Done:=WaitForSingleObject(procinfo.hProcess, 300) = WAIT_OBJECT_0;
if not Done and (WaitTime <> INFINITE) and (GetTickCount - StartTime > WaitTime) then begin
TerminateProcess(procinfo.hProcess, Result);
raise Exception.CreateFmt(SAppNotFinished, [CmdLine]);
end;
while True do begin
PeekNamedPipe(ChildStdoutRd, nil, 0, nil, @sz, nil);
if sz > 0 then begin
sz:=FileRead(ChildStdoutRd, Buf, SizeOf(Buf));
if sz > 0 then begin
SetLength(OutStr, Length(OutStr) + sz);
Move(Buf, OutStr[Length(OutStr) - sz + 1], sz);
end;
end
else
break;
end;
until Done;
GetExitCodeProcess(procinfo.hProcess, Result);
end
else
Result:=0;
finally
CloseHandle(procinfo.hProcess);
end;
finally
if ChildStdoutRd <> 0 then
CloseHandle(ChildStdoutRd);
if ChildStdoutWr <> 0 then
CloseHandle(ChildStdoutWr);
if ChildStdinRd <> 0 then
CloseHandle(ChildStdinRd);
if ChildStdinWr <> 0 then
CloseHandle(ChildStdinWr);
if Tmp1 <> 0 then
CloseHandle(Tmp1);
if Tmp2 <> 0 then
CloseHandle(Tmp2);
end;
end;
← →
Gandalf (2003-12-18 13:02) [3]Оффтопик. См. поиск по Мастаку все найдешь.
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2004.02.25;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.034 c