看別人寫的檔案分割工具挺好用，也學著寫了一個，附原始碼。 (轉)

看別人寫的檔案分割工具挺好用，也學著寫了一個，附原始碼。 (轉)[@more@]

看別人寫的分割工具挺好用，用ＶＢ學著寫了一個，附。

 

VERSION 5.00
= "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.FofrmMain
  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  ' 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.Commanutton 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 fra
  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 txtFile
  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 MmDlg.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 "32.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
  pidl 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