鑒于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
'****完成****
uj5u.com熱心網友回復：
謝謝分享......
uj5u.com熱心網友回復：
附上前兩種方法：方法一：一句代碼搞定:
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
uj5u.com熱心網友回復：
狗屁！正真的方法是Office選全安裝到本地磁盤，不選任何的需要時安裝，什么問題都不會有。
uj5u.com熱心網友回復：
肯定是OFFICE沒有裝好。重新裝一個吧
uj5u.com熱心網友回復：
是，不過唯一扯淡的是，只能解決自己電腦。uj5u.com熱心網友回復：
這種方法是萬用的，到了別人電腦也能正常運行，別忘了可不是每個人都是電腦高手。uj5u.com熱心網友回復：
收藏先！留后用。uj5u.com熱心網友回復：
不錯的分享。uj5u.com熱心網友回復：
謝謝分享，學習了。轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/109576.html
標籤：控件
上一篇：很急！用IF判斷記錄集的某個欄位rs.fields("status")的值是否符合要求
下一篇：C++ ADO版本