module1.bas

葡萄木马防火墙

Attribute VB_Name = "sdrv"
Private Type DEV_BROADCAST_HDR
lSize As Long
lDevicetype As Long
lReserved As Long
End Type
Private Type DEV_BROADCAST_VOLUME
lSize As Long
lDevicetype As Long
lReserved As Long
lUnitMask As Long
iFlag As Integer
End Type
Global lpPrevWndProc As Long
Global WM_TASKBARCREATED As Long
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public info As DEV_BROADCAST_HDR
Public info_volume As DEV_BROADCAST_VOLUME
Public Const WM_DEVICECHANGE = &H219
Public Const DBT_DEVICEARRIVAL As Long = &H8000&
Public Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
Dim dellist() As String
Dim di As Integer
Dim tmpRpid As Long

Function WindowProc(ByVal hwnd2 As Long, ByVal message2 As Long, ByVal wParam2 As Long, ByVal lParam2 As Long) As Long
'--------------
If message2 = &H501 Then
   Call hookfile.NotificationReceipt(wParam2, lParam2)
End If
'--------------

If message2 = &H219 Then
   PlaySound App.path & "\gwf1.wav", 0, &H1
   FirstRun
   If wParam2 = DBT_DEVICEARRIVAL Then gui.AddTextData "移动存储器:安装", RGB(123, 123, 15)
   If wParam2 = DBT_DEVICEREMOVECOMPLETE Then gui.AddTextData "移动存储器:卸载", RGB(123, 123, 15)
   GoTo pt:
End If
If message2 = &H400 + 100 Then
   If lParam2 = &H203 Then
   Form1.Show
   SetClose.sp 0, 1
   End If
End If
'If message2 = &H401 Then gui.AddTextData "进程监视 -开启", RGB(123, 223, 15)
'-------------------------
   Dim ReP As String
   Dim rep2 As String
'-------------------------
If message2 = &H402 Then '--系统运行程序
   'scanpro.scanpw App.Path & "\t2.dll", 0
   'scanpro.scanpw App.Path & "\t2.dll", 1
   'scanpro.scanpw App.Path & "\t2.dll", 0
   'scanpro.scanpw App.Path & "\t2.dll", 1
   PlaySound App.path & "\gwf2.wav", 0, &H1
   'MsgBox "参数2" & lParam2
   ReP = GetRemoteData(wParam2, lParam2)
   If Form2.Check1.value = 1 Then
   rep2 = GetPname(wParam2)
   gui.AddTextData "程序:[UNICODE]" & ReP, 0
   gui.AddTextData "被:" & rep2 & "启动", 0
   End If
   'MsgBox Len(ReP)
   If Len(ReP) > 5 Then
   tmp2 = right(left(ReP, 4), 3)
   'MsgBox tmp2
   ty = GetDriveType(tmp2)
   'MsgBox ty
   If ty = 2 Or ty = 4 Or ty = 5 Or ty = 6 Then
   gui.AddTextData "移动存储器中程序: " & ReP, 0
   rep2 = GetPname(wParam2)
   gui.AddTextData "被:" & rep2 & "启动", 0
   MsgBox "移动存储器中程序: " & ReP & "被" & rep2 & "启动 -高危操作", 16 + vbSystemModal
   End If
   End If
End If

'------------------------------------------------------------
If message2 = &H403 Then '--系统运行程序
   'scanpro.scanpw App.Path & "\t2.dll", 0
   'scanpro.scanpw App.Path & "\t2.dll", 1
'   scanpro.scanpw App.Path & "\t2.dll", 0
'scanpro.scanpw App.Path & "\t2.dll", 1
   PlaySound App.path & "\gwf2.wav", 0, &H1
   'MsgBox "参数2" & lParam2
   ReP = StrConv(GetRemoteData(wParam2, lParam2), vbUnicode)
   If Form2.Check1.value = 1 Then
   rep2 = GetPname(wParam2)
   gui.AddTextData "程序:[ANSI]" & ReP, 0
   gui.AddTextData "被:" & rep2 & "启动", 0
   End If
   'MsgBox Len(ReP)
   If Len(ReP) > 5 Then
   tmp2 = right(left(ReP, 4), 3)
   'MsgBox tmp2
   ty = GetDriveType(tmp2)
   'MsgBox ty
   If ty = 2 Or ty = 4 Or ty = 5 Or ty = 6 Then
   gui.AddTextData "移动存储器中程序: " & ReP, 0
   rep2 = GetPname(wParam2)
   gui.AddTextData "被:" & rep2 & "启动", 0
   MsgBox "移动存储器中程序: " & ReP & "被" & rep2 & "启动 -高危操作", 16 + vbSystemModal
   End If
   End If
End If
'--------------------------------------------------------------
If message2 = &H404 Then '--系统运行程序
   scanpro.scanpw App.path & "\t2.dll", 0
scanpro.scanpw App.path & "\t2.dll", 1
   PlaySound App.path & "\gwf2.wav", 0, &H1
   'MsgBox "参数2" & lParam2
   ReP = StrConv(GetRemoteData(wParam2, lParam2), vbUnicode)
   If Form2.Check1.value = 1 Then
   rep2 = GetPname(wParam2)
   gui.AddTextData "程序 -Shell:[ANSI]" & ReP, 0
   gui.AddTextData "被:" & rep2 & "启动", 0
   End If
End If
'--------------------------------------------------------------
If message2 = &H405 Then '--系统运行程序
   scanpro.scanpw App.path & "\t2.dll", 0
scanpro.scanpw App.path & "\t2.dll", 1
   PlaySound App.path & "\gwf2.wav", 0, &H1
   'MsgBox "参数2" & lParam2
   ReP = GetRemoteData(wParam2, lParam2)
   If Form2.Check1.value = 1 Then
   rep2 = GetPname(wParam2)
   gui.AddTextData "程序 -Shell:[UNICODE]" & ReP, 0
   gui.AddTextData "被:" & rep2 & "启动", 0
   End If
End If
If message2 = &H407 Then '--系统运行程序
   scanpro.scanpw App.path & "\t2.dll", 0
   scanpro.scanpw App.path & "\t2.dll", 1
   PlaySound App.path & "\gwf2.wav", 0, &H1
   'MsgBox "参数2" & lParam2
   ReP = GetRemoteData(wParam2, lParam2)
   If Form2.Check1.value = 1 Then
   rep2 = GetPname(wParam2)
   gui.AddTextData "程序 -Shell:[ANSI]" & ReP, 0
   gui.AddTextData "被:" & rep2 & "启动", 0
   End If
End If
'---------------------------------------------------------------
If message2 = &H406 Then

   gui.AddTextData "发现远程注入DLL: ", 0
End If
'---------------------------------------------------------------
If message2 = WM_TASKBARCREATED Then
   scanpro.scanpw App.path & "\t2.dll", 0
   scanpro.scanpw App.path & "\t2.dll", 1
   SetClose.sp 0, 0
End If
'---------------------------------------------------------------
'If message2 = &HF Then
'Dim tmp As gpFrame
'tmp.FrCaption = "信息查看"
'tmp.FrPic = App.Path & "\ico1.ico"
'rectframe Form1.hwnd, 10, 10, 200, 500, RGB(48, 127, 201), tmp
'End If
pt:
WindowProc = CallWindowProc(lpPrevWndProc, hwnd2, message2, wParam2, lParam2)

End Function

Function WindowProc2(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  WindowProc2 = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

Public Function FirstRun()
On Error GoTo safe:
For i = 0 To 31
hgf = GetDriveType(LCase(Chr(65 + i)) & ":")
Dim yu As Boolean
If Form2.Check1.value = 1 And hgf = 3 Then yu = True Else yu = False
If hgf = 2 Or hgf = 4 Or hgf = 5 Or hgf = 6 Or yu = True Then
fp = LCase(Chr(65 + i) & ":/autorun.inf")
'MsgBox Scanfile(fp), 16
If Scanfile(fp) = True Then
   If MsgBox(FileScan(LCase(Chr(65 + i)) & ":/autorun.inf"), 16 + vbYesNo, LCase(Chr(65 + i)) & ":/autorun.inf" & " -葡萄保护者") = vbYes Then
   g = Form1.List2.ListCount - 1
   For S = 0 To g
   If isKf(Form1.List2.List(S)) Then
   Form1.List2.List(S) = Form1.List2.List(S) & "...删除成功！"
   Else
   Form1.List2.List(S) = Form1.List2.List(S) & "...删除失败！"
   End If
   Next S
   If MsgBox("是否删除 U盘自运行程序引导文件?", 32 + vbYesNo) = vbYes Then
   If isKf(LCase(Chr(65 + i)) & ":/autorun.inf") Then
   Form1.List2.AddItem LCase(Chr(65 + i)) & ":/autorun.inf" & "...删除成功！"
   Else
   Form1.List2.AddItem LCase(Chr(65 + i)) & ":/autorun.inf" & "...删除失败！"
   End If
   End If
   Else
   g = Form1.List2.ListCount - 1
   For S = 0 To g
   Form1.List2.List(S) = Form1.List2.List(S) & "...自动运行程序"
   Next S
   End If
End If
End If
safe:
Next i
Open App.path & "\Save.log" For Input As #1
Do While Not EOF(1)
Input #1, str1
str2 = str2 & str1 & Chr(13) & Chr(10)
Loop
Close #1
For S = 0 To Form1.List2.ListCount - 1
    str2 = str2 & Form1.List2.List(S) & Chr(13) & Chr(10)
    gui.AddTextData Form1.List2.List(S), 0
Next S
str2 = str2 & "年份:" & Date & "时间:" & Time & Chr(13) & Chr(10)
Open App.path & "\Save.log" For Output As #1
Print #1, str2
Close #1
Form1.List2.Clear
'Form1.List1.List(Form1.List1.ListCount - 1) = Form1.List1.List(Form1.List1.ListCount - 1) & LCase(Chr(65 + i)) & ":" & "盘 -...该盘安全"
End Function

Public Function FileScan(ppath As String) As String
Dim result As String
Open ppath For Input As #1
Dim str1 As String
Dim S2 As String
Dim s3 As String
Dim pf As String
pf = left(ppath, 3)

Do While Not EOF(1)
Input #1, str1
i = InStr(str1, "=")
If i <> 0 Then
S2 = left(str1, i - 1)
s3 = right(str1, Len(str1) - i)
'---自运行"
i1 = InStr(LCase(str1), LCase("open"))
i2 = InStr(LCase(str1), LCase("shellexecute"))
Dim k As String
k = pShowN(s3)
pt = left(ppath, 3)
If i1 <> 0 Then result = result & "自动运行程序: " & pt & k & Chr(13) & Chr(10): Form1.List2.AddItem pt & k
'---添加新项目
i1 = InStr(LCase(str1), LCase("shell"))
If i1 <> 0 Then
i2 = InStr(LCase(str1), LCase("command"))
If i2 <> 0 Then
result = result & "新右建菜单 -命令: " & s3 & Chr(13) & Chr(10): Form1.List2.AddItem sfcl(s3, pf)
Else
result = result & "新右建菜单 -标题: " & s3 & Chr(13) & Chr(10)
End If
End If
End If

Loop
Close #1
FileScan = UCase(result) & Chr(13) & Chr(10) & "包含可疑程序 -危险" & Chr(13) & Chr(10) & "是否清除?"
End Function

Public Function pShowN(ByVal pvsl As String) As String
i = InStr(pvsl, Chr(34))
If i <> 0 Then
i2 = right(pvsl, Len(pvsl) - 1)
i3 = left(i2, Len(i2) - 1)
Else
i3 = pvsl
End If
pShowN = i3
End Function

Public Function sfcl(ByVal pv As String, ppf As String) As String
i = InStr(pv, Chr(32))
fg = right(pv, Len(pv) - i)
i2 = InStr(fg, ":")
If i2 = 0 Then
sfcl = ppf & pShowN(fg)
Else
sfcl = pShowN(fg)
End If
End Function

Public Function isKf(ByVal fpath As String) As Boolean
h = DeleteFile(fpath)
If h <> 0 Then isKf = True Else isKf = False
End Function



Function SaveLog()
Open App.path & "\Save.log" For Input As #1
Do While Not EOF(1)
Input #1, str1
str2 = str2 & str1 & Chr(13) & Chr(10)
Loop
Close #1
For S = 1 To pTDI
    str2 = str2 & pTextData(pTDI).text & Chr(13) & Chr(10)
    'Form1.List1.AddItem Form1.List2.List(s)
Next S
If Len(str2) > 5 Then
str2 = str2 & "年份:" & Date & "时间:" & Time & Chr(13) & Chr(10)
Open App.path & "\Save.log" For Output As #1
Print #1, str2
Close #1
End If
Form1.List2.Clear


End Function
Function Scanfile(ByVal fpath As String) As Boolean
On Error GoTo err01:
t1 = FileLen(fpath)
Scanfile = True
Exit Function
err01:
Scanfile = False
End Function
Public Function ptGetFileSize(ByVal filepath As String) As Long
On Error GoTo err01
ptGetFileSize = FileLen(filepath)
Exit Function
err01:
ptGetFileSize = 0
End Function