VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [過去ログ] [管理用]

投稿日: 2004/02/25(Wed) 11:51
投稿者ak
Eメール
URL
タイトルRe: 文字コード変換について

こんにちは。

>・入力ファイルをバイナリで読む。
>・1文字ずつ検索(INPUT)し、S-JISコードが4桁(2バイトコード)なら以下を行う。
>・入力用変換TBLを検索し位置する文字列を探す。
>・一致したら同じ開始位置で出力用TBLから変換文字コードを取得し変数に代入
>・変数に$hを連結しChrで文字に変換する。
>・変換した文字列をString配列に代入し、その後配列の該当個所を出力ファイルに
>  PUTする。

ようするにファイル内容を2バイトずつ読込み[F040]〜[F1FC]を[EB40]〜[ECFC]に
[FA40]〜[FCFC]を[ED40]〜[EFFC]にそれ以外はそのまま出力できれば良いのですよね。

下記にサンプルを記述しておきましたので参考にしてください。

はずしていたらすみません。

'(*.frm)フォームにCommandButtonを1個配置してください。
Option Explicit
Private Const FILE_TEST_PATH = "C:\Test.dat"    '元ファイルのフルパス
Private Const FILE_CONV_PATH = "C:\Test2.dat"   '変換後ファイルのフルパス

Private Sub Form_Load()
    Dim ii  As Integer
    Dim iFF As Integer
    
    If Dir(FILE_TEST_PATH) = "" Then
    
        'テストデータ作成
        iFF = FreeFile()    '空きファイル番号取得
        
        Open FILE_TEST_PATH For Binary Access Write As #iFF
            
            For ii = &HF040 To &HF1FC
                Put #iFF, , ii
            Next ii
            
            For ii = &HFA40 To &HFCFC
                Put #iFF, , ii
            Next ii
            
        Close #iFF
    
    End If
    
End Sub

Private Sub Command1_Click()
    If pfnFileConv(FILE_TEST_PATH, FILE_CONV_PATH) Then MsgBox "変換しました。", vbInformation
End Sub

'****************************************************************
'概要      :コード変換
'パラメータ    :変数名        ,IO ,型        ,説明
'          :sSrcFile      ,I  ,String    ,元ファイル
'          :sSrcFile      ,I  ,String    ,変換ファイル
'          :戻り値        ,O  ,Boolean   ,True:成功 False:失敗
'説明      :コードを変換し指定されたファイルに出力する
'****************************************************************
Private Function pfnFileConv(ByVal sSrcFile As String, ByVal sConvFile As String) As Boolean
    Dim iFF(1)  As Integer  'ファイル番号
    Dim iTmp    As Integer
    
On Local Error GoTo Error_Handler
    
    pfnFileConv = False
    
    iFF(0) = FreeFile()
    
    Open sSrcFile For Binary Access Read As #iFF(0)
        
        iFF(1) = FreeFile()
        
        Open sConvFile For Binary Access Write As #iFF(1)
        
        Do While Not EOF(iFF(0))
            Get #iFF(0), , iTmp
            Put #iFF(1), , pfnConv(iTmp)
        Loop
        
        Close #iFF(1)
        
    Close #iFF(0)
    
    pfnFileConv = True
    
    Exit Function
Error_Handler:
    MsgBox "エラーNo:" & Err.Number & vbCrLf & "エラー内容" & Err.Description, vbCritical
End Function

'****************************************************************
'概要      :コード変換
'パラメータ    :変数名        ,IO ,型        ,説明
'          :iValue        ,I  ,Integer   ,コード
'          :戻り値        ,O  ,Integer   ,変換されたコード
'説明      :
'****************************************************************
Private Function pfnConv(ByVal iValue As Integer) As Integer
    Dim iRet    As Integer
    Const CNS_F040_F1FC = &HEB40 - &HF040
    Const CNS_FA40_FCFC = &HED40 - &HFA40
    
    Select Case iValue
        Case &HF040 To &HF1FC
            iRet = iValue + CNS_F040_F1FC
        Case &HFA40 To &HFCFC
            iRet = iValue + CNS_FA40_FCFC
        Case Else
            iRet = iValue
    End Select
    
    pfnConv = iRet

End Function


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- Web Forum -