打开VB提示安装Office终极解决方法

Question

鉴于office安装问题太烦人，于是打算彻底干掉它。除了前面讲的用Open锁定msi.dll的方法外，还有更好的方法。
Open虽然简单，但会禁止msi文件，所以又找到一种新的不妨碍其它程序的办法。方法是hook当前进程的ZwOpenFile(NtOpenFile)，发现是msi.dll时跳过即可。代码如下：'窗体
Option ExplicitPrivate Sub Form_Load()
        Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
        Me.Show
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        Unhook
End Sub'模块
Option ExplicitPrivate Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function ZwOpenFile Lib "NTDLL.DLL" (ByRef Filehandle As Long, _
                                                ByVal DesiredAccess As Long, _
                                                ByRef ObjectAttributes As OBJECT_ATTRIBUTES, _
                                                ByRef IoStatusBlock As IO_STATUS_BLOCK, _
                                                ByVal ShareAccess As Long, _
                                                ByVal OpenOptions As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)Private Const STATUS_OBJECT_NAME_NOT_FOUND = &HC0000034Private Type IO_STATUS_BLOCK
        Status                          As Long
        Information                     As Long
End TypePrivate Type OBJECT_ATTRIBUTES
        length                          As Long
        RootDirectory                   As Long
        ObjectName                      As Long
        Attributes                      As Long
        SecurityDescriptor              As Long
        SecurityQualityOfService        As Long
End TypePrivate MyHook As cls_HookApi   '自定义hookSub Main()
        App.TaskVisible = False
        Set MyHook = New cls_HookApi
        MyHook.HookApi "ntdll.dll", "ZwOpenFile", GetFunAddr(AddressOf ZwOpenFileCallback), GetCurrentProcess
        Load frm_Main
End Sub'NtOpenFile回调
Public Function ZwOpenFileCallback(Filehandle As Long, ByVal DesiredAccess As Long, ObjectAttributes As OBJECT_ATTRIBUTES, IoStatusBlock As IO_STATUS_BLOCK, ByVal ShareAccess As Long, ByVal OpenOptions As Long) As Long
        Dim lRetVal As Long
        MyHook.HookStatus False
        'Debug.Print ObjectAttrToName(ObjectAttributes)
        If LCase(ObjectAttrToName(ObjectAttributes)) Like LCase("*msi.dll") Then
                lRetVal = STATUS_OBJECT_NAME_NOT_FOUND '返回值改为对象不存在
        Else
                lRetVal = ZwOpenFile(Filehandle, DesiredAccess, ObjectAttributes, IoStatusBlock, ShareAccess, OpenOptions)
        End If
        MyHook.HookStatus True
        ZwOpenFileCallback = lRetVal
End Function'得到文件名称
Private Function ObjectAttrToName(ObjectAttr As OBJECT_ATTRIBUTES) As String
        Dim bytCode() As Byte
        Dim dwName As Long
        Dim dwLength As Integer
        CopyMemory dwLength, ByVal ObjectAttr.ObjectName, 2
        If dwLength > 0 Then
                CopyMemory dwName, ByVal ObjectAttr.ObjectName + 4, 4
                ReDim bytCode(dwLength - 1)
                CopyMemory bytCode(0), ByVal dwName, dwLength
                ObjectAttrToName = StrConv(StrConv(bytCode, vbUnicode), vbFromUnicode)
                ObjectAttrToName = Replace(ObjectAttrToName, "\??\", "")
        End If
        Erase bytCode
End FunctionPublic Function GetFunAddr(lngFunAddr As Long) As Long
        GetFunAddr = lngFunAddr
End FunctionSub Unhook()
        Set MyHook = Nothing
End Sub'类
Option ExplicitPrivate Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFFPrivate mbytOldCode(5) As Byte
Private mbytNewCode(5) As Byte
Private mlngFunAddr As LongPrivate mhProcess As LongPublic Function HookApi(ByVal strDllName As String, ByVal strFunName As String, ByVal lngFunAddr As Long, ByVal hProcess As Long) As Boolean
        Dim hModule As Long, dwJmpAddr As Long
        mhProcess = GetCurrentProcess
        hModule = LoadLibrary(strDllName)
        If hModule = 0 Then HookApi = False: Exit Function
        mlngFunAddr = GetProcAddress(hModule, strFunName)
        If mlngFunAddr = 0 Then HookApi = False: Exit Function
        CopyMemory mbytOldCode(0), ByVal mlngFunAddr, 6
        mbytNewCode(0) = &HE9
        dwJmpAddr = lngFunAddr - mlngFunAddr - 5
        CopyMemory mbytNewCode(1), dwJmpAddr, 4
        HookStatus True
        HookApi = True
End FunctionPublic Function HookStatus(ByVal blnIsHook As Boolean) As Boolean
        If blnIsHook Then
                If WriteProcessMemory(mhProcess, ByVal mlngFunAddr, mbytNewCode(0), 5, 0) <> 0 Then HookStatus = True '拦截
        Else
                If WriteProcessMemory(mhProcess, ByVal mlngFunAddr, mbytOldCode(0), 5, 0) <> 0 Then HookStatus = False '恢复
        End If
End FunctionPrivate Sub Class_Terminate()
        HookStatus False
End Sub'****完成****

Answer 1

附上前两种方法：方法一：一句代码搞定:Open "msi.dll" For Binary Lock Read Write As #235   '自己定义文件号方法二：使用API OpenFile或CreateFile(需完整路径)Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As Long, ByVal wStyle As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate hFile_Msi As LongSub LockMsi()        hFile_Msi = OpenFile("msi.dll", ByVal VarPtr(0&), &H10)        'Debug.Print hFile_MsiEnd SubSub UnLockMsi()        If hFile_Msi > 0 Then CloseHandle hFile_MsiEnd SubSub Main()        LockMsi '先锁定，再加载窗体        Load Form1        Form1.ShowEnd Sub

Answer 2

狗屁！
正真的方法是Office选全安装到本地磁盘，不选任何的需要时安装，什么问题都不会有。

Answer 3

肯定是OFFICE没有装好。
重新装一个吧