SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

VB テクニック編32 - ファイル分割・統合、バイナリファイル I/O

■SAK 関数利用規程

  ・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
  ・著作権明示部分の改編は認めない。
  ・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
    プログラムを開発することは自由です。
  ・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
    その他有償プロダクトとして配布・販売するには、私の許可が必要です。
    (無償のフリーソフトウェアなら、自由に配布しても良い。)
  ・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
    賠償しません。

■ファイル分割・統合、バイナリファイル I/O

  ・フロッピーやメール容量を超えるファイルを分割するには、次のようにする。
    分割ファイルの拡張子は .001 〜 .999 となる。
    CnvMltVol 関数を呼ぶ場合、分割ファイルの拡張子は .001 固定で良い。
    分割サイズは FPD の場合、1440000 bytes である。
    32000 bytes 未満を指定することはできない。
    また、高速処理のために、実分割サイズは 32000 の倍数になる。
    (指定分割サイズを超えることはない。)

  If CnvMltVol("g:\tmp\schtbl.lzh", "g:\tmp\schtbl_lzh.001", 1440000) = False Then
    msgbox "ファイル分割エラー"
    Exit Sub
  End If

  ・分割ファイルをオリジナルファイルに統合する場合、次のようにする。
    分割ファイルの拡張子は .001 〜 .999 である。
    CnvSglVol 関数を呼ぶ場合、分割ファイルの拡張子は .001 固定で良い。

  If CnvSglVol("g:\tmp\schtbl_lzh.001", "g:\tmp\schtbl.lzh") = False Then
    msgbox "ファイル統合エラー"
    Exit Sub
  End If

  ・手動統合方法 - 手作業でファイル統合するには、コマンドプロンプトから、
      copy a:\schtbl_lzh.001 g:\tmp\  ← 001 のフロッピーをセットしてから
      copy a:\schtbl_lzh.002 g:\tmp\  ← 002 のフロッピーに入れ換えてから
      copy a:\schtbl_lzh.??? g:\tmp\  ← ??? のフロッピーに入れ換えてから
      g:
      cd \tmp
      copy schtbl_lzh.001 /b + schtbl_lzh.002 /b + schtbl_lzh.??? /b schtbl.lzh
    とすることによって、統合可能である。

'=======================================================================
'  マルチボリューム分割
'=======================================================================
'【引数】
'  infnm    = 入力ファイル名
'  outfnm   = 出力ファイル名
'  outsize  = ファイル分割サイズ
'【戻り値】
'  boolean
'    TRUE  正常
'    FALSE エラー
'【処理】
'  ・入力ファイルを指定された容量に分割する。
'【著作権】
'  CnvMltVol ver 2.00  Copyright (C) 1999-2002 Y.SAK
'【履歴】
'  1999.01.27 sak      ver 1.00 新規作成
'  2002.04.07 sak      ver 2.00 VB6 コンバート
'=======================================================================
Public Function CnvMltVol(infnm As String, outfnm As String, outsize As Long) As Boolean

  Dim i          As Long
  Dim fnm        As String
  Dim fno        As Long
  Dim fno1       As Long
  Dim filesize   As Long
  Dim writesize  As Long
  Dim l          As Long
  Dim seqno      As Long

'** 異常終了セット
  CnvMltVol = False

'** 分割サイズチェック
  If outsize < 32000 Then
    MsgBox "分割サイズが 32000 未満です。" + Chr(10) + "32000 以上を指定して下さい。", 48, "CnvMltVol()"
    Exit Function
  End If

'** 入力ファイルオープン
  On Local Error Resume Next
  fno = FreeFile
  Open infnm For Input As fno Len = 32000
  If Err <> 0 Then
    MsgBox "入力ファイルのオープンに失敗しました。" + Chr(10) + " for input infnm = " + infnm, 48, "CnvMltVol()"
    Exit Function
  End If
  Close fno
  Err = 0
  fno = FreeFile
  Open infnm For Binary As fno Len = 32000
  If Err <> 0 Then
    MsgBox "入力ファイルのオープンに失敗しました。" + Chr(10) + "for binary infnm = " + infnm, 48, "CnvMltVol()"
    Exit Function
  End If

'** 分割処理
  i = InStrRev(outfnm, ".")
  If i = 0 Then Exit Function
  fnm = Left(outfnm, i - 1)
  seqno = 1
  fno1 = OpenMltFile(fnm, seqno, False)
  If fno1 = False Then
    Close fno
    Exit Function
  End If
  filesize = LOF(fno)
  writesize = 0
  Do Until filesize < 1
    l = filesize
    If l > 32000 Then l = 32000
    ReDim rec(l - 1) As Byte
    Get fno, , rec
    If writesize + l > outsize Then
      Close fno1
      seqno = seqno + 1
      fno1 = OpenMltFile(fnm, seqno, False)
      If fno1 = False Then
        Close fno
        Exit Function
      End If
      writesize = 0
    End If
    Put fno1, , rec
    writesize = writesize + l
    filesize = filesize - l
  Loop

'** ファイルクローズ
  Close fno1
  Close fno
  On Local Error GoTo 0

'** 正常終了セット
  CnvMltVol = True

End Function

'=======================================================================
'  マルチボリューム統合
'=======================================================================
'【引数】
'  infnm    = 入力ファイル名
'  outfnm   = 出力ファイル名
'【戻り値】
'  boolean
'    TRUE  正常
'    FALSE エラー
'【処理】
'  ・分割ファイルを統合する。
'【著作権】
'  CnvSglVol ver 2.00  Copyright (C) 1999-2002 Y.SAK
'【履歴】
'  1999.01.27 sak      ver 1.00 新規作成
'  2002.04.07 sak      ver 2.00 VB6 コンバート
'=======================================================================
Public Function CnvSglVol(infnm As String, outfnm As String) As Boolean

  Dim i          As Long
  Dim fnm        As String
  Dim fno        As Long
  Dim fno1       As Long
  Dim filesize   As Long
  Dim l          As Long
  Dim seqno      As Long

'** 異常終了セット
  CnvSglVol = False

'** 統合処理
  i = InStrRev(infnm, ".")
  If i = 0 Then Exit Function
  fnm = Left(infnm, i - 1)
  seqno = 1
  fno = OpenMltFile(fnm, seqno, True)
  If fno = False Then
    MsgBox "分割ファイルが見つかりません。" + Chr(10) + "infnm = " + infnm, 48, "CnvSglVol()"
    Exit Function
  End If
  On Local Error Resume Next
  fno1 = FreeFile
  Open outfnm For Binary As fno1 Len = 32000
  If Err <> 0 Then
    Close fno
    MsgBox "統合ファイルのオープンに失敗しました。" + Chr(10) + "outfnm = " + outfnm, 48, "CnvSglVol()"
    Exit Function
  End If
  Do
    filesize = LOF(fno)
    Do Until filesize < 1
      l = filesize
      If l > 32000 Then l = 32000
      ReDim rec(l - 1) As Byte
      Get fno, , rec
      Put fno1, , rec
      filesize = filesize - l
    Loop
    Close fno
    seqno = seqno + 1
    fno = OpenMltFile(fnm, seqno, True)
  Loop Until fno = False

'** ファイルクローズ
  Close fno1
  Close fno
  Close
  On Local Error GoTo 0

'** 正常終了セット
  CnvSglVol = True

End Function

'=======================================================================
'  分割ファイルオープン
'=======================================================================
'【引数】
'  outfnm   = オープンファイル名
'  no       = シリアル No.
'  chk      = 存在チェックする(TRUE)、しない(FALSE)
'【戻り値】
'  long     = ファイル No.
'           = 0 エラー
'【処理】
'  ・入力ファイルを指定された容量に分割する。
'【著作権】
'  OpenMltFile ver 2.00  Copyright (C) 1999-2002 Y.SAK
'【履歴】
'  1999.01.27 sak      ver 1.00 新規作成
'  2002.04.07 sak      ver 2.00 VB6 コンバート
'=======================================================================
Public Function OpenMltFile(outfnm As String, no As Long, chk As Boolean) As Long

  Dim fnm        As String
  Dim fno        As Long

'** 異常終了セット
  OpenMltFile = False

'** 分割ファイルオープン
  If no > 999 Then
    MsgBox "分割ファイルが 999 を越えました。" + Chr(10) + "outfnm = " + outfnm, 48, "OpenMltFile()"
    Exit Function
  End If
  fnm = outfnm + "." + Right("000" + LTrim(Str(no)), 3)
  On Local Error Resume Next
  If chk = True Then
    fno = FreeFile
    Open fnm For Input As fno Len = 32000
    If Err <> 0 Then Exit Function
    Close fno
  End If
  fno = FreeFile
  Open fnm For Binary As fno Len = 32000
  If Err <> 0 Then
    MsgBox "分割ファイルのオープンに失敗しました。" + Chr(10) + "fnm = " + fnm, 48, "OpenMltFile()"
    Exit Function
  End If

'** 正常終了セット
  OpenMltFile = fno

End Function

■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK