猫解决打开VB6反复提示windows正在设置Office
发布时间：2022-01-10, 17:06:05 分类：VB | 编辑 off 网址 | 辅助
正文 521字数 483,488阅读
打开vb6软件一直提示 windows 正在设置 Office
每次安装VB或Office都会遇到这个问题，有时重装几次都不能解决，只好连按五次“取消”才能进入。
这个问题存在很久了，我网上找了很多的解决办法都没最终解决。
今天将注册表的项一个个删除，终于找到引起这个问题的最终原因了：
将
[HKEY_CLASSES_ROOT\Installer\Features\4080110900063D11C8EF10054038389C]Run code
Cut to clipboard
ProductNonBootFilesRun code
Cut to clipboard
注：
Features下的文件夹4080110900063D11C8EF10054038389C
名称可能与安装的Office版本不同而不同，
我的一台电脑上是
00004109110000000000000000F01FEC
在另一台能正常打开VB的电脑上，含有子键“ProductNonBootFiles”的文件夹根本就不存在
打开VB开发的软件就不会再出现类假的安装提示了。我做了一些常用的OFFICE操作，未发现受影响。
这可能是目前唯一简便有效的方法(重装、修复除外)
（支付宝）给作者钱财以资鼓励 （微信）→
有过 2 条评论 »
鉴于office安装问题太烦人，于是打算彻底干掉它。除了前面讲的用Open锁定msi.dll的方法外，还有更好的方法。 Open虽然简单，但会禁止msi文件，所以又找到一种新的不妨碍其它程序的办法。 方法是hook当前进程的ZwOpenFile(NtOpenFile)，发现是msi.dll时跳过即可。 代码如下： '窗体 Option Explicit Private Sub Form_Load() Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 Me.Show End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Unhook End Sub '模块 Option Explicit Private 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 = &HC0000034 Private Type IO_STATUS_BLOCK Status As Long Information As Long End Type Private Type OBJECT_ATTRIBUTES length As Long RootDirectory As Long ObjectName As Long Attributes As Long SecurityDescriptor As Long SecurityQualityOfService As Long End Type Private MyHook As cls_HookApi '自定义hook Sub 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 Function Public Function GetFunAddr(lngFunAddr As Long) As Long GetFunAddr = lngFunAddr End Function Sub Unhook() Set MyHook = Nothing End Sub '类 Option Explicit Private 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 = &H1F0FFF Private mbytOldCode(5) As Byte Private mbytNewCode(5) As Byte Private mlngFunAddr As Long Private mhProcess As Long Public 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 Function Public 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 Function Private Sub Class_Terminate() HookStatus False End Sub '****完成****附上前两种方法： 方法一：一句代码搞定: 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 Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private hFile_Msi As Long Sub LockMsi() hFile_Msi = OpenFile("msi.dll", ByVal VarPtr(0&), &H10) 'Debug.Print hFile_Msi End Sub Sub UnLockMsi() If hFile_Msi > 0 Then CloseHandle hFile_Msi End Sub Sub Main() LockMsi '先锁定，再加载窗体 Load Form1 Form1.Show End Sub