Expertenfrage Pipe, Shell, Rückgabewerte

  • Access

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Petersilie.

    Expertenfrage Pipe, Shell, Rückgabewerte

    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.

    Quellcode

    1. Option Explicit
    3. Private Declare PtrSafe Function CreatePipe Lib "kernel32" (phReadPipe As LongPtr, phWritePipe As LongPtr, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
    4. 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
    5. 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
    7. Type SECURITY_ATTRIBUTES
    8. nLength As Long
    9. lpSecurityDescriptor As LongPtr
    10. bInheritHandle As Long
    11. End Type
    13. Private Type OVERLAPPED
    14. Internal As LongPtr
    15. InternalHigh As LongPtr
    16. offset As Long
    17. OffsetHigh As Long
    18. hEvent As LongPtr
    19. End Type
    21. Private Type STARTUPINFO
    22. cb As Long
    23. lpReserved As Long
    24. lpDesktop As Long
    25. lpTitle As Long
    26. dwX As Long
    27. dwY As Long
    28. dwXSize As Long
    29. dwYSize As Long
    30. dwXCountChars As Long
    31. dwYCountChars As Long
    32. dwFillAttribute As Long
    33. dwFlags As Long
    34. wShowWindow As Integer
    35. cbReserved2 As Integer
    36. lpReserved2 As Long
    37. hStdInput As Long
    38. hStdOutput As LongPtr
    39. hStdError As Long
    40. End Type
    42. Private Type PROCESS_INFORMATION
    43. hProcess As Long
    44. hThread As Long
    45. dwProcessID As Long
    46. dwThreadID As Long
    47. End Type
    49. Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    50. 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
    51. Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
    53. Function ShellExecuteCapture(sCommandLine As String, Optional bShowWindow As Boolean = False) As String
    54. Const clReadBytes As Long = 256, INFINITE As Long = &HFFFFFFFF
    55. Const STARTF_USESHOWWINDOW = &H1, STARTF_USESTDHANDLES = &H100&
    56. Const SW_HIDE = 0, SW_NORMAL = 1
    57. Const NORMAL_PRIORITY_CLASS = &H20&
    59. Const PIPE_CLIENT_END = &H0 'The handle refers to the client end of a named pipe instance. This is the default.
    60. 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.
    61. Const PIPE_TYPE_BYTE = &H0 'The named pipe is a byte pipe. This is the default.
    62. Const PIPE_TYPE_MESSAGE = &H4 'The named pipe is a message pipe. If this value is not specified, the pipe is a byte pipe
    65. Dim tProcInfo As PROCESS_INFORMATION, lRetVal As Long, lSuccess As Long
    66. Dim tStartupInf As STARTUPINFO
    67. Dim tSecurAttrib As SECURITY_ATTRIBUTES, lhwndReadPipe As LongPtr, lhwndWritePipe As LongPtr
    68. Dim lBytesRead As Long, sBuffer As String
    69. Dim lPipeOutLen As Long, lPipeInLen As Long, lMaxInst As Long
    71. tSecurAttrib.nLength = Len(tSecurAttrib)
    72. tSecurAttrib.bInheritHandle = 1&
    73. tSecurAttrib.lpSecurityDescriptor = 0&
    75. lRetVal = CreatePipe(lhwndReadPipe, lhwndWritePipe, tSecurAttrib, 0)
    76. If lRetVal = 0 Then
    77. 'CreatePipe failed
    78. Exit Function
    79. End If
    81. tStartupInf.cb = Len(tStartupInf)
    82. tStartupInf.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    83. tStartupInf.hStdOutput = lhwndWritePipe
    84. If bShowWindow Then
    85. 'Show the DOS window
    86. tStartupInf.wShowWindow = SW_NORMAL
    87. Else
    88. 'Hide the DOS window
    89. tStartupInf.wShowWindow = SW_HIDE
    90. End If
    92. lRetVal = CreateProcessA(0&, sCommandLine, tSecurAttrib, tSecurAttrib, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, tStartupInf, tProcInfo)
    93. If lRetVal <> 1 Then
    94. 'CreateProcess failed
    95. Exit Function
    96. End If
    98. 'Process created, wait for completion. Note, this will cause your application
    99. 'to hang indefinately until this process completes.
    100. WaitForSingleObject tProcInfo.hProcess, INFINITE
    101. Dim K As OVERLAPPED
    103. 'Determine pipes contents
    104. lSuccess = GetNamedPipeInfo(lhwndReadPipe, PIPE_TYPE_BYTE, lPipeOutLen, lPipeInLen, lMaxInst)
    105. If lSuccess Then
    106. 'Got pipe info, create buffer
    107. sBuffer = String(lPipeOutLen, 0)
    108. 'Read Output Pipe
    109. 'lSuccess = ReadFile(lhwndReadPipe, sBuffer, lPipeOutLen, lBytesRead, 0&)
    110. lSuccess = ReadFile(lhwndReadPipe, sBuffer, lPipeOutLen, lBytesRead, K)
    111. If lSuccess = 1 Then
    112. 'Pipe read successfully
    113. ShellExecuteCapture = Left$(sBuffer, lBytesRead)
    114. End If
    115. End If
    117. 'Close handles
    118. Call CloseHandle(tProcInfo.hProcess)
    119. Call CloseHandle(tProcInfo.hThread)
    120. Call CloseHandle(lhwndReadPipe)
    121. Call CloseHandle(lhwndWritePipe)
    122. 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.

    Hallo,

    du hast deine WinAPI Functions für VBA7 Office64 bit ausgelegt.

    Visual Basic-Quellcode

    1. #if Vba7 then
    2. ' Code is running in the new VBA7 editor
    3. #if Win64 then
    4. ' Code is running in 64-bit version of Microsoft Office
    5. #else
    6. ' Code is running in 32-bit version of Microsoft Office
    7. #end if
    8. #else
    9. ' Code is running in VBA version 6 or earlier
    10. #end if


    msdn.microsoft.com/de-de/vba/l…for-applications-overview


    Du musst deine Types und Declares auf jede eventualität anpassen, sofern diese auf mehereren Windows Systemen laufen sollen.

    Ist nervig, da man alles doppelt und dreifach machen muss, aber was solls...
    Hab damit auch oft zu kämpfen

Facebook
Telefonspende