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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

看别人写的文件分割工具挺好用,用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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航