● ファイルを分割・結合する ●

ギリギリでフロッピーディスクに入らないときって悔しいよね。

分割されて作成されるファイルの拡張子は、dv01、dv02、dv03… というように、dv + ファイルのインデックス2桁にする。この場合、99個までしか分割できないけど、そこら辺は自分で改造するなりして補ってください。またここでは、必要最低限の実装のみでエラー処理は省略しています。この点は了承をば。

'-------------------------------------------------------------------
' 関数名 :  GetCurrentDir
' 機能    : カレントディレクトリを取得する
' 引数    : なし
' 返り値 : カレントディレクトリが返る
'-------------------------------------------------------------------
Private Function GetCurrentDir() As String

    Dim FilePath As String

    FilePath = App.Path

    If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

    GetCurrentDir = FilePath

End Function

'-------------------------------------------------------------------
' 関数名 :  ExecuteDivFile
' 機能   : ファイルを分割する
' 引数   : (in) FilePath … 分割対象ファイルのフルパス
'          (in) MKFileName … 分割作成されるファイルの名前
'          (in) DivSizeID … 0:フロッピーディスク分割(1450000Byte)
'                               1:100000Byte  2:50000Byte
' 返り値 : なし
'-------------------------------------------------------------------

Public Sub ExecuteDivFile(ByVal FilePath As String, ByVal MKFileName As String, ByVal DivSizeID As Long)

    Dim BaseFilePath As String  '分割対象となるファイルのフルパス
    Dim BaseFileSize As Long    '分割対象となるファイルのサイズ
    Dim BinFileData() As Byte    '分割対象となるファイルを読み込むためのバッファ
    Dim i As String                  '作業用変数
    Dim ROOPMAX As String      'For分でループするときの最大値
    Dim FileNumber01 As String  'ファイルナンバー
    Dim FileNumber02 As String  'ファイルナンバー
    Dim ReadFileData As Long    '分割するサイズを格納するバッファサイズ
    Dim DivFileSize As Long       'ファイル分割サイズ

    '分割対象となるファイルのフルパスをセット
    BaseFilePath = FilePath

    '分割対象となるファイルのサイズをセット
    BaseFileSize = FileLen(BaseFilePath)

    '分割対象ファイルのサイズが指定サイズより小さい場合
    If BaseFileSize <= DivFileSize Then
          Call MsgBox("ファイルを分割する必要がありません", vbOKOnly + vbInformation, "ファイル分割 - エラー")
          Exit Sub
    End If

    'ファイル分割サイズを設定
    Select Case DivSizeID
          Case 0
                DivFileSize = 1450000
          Case 1
                DivFileSize = 100000
          Case 2
                DivFileSize = 50000
          Case Else
                Call MsgBox("第3引数が不正です", vbOKOnly + vbExclamation, "ファイル分割 - エラー")
                Exit Sub
    End Select

    'For分でループするときの最大値を求める
    ROOPMAX = BaseFileSize \ DivFileSize

    '分割対象となるファイルのサイズを指定分割サイズで割ったとき
    '余りがあるなら、ループ最大カウンタを1つ追加する
    If BaseFileSize Mod DivFileSize <> 0 Then
          ROOPMAX = ROOPMAX + 1
    End If

    'ファイルナンバーを割り当てる
    FileNumber01 = FreeFile

    '分割対象ファイルを開く
    Open FilePath For Binary Access Read As #FileNumber01
          For i = 1 To ROOPMAX
                '読みこむファイルサイズ分を初期化した後に確保
                Erase BinFileData

                If i = ROOPMAX Then
                      ReadFileData = FileLen(BaseFilePath) - (DivFileSize * (i - 1))
                Else
                      ReadFileData = DivFileSize
                End If

                'メモリ再確保
                ReDim Preserve BinFileData(ReadFileData - 1) As Byte

                '読みこみ位置を指定
                Seek #FileNumber01, 1 + (DivFileSize * (i - 1))
                Get #FileNumber01, , BinFileData()     '読みこみ

                'ファイルナンバーを割り当てる
                FileNumber02 = FreeFile
                Open GetCurrentDir & MKFileName & Chr$(46) & "dv" & Format$(CStr(i), "00") _
                                                               For Binary Access Write As #FileNumber02
                      Put #FileNumber02, , BinFileData()     '書きこみ
                Close #FileNumber02
          Next i
    Close #FileNumber01

End Sub

'-------------------------------------------------------------------
' 関数名 :  ExecuteDockFile
' 機能   : 分割ファイルを結合する
' 引数   : (in) FilePath … 1つ目(拡張子dv01)の分割対象ファイルのフルパス
'          (in) MKFileName … 結合されて作成されるファイルの名前
' 返り値 : なし
' 備考   :メモリーエラーに注意
'-------------------------------------------------------------------
Public Sub ExecuteDockFile(ByVal FilePath As String, ByVal MKFileName As String)

    Dim FileNumber01 As Integer  'ファイルナンバー
    Dim FileNumber02 As Integer  'ファイルナンバー
    Dim BinFileData() As Byte    '分割ファイルから読み込んだデータを格納するバッファ
    Dim GetFileName As String    '1つ目(拡張子dv01)の分割ファイル名
    Dim tgFileName As String      '読み込むための分割ファイル名
    Dim GetFileDir As String      '1つ目(拡張子dv01)の分割ファイルのあるディレクトリ
    Dim i As Integer              '作業用変数

    '1つ目(拡張子dv01)の分割対象ファイルのフルパスからファイル名を得る
    GetFileName = Dir$(FilePath)

    '結合対象ファイルの拡張子の数字部分を除いたファイル名を得る
    GetFileName = Left$(GetFileName, Len(GetFileName) - 2)

    '1つ目(拡張子dv01)の分割対象ファイルのあるディレクトリを得る
    GetFileDir = Left$(FilePath, Len(FilePath) - Len(GetFileName) - 2)

    'ファイルナンバーを割り当てる
    FileNumber02 = FreeFile

    Open GetFileDir & MKFileName For Binary Access Write As #FileNumber02
          For i = 1 To 99
                tgFileName = GetFileDir & GetFileName & Format$(CStr(i), "00")

                'ファイルが見つからなければループを抜ける
                If Dir$(tgFileName) = "" Then Exit For

                FileNumber01 = FreeFile   'ファイルナンバーを割り当てる

                '分割対象ファイルを開く
                Open tgFileName For Binary Access Read As #FileNumber01
                      Erase BinFileData  '初期化
                      ReDim Preserve BinFileData(FileLen(tgFileName) - 1)  As Byte 'ファイルサイズ分バッファを確保
                      Get #FileNumber01, , BinFileData()    '読みこみ
                      Put #FileNumber02, , BinFileData()    '書きこみ
                Close #FileNumber01
          Next i
    Close #FileNumber02

End Sub

以上で終わり。使用上制限がある部分は改造してより良いものを作ってみてちょ。


戻る