VERSION 5.00Object = "{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 EndEndAttribute VB_Name = "frmMain"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption 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 LongEnd 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 LongDim ItemSize As LongDim FileSize As LongDim ReadSize As LongDim i As LongDim vArr() As ByteDim fnum2 As IntegerDim FileName As StringDim 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 IfEnd Function
Private Sub cmdFind_Click()Dim TmpPath As String
ShowDir Me.hWnd, TmpPath If Trim(TmpPath) <> "" Then txtObject.Text = Trim(TmpPath) End IfEnd 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 IfEnd Sub
Private Sub cmdSplit_Click() If Trim(txtSourceFile.Text) = "" Then MsgBox "请选择要分割的文件." OperateFile txtSourceFile.Text, TrueEnd Sub
Private Sub cmdUnit_Click() OperateFile txtSourceFile.Text, FalseEnd 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 IfEnd 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 = 1End Sub
Private Sub optSplit_Click() cmdStart.Enabled = True cmbSplitSize.Enabled = True cmdOk.Enabled = FalseEnd Sub
Private Sub optUnit_Click() cmdStart.Enabled = False cmbSplitSize.Enabled = False cmdOk.Enabled = TrueEnd Sub