form2.frm

W32HLLP病毒清除工具,专门处理被W32HLLP感染的病毒档案.

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form formMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "W32/HLLP.Philis病毒清除工具"
   ClientHeight    =   2610
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4245
   Icon            =   "Form2.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2610
   ScaleWidth      =   4245
   StartUpPosition =   3  '窗口缺省
   Begin VB.CheckBox Check1 
      Caption         =   "修复前备份文件"
      Height          =   255
      Left            =   2280
      TabIndex        =   10
      Top             =   840
      Value           =   1  'Checked
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Height          =   1815
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   8
      Top             =   2640
      Width           =   3975
   End
   Begin VB.CommandButton Command3 
      Caption         =   ">>"
      Height          =   255
      Left            =   3600
      TabIndex        =   7
      Top             =   2280
      Width           =   495
   End
   Begin VB.OptionButton Option2 
      Caption         =   "查杀文件夹"
      Height          =   375
      Left            =   2400
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   120
      Width           =   1575
   End
   Begin VB.OptionButton Option1 
      Caption         =   "查杀文件"
      Height          =   375
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   120
      Value           =   -1  'True
      Width           =   1575
   End
   Begin MSComDlg.CommonDialog cDiag 
      Left            =   5400
      Top             =   1560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame1 
      Height          =   975
      Left            =   120
      TabIndex        =   0
      Top             =   600
      Width           =   3975
      Begin VB.CommandButton Command1 
         Caption         =   "选择要修复的文件"
         Height          =   495
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   1935
      End
   End
   Begin VB.Frame Frame2 
      Height          =   975
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   3975
      Begin VB.CheckBox Check2 
         Caption         =   "包含子文件夹"
         Height          =   255
         Left            =   2160
         TabIndex        =   4
         Top             =   480
         Value           =   1  'Checked
         Width           =   1695
      End
      Begin VB.CommandButton Command2 
         Caption         =   "选择要修复的文件夹"
         Height          =   495
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   1935
      End
   End
   Begin VB.Label Label1 
      Caption         =   "状态：没有选定文件。"
      ForeColor       =   &H00000000&
      Height          =   495
      Left            =   120
      TabIndex        =   9
      Top             =   1680
      Width           =   3975
   End
End
Attribute VB_Name = "formMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim lngCount As Long


Private Sub Command1_Click()
Dim wFile As String

On Error Resume Next

    With cDiag                      ' ask user for filename
        .DialogTitle = "选择要恢复的文件:"
        .Filter = "*.EXE|*.exe"
        .ShowOpen
    End With
    
    wFile = cDiag.FileName
    
    If wFile = "" Then Exit Sub
    
    lngCount = 0
    
    Call KillFile(wFile)

End Sub




Private Sub Command2_Click()
On Error GoTo ErrH:
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
    Dim wFolder As String
  
  '呼叫本程序
  bi.hOwner = Me.hWnd
  
  '设置标题
  bi.lpszTitle = "要修复的文件夹: "
  
  '设置返回的类型
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
  
  '显示对话框
  pidl& = SHBrowseForFolder(bi)
  
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
      
      '显示选择的文件夹
      pos% = InStr(path$, Chr$(0))
      wFolder = Left(path$, pos - 1)
      Label1.Caption = wFolder
      
    Else
'      MsgBox "对话框取消", vbInformation
    End If
    If wFolder = "" Then Exit Sub
    
    lngCount = 0
    Call Search(wFolder, "*.exe")
    
    Label1.Caption = "成功查杀" & lngCount & "个文件"
    
    Exit Sub
ErrH:
    MsgBox Err.Description, vbCritical, Err.Number

End Sub


Private Sub Command3_Click()
    
    If Me.Height = 2970 Then
        Command3.Caption = "<<"
        Me.Height = 5025
    Else
        Command3.Caption = ">>"
        Me.Height = 2970
    
    End If
    
End Sub

Private Sub Form_Load()

'    Command3.Caption = ">>"
    Me.Height = 2970
    
End Sub

Private Sub Option1_Click()
    
    Frame1.ZOrder
    Check1.ZOrder
    
End Sub

Private Sub Option2_Click()
    
    Frame2.ZOrder
    Check1.ZOrder
    
End Sub





Function FindOffset(ByVal wFile As String) As Boolean ' returns offset of marker
    
    On Error Resume Next
    
    Dim FF As Long
    Dim rByte As Byte
    Dim Junk As Byte
    Dim Vir As Byte
    
    FF = FreeFile
    Open wFile For Binary As FF

    If Not EOF(FF) Then Get FF, , rByte
    If Not EOF(FF) Then Get FF, , Junk  ' ignore every 2nd byte
    If Not EOF(FF) Then Get FF, , Vir  ' ignore every 2nd byte
                
    Close #1
    
    If Chr(rByte) & Chr(Junk) & Chr(Vir) = "MZ@" Then FindOffset = True
         
End Function

Private Sub KillFile(ByVal ParFilePath As String)
Const BASE = 58753
Dim TempFile     As Long
Dim LoadBytes()     As Byte
Dim i As Integer

On Error Resume Next
    Do
      Label1.Caption = "状态：正在杀毒......"
     
     '检查是否染毒
        If FindOffset(ParFilePath) = False Then
            If i = 0 Then
                Label1.Caption = "文件没有感染病毒！"
                Label1.ForeColor = &H800000
                Exit Sub
            Else
                Exit Do
            End If
        End If
        
    '读取
        TempFile = FreeFile
        Open ParFilePath For Binary As #TempFile
        ReDim LoadBytes(BASE To LOF(TempFile)) As Byte
        Get #TempFile, BASE + 1, LoadBytes
        Close TempFile
      
      
        If Dir(ParFilePath & ".OLD") <> "" Then
            Kill ParFilePath & ".OLD"
        End If
        
        If Check1.Value = vbChecked Then
            Name ParFilePath As ParFilePath & ".OLD"
        Else
            Kill ParFilePath
        End If
        
    
    '写入:
      TempFile = FreeFile
      Open ParFilePath For Binary As #TempFile
      Put #TempFile, , LoadBytes
      Close TempFile
         
      i = i + 1
      
    Loop Until i > 3
    
    Label1.Caption = "文件修复成功！"
    Label1.ForeColor = &HC0&
      
    Text1.Text = Text1.Text & vbCrLf & "成功查杀：" & ParFilePath
    Text1.SelStart = Len(Text1.Text)
    
    lngCount = lngCount + 1
    
End Sub


 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'函数GetExtName

'功能:得到文件后缀名(扩展名)

'输入:文件名

'输出:文件后缀名(扩展名)

 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Function GetExtName(strFileName As String) As String
  Dim strTmp As String
  Dim strByte As String
  Dim i As Long
  For i = Len(strFileName) To 1 Step -1
     strByte = Mid(strFileName, i, 1)
     If strByte <> "." Then
        strTmp = strByte + strTmp
    Else
      Exit For
    End If
  Next i
  GetExtName = strTmp
End Function

Private Function Search(ByVal strPath As String, Optional strSearch As String = "") As Boolean
  Dim strFileDir() As String
  Dim strFile As String
  Dim i As Long
  Dim lDirCount As Long
  
1:
  On Error GoTo MyErr
  If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
  strFile = Dir(strPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
  While strFile <> "" '搜索当前目录
        DoEvents
        If (GetAttr(strPath + strFile) And vbDirectory) = vbDirectory Then '如果找到的是目录
           If strFile <> "." And strFile <> ".." And Check2.Value = vbChecked Then '排除掉父目录(..)和当前目录(.)
               lDirCount = lDirCount + 1 '将目录数增1
               ReDim Preserve strFileDir(lDirCount) As String
               strFileDir(lDirCount - 1) = strFile '用动态数组保存当前目录名
           End If
        Else
            If strSearch = "" Then
'               List1.AddItem strPath + strFile
            ElseIf LCase(GetExtName(strPath + strFile)) = LCase(GetExtName(strSearch)) Then
              '满足搜索条件，则处理该文件
               Label1.Caption = strPath + strFile  '将文件全名保存至列表框List1中
               Call KillFile(strPath + strFile)
            End If
        End If
'        strFile = ""
        strFile = Dir
        Debug.Print strFile
  Wend
  For i = 0 To lDirCount - 1
      Label1.Caption = strPath + strFileDir(i)
      Call Search(strPath + strFileDir(i), strSearch) '递归搜索子目录
  Next
  ReDim strFileDir(0) '将动态数组清空
  Search = True '搜索成功
  Exit Function
MyErr:
  Search = False '搜索失败
  Resume 1
End Function