VB 写的文件分割工具,还蛮好用的。附上源码

    技术2024-10-24  27

    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

     

    最新回复(0)