0

只要输出相对较小，我就有一个可以完美运行的功能。但是如果输出很长（我认为断点是 4150 字节），函数会返回错误并且输出为空白。似乎某处需要增加缓冲区，但我对旧版本的 VB 不是很熟悉，所以我不知道该去哪里找。不幸的是，我无法将程序升级到 VB 6.0 以外的任何版本，所以我真的有点卡在这里。有任何想法吗？

    Public Function Redirect(szBinaryPath As String, szCommandLn As String) As String
        Dim tSA_CreatePipe              As SECURITY_ATTRIBUTES
        Dim tSA_CreateProcessPrc        As SECURITY_ATTRIBUTES
        Dim tSA_CreateProcessThrd       As SECURITY_ATTRIBUTES
        Dim tSA_CreateProcessPrcInfo    As PROCESS_INFORMATION
        Dim tStartupInfo                As STARTUPINFO
        Dim hRead                       As Long
        Dim hWrite                      As Long
        Dim bRead                       As Long
        Dim abytBuff()                  As Byte
        Dim lngResult                   As Long
        Dim szFullCommand               As String
        Dim lngExitCode                 As Long
        Dim lngSizeOf                   As Long
        Dim intReturn                   As Integer

        tSA_CreatePipe.nLength = Len(tSA_CreatePipe)
        tSA_CreatePipe.lpSecurityDescriptor = 0&
        tSA_CreatePipe.bInheritHandle = True

        tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc)
        tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd)

        If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then
            tStartupInfo.cb = Len(tStartupInfo)
            GetStartupInfo tStartupInfo

            With tStartupInfo
                .hStdOutput = hWrite
                .hStdError = hWrite
                .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
                .wShowWindow = SW_HIDE
            End With

            szFullCommand = """" & szBinaryPath & """" & " " & szCommandLn

            lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo)

            If (lngResult <> 0&) Then
                lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, WAIT_LONG)

                lngSizeOf = GetFileSize(hRead, 0&)
                If (lngSizeOf > 0) Then
                    ReDim abytBuff(lngSizeOf - 1)
                    If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then
                        Redirect = StrConv(abytBuff, vbUnicode)
                    End If
                End If
                Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode)
                CloseHandle tSA_CreateProcessPrcInfo.hThread
                CloseHandle tSA_CreateProcessPrcInfo.hProcess

                If (lngExitCode <> 0&) Then Err.Raise vbObject + 1235&, "GetExitCodeProcess", "Non-zero Application exist code"
                CloseHandle hWrite
                CloseHandle hRead
            Else
                Err.Raise vbObject + 1236&, "CreateProcess", "CreateProcess Failed, Code: " & Err.LastDllError
            End If
        End If
    End Function
4

0 回答 0