For i = 0 To LenAsc
byteSave(i) = CByte("&H" & strMid(i))
'MsgBox Hex(byteSave(i))
Next
'Print i


End Sub


Sub CloseSockets()

Dim i As Long

Dim Rema As Long
Dim Loca As Long

Dim tcpt As MIB_TCPTABLE


GetTcpTable tcpt, Len(tcpt), 0
For i = 0 To tcpt.dwNumEntries - 1
Rema = tcpt.table(i).dwRemoteAddr
Loca = tcpt.table(i).dwLocalAddr
'Remp = ntohs(tcpt.table(i).dwRemotePort)
'locp = ntohs(tcpt.table(i).dwLocalPort)
If Rema = Loca And tcpt.table(i).dwState = 5 Then   '一般remote IP和local IP相同就是HF
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)

End If
Next
End Sub

Function ReadProcessMemt(ByVal hProcess As Long, ByVal lpBaseAddress As Long, _
ByRef lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
ReadProcessMemt = ReadProcessMem(hProcess, lpBaseAddress, lpBuffer, nSize, lpNumberOfBytesWritten)

End Function

Function ReadProcessMeml(ByVal hProcess As Long, ByVal lpBaseAddress As Long, _
ByRef lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
ReadProcessMeml = ReadProcessMem(hProcess, lpBaseAddress, lpBuffer, nSize, lpNumberOfBytesWritten)

End Function






Function EnumProcess(ByRef out_ProcessIds() As Long, ByRef out_ProcessPath() As String) As Long
Dim cb As Long
Dim cbNeeded As Long
Dim l_NumProcess As Long

cb = 8
cbNeeded = 96

EnumProcess = 0
'{{{取得所有的進(jìn)程數(shù)和ID
Do While cb <= cbNeeded
cb = cb * 2
'在以下這句中，《Hardcore Visual Basic》一書寫成ReDim aProcesses(0 To (cRequest
'/ 4) - 1) As Long，不明白他為什么要這么寫？我最初的調(diào)試不成功，后來把減1
'去掉后就成功了^^
     ReDim ProcessIDs(cb / 4) As Long
     Call EnumProcesses(out_ProcessIds(0), cb, cbNeeded)
Loop
l_NumProcess = cbNeeded / 4          '進(jìn)程數(shù)目
'}}}



'{{{
Dim l_hProcess As Long
Dim lRet As Long, i As Long, l_Modules(0 To 250) As Long
For i = 0 To l_NumProcess
'取得一個(gè)進(jìn)程的句柄
'使用OpenProcess函數(shù)打開句柄，其中的兩個(gè)常量在winnt.h中可以找到相應(yīng)的聲明。
  l_hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, ProcessIDs(i))

   '如果句柄有效，則
If l_hProcess <> 0 Then
        lRet = EnumProcessModules(out_ProcessIds(i), l_Modules(0), 255, cbNeeded)
If lRet <> 0 Then
   out_ProcessPath(i) = Space(255)
    lRet = GetModuleFileNameExA(out_ProcessIds(i), l_Modules(0), out_ProcessPath(i), 255)
End If
End If

   lRet = CloseHandle(out_ProcessIds(i))
Next
 '}}}
 
 
EnumProcess = l_NumProcess              '返回進(jìn)程數(shù)
End Function




Function EnumModulebyHandle(ByVal in_PId As Long, ByRef out_ModuleIDs() As Long, ByRef out_ModulePath() As String _
, ByRef out_DllAddr() As Long) As Long
Dim i As Long
Dim l_moduleName As String
Dim l_numModule As Long

   '如果句柄有效，則
EnumModulebyHandle = 0

If in_PId = 0 Then
Debug.Print "傳入的進(jìn)程PID=0"
Exit Function
End If
Debug.Print "傳入的進(jìn)程PID=" & in_PId

'=============枚舉模塊名稱start
    Dim l_stuProcess As MODULEENTRY32
    Dim n As Long
    Dim l_hSnapShot As Long
    l_hSnapShot = CreateToolhelp32Snapshot(8, in_PId)
    l_stuProcess.dwSize = Len(l_stuProcess)
    n = Module32First(l_hSnapShot, l_stuProcess)
    Do While n > 0
        out_ModuleIDs(l_numModule) = l_stuProcess.th32ModuleID         '獲得ID
        out_ModulePath(l_numModule) = Left(l_stuProcess.szModule, InStr(l_stuProcess.szModule, Chr(0)) - 1) '獲得名稱
        out_DllAddr(l_numModule) = l_stuProcess.hModule          '獲得地址
        n = Module32Next(l_hSnapShot, l_stuProcess)
        Debug.Print "ID:" & Hex(out_ModuleIDs(l_numModule)), "名稱:" & out_ModulePath(l_numModule), Hex(out_DllAddr(l_numModule))
        l_numModule = l_numModule + 1                                '計(jì)算數(shù)量
    Loop
'=============枚舉end


EnumModulebyHandle = l_numModule - 1
End Function



Function GetModuleAddr(ByVal Phandle As Long, ByVal Dllhandle As Long, ByRef out_DllAddr As Long _
, ByRef out_DllImgSize As Long, ByRef out_DllEntry As Long) As Long
Dim cb As Long
Dim l_Dllinfo As LPMODULEINFO

GetModuleAddr = GetModuleInformation(Phandle, Dllhandle, l_Dllinfo, 255)

out_DllAddr = l_Dllinfo.lpBaseOfDll
out_DllImgSize = l_Dllinfo.SizeOfImage
out_DllEntry = l_Dllinfo.EntryPoint
End Function


Function WriteMemL(ByVal Phandle As Long, ByVal AddrToWrite As Long, ByVal DataToWrite As Long)
WriteMemL = WriteProcessMemory(Phandle, AddrToWrite, DataToWrite, 4, 0)
End Function


Function CreateRemoteThreadVB(ByVal hProcess As Long, ByVal lpThreadAttributes As Long, dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
CreateRemoteThreadVB = CreateRemoteThread(hProcess, ByVal lpThreadAttributes, dwStackSize, ByVal lpStartAddress, ByVal lpParameter, ByVal dwCreationFlags, lpThreadId)

End Function
 
 
Function VirtualProtectEx2(ByVal hProcess As Long, lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
VirtualProtectEx2 = VirtualProtectEx(ByVal hProcess, lpAddress, ByVal dwSize, ByVal flNewProtect, lpflOldProtect)
End Function


Function VirtualAllocEx2(ByVal hProcess As Long, lpAddress As Long, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
VirtualAllocEx2 = VirtualAllocEx(hProcess, ByVal 0&, dwSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)

End Function

Function VirtualFreeEx2(ByVal hProcess As Long, lpAddress As Long, ByRef dwSize As Long) As Long
VirtualFreeEx2 = VirtualFreeEx(hProcess, lpAddress, dwSize, MEM_RELEASE)
End Function

Sub Wait(ByVal mWaitTime As Single)                 '延時(shí),毫秒
If mWaitTime <= 0 Then                              '進(jìn)入?yún)?shù)為0則不等待
Exit Sub
End If

Dim start As Single
start = Timer
mWaitTime = mWaitTime / 1000
Do While start + mWaitTime > Timer
Sleep 10
DoEvents
Loop
End Sub


   
Function GetSpecialfolder(CSIDL As Long) As String
          Dim r     As Long
          Dim IDL     As ITEMIDLIST
          'Get   the   special   folder
          Dim path     As String
          r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
          If r = NO_ERROR Then
                  'Create   a   buffer
                  path = Space$(512)
                  'Get   the   path   from   the   IDList
                  r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path$)
                  'Remove   the   unnecessary   chr$(0)'s
                  GetSpecialfolder = Left$(path, InStr(path, Chr$(0)) - 1)
                  Exit Function
          End If
          GetSpecialfolder = ""
  End Function
   
Sub KillCookie()
On Error Resume Next
          Dim CookiesPath     As String
          CookiesPath = GetSpecialfolder(CSIDL_COOKIES)       '獲取COOKIES文件夾路徑
          '為了防止在ie打開時(shí)，內(nèi)存中還有部分COOKIES存在，加了下面這句
          Call InternetSetOption(0, INTERNET_OPTION_END_BROWSER_SESSION, ByVal 0&, 0)
          Kill CookiesPath + "\*.txt"         '全部刪除，如果需要?jiǎng)h除某一個(gè)COOKIES的話，需要用dir或fso枚舉出所有文件，然后用kill語句刪除
End Sub


Function HexToBin(ByVal in_strHex As String, ByRef out_StrBin As String, ByVal in_lenHex As Long) As Long
Dim i As Long
Dim l_byte As Byte
Dim l_strIn As String
Dim l_str1byte As String

in_lenHex = in_lenHex * 2
For i = 1 To in_lenHex - Len(in_strHex)                 '把字符串少了的字節(jié)用0填充
in_strHex = "0" & in_strHex
Next
out_StrBin = ""

For i = 1 To Len(in_strHex)
l_byte = CByte("&h" & Mid(in_strHex, i, 1))
Select Case l_byte
Case 0
l_str1byte = "0000"
Case 1
l_str1byte = "0001"
Case 2
l_str1byte = "0010"
Case 3
l_str1byte = "0011"
Case 4
l_str1byte = "0100"
Case 5
l_str1byte = "0101"
Case 6
l_str1byte = "0110"
Case 7
l_str1byte = "0111"
Case 8
l_str1byte = "1000"
Case 9
l_str1byte = "1001"
Case 10
l_str1byte = "1010"
Case 11
l_str1byte = "1011"
Case 12
l_str1byte = "1100"
Case 13
l_str1byte = "1101"
Case 14
l_str1byte = "1110"
Case 15
l_str1byte = "1111"
End Select

out_StrBin = out_StrBin & l_str1byte
Next

HexToBin = Len(out_StrBin)                                          'BIN的長度
End Function
Function BinToHex(ByVal in_strBin As String, ByRef out_strHex As String) As Long 'len(傳入?yún)?shù))必須是4的倍數(shù)
Dim i As Long
Dim l_1byte As Byte
Dim l_bit(1 To 256)  As Long

out_strHex = ""
If Len(in_strBin) Mod 4 <> 0 Then
Exit Function
End If

For i = 1 To Len(in_strBin)                         '先將bin字符串的每一位轉(zhuǎn)成數(shù)字
l_bit(i) = CByte("&h" & Mid(in_strBin, i, 1))
'Debug.Print l_bit(i)
Next

For i = 1 To Len(in_strBin)
l_1byte = l_bit(i) * 2 ^ 3 + l_bit(i + 1) * 2 ^ 2 + l_bit(i + 2) * 2 + l_bit(i + 3)
out_strHex = out_strHex & Hex(l_1byte)
i = i + 3                                           'i只能加3,因?yàn)镕OR會(huì)自動(dòng)把i+1
Next
BinToHex = Len(in_strBin) / 4

End Function


Sub antiDBG()
End Sub



Sub WriteAndSend(ByVal l_Phandle As Long, ByVal l_strAllWrite As String, ByVal l_addrWrite As Long, ByVal l_addrCThread As Long)
Dim l_byteToWrite() As Byte, i As Long, l_lngUnicode As Long
Dim l_intHeight As Integer
Dim l_intLow As Integer
Dim l_lngNumWords As Long
ReDim l_byteToWrite(0 To LenB(l_strAllWrite))              '寫入WAR3

l_lngNumWords = 0
For i = 0 To Len(l_strAllWrite) - 1
If Asc(Mid(l_strAllWrite, i + 1, 2)) > 0 Then
l_byteToWrite(i + l_lngNumWords) = Asc(Mid(l_strAllWrite, i + 1, 1))

ElseIf Asc(Mid(l_strAllWrite, i + 1, 2)) < 0 Then
l_lngUnicode = Asc(Mid(l_strAllWrite, i + 1, 2)) + 65536  '漢字處理
l_intHeight = l_lngUnicode / 256 - 1
l_intLow = l_lngUnicode Mod 256
l_byteToWrite(i + l_lngNumWords) = CByte(l_intHeight)         'AscB(MidB(l_strAllWrite, i + 1, 1))
l_byteToWrite(i + l_lngNumWords + 1) = CByte(l_intLow)  'AscB(MidB(l_strAllWrite, i + 2, 1))
l_lngNumWords = l_lngNumWords + 1

ElseIf Asc(Mid(l_strAllWrite, i + 1, 2)) = 0 Then
Exit For
End If
Next
l_byteToWrite(i + l_lngNumWords) = &H0                                  '字符串以0結(jié)尾

Call WriteMem(l_Phandle, l_addrWrite, l_byteToWrite, 0)   '寫入

If l_addrCThread <> 0 Then
Call CreateRemoteThreadVB(l_Phandle, 0&, 0, l_addrCThread, 0&, 0&, 0&) '&h11234 createthread it
End If
End Sub


Sub SetWindowTop(ByVal in_Hwnd As Long, ByVal in_TopOrNot As Long)
Dim l_lngrtn  As Long
If in_TopOrNot = 1 Then
'讓窗口在頂層
l_lngrtn = SetWindowPos(in_Hwnd, -1, 0, 0, 0, 0, 3)
ElseIf in_TopOrNot = 0 Then
'取消窗口在頂層
l_lngrtn = SetWindowPos(in_Hwnd, -2, 0, 0, 0, 0, 3)
End If
End Sub

Function GetPidbyWindow(ByVal in_Hwnd As Long) As Long
Call GetWindowThreadProcessId(in_Hwnd, GetPidbyWindow)
End Function


Function Cls_TerminateProcess(ByVal in_Phandle As Long)
Cls_TerminateProcess = TerminateProcess(in_Phandle, 1)
End Function