分享
 
 
 

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

王朝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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有