![]() |
Readfile bleibt hängen
Moin Leute.
Habe folgendes Problem: Ich will mit einem gsec-Befehl prüfen, ob ein gewisser Pfad vorhanden ist - klappt meistens, doch manchmal ist der Text, den die cmd liefert nicht in der Pipe, die ich mit Readfile prüfe -> Readfile bleibt hängen. Habe schon gelesen, dass das was mit Overlapped zutun hat, wurde aber durch die vorhandenen Beispiele nicht wirklich schlau. Hier mal der Hauptteil der Funktion:
Code:
Habe das überflüssige rausgemacht, also nicht wundern, dass es so komisch eingerückt ist.
function TfrmUser.GsecUser(arc: integer): boolean;
var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; SecurityAttr: TSecurityAttributes; pipOutW, pipOutR, pipErrW, pipErrR : THandle; dwBR: DWORD; sCommand: String; Buffer: Array [0..254] Of Char; erg: Boolean; begin Result := true; erg := true; FillChar(StartupInfo, SizeOf(StartupInfo), 0); FillChar(ProcessInfo, SizeOf(ProcessInfo), 0); FillChar(SecurityAttr, SizeOf(SecurityAttr), 0); SecurityAttr.nLength := SizeOf(SecurityAttr); SecurityAttr.bInheritHandle := true; SecurityAttr.lpSecurityDescriptor := nil; CreatePipe(pipOutR, pipOutW, @SecurityAttr, 0); CreatePipe(pipErrR, pipErrW, @SecurityAttr, 0); StartupInfo.cb := sizeof(StartupInfo); StartupInfo.hStdInput := 0; StartupInfo.wShowWindow := SW_HIDE; StartupInfo.hStdOutput := pipOutW; StartupInfo.hStdError := pipErrW; StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; CreateProcess(nil, PChar(sCommand), nil, nil, true, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo); ReadFile(pipErrR, Buffer, 255, dwBR, nil); CloseHandle(pipErrR); CloseHandle(pipOutR); WaitForSingleObject(ProcessInfo.hProcess, INFINITE); CloseHandle(ProcessInfo.hProcess); Result := erg; end; Es entscheidet sich zwischen pipErrR und pipOutR, beide können den Text enthalten. Eine der beiden Pipes bringt Readfile immer zum hängen, daher kann ich auch nicht beide prüfen. Irgendwo muss ein Timeout rein, nur habe ich keine Idee, wie ich diesen programmieren soll. Ich hoffe mein anliegen ist klar geworden und ihr könnt mir helfen. Danke schonmal im Vorraus. |
AW: Readfile bleibt hängen
Warum nimmst du nicht DirectoryExists? Und wo wird sCommand ein Wert zugewiesen?
|
AW: Readfile bleibt hängen
Ich prüfe nicht ob es diesen Ordner gibt, sondern ich prüfe, ob ich neue User mittels gsec anlegen kann.
den Part, wo sCommand formatiert wird, habe ich ausgelassen, da es irrelevant ist, aber der Wert sieht in etwa so aus: "C:\Program Files\Firebird\Firebird_1_5\bin\gsec.exe" -user blabla -password blabla -database 127.0.0.1:"C:\Program Files\Firebird\Firebird_1_5\security.fdb" -display Dieser Befehl wird ausgeführt. Entweder kriege ich alle User angezeigt, oder es kommt eine Errormsg. |
AW: Readfile bleibt hängen
Ist jetzt kein Post im Sinne von 'hey, hier ist dein Fehler!', aber vielleicht hilft meine Funktion (keine Gewähr auf 100% Premium-Code!) etwas weiter? Ich könnte mir vorstellen, dass ReadFile() erst zurückkehrt, wenn auch deine 255 Bytes gelesen wurden, was vielleicht nicht immer der Fall ist. Das müsste aber im MSDN stehen.
Delphi-Quellcode:
function RunProcess(Filename, WorkingDir: string; Timeout: Integer; var Output: AnsiString): Integer; overload;
var OK: Boolean; Handle: Cardinal; SI: TStartupInfo; PI: TProcessInformation; SA: TSecurityAttributes; SD: TSecurityDescriptor; ReadPipeOut, WritePipeOut: THandle; ReadPipeIn, WritePipeIn: THandle; ReadCount: DWORD; Avail: DWORD; Tmp: AnsiString; Started: Cardinal; begin Result := 1; Output := ''; if Filename = '' then Exit; if not InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION) then Exit; if not SetSecurityDescriptorDacl(@SD, True, nil, False) then Exit; SA.lpSecurityDescriptor := @SD; SA.nLength := SizeOf(TSecurityAttributes); SA.bInheritHandle := True; if not CreatePipe(ReadPipeOut, WritePipeOut, @SA, 0) then Exit; if not CreatePipe(ReadPipeIn, WritePipeIn, @SA, 0) then begin CloseHandle(ReadPipeOut); CloseHandle(WritePipeOut); Exit; end; FillChar(SI, SizeOf(TStartupInfo), #0); FillChar(PI, SizeOf(TProcessInformation), #0); SI.cb := SizeOf(TStartupInfo); SI.dwFlags := STARTF_FORCEOFFFEEDBACK or STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; SI.wShowWindow := SW_HIDE; SI.hStdOutput := WritePipeOut; SI.hStdError := WritePipeOut; SI.hStdInput := ReadPipeIn; OK := CreateProcess(nil, @Filename[1], nil, nil, True, CREATE_NEW_PROCESS_GROUP or NORMAL_PRIORITY_CLASS or CREATE_NO_WINDOW, nil, @WorkingDir[1], SI, PI); try if OK then begin Handle := PI.hProcess; Result := 0; Started := GetTickCount; while WaitForSingleObject(Handle, 100) = WAIT_TIMEOUT do begin PeekNamedPipe(ReadPipeOut, nil, 0, nil, @Avail, nil); if Avail > 0 then begin SetLength(Tmp, Avail); ReadFile(ReadPipeOut, Tmp[1], Avail, ReadCount, nil); Output := Output + Tmp; Started := GetTickCount; end; if Started + Timeout < GetTickCount then begin Result := 2; // Timeout! Exit; end; end; // Prozess ist zuende, noch den Rest holen. kA ob das muss.. PeekNamedPipe(ReadPipeOut, nil, 0, nil, @Avail, nil); if Avail > 0 then begin SetLength(Tmp, Avail); ReadFile(ReadPipeOut, Tmp[1], Avail, ReadCount, nil); Output := Output + Tmp; end; end; finally CloseHandle(PI.hThread); CloseHandle(PI.hProcess); CloseHandle(ReadPipeOut); CloseHandle(WritePipeOut); CloseHandle(ReadPipeIn); CloseHandle(WritePipeIn); end; end; |
AW: Readfile bleibt hängen
Sorry, falls ich es nicht richtig beschrieben habe.
Wenn ich Readfile mit einer bestimmten Pipe benutze, bleibt es einfach hängen ! Gibt keinen Wert zurück. pipOutW, pipErrW geben immer False zurück. Wenn pipOutR = True, dann wird pipErrR das Programm zum absturz bringen und visa versa. In welcher Pipe geschrieben wird, ist unabhängig von dem, was mir geliefert wird über die cmd.exe. In einem Programmstand hat die pipOutR funktioniert, in dem anderen die pipErrR. Dadurch bin ich ja erst auf dieses Problem gestoßen und deshalb müsste ich auch beide Pipes auf Inhalt prüfen. PS: Wir haben versucht meine Funktion an deine etwas anzupassen, aber es bleibt beim Gleichen, bei der bestimmten Pipe bleibt das Programm einfach hängen. |
AW: Readfile bleibt hängen
Nun wäre es schön wenn man wüsste was in der Pipe enthalten ist.
Kann es sein das u.U. irgend ein Eingabepromt von gsec kommt ?. (Kenne mich jetzt mit dem Teil Nicht so aus...) |
AW: Readfile bleibt hängen
Meine Funktion war dann doch wohl falsch. Habe deine (turboPASCAL) Funktion aus einem anderen Thread genommen.
Delphi-Quellcode:
Damit gehts. Danke dafür.
procedure RunConsoleApp(const CommandLine: string; AStrings: TStrings);
type TCharBuffer = array[0..MaxInt - 1] of Char; const MaxBufSize = 1024; var I: Longword; SI: TStartupInfo; PI: TProcessInformation; SA: PSecurityAttributes; SD: PSECURITY_DESCRIPTOR; NewStdIn: THandle; NewStdOut: THandle; ReadStdOut: THandle; WriteStdIn: THandle; Buffer: ^TCharBuffer; BufferSize: Cardinal; Last: WideString; Str: WideString; ExitCode: DWORD; Bread: DWORD; Avail: DWORD; begin GetMem(SA, SizeOf(TSecurityAttributes)); case Win32Platform of VER_PLATFORM_WIN32_NT: begin GetMem(SD, SizeOf(SECURITY_DESCRIPTOR)); SysUtils.Win32Check(InitializeSecurityDescriptor(SD, SECURITY_DESCRIPTOR_REVISION)); SysUtils.Win32Check(SetSecurityDescriptorDacl(SD, True, nil, False)); SA.lpSecurityDescriptor := SD; end; {end VER_PLATFORM_WIN32_NT} else SA.lpSecurityDescriptor := nil; end; {end case} SA.nLength := SizeOf(SECURITY_ATTRIBUTES); SA.bInheritHandle := True; SysUtils.Win32Check(CreatePipe(NewStdIn, WriteStdIn, SA, 0)); if not CreatePipe(ReadStdOut, NewStdOut, SA, 0) then begin CloseHandle(NewStdIn); CloseHandle(WriteStdIn); SysUtils.RaiseLastWin32Error; end; {end if} GetStartupInfo(SI); SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; SI.wShowWindow := {SW_SHOWNORMAL} SW_HIDE; SI.hStdOutput := NewStdOut; SI.hStdError := NewStdOut; SI.hStdInput := NewStdIn; if not CreateProcess(nil, PChar(CommandLine), nil, nil, True, CREATE_NEW_CONSOLE, nil, nil, SI, PI) then begin CloseHandle(NewStdIn); CloseHandle(NewStdOut); CloseHandle(ReadStdOut); CloseHandle(WriteStdIn); SysUtils.RaiseLastWin32Error; end; {end if} Last := ''; BufferSize := MaxBufSize; Buffer := AllocMem(BufferSize); try repeat SysUtils.Win32Check(GetExitCodeProcess(PI.hProcess, ExitCode)); PeekNamedPipe(ReadStdOut, Buffer, BufferSize, @Bread, @Avail, nil); if (Bread <> 0) then begin if (BufferSize < Avail) then begin BufferSize := Avail; ReallocMem(Buffer, BufferSize); end; {end if} FillChar(Buffer^, BufferSize, #0); ReadFile(ReadStdOut, Buffer^, BufferSize, Bread, nil); Str := Last; I := 0; while (I < Bread) do begin case Buffer^[I] of #0: inc(I); #10: begin inc(I); AStrings.Add(Str); Str := ''; end; {end #10} #13: begin inc(I); if (I < Bread) and (Buffer^[I] = #10) then inc(I); AStrings.Add(Str); Str := ''; end; {end #13} else begin Str := Str + Buffer^[I]; inc(I); end; {end else} end; {end case} end; {end while} Last := Str; end; {end if} Sleep(1); Application.ProcessMessages; until (ExitCode <> STILL_ACTIVE); if Last <> '' then AStrings.Add(Last); finally FreeMem(Buffer); end; {end try/finally} CloseHandle(PI.hThread); CloseHandle(PI.hProcess); CloseHandle(NewStdIn); CloseHandle(NewStdOut); CloseHandle(ReadStdOut); CloseHandle(WriteStdIn); end; {end procedure} Ein Eingabeprompt habe ich nicht bekommen, denn mit -display hintendran werden nur die Benutzer aufgelistet und man springt nicht in GSEC rein. |
AW: Readfile bleibt hängen
Ok, geht doch nicht. :D
Folgendes:
Delphi-Quellcode:
Hier existiert eine Endlosschleife. Habe es nun in einem anderen Programmstand ausprobiert. Liegt diesmal zwar nicht am Readfile, doch Bread bleibt immer 0. Buffer ist voll mit #0 und ExitCode bleibt ständig auf STILL_ACTIVE bzw. 259. Irgendwelche Vorschläge? :/
repeat
SysUtils.Win32Check(GetExitCodeProcess(PI.hProcess, ExitCode)); PeekNamedPipe(ReadStdOut, Buffer, BufferSize, @Bread, @Avail, nil); if (Bread <> 0) then begin if (BufferSize < Avail) then begin BufferSize := Avail; ReallocMem(Buffer, BufferSize); end; {end if} FillChar(Buffer^, BufferSize, #0); ReadFile(ReadStdOut, Buffer^, BufferSize, Bread, nil); Str := Last; I := 0; while (I < Bread) do begin case Buffer^[I] of #0: inc(I); #10: begin inc(I); AStrings.Add(Str); Str := ''; end; {end #10} #13: begin inc(I); if (I < Bread) and (Buffer^[I] = #10) then inc(I); AStrings.Add(Str); Str := ''; end; {end #13} else begin Str := Str + Buffer^[I]; inc(I); end; {end else} end; {end case} end; {end while} Last := Str; end; {end if} Sleep(1); Application.ProcessMessages; until (ExitCode <> STILL_ACTIVE); Edit: Hinzuzufügen wäre noch, dass sich am Befehl, den ich ausführe, NICHTS verändert hat. Edit2: bin am verzweifeln ;o Habe mal spaßeshalber jede Pipe kontrolliert... Alle 4 (NewStdIn,NewStdOut,ReadStdOut,WriteStdIn) sind leer. oO |
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:41 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz