modremoteloaddll.bas

DLL注入

    '至于+1，书上说是因为OS核心是C写的,而C下的字符串有个结束符“\0”,要多占一位。
    nSize = LenB(lpszLibName) + 1
    
    LoadDLL = False
    
    '如果已经加载则不进行注入
    If IsDllLoaded(dwProcessId, lpszLibName, hMod) Then
        MsgBox "DLL已经加载到指定进程。", vbInformation Or vbOKOnly, "提示"
        Exit Function
    End If
     
    '除去错误判断，就只有8行代码，已经很简单了
    
    '打开进程，OpenProcess返回一个可操作的句柄，失败则返回0
    hProcess = OpenProcess(PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, dwProcessId)
    If hProcess = 0 Then
        MsgBox "打开进程失败。", vbInformation Or vbOKOnly, "错误"
        Exit Function
    End If
    
    '分配内存,VirtualAllocEx返回分配的内存的起始地址(BaseAddress)，失败则返回0
    lpszRemoteFile = VirtualAllocEx(hProcess, 0, nSize, MEM_COMMIT, PAGE_READWRITE)
    If lpszRemoteFile = 0 Then
        MsgBox "分配内存失败。", vbInformation Or vbOKOnly, "错误"
        '关闭已经打开的进程句柄后退出
        CloseHandle (hProcess)
        Exit Function
    End If
    
    '写入DLL地址，失败则返回0。注意：第二个参数是分配的内存的起始地址
    ret = WriteProcessMemory(hProcess, lpszRemoteFile, lpszLibName, nSize, 0)
    If ret = 0 Then
        MsgBox "写入内存失败。", vbInformation Or vbOKOnly, "错误"
        CloseHandle (hProcess)
        Exit Function
    End If
    
    '获取LoadLibraryA函数地址,GetProcAddress返回函数的地址，失败则返回0
    dwAddress = GetProcAddress(GetModuleHandle("kernel32"), "LoadLibraryA")
    If dwAddress = 0 Then
        MsgBox "获取函数地址失败。", vbInformation Or vbOKOnly, "错误"
        CloseHandle (hProcess)
        Exit Function
    End If
    
    '创建远程线程，CreateRemoteThread返回线程句柄，失败则返回0
    hThread = CreateRemoteThread(hProcess, 0, 0, dwAddress, lpszRemoteFile, 0, 0)
    If hThread = 0 Then
        MsgBox "创建线程失败。", vbInformation Or vbOKOnly, "错误"
        CloseHandle (hProcess)
        Exit Function
    End If
    
    '等待线程返回，如果线程长时间没有信号返回就可能出现了异常
    '这个API函数可以用来复活进程，配合WaitForInputIdle。创建两个进程，互相等待对方，如果一方返回了不是超时的信号
    '就说明被结束了或出了其他问题，然后马上复活对方，这样就简单的让进程结束不了。
    WaitForSingleObject hThread, INFINITE
    
    '关闭句柄
    CloseHandle (hThread)
    CloseHandle (hProcess)
    
    LoadDLL = True

End Function

'卸载DLL
Public Function UnloadDLl(ByVal dwProcessId As Long, ByVal lpszLibName As String) As Boolean
    Dim hProcess, hThread, dwAddress As Long
    Dim hMod As MODULEENTRY32 '必需的，卸载时需要用到
    
    UnloadDLl = False
    
    '调用IsDllLoaded不仅是判断DLL是否已经加载，更重要的是卸载DLL是要用到在IsDllLoaded函数中返回的变量hMod
    If IsDllLoaded(dwProcessId, lpszLibName, hMod) = False Then
        MsgBox "进程：" & dwProcessId & vbCrLf & "中找不到模块：" & vbCrLf & lpszLibName
        Exit Function
    End If
    
    '打开进程
    hProcess = OpenProcess(PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, dwProcessId)
    If hProcess = 0 Then
        MsgBox "打开进程失败。", vbInformation Or vbOKOnly, "错误"
        Exit Function
    End If
      
    '获取FreeLibrary函数地址
    dwAddress = GetProcAddress(GetModuleHandle("kernel32"), "FreeLibrary")
    If dwAddress = 0 Then
        MsgBox "获取函数地址失败。", vbInformation Or vbOKOnly, "错误"
        CloseHandle (hProcess)
        Exit Function
    End If
    
    '创建远程线程
    hThread = CreateRemoteThread(hProcess, 0, 0, dwAddress, hMod.modBaseAddr, 0, 0)
    If hThread = 0 Then
        MsgBox "创建线程失败。", vbInformation Or vbOKOnly, "错误"
        CloseHandle (hProcess)
        Exit Function
    End If
    
    '等待线程返回
    WaitForSingleObject hThread, INFINITE
    
    '关闭句柄
    CloseHandle (hThread)
    CloseHandle (hProcess)
    
    UnloadDLl = True

End Function

'判断DLL是否已加载
Private Function IsDllLoaded(ByVal dwProcessId As Long, ByVal lpszLibName As String, ByRef hMod As MODULEENTRY32) As Boolean
    Dim hthSnapshot, bMoreMods As Long
    Dim bFound As Boolean
    
    bFound = False
    hMod.dwSize = Len(hMod)
    
    '创建DLL模块快照，获取句柄传递给Module32First和Module32Next
    hthSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, dwProcessId)

    '逐个模块进行查找
    bMoreMods = Module32First(hthSnapshot, hMod)
    Do While bMoreMods <> 0
        '这里不直接用“=”比较是因为hMod.szExePath尾部有Chr(0)，而lpszLibName没有
        If InStr(UCase(hMod.szExePath), UCase(lpszLibName)) > 0 Then
            bFound = True
            Exit Do
        End If
        '查找下一个
        bMoreMods = Module32Next(hthSnapshot, hMod)
    Loop
    
    CloseHandle (hthSnapshot)
    
    IsDllLoaded = bFound
    
End Function


'-----------------------------------------------------------------------------------------------------------------------------------------
'                                  程序结束
'-----------------------------------------------------------------------------------------------------------------------------------------