Konsolenfenster auslesen u. ausblenden

12/11/2008 - 08:39 von Ahmed Martens | Report spam
Hallo Leute,

ich habe folgende Programmroutine gefunden, die auch einwandfrei
funktioniert. Das einzige was mich an dieser Routine noch stört, ist die
Tatsache, dass das Konsolenfenster nicht ausgeblendet werden kann. Ich
bekomme das einfach nicht hin.

Nach dem was ich recherchieren konnte, sollte die Konsole in der
CreateProcess-Anweisung ausgeblendet werden können. Tut es aber nicht.

Hier einmal jetzt meine Routinen:

<Code>

'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schàden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klàren, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source !

Option Explicit

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe _
As Long, phWritePipe As Long, lpPipeAttributes As Any, _
ByVal nSize As Long) As Long

Private Declare Function ReadFile Lib "kernel32" (ByVal hFile _
As Long, ByVal lpBuffer As String, ByVal _
nNumberOfBytesToRead As Long, lpNumberOfBytesRead As _
Long, ByVal lpOverlapped As Any) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As _
String, lpProcessAttributes As Any, lpThreadAttributes _
As Any, ByVal bInheritHandles As Long, ByVal _
dwCreationFlags As Long, ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, _
lpProcessInformation As Any) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long

Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal _
hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize _
As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Const NORMAL_PRIORITY_CLASS = &H20&
Const STARTF_USESTDHANDLES = &H100&

Const SW_HIDE = 0
Const SW_MAXIMIZE = 3
Const SW_MINIMIZE = 6
Const SW_NORMAL = 1
Const SW_SHOW = 5
Const SW_SHOWDEFAULT = 10
Const SW_SHOWMAXIMIZED = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNA = 8
Const SW_SHOWNOACTIVATE = 4
Const SW_SHOWNORMAL = 1


Private Sub Command1_Click()
Dim OutText As String
Dim WithUml As String

'Hier den Pfad einer Batchdatei oder einer Konsolenanwendung
'die eine Ausgabe hat eintragen
Call ExecCmd("C:\Programme\FreePDF_XP\Test_Ghostscript.bat")
End Sub

Private Function ExecCmd(cmdline$) As String
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long, hWritePipe As Long
Dim L As Long, Result As Long, bSuccess As Long
Dim Buffer As String

Dim retText As String

sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
Result = CreatePipe(hReadPipe, hWritePipe, sa, 0)

If Result = 0 Then
MsgBox "CreatePipe failed Error!"
Exit Function
End If

start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES
start.wShowWindow = SW_MINIMIZE
start.hStdOutput = hWritePipe


Result = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

If Result <> 0 Then
'*** Anfang der Verbesserung Achim Neubauer***

Dim lPeekData As Long

Do
Call PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, _
lPeekData, ByVal 0&)

If lPeekData > 0 Then
Buffer = Space$(lPeekData)
bSuccess = ReadFile(hReadPipe, Buffer, Len(Buffer), L,
0&)

If bSuccess = 1 Then
Text1.Text = Text1.Text & Replace(Left(Buffer, L),
vbLf, vbCrLf, 1, , vbBinaryCompare)
Text1.SelStart = Len(Text1.Text)
Else
MsgBox "ReadFile failed!"
End If
Else
bSuccess = WaitForSingleObject(proc.hProcess, 0&)

If bSuccess = 0 Then
Exit Do
End If
End If

DoEvents
Loop

'*** Ende der Verbesserung Achim Neubauer ***
Else
MsgBox "Error while starting process!"
End If

Call CloseHandle(proc.hProcess)
Call CloseHandle(proc.hThread)
Call CloseHandle(hReadPipe)
Call CloseHandle(hWritePipe)

ExecCmd = retText
End Function

<\Code>

Kann von den Profis vielleicht einer einmal ein Blick darauf werfen und
mir einen Tipp geben, was ich falsch mache?

Danke schon einmal im voraus.

Gruß Ahmed
Antworten bitte nur in der Newsgroup.
 

Lesen sie die antworten

#1 Ahmed Martens
12/11/2008 - 13:29 | Warnen spam
Hallo Leute,

ich habe die Lösung nach endlos langer suche gefunden.
Am Wed, 12 Nov 2008 08:39:09 +0100 schrieb Ahmed Martens:

[...]

Const NORMAL_PRIORITY_CLASS = &H20&
Const STARTF_USESTDHANDLES = &H100&


Const STARTF_USESHOWWINDOW = &H1


start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES


start.dwFlags = STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW

start.wShowWindow = SW_MINIMIZE



[...]

Nur mit dieser Ergànzung wird die wShowWindow-Anweisung ausgeführt.
Jetzt habe ich alles was ich brauche.

Gruß Ahmed
Antworten bitte nur in der Newsgroup.

Ähnliche fragen