出力が比較的小さい限り、完全に機能する関数があります。しかし、出力が長い場合 (ブレークポイントは 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