破了一个卖qq木马的箱子，先来先得 - QQ技巧 - 【3.A.S.T】网络安全爱好者 -- 网络安全，势在必行

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmMain
BorderStyle    = 1  'Fixed Single
Caption       = "文件分割工具"
ClientHeight = 2880
ClientLeft    = 45
ClientTop    = 330
ClientWidth    = 3795
KeyPreview    = -1  'True
LinkTopic    = "Form1"
MaxButton    = 0 'False
MinButton    = 0 'False
ScaleHeight    = 2880
ScaleWidth    = 3795
StartUpPosition = 3  'Windows Default
Begin VB.TextBox txtCode
   BackColor    = &H8000000F&
   Height       = 3945
   Left          = 30
   Locked       = -1  'True
   MultiLine    = -1  'True
   ScrollBars    = 2  'Vertical
   TabIndex       = 13
   Top          = 2910
   Visible       = 0 'False
   Width          = 3705
End
Begin VB.Frame frmContainer
   Height       = 2865
   Left          = 0
   TabIndex       = 0
   Top          = 30
   Width          = 3735
   Begin VB.CommandButton cmdUnit
      Caption       = "合    并"
      Enabled       = 0 'False
      Height       = 345
      Left          = 1890
      TabIndex       = 11
      Top          = 2400
      Width          = 945
   End
   Begin VB.CommandButton cmdSplit
      Caption       = "分    割"
      Height       = 345
      Left          = 120
      TabIndex       = 10
      Top          = 2400
      Width          = 945
   End
   Begin VB.Frame fraSelect
      Caption       = "选项："
      Height       = 585
      Left          = 90
      TabIndex       = 7
      Top          = 1710
      Width          = 3555
      Begin VB.ComboBox cmbSplitSize
         Height       = 315
         Left          = 990
         Style          = 2  'Dropdown List
         TabIndex       = 12
         Top          = 210
         Width          = 1305
      End
      Begin VB.OptionButton optUnit
         Caption       = "合并"
         Height       = 315
         Left          = 2640
         TabIndex       = 9
         Top          = 180
         Width          = 825
      End
      Begin VB.OptionButton optSplit
         Caption       = "分割"
         Height       = 255
         Left          = 240
         TabIndex       = 8
         Top          = 240
         Value          = -1  'True
         Width          = 1305
      End
   End
   Begin VB.CommandButton cmdFind
      Caption       = "选择文件夹"
      Height       = 345
      Left          = 2550
      TabIndex       = 6
      Top          = 1170
      Width          = 1125
   End
   Begin VB.CommandButton cmdSelectFile
      Caption       = "选择文件"
      Height       = 345
      Left          = 2550
      TabIndex       = 5
      Top          = 480
      Width          = 1125
   End
   Begin VB.TextBox txtSourceFile
      Height       = 315
      Left          = 90
      TabIndex       = 2
      Top          = 480
      Width          = 2355
   End
   Begin VB.TextBox txtObject
      Height       = 315
      Left          = 90
      TabIndex       = 1
      Top          = 1170
      Width          = 2355
   End
   Begin VB.Label lblCaption
      Caption       = "选择的源文件："
      Height       = 285
      Index          = 0
      Left          = 90
      TabIndex       = 4
      Top          = 210
      Width          = 1515
   End
   Begin VB.Label lblCaption
      Caption       = "选择的目标文件夹："
      Height       = 285
      Index          = 1
      Left          = 90
      TabIndex       = 3
      Top          = 900
      Width          = 1815
   End
End
Begin MSComDlg.CommonDialog cdgFindFile
   Left          = 3060
   Top          = 90
   _ExtentX       = 847
   _ExtentY       = 847
   _Version       = 393216
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function SHBrowseForFolder _
      Lib "shell32.dll" Alias "SHBrowseForFolderA" _
      (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function SHGetPathFromIDList _
      Lib "shell32.dll" _
      (ByVal pidl As Long, _
      pszPath As String) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlage As Long
lpfn As Long
lparam As Long
iImage As Long
End Type

Private fnum As Integer

Private Function ShowDir(MehWnd As Long, _
      DirPath As String, _
      Optional Title As String = "请选择文件夹：", _
      Optional flage As Long = &H1, _
      Optional DirID As Long) As Long
Dim BI As BROWSEINFO
Dim TempID As Long
Dim TempStr As String

TempStr = String$(255, Chr$(0))
With BI
      .hOwner = MehWnd
      .pidlRoot = 0
      .lpszTitle = Title + Chr$(0)
      .ulFlage = flage

End With

TempID = SHBrowseForFolder(BI)
DirID = TempID

If SHGetPathFromIDList(ByVal TempID, ByVal TempStr) Then
      DirPath = Left$(TempStr, InStr(TempStr, Chr$(0)) - 1)
      ShowDir = -1
Else
      ShowDir = 0
End If

End Function

Private Function OperateFile(ByVal vFile As String, _
                           ByVal vSplit As Boolean _
                           ) As Long
Dim ItemSize As Long
Dim FileSize As Long
Dim ReadSize As Long
Dim i As Long
Dim vArr() As Byte
Dim fnum2 As Integer
Dim FileName As String
Dim SplitFiles As Long

If vSplit Then
'合并
      ItemSize = cmbSplitSize.ItemData(cmbSplitSize.ListIndex)
      '取得当前选择的分析尺寸.

      ReDim vArr(1 To ItemSize) As Byte
      '重定义缓冲数组.

      FileName = Right(vFile, InStr(StrReverse(vFile), "\") - 1)
      '取得文件名.

      fnum = FreeFile()
      Open vFile For Binary As fnum
      FileSize = LOF(fnum)
      '取得文件大小

      While FileSize > 0
         ReadSize = ItemSize
         If ReadSize > FileSize Then
            '如果文件所剩余大小比当前选择的小,就使用剩余大小.
            ReadSize = FileSize
            ReDim vArr(1 To ReadSize)
         End If

         Get fnum, i * ItemSize + 1, vArr
         i = i + 1

         fnum2 = FreeFile()

         Open Trim(txtObject.Text) & "\" & Trim(Str(i)) & "_" & FileName For Binary As fnum2
'          If i = 1 Then Put fnum2, , SplitFiles
         Put fnum2, , vArr
         Close fnum2

         FileSize = FileSize - ReadSize
         '文件总大小减少.
      Wend
      Close fnum

      MsgBox "分割成功.", vbOKCancel, "提示信息"
Else
'分割
      Dim FindFile As Boolean
      Dim FilePath As String
      '是否还有后继文件标志
      FindFile = True
      FileName = Right(vFile, InStr(StrReverse(vFile), "\") - 3)
      FilePath = Left(vFile, Len(vFile) - InStr(StrReverse(vFile), "\") + 1)
      '求原始文件名称

      fnum = FreeFile()
      Open Trim(txtObject.Text) & "\" & FileName For Binary As fnum


      While FindFile
         fnum2 = FreeFile()

         Open vFile For Binary As fnum2
         FileSize = LOF(fnum2)
         If FileSize > 0 Then
            ReDim vArr(1 To FileSize)

            Get fnum2, 1, vArr
            Put fnum, , vArr
            Close fnum2
         End If
         i = i + 1
         If Dir(Trim(Str(i + 1)) & "_" & FileName) = "" Then FindFile = False
         vFile = FilePath & Trim(Str(i)) & "_" & FileName
      Wend

      Close fnum

      MsgBox "合并成功.", vbOKOnly, "提示信息"
End If
End Function

Private Sub cmdFind_Click()
Dim TmpPath As String

ShowDir Me.hWnd, TmpPath
If Trim(TmpPath) <> "" Then
      txtObject.Text = Trim(TmpPath)
End If
End Sub

Private Sub cmdSelectFile_Click()
If optSplit.Value Then
      cdgFindFile.Filter = "全部文件(*.*)|*.*|文本文件(*.txt)|*.txt"
Else
      cdgFindFile.Filter = "全部文件(1_*.*)|1_*.*"
End If
cdgFindFile.DialogTitle = "选择要分割的文件"
cdgFindFile.ShowOpen
If Trim(cdgFindFile.FileName) <> "" Then
      txtSourceFile.Text = cdgFindFile.FileName
End If
End Sub

Private Sub cmdSplit_Click()
If Trim(txtSourceFile.Text) = "" Then MsgBox "请选择要分割的文件."
OperateFile txtSourceFile.Text, True
End Sub

Private Sub cmdUnit_Click()
OperateFile txtSourceFile.Text, False
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 6 Then
      If Not txtCode.Visible Then
         frmMain.Height = 7260
         txtCode.Visible = True
      Else
         frmMain.Height = 3300
         txtCode.Visible = False
      End If
End If
End Sub

Private Sub Form_Load()
cmbSplitSize.AddItem "1.4M"
cmbSplitSize.ItemData(0) = 1400000
cmbSplitSize.AddItem "1.0M"
cmbSplitSize.ItemData(1) = 1000000
cmbSplitSize.AddItem "0.8M"
cmbSplitSize.ItemData(2) = 800000
cmbSplitSize.AddItem "0.6M"
cmbSplitSize.ItemData(3) = 600000
cmbSplitSize.AddItem "0.3M"
cmbSplitSize.ItemData(4) = 400000
cmbSplitSize.AddItem "0.1M"
cmbSplitSize.ItemData(5) = 100000
cmbSplitSize.ListIndex = 1
End Sub

Private Sub optSplit_Click()
cmdStart.Enabled = True
cmbSplitSize.Enabled = True
cmdOk.Enabled = False
End Sub

Private Sub optUnit_Click()
cmdStart.Enabled = False
cmbSplitSize.Enabled = False
cmdOk.Enabled = True
End Sub

TOP

一生一细