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