关于卸载DLL文件?

[nanfei01055]

不知道为什么我用下面这个函数卸载DLL,每次要执行两遍才能卸载掉DLL,但执行时每一步都跟踪调试过,没有问题,有高手的话,给指点一下:

Function EnjectLib(ProcessId As Long, LibName As String) As Long
Dim hProcess As Long
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId)
If hProcess = 0 Then Exit Function

Dim hModuleSnap As Long
hModuleSnap = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessId)
Dim me32 As MODULEENTRY32
me32.dwSize = Len(me32)
Dim bFound As Boolean
bFound = False
Dim hMod As Long
hMod = 0
If Module32First(hModuleSnap, me32) <> 0 Then
Do
If InStr(LCase(me32.szExePath), LCase(LibName)) > 0 Then
hMod = me32.hModule
bFound = True
End If
Loop While (Not bFound) And (Module32Next(hModuleSnap, me32) <> 0)
End If
CloseHandle hModuleSnap
If hMod = 0 Then
CloseHandle hProcess
Exit Function
End If
Dim pfnRemote As Long
pfnRemote = GetProcAddress(GetModuleHandle("Kernel32"), "FreeLibrary")
If pfnRemote = 0 Then
CloseHandle hProcess
Exit Function
End If
Dim hThread As Long
hThread = CreateRemoteThread(hProcess, 0, 0, pfnRemote, hMod, 0, 0)
If hThread = 0 Then
CloseHandle hProcess
Exit Function
End If
WaitForSingleObject hThread, INFINITE
CloseHandle hProcess
CloseHandle hThread
EnjectLib = 1
End Function

[nanfei01055]

为了方便大家调试附上声明及注入代码:
Option Explicit

Private Const PROCESS_VM_READ = &H10
Private Const TH32CS_SNAPPROCESS = &H2
Private Const MEM_COMMIT = 4096
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = 4
Private Const PROCESS_Create_THREAD = (&H2)
Private Const PROCESS_VM_OPERATION = (&H8)
Private Const PROCESS_VM_WRITE = (&H20)
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const INFINITE = &HFFFF
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "KERNEL32.DLL" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Const TH32CS_SNAPMODULE = &H8
Private Type MODULEENTRY32
dwSize As Long 'Ö¸¶¨½á¹¹µÄ´óС£¬ÔÚµ÷ÓÃModule32FirstÇ°ÐèÒªÉèÖ㬷ñÔò½«»áʧ°Ü
th32ModuleID As Long 'Ä£¿éºÅ
th32ProcessID As Long '°üº¬±¾Ä£¿éµÄ½ø³ÌºÅ
GlblcntUsage As Long '±¾Ä£¿éµÄÈ«¾ÖÒýÓüÆÊý
ProccntUsage As Long '°üº¬Ä£¿éµÄ½ø³ÌÉÏÏÂÎÄÖеÄÄ£¿éÒýÓüÆÊý
modBaseAddr As Byte 'Ä£¿é»ùµØÖ·
modBaseSize As Long 'Ä£¿é´óС£¨×Ö½ÚÊý£©
hModule As Long '°üº¬Ä£¿éµÄ½ø³ÌÉÏÏÂÎÄÖеÄhModule¾ä±ú
szModule As String * 256 'Ä£¿éÃû
szExePath As String * 1024 'Ä£¿é¶ÔÓ¦µÄÎļþÃûºÍ·¾¶
End Type
Private Declare Function Module32First Lib "KERNEL32.DLL" (ByVal hSnapshot As Long, ByRef lpme As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "KERNEL32.DLL" (ByVal hSnapshot As Long, ByRef lpme As MODULEENTRY32) As Long

Function InjectLib(ProcessId As Long, LibName As String) As Long
Dim MyRemoteProcessId As Long 'Ä¿±ê½ø³Ìpid
Dim MyDllFileName As String 'dllÎļþ·¾¶
Dim MyDllFileLength As Long 'dllÎļþÃû³¤¶È
Dim MyDllFileBuffer As Long 'дÈëdllÎļþÃûµÄÄÚ´æµØÖ·
Dim MyAddr As Long 'Ö´ÐÐÔ¶³ÌÏ̴߳úÂëµÄÆðʼµØÖ·,ÕâÀïµÈÓÚLoadLibraryAµÄµØÖ·
Dim MyReturn As Long
MyDllFileName = LibName
MyDllFileLength = LenB(StrConv(MyDllFileName, vbFromUnicode)) + 1
MyRemoteProcessId = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId)
If MyRemoteProcessId = 0 Then Exit Function

MyDllFileBuffer = VirtualAllocEx(MyRemoteProcessId, 0, MyDllFileLength, MEM_COMMIT, PAGE_READWRITE)
If MyDllFileBuffer = 0 Then Exit Function

MyReturn = WriteProcessMemory(MyRemoteProcessId, MyDllFileBuffer, ByVal (MyDllFileName), MyDllFileLength, 0)
If MyReturn = 0 Then Exit Function

MyAddr = GetProcAddress(GetModuleHandle("Kernel32"), "LoadLibraryA")
If MyAddr = 0 Then Exit Function

Dim MyResult As Long
MyResult = CreateRemoteThread(MyRemoteProcessId, 0, 0, MyAddr, MyDllFileBuffer, 0, 0)
If MyResult = 0 Then Exit Function

WaitForSingleObject MyResult, INFINITE
VirtualFreeEx MyRemoteProcessId, MyDllFileBuffer, 0, MEM_RELEASE
CloseHandle MyResult
CloseHandle MyRemoteProcessId
InjectLib = 1
End Function

[tzwsoho]

俺是打酱油的....

[nanfei01055]

怎么就一个人,大家都来看看?

[nanfei01055]

咋就没人呢?

[Tiger_Zhao]

很明显是执行间隔时间的问题，卸载是需要时间的，而单步调试的语句执行间隔足够了，而不间断执行太快了。
在适当的地方加入延时功能。

[nanfei01055]

你说的我知道,单步调试其实也没有卸载成功,也是需要两遍的,我说的一切正常,是指每一步数据都正常,没有退出.

[nanfei01055]

不过还是谢谢你,我用其它方法解决了.其它你写的那个过程用sleep,不就可以了吗?

[nanfei01055]

请问5楼,能否给段代码,我觉得你说的有道理,但不知道怎么做?

[Tiger_Zhao]

用下面的函数，虽然不是很精确，但是只要秒数给大点保证足够卸载就可以了

Sub Wait(ByVal Seconds As Long)
    Dim dtStart As Date, dtNow As Date
    
    dtStart = Now()
    Do
        DoEvents
        dtNow = Now()
    Loop Until DateDiff("s", dtStart, dtNow) >= Seconds
    'Debug.Print dtStart, dtNow
End Sub