Hallo Gemeinde,
ich habe ein kleines Problem. Der Aufruf der Shell und das Warten auf Antwort funktioniert ganz gut, ich möchte jedoch auch das Ergebnis auswerten. Dazu übergebe ich | find /c "100%" und erhalte eine 1, wenn der Download erfolgreich war (sicheres FTP. Alles funktioniert fein, aber leider nicht auf einem Windows 7 mit 64 Bit Office. Die Deklarationen habe ich allesamt angepasst, es scheitert an der Funktion Readfile ganz am Ende, davor wird alles erfolgreich durchlaufen. Noch ein kleiner Unterschied, das Dos-Fenster wird unter Windows 10 32 Bit Office (Access) nicht angezeigt, sw_hide, unter Windows 7 64 Bit jedoch schon. Keine Ahnung, warum sich das anders verhält, der Parameter in der Startupinfo ist derselbe.
Hier der Code.
Der Übergabewert ist: (verändert)
cmd /c D:\winscp.com /command " open ftps://benutzer:kennwort@firma.de/Ordner -certificate="AA:BB:..." -explicittls " "get datei.endung D:\datei.endung" "exit " > more && type more | find /c "100%"
Ich danke euch. Wie geschrieben, das Access hängt sich weg beim readfile, bleibt dort mit der Sanduhr stehen. Die Übergabewerte sind allesamt gefüllt, unter Win 10 Office 32 Bit funktioniert alles.
ich habe ein kleines Problem. Der Aufruf der Shell und das Warten auf Antwort funktioniert ganz gut, ich möchte jedoch auch das Ergebnis auswerten. Dazu übergebe ich | find /c "100%" und erhalte eine 1, wenn der Download erfolgreich war (sicheres FTP. Alles funktioniert fein, aber leider nicht auf einem Windows 7 mit 64 Bit Office. Die Deklarationen habe ich allesamt angepasst, es scheitert an der Funktion Readfile ganz am Ende, davor wird alles erfolgreich durchlaufen. Noch ein kleiner Unterschied, das Dos-Fenster wird unter Windows 10 32 Bit Office (Access) nicht angezeigt, sw_hide, unter Windows 7 64 Bit jedoch schon. Keine Ahnung, warum sich das anders verhält, der Parameter in der Startupinfo ist derselbe.
Hier der Code.
Quellcode
- Option Explicit
- Private Declare PtrSafe Function CreatePipe Lib "kernel32" (phReadPipe As LongPtr, phWritePipe As LongPtr, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
- Private Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
- Private Declare PtrSafe Function GetNamedPipeInfo Lib "kernel32" (ByVal hNamedPipe As LongPtr, ltype As Long, llenoutbuf As Long, lleninbuf As Long, lpMaxInstances As Long) As Long
- Type SECURITY_ATTRIBUTES
- nLength As Long
- lpSecurityDescriptor As LongPtr
- bInheritHandle As Long
- End Type
- Private Type OVERLAPPED
- Internal As LongPtr
- InternalHigh As LongPtr
- offset As Long
- OffsetHigh As Long
- hEvent As LongPtr
- 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 LongPtr
- hStdError As Long
- End Type
- Private Type PROCESS_INFORMATION
- hProcess As Long
- hThread As Long
- dwProcessID As Long
- dwThreadID As Long
- End Type
- Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
- Private Declare PtrSafe 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 PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
- Function ShellExecuteCapture(sCommandLine As String, Optional bShowWindow As Boolean = False) As String
- Const clReadBytes As Long = 256, INFINITE As Long = &HFFFFFFFF
- Const STARTF_USESHOWWINDOW = &H1, STARTF_USESTDHANDLES = &H100&
- Const SW_HIDE = 0, SW_NORMAL = 1
- Const NORMAL_PRIORITY_CLASS = &H20&
- Const PIPE_CLIENT_END = &H0 'The handle refers to the client end of a named pipe instance. This is the default.
- Const PIPE_SERVER_END = &H1 'The handle refers to the server end of a named pipe instance. If this value is not specified, the handle refers to the client end of a named pipe instance.
- Const PIPE_TYPE_BYTE = &H0 'The named pipe is a byte pipe. This is the default.
- Const PIPE_TYPE_MESSAGE = &H4 'The named pipe is a message pipe. If this value is not specified, the pipe is a byte pipe
- Dim tProcInfo As PROCESS_INFORMATION, lRetVal As Long, lSuccess As Long
- Dim tStartupInf As STARTUPINFO
- Dim tSecurAttrib As SECURITY_ATTRIBUTES, lhwndReadPipe As LongPtr, lhwndWritePipe As LongPtr
- Dim lBytesRead As Long, sBuffer As String
- Dim lPipeOutLen As Long, lPipeInLen As Long, lMaxInst As Long
- tSecurAttrib.nLength = Len(tSecurAttrib)
- tSecurAttrib.bInheritHandle = 1&
- tSecurAttrib.lpSecurityDescriptor = 0&
- lRetVal = CreatePipe(lhwndReadPipe, lhwndWritePipe, tSecurAttrib, 0)
- If lRetVal = 0 Then
- 'CreatePipe failed
- Exit Function
- End If
- tStartupInf.cb = Len(tStartupInf)
- tStartupInf.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
- tStartupInf.hStdOutput = lhwndWritePipe
- If bShowWindow Then
- 'Show the DOS window
- tStartupInf.wShowWindow = SW_NORMAL
- Else
- 'Hide the DOS window
- tStartupInf.wShowWindow = SW_HIDE
- End If
- lRetVal = CreateProcessA(0&, sCommandLine, tSecurAttrib, tSecurAttrib, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, tStartupInf, tProcInfo)
- If lRetVal <> 1 Then
- 'CreateProcess failed
- Exit Function
- End If
- 'Process created, wait for completion. Note, this will cause your application
- 'to hang indefinately until this process completes.
- WaitForSingleObject tProcInfo.hProcess, INFINITE
- Dim K As OVERLAPPED
- 'Determine pipes contents
- lSuccess = GetNamedPipeInfo(lhwndReadPipe, PIPE_TYPE_BYTE, lPipeOutLen, lPipeInLen, lMaxInst)
- If lSuccess Then
- 'Got pipe info, create buffer
- sBuffer = String(lPipeOutLen, 0)
- 'Read Output Pipe
- 'lSuccess = ReadFile(lhwndReadPipe, sBuffer, lPipeOutLen, lBytesRead, 0&)
- lSuccess = ReadFile(lhwndReadPipe, sBuffer, lPipeOutLen, lBytesRead, K)
- If lSuccess = 1 Then
- 'Pipe read successfully
- ShellExecuteCapture = Left$(sBuffer, lBytesRead)
- End If
- End If
- 'Close handles
- Call CloseHandle(tProcInfo.hProcess)
- Call CloseHandle(tProcInfo.hThread)
- Call CloseHandle(lhwndReadPipe)
- Call CloseHandle(lhwndWritePipe)
- End Function
Der Übergabewert ist: (verändert)
cmd /c D:\winscp.com /command " open ftps://benutzer:kennwort@firma.de/Ordner -certificate="AA:BB:..." -explicittls " "get datei.endung D:\datei.endung" "exit " > more && type more | find /c "100%"
Ich danke euch. Wie geschrieben, das Access hängt sich weg beim readfile, bleibt dort mit der Sanduhr stehen. Die Übergabewerte sind allesamt gefüllt, unter Win 10 Office 32 Bit funktioniert alles.