home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Voice_Lagg2118646272008.psc / VcProtectexample / Modules / modInjProc.bas < prev   
BASIC Source File  |  2008-06-21  |  4KB  |  80 lines
  1. Attribute VB_Name = "modInjProc"
  2. Option Explicit
  3.  
  4. Private Type PROCESSENTRY32
  5.  dwSize As Long
  6.  cntUsage As Long
  7.  th32ProcessID As Long
  8.  th32DefaultHeapID As Long
  9.  th32ModuleID As Long
  10.  cntThreads As Long
  11.  th32ParentProcessID As Long
  12.  pcPriClassBase As Long
  13.  dwFlags As Long
  14.  szExeFile As String * 260
  15. End Type
  16.  
  17. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  18. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  19. Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal fAllocType As Long, FlProtect As Long) As Long
  20. Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
  21. Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal ProcessHandle As Long, lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Any, ByVal lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
  22. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  23. Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
  24. Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
  25. Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
  26. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  27. Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  28. Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
  29. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  30.  
  31. Public ProsH As Long
  32.  
  33. Public Function InjectDll(DllPath As String, ProsH As Long)
  34. On Error Resume Next
  35. Dim DLLVirtLoc As Long, DllLength, Inject As Long, LibAddress As Long
  36. Dim CreateThread As Long, ThreadID As Long
  37. DllLength = Len(DllPath)
  38. DLLVirtLoc = VirtualAllocEx(ProsH, ByVal &H0, DllLength, ByVal &H1000, ByVal &H4)
  39. If DLLVirtLoc = 0 Then Exit Function
  40. Inject = WriteProcessMemory(ProsH, DLLVirtLoc, ByVal DllPath, DllLength, vbNull)
  41. LibAddress = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")
  42. If LibAddress = 0 Then Exit Function
  43. CreateThread = CreateRemoteThread(ProsH, vbNull, 0, LibAddress, DLLVirtLoc, 0, ThreadID)
  44. Call WaitForSingleObject(CreateThread, &HFFFF)
  45. If DLLVirtLoc <> 0 Then Call VirtualFreeEx(ProsH, DLLVirtLoc, 0, &H8000)
  46. If LibAddress <> 0 Then Call CloseHandle(LibAddress)
  47. If CreateThread <> 0 Then Call CloseHandle(CreateThread)
  48. If ProsH <> 0 Then Call CloseHandle(ProsH)
  49. End Function
  50.  
  51. Public Function GetHProcExe(strExeName As String) As Long
  52. On Error Resume Next
  53. Dim hSnap As Long
  54. hSnap = CreateToolhelpSnapshot(2, 0)
  55. Dim peProcess As PROCESSENTRY32
  56. peProcess.dwSize = LenB(peProcess)
  57. Dim nProcess As Long
  58. nProcess = Process32First(hSnap, peProcess)
  59. Do While nProcess
  60. If StrComp(Trim(peProcess.szExeFile), strExeName, vbTextCompare) = 0 Then
  61. GetHProcExe = OpenProcess(&H1F0FFF, False, peProcess.th32ProcessID)
  62. Exit Function
  63. End If
  64. peProcess.szExeFile = vbNullString
  65. nProcess = Process32Next(hSnap, peProcess)
  66. Loop
  67. CloseHandle hSnap
  68. End Function
  69.  
  70. Public Function OpenApplication(ByVal StrAppPath As String) As Long
  71. On Error Resume Next
  72. Dim ReturnVal As Long
  73. ReturnVal = ShellExecute(0&, "open", StrAppPath, "", "", vbNormalFocus)
  74. If ReturnVal = 5& Then
  75. OpenApplication = ShellExecute(0&, "runas", StrAppPath, "", "", vbNormalFocus)
  76. Else
  77. OpenApplication = ReturnVal
  78. End If
  79. End Function
  80.