| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
одно и тоже консольное приложение работает по разному
Jeyson © (2009-09-08 12:40:00)собственно вот в чем дело, сделал на делфи программу которая запускает консольное приложение, которое в свое время связывается с сервером, так вот проблема в том что когда консольное приложение не может связаться с сервером то мне выдается ее результат на экран, а вот когда она связывается с сервером то результата не дождаться, хотя там спрашивают "Хотите зарегистрироваться", может что то упустил из виду
var
Form1: TForm1;
implementation
var
FChildStdoutRd, FChildStdoutWr,FChildStdinRd, FChildStdinWr, Tmp1,Tmp2 :THAndle;
{$R *.DFM}
function CreateChildProcess(ExeName, CommadLine: String; StdIn,
StdOut: THandle): Boolean;
Var
piProcInfo: TProcessInformation;
siStartInfo: TStartupInfo;
begin
// Set up members of STARTUPINFO structure.
ZeroMemory(@siStartInfo, SizeOf(TStartupInfo));
siStartInfo.cb:=SizeOf(TStartupInfo);
siStartInfo.hStdInput:=StdIn;
siStartInfo.hStdOutput:=StdOut;
siStartInfo.dwFlags:=STARTF_USESTDHANDLES;
// Create the child process.
Result:=CreateProcess(Nil,
'c:\cpp\read.exe',//PChar(ExeName+' '+CommadLine), // command line
Nil, // process security attributes
Nil, // primary thread security attributes
TRUE, // handles are inherited
0, // creation flags
Nil, // use parent's environment
'c:\cpp\', // use parent's current directory
siStartInfo, // STARTUPINFO pointer
piProcInfo); // receives PROCESS_INFORMATION
end;
procedure NewPipe;
var
FSaAttr:TSECURITYATTRIBUTES;
begin
with (FsaAttr) do
begin
FsaAttr.nLength:=SizeOf(SECURITY_ATTRIBUTES);
FsaAttr.bInheritHandle:=True;
FsaAttr.lpSecurityDescriptor:=Nil;
end;
CreatePipe(FChildStdoutRd, FChildStdoutWr, @FsaAttr, 1);
CreatePipe(FChildStdinRd, FChildStdinWr, @FsaAttr, 1);
//Делаем НЕ наследуемые дубликаты
//Это нужно, чтобы не тащить лишние хэндлы в дочерний процесс...
DuplicateHandle(GetCurrentProcess(), FChildStdoutRd,
GetCurrentProcess(), @Tmp1, 0, False, DUPLICATE_SAME_ACCESS);
DuplicateHandle(GetCurrentProcess(), FChildStdinWr,
GetCurrentProcess(), @Tmp2, 0, False, DUPLICATE_SAME_ACCESS);
CloseHandle(FChildStdoutRd);//Закроем наследуемый вариант "Читального" хэндла
CloseHandle(FChildStdinWr); //Закроем наследуемый вариант "Писального" хэндла
FChildStdoutRd:=Tmp1; //И воткнем их места НЕ наследуемые дубликаты
FChildStdinWr:=Tmp2; //И воткнем их места НЕ наследуемые дубликаты
CreateChildProcess('cmd.exe', '', FChildStdinRd, FChildStdoutWr)
end;
function WriteToChild(Data: String):
Boolean;
Var
dwWritten, BufSize: DWORD;
chBuf: PChar;
begin
//Обратите внимание на Chr($0D)+Chr($0A)!!! Без них - будет работать с ошибками
//На досуге - подумайте почему...
//Для тех, кому думать лень - подскажу - это пара символов конца строки.
//(вообще-то можно обойтись одним, но так надежнее, программы-то бывают разные)
chBuf:=PChar(Data+Chr($0D)+Chr($0A));
BufSize:=Length(chBuf);
Result:=WriteFile(FChildStdinWr, chBuf^, BufSize, dwWritten, Nil);
Result:=Result and (BufSize = dwWritten);
end;
function ReadStrFromChild(Timeout: Integer): String;
Var
i: Integer;
dwRead, BufSize, DesBufSize: DWORD;
chBuf: PChar;
Res: Boolean;
begin
Try
BufSize:=0;
New(chBuf);
Repeat
For i:=0 to 9 do
begin
Res:=PeekNamedPipe(FChildStdoutRd, nil, 0, nil, @DesBufSize, nil);
Res:=Res and (DesBufSize > 0);
If Res Then
Break;
Sleep(Round(Timeout/10));
end;
If Res Then
begin
If DesBufSize > BufSize Then
begin
FreeMem(chBuf);
GetMem(chBuf, DesBufSize);
BufSize:=DesBufSize;
end;
Res:=ReadFile(FChildStdoutRd, chBuf^, BufSize, dwRead, Nil);
Result:=Result+ChBuf;
end;
Until not Res;
Except
Result:='Read Err';
End;
end;
function DosToWin(St: string): string;
var
Ch: PChar;
begin
Ch := StrAlloc(Length(St) + 1);
OemToAnsi(PChar(St), Ch);
Result := Ch;
StrDispose(Ch)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not WriteToChild(Edit1.Text) then ShowMessage('error');
Memo1.Lines.Add(DosToWin(ReadStrFromChild(100)));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.Add(DosToWin(ReadStrFromChild(100)));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
NewPipe;
Memo1.Lines.Add(DosToWin(ReadStrFromChild(100)));
end;
Anatoly Podgoretsky (2009-09-15 14:00:00) [1]Обычное дело.
Дмитрий С (2009-09-15 10:24:00) [2]Может в stderror пишет? На всякий случай мысль.
Jeyson (2009-09-14 10:11:00) [3]Удалено модератором
Примечание: Создание пустых сообщений
Jeyson (2009-09-09 07:54:00) [4]Удалено модератором
Примечание: Создание пустых сообщений
Медвежонок Пятачок (2009-09-08 14:51:00) [5]в стдаут она пишет при запуске из командной строки?
если да, то остается вариант с неправильной передачей хендлов в дочерний процесс
Jeyson (2009-09-08 14:47:00) [6]дело в том что исходников консольной программы нет
Медвежонок Пятачок (2009-09-08 14:38:00) [7]включать голову и пробовать локализовать проблему.
например оттрассировать вывод в пайп в дочернем процессе.
строка до вызова записи
строка после вызова, результат записи. сколько записалось, последний гетластеррор после записи и так далее.
Jeyson (2009-09-08 14:06:00) [8]а как можно решить эту проблему
Медвежонок Пятачок (2009-09-08 13:59:00) [9]Там нет ничего, иначе бы ты вышел из цикла репита.
Либо запускаемы процесс пишет свой вывод не в тот пайп, либо сам процесс создан так, что ему переданы невалидные хендлы.
Jeyson (2009-09-08 13:38:00) [10]Вопрос как раз в том почему говорит что пайп пуст, ведь там есть что надо считать
Медвежонок Пятачок (2009-09-08 13:36:00) [11]тогда какие вопросы?
Jeyson (2009-09-08 13:33:00) [12]Пробовал, говорит что пайп пуст, ну то есть нет ничего что можно было бы считать
Медвежонок Пятачок (2009-09-08 13:25:00) [13]оттрассировать рипит внутри ReadStrFromChild не пробовал?
Jeyson (2009-09-08 12:51:00) [14]Подключение происходит мгновенно, и при нажатии на кнопку должен появляться в мемо результат
| |
