在VB 6.0中重定向进程输出

时间:2013-06-07 04:53:03

标签: visual-studio vb6

只要输出相对较小,我就有了完美的功能。但是如果输出很长(我认为断点是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

0 个答案:

没有答案