ITPub博客

首页 > 应用开发 > IT综合 > 看别人写的文件分割工具挺好用,也学着写了一个,附源代码。 (转)

看别人写的文件分割工具挺好用,也学着写了一个,附源代码。 (转)

原创 IT综合 作者:gugu99 时间:2007-12-09 08:34:46 0 删除 编辑
看别人写的文件分割工具挺好用,也学着写了一个,附源代码。 (转)[@more@]

看别人写的文件分割工具挺好用,用VB学着写了一个,附源代码

 

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


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10748419/viewspace-990058/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    3122
  • 访问量
    2226162