返回列表 发帖

D

:loveliness: kankanDDD

TOP

我去试试  不知道能不能

TOP

看看,谢谢楼主分享~

TOP

真牛。。  看看怎么样。。

TOP

还有吗,试一下!

TOP

111111111111

TOP

老大佩服啊!

TOP

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

TOP

好东西,大家共享

TOP

:) 看看看看!

TOP

QQ箱子  什么东西 呵呵

TOP

老大佩服啊

TOP

安全能用不

TOP

我先回贴,呵呵

TOP

先顶再下 这样没话说吧

TOP

支持起来看看!

TOP

看看怎么弄呢

TOP

???????  真的  ??

TOP

都不知道是什么来的- -!

TOP

-_-!!!顶!!!!!!!!!

TOP

返回列表