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