form1.frm

提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包

If isShowTable = True And isintable = True Then
If pTDI <> 0 Then
For i = 1 To pTDI
    pTextData(i).text = ""
    pTextData(i).color = 0
Next i
End If
pTDI = 0
Me.VScroll1.value = 0
'DrawFF Me.hwnd, 0, 0, 80, Me.Width / 15, RGB(44, 125, 200)
ptip = "执行: 处理中..."
Form_Paint
'gui.pDrawString Me.hwnd, Text1.left, Text1.Height + 5, "执行: 处理中...", RGB(232, 247, 255)
'----查看端口
If htmp = 0 Then
topshowS = "查看端口"
Me.kanduankou
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = False
End If
'----end

'----查看进程
If htmp = 1 Then
topshowS = "查看进程"
scanpro.scanpw "", 4
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = True
End If
'----end
'----查看已加载驱动
If htmp = 2 Then
topshowS = "查看已加载驱动"
scanpro.scandeva
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = False
End If
'----end
'----查看自启动项目
If htmp = 3 Then
topshowS = "查看自启动程序"
On Error GoTo err07:
'---------
   pRegEumn HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Runservices"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServicesOnce"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\Setup"
   pRegEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnceEx"
   pRegEumn HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Terminal Server\Wds\rdpwd\RsAutorunsDisabled"
   pRegEumn HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run"
   pRegEumn HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"
   pRegEumn HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Runservices"
   pRegEumn HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServicesOnce"
   pRegEumn HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run"
   pRegEumn HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\RunOnce\Setup"
   blsCanFile
   'Me.Caption = "第1步"
   uit = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Userinit")
   'Me.Caption = "第2步"
   If uit <> "" And LCase(uit) = LCase(GSystemPath & "\" & "userinit.exe") Then
   gui.AddTextData uit, 0
   Else
   gui.AddTextData uit, RGB(255, 0, 0)
   End If
   uit = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell")
   'Me.Caption = "第3步"
   If uit <> "" And LCase(uit) = LCase("explorer.exe") Then gui.AddTextData GSystemPath & "\" & uit, 0 Else gui.AddTextData GSystemPath & "\" & uit, RGB(255, 0, 0)
   uit = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "UIHost")
   'Me.Caption = "第4步"
   If uit <> "" And LCase(uit) = LCase("logonui.exe") Then gui.AddTextData GSystemPath & "\" & uit, 0 Else gui.AddTextData GSystemPath & "\" & uit, RGB(255, 0, 0)
   
   pRegEumn HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows\load"
   Dim tmpv As String
   ReadValuem HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Session Manager", "BootExecute"
   'Me.Caption = "第5步"
'---------
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = False
End If
'----end
'----查看BHO
If htmp = 4 Then
topshowS = "查看浏览器辅助对象"
scaniebho
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = False
End If
'----end
'----查看IE插件
If htmp = 5 Then
topshowS = "查看Internet Explorer插件 "
tusereg.scaniecj
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = False
End If
'----end
'----查看SSDT
If htmp = 6 Then
topshowS = "查看系统函数服务引索 "
viru.GetSSDTvb
Me.nml
pDrawText Me.hwnd, 90, 140
isShowTable = False
isShowData = True
button2.Picture = LoadPicture(App.path & "\button.bmp")
List5.Visible = False
End If
'----end
End If
'----Function end
On Error GoTo err01:
If isShowData = True Then
yu = Int(baridx + htmp2 + 1)
Text1 = pTextData(yu).text
If htmp = 1 Then
pn = InStrRev(Text1, ":")
If pn = 0 Then Exit Sub
mypid = right(Text1, Len(Text1) - pn)
scanpro.GetPmod mypid
End If
End If
'---
isShowTable = False
Exit Sub
err01:
MsgBox "程序错误 -获取模块失败", 16
Exit Sub
err07:
MsgBox "程序错误 -获取数据失败", 16
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

'-------
If isShowTable = True Then
If X > 10 And X < 220 + 10 And Y > 220 And Y < 359 Then
   isintable = True
'------------
h = Int((Y - 220) / 20)

If htmp <> h Then
tps = 220 + 20 * h
btm = tps + 20
pListE Me.hwnd, 10, tps - 1, btm, 220, RGB(232, 247, 255), RGB(48, 127, 201)
For isa = 0 To 6
tps = 220 + 20 * isa
btm = tps + 20
If isa <> h Then pListE Me.hwnd, 10, tps - 1, btm, 220, RGB(255, 255, 255), RGB(48, 127, 201)
Next isa
For i = 0 To 6
    tps = 220 + 20 * i
    Call pDrawString(Me.hwnd, 13, tps + 3, chooseTable(i), RGB(48, 127, 201))
Next i
htmp = h
End If
'------------
   Else
   isintable = False
   htmp = 0
End If
End If
'-------
If isShowData = True Then
   If X > 90 And X < VScroll1.left - 10 And Y > 154 And Y < 15 * 10 + 154 Then
   isindata = True
   h2 = Int((Y - 154) / 15)
If htmp2 <> h2 Then
   Text2 = htmp2 & " | " & h2
   tps = 154 + 15 * h2
   btm = tps + 15
   'pListE Me.hwnd, 90, tps, btm, 430, RGB(232, 247, 255), RGB(48, 127, 201)
   pListE Me.hwnd, 90, tps, btm, 550, RGB(48, 127, 201), RGB(232, 247, 255)
   For i = 0 To 9
   tps = 154 + 15 * i
   btm = tps + 15
   If h2 <> i Then pListE Me.hwnd, 90, tps, btm, 550, RGB(232, 247, 255), RGB(232, 247, 255)
   'If h2 <> i Then pListE Me.hwnd, 90, tps, btm, 430, RGB(32, 247, 255), RGB(0, 247, 255)
   Next i
   pDrawText Me.hwnd, 90, 140
   htmp2 = h2
End If
   Else
   isindata = False
   End If
End If
End Sub

Private Sub Form_Paint()

'--------
Dim tmp As gpFrame
tmp.FrCaption = topshowS
tmp.FrPic = App.path & "\ico1.ico"
rectframe Me.hwnd, 10, 100, Me.Height / 15 - 20 - 70, Me.Width / 15 - 20, RGB(48, 127, 201), tmp
If pTDI < 10 Then VisibleBar (False) Else VisibleBar (True)
pDrawText Me.hwnd, 90, 140
DrawFF Me.hwnd, 0, 0, 80, Me.Width / 15, RGB(44, 125, 200)
Label1.Caption = ptip

If isShowTable = True Then
For isa = 0 To 6
    tps = 220 + 20 * isa
    btm = tps + 20
    pListE Me.hwnd, 10, tps - 1, btm, 220, RGB(255, 255, 255), RGB(48, 127, 201)
Next isa
For i = 0 To 6
    tps = 220 + 20 * i
    Call pDrawString(Me.hwnd, 13, tps + 3, chooseTable(i), RGB(48, 127, 201))
Next i
Exit Sub
Else
nml
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Caption = "葡萄守护者       -正在准备关闭..."
'SaveLog
tyu = DelDDvr(0)
'If tyu <> 9 Then MsgBox "驱动卸载失败" & tyu, 16
'If Command = "-Speed" Then
'scanpro.scanpw App.path & "\t2.dll", 2
'scanpro.scanpw App.path & "\t2.dll", 3
'End If
If MsgBox("您的真的要关闭 -葡萄守护者? -您将失去保护", 32 + vbYesNo) = vbNo Then
Cancel = True
jkoo = AddSer(0)
If jkoo <> 9 Then MsgBox "驱动加载失败" & jkoo, 16
'If Command = "-Speed" Then
'scanpro.scanpw App.path & "\t2.dll", 0
'scanpro.scanpw App.path & "\t2.dll", 1
'GoTo yu:
'End If
yu:
Me.Caption = "葡萄守护者"
Else
End
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next

End Sub

Private Sub Form_Unload(Cancel As Integer)
'scanpro.scanpw App.Path & "\t2.dll", 2
'scanpro.scanpw App.Path & "\t2.dll", 3
tyu = DelDDvr(0)
Call SHNotify_Unregister
Dim h As String
Dim j As Long


SetClose.sp 0, 1
End Sub
Function meSafe()
On Error GoTo err01:
FileLen App.path & "\save.log"
Exit Function
err01:
Open App.path & "\save.log" For Output As #1
Print #1, ""
Close
End Function
Function meSafeA()
On Error GoTo err01:
FileLen App.path & "\Setting.ini"
Exit Function
err01:
Open App.path & "\save.log" For Output As #1
Print #1, ""
Close
End Function


Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
up.Picture = LoadPicture(App.path & "\up.bmp")
down.Picture = LoadPicture(App.path & "\down.bmp")
bar.Picture = LoadPicture(App.path & "\bar.bmp")
End Sub

Private Sub hs1_Change()
Dim tmp As gpFrame
tmp.FrCaption = topshowS
tmp.FrPic = App.path & "\ico1.ico"
rectframe Me.hwnd, 10, 100, Me.Height / 15 - 20 - 70, Me.Width / 15 - 20, RGB(48, 127, 201), tmp
pDrawText Me.hwnd, 90, 140
End Sub

Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
button1.Picture = LoadPicture(App.path & "\button.bmp")
End Sub

Private Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If isShowTable = False Then button2.Picture = LoadPicture(App.path & "\button.bmp")
End Sub

Private Sub List1_Click()
Text1 = ""
Text1.Visible = True
Text1.text = List1.List(List1.ListIndex) & Chr(13) & Chr(10) & "双击鼠标左键隐藏"
End Sub



Private Sub List4_Click()
Text1 = ""
Text1.Visible = True
Text1.text = List4.List(List4.ListIndex) & Chr(13) & Chr(10)
End Sub

Private Sub List4_DblClick()
If MsgBox("是否将该DLL从进程中强制卸载 -会导致不可预料后果", 16 + vbYesNo) = vbYes Then
   If mypid = GetCurrentProcessId Then MsgBox "不允许卸载自身程序", 16: Exit Sub
   If viru.RemoveDLL(mypid, List4.List(List4.ListIndex)) = True Then MsgBox "卸载成功！", 64 Else MsgBox "卸载失败！", 16
   scanpro.GetPmod mypid
End If
End Sub

Private Sub List4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   If Y > List4.Height / 2 Then
   Text1.top = List4.top
   Else
   Text1.top = List4.top + List4.Height - Text1.Height
   End If
End If
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   If Y > List1.Height / 2 Then
   Text1.top = List1.top
   Else
   Text1.top = List1.top + List1.Height - Text1.Height
   End If
End If
End Sub



Private Sub List5_Click()
Text1.text = List5.List(List5.ListIndex) & Chr(13) & Chr(10)
End Sub

Private Sub List5_DblClick()
If List5.ListIndex = 0 Then MsgBox "请选择DLL文件 -选择对象错误", 16: Exit Sub
'If MsgBox("是否将该DLL从进程中强制卸载 -会导致不可预料后果", 16 + vbYesNo) = vbYes Then
'   If mypid = GetCurrentProcessId Then MsgBox "不允许卸载自身程序", 16: Exit Sub
'   If viru.RemoveDLL(mypid, List5.List(List5.ListIndex)) = True Then MsgBox "卸载成功！", 64 Else MsgBox "卸载失败！", 16
'   scanpro.GetPmod mypid
'End If
'Form2.Show
dllname = List5.List(List5.ListIndex)
scanpw dllname, 5
tihuan1.top = Me.top + (Me.Height - tihuan1.Height) / 2
tihuan1.left = Me.left + (Me.Width - tihuan1.Width) / 2
tihuan1.Show
Me.Enabled = False
End Sub

Private Sub List5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then List5.Visible = False
End Sub

Private Sub Text1_Change()
Label1.Caption = "详细:" & Text1
End Sub

Private Sub Text1_DblClick()

Text1.Visible = False
End Sub





Public Sub LoadSetting()
On Error GoTo err01:
cipan = GetIni(App.path & "\Setting.ini", "设置", "硬盘")
Form2.Check1.value = cipan

wjjk = GetIni(App.path & "\Setting.ini", "设置", "文件监控1")
Form2.List1.AddItem FileSetting(1, wjjk)
qidong = GetIni(App.path & "\Setting.ini", "设置", "启动")
Form2.Check2.value = qidong

Exit Sub
err01:
MsgBox "载入设置失败", 16
End Sub

Public Function FileSetting(ByVal fi As Long, ByVal i As String) As String
Dim tmpsd As String
Select Case fi
       Case 1
       tmpsd = "Windows文件夹 " '-36
       If i = "1" Then tmp2 = " -监控开启":  Call SHNotify_Register(hwnd): Label6.Caption = "文件监视 -开启" Else tmp2 = " -监控关闭"
End Select
FileSetting = tmpsd & tmp2
End Function








Function nml()
Me.Cls
'DrawFF Me.hwnd, 0, 0, 80, Me.Width / 15, RGB(44, 125, 200)
'--------
Dim tmp As gpFrame
tmp.FrCaption = topshowS
tmp.FrPic = App.path & "\ico1.ico"
rectframe Me.hwnd, 10, 100, Me.Height / 15 - 20 - 70, Me.Width / 15 - 20, RGB(48, 127, 201), tmp
pDrawText Me.hwnd, 90, 140
DrawFF Me.hwnd, 0, 0, 80, Me.Width / 15, RGB(44, 125, 200)
Me.Label1.Caption = ptip
If pTDI < 10 Then Me.VScroll1.Visible = False Else Me.VScroll1.Visible = True
If Me.hs1.Max < 5 Then Me.hs1.Visible = False Else Me.hs1.Visible = True
End Function

Function kanduankou()
Dim str1 As String
Dim str2 As String
Dim str4 As String
Dim str5 As String
Dim str6 As String
Dim str7 As String
Dim str8 As String

str7 = "|进程"
str1 = "远程地址        |"
str2 = "本地地址        |"
str4 = "远程端口|"
str5 = "本地端口|"
str6 = "连接状态 "
str8 = "进程名称       |"

   Call AddTextData(str8 & str2 & str5 & str1 & str4 & str6 & str7, RGB(0, 0, 0))
   AddTextData "TCP协议", 0
   modNetstat.RTtcp
   AddTextData "UDP协议", 0
   modNetstat.RTudp
End Function



Private Sub VScroll1_Change()
Dim tmp As gpFrame
baridx = VScroll1.value
tmp.FrCaption = topshowS
tmp.FrPic = App.path & "\ico1.ico"
rectframe Me.hwnd, 10, 100, Me.Height / 15 - 20 - 70, Me.Width / 15 - 20, RGB(48, 127, 201), tmp
pDrawText Me.hwnd, 90, 140

End Sub

Private Sub VScroll1_Scroll()
Dim tmp As gpFrame

tmp.FrCaption = topshowS
tmp.FrPic = App.path & "\ico1.ico"
rectframe Me.hwnd, 10, 100, Me.Height / 15 - 20 - 70, Me.Width / 15 - 20, RGB(48, 127, 201), tmp
pDrawText Me.hwnd, 90, 140
baridx = VScroll1.value
End Sub