VB6 防止反编译的代码2025年4月5日 11:42
1.检测程序是否被各类debug程式所加载
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Const MAX_PATH As Integer = 260
Const TH32CS_SNAPPROCESS As Long = 2&
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type
Private Sub Command1_Click()
If Opencsrss = True Then
MsgBox "发现调试器,请关闭", , "警告"
Else
MsgBox "没有发现调试", , "恭喜"
End If
End Sub
Private Function Opencsrss() As Boolean
'发现调试器返回TRUE，没有发现则返回FALSE
On Error GoTo maple
Dim Process As PROCESSENTRY32
Dim hSnapShot As Long
Dim l1 As Long
Dim flag As Boolean
Dim mName As String
Dim i As Integer
Dim pid As Long, WOW As Long '注意这2个变量就用来存放2个ID
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&) '建立进程快照
If hSnapShot Then
Process.dwSize = 1060
If (Process32First(hSnapShot, Process)) Then '遍历第一个进程,获得PROCESSENTRY32结构
Do
i = InStr(1, Process.szExeFile, Chr(0)) '获得映像名称
mName = LCase(Left(Process.szExeFile, i - 1)) '并转换成小写
If mName = "csrss.exe" Then '是不是WOW.exe
WOW = Process.th32ProcessID '获得进程ID
End If
Loop Until (Process32Next(hSnapShot, Process) ＜ 1) '遍历所有进程直到返回值为False
End If
l1 = CloseHandle(hSnapShot)
End If
If WOW ＜＞ 0 Then
Dim jiejie As Long
jiejie = OpenProcess(1&, -1&, WOW)
'测试打开能力
If jiejie ＜＞ 0 Then
Opencsrss = True
Else
Opencsrss = False
End If
End If
Exit Function
maple:
Opencsrss = False
End Function2.timer反调试
Private Sub Command1_Click()
'假设这里是我们的注册过程，我们隔三差五随意将以下代码复制粘帖
'------------------------------
Dim ctime As Double
Dim dtime As Double
ctime = Timer
dtime = Timer
If dtime - ctime = 0 Then
MsgBox dtime - ctime, , "正常运行,经历时间:"
'实际软件中，应该彻底隐蔽这些提示消息
Else
MsgBox dtime - ctime, , "发现调试器,经历时间:"
End If
End Sub为什么用timer??很简单,当别人开始调试的时候,莫非他是千只眼,一眼千行?? :)
3.对于运行环境进行检测
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Private Type STARTUPINFO '(createprocess)
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Sub Command1_Click()
If StartAnti = True Then
MsgBox "发现调试器,请关闭", , "警告"
Else
MsgBox "没有发现调试器", , "通过"
End If
End Sub
Private Sub Form_Load()
If StartAnti = True Then
MsgBox "发现调试器,请关闭", , "警告"
Else
MsgBox "没有发现调试器", , "通过"
End If
End Sub
Private Function StartAnti() As Boolean
Dim Huanjing As STARTUPINFO
GetStartupInfo Huanjing
If Huanjing.dwX ＜＞ 0 Or Huanjing.dwY ＜＞ 0 Or Huanjing.dwXCountChars ＜＞ 0 Or Huanjing.dwYCountChars ＜＞ 0 Or Huanjing.dwFillAttribute ＜＞ 0 Or Huanjing.dwXSize ＜＞ 0 Or Huanjing.dwYSize ＜＞ 0 Then
StartAnti = True
Else
StartAnti = False
End If
End Function4.检查我们的程序是否在正常的父进程中运行
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Const MAX_PATH As Integer = 260
Const TH32CS_SNAPPROCESS As Long = 2&
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type
Private Sub Form_Load()
Fujincheng
End Sub
Private Sub Fujincheng()
'这个过程是检测父进程的父进程是否是EXPLORE的父进程
Dim Process As PROCESSENTRY32
Dim hSnapShot As Long
Dim XNN As Long
Dim flag As Boolean
Dim mName As String
Dim i As Integer
Dim pid As Long, explorer As Long '注意这2个变量就用来存放2个ID
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&) '建立进程快照
'搜索explorer.exe进程,并获得其ID
If hSnapShot Then
Process.dwSize = 1060
If (Process32First(hSnapShot, Process)) Then '遍历第一个进程,获得PROCESSENTRY32结构
Do
i = InStr(1, Process.szExeFile, Chr(0)) '获得映像名称
mName = LCase(Left(Process.szExeFile, i - 1)) '并转换成小写
If mName = "explorer.exe" Then '是不是explorer.exe
explorer = Process.th32ProcessID
ElseIf mName = LCase(App.EXEName & ".exe") Then '是不是自己
pid = Process.th32ParentProcessID '获得父进程ID
Else
flag = False
End If
Loop Until (Process32Next(hSnapShot, Process) < 1) '遍历所有进程直到返回值为False
End If
XNN = CloseHandle(hSnapShot)
End If
Dim Openit As Long
Openit = OpenProcess(1&, -1&, pid)
If pid <> explorer Then MsgBox "发现父进程调试", , "警告": TerminateProcess Openit, 0
End Sub正常的父进程可是windows的主进程哦:EXPLORE,,别搞错了:)
全部回复（0）