[リストへもどる]
一括表示

投稿時間:2004/02/24(Tue) 16:19
投稿者名:澤田
Eメール:cs8h_trmr@hotmail.com
URL :
タイトル:
文字コード変換について
始めまして。
VB初心者の澤田と申します。
困っていますどうか助けてください。

VB6.0(SP5)でWin拡張文字コード(F040〜F1FC,FA40〜FCFC)をDos拡張文字コード
(EB40〜ECFC,ED40〜EFFC)に変換するPGMを作成しています。
入力ファイルはテキストデータ(S-JIS)で、出力もテキストデータ(S-JIS)です。

実行すると、PUTする変数内では変換後S-JISコード(EB40,etc...)に変換されて
いるのですが、それをPUTすると何故か文字コードの変換(S-JISコードで"8145")
がされてしまいます。

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

ソースはこんな感じです。
Dim strInPath As String
Dim strOutPath As String
Dim strInTBL(14) As String '変換テーブル
Dim strOutTBL(14) As String '変換テーブル
Dim strInData As String '入力レコード
Dim strSjisData As String '入力1文字
Dim strHexData As String 'HEX変換後1文字

'*
'* module : mdlWINCONV
'* outline: Win拡張文字コードをDos拡張文字コードに変換する。
'*
'*
Sub mdlWINCONV(intConvRC As Integer)
    Dim lngCntLoop As Long 'ループ回数
    Dim lngFileSize As Long 'ファイルサイズ
    Dim strOutData() As String
    Dim strSrchDat As String 'サーチ用文字列
    
    '入出力先設定
    strInPath = frmMain.txtINPATH.Text
    strOutPath = frmMain.txtOUTPATH.Text
    
    Open strInPath For Binary As #1  '入力ファイルOPEN
    Open strOutPath For Binary As #2  '出力ファイルOPEN
    lngFileSize = LOF(1)  'LOF 関数でファイルサイズを得る
    
    If Not lngFileSize Then        'ファイルサイズが 0 以外だった場合
        ReDim strOutData(lngFileSize) '配列サイズをファイルサイズ分確保
        Do While Not EOF(1)
           strInData = Input(1, #1) 'ファイルからデータを読み込む
           strHexData = Hex$(Asc(strInData + Chr$(0)))
          '読み込んだ1文字のS-JISコードが4桁(2バイトコード)で、
          '上2桁が"F0","F1","FA","FB","FC"なら変換関数をCALLする。
           strSrchDat = Mid(strHexData, 1, 2)
           If Len(strHexData) = 4 Then
               If strSrchDat = "F0" Or strSrchDat = "F1" Or strSrchDat = "FA" Or _
               strSrchDat = "FB" Or strSrchDat = "FC" Then
                   Call mdlCHGSJIS
               End If
           End If
          'HEXデータを文字列として出力する
           strOutData(lngCntLoop) = Chr("&h" + strHexData)
           Put #2, , strOutData(lngCntLoop)
           lngCntLoop = lngCntLoop + 1
        Loop
    End If
    Close #1
    Close #2
End Sub
'*
'* module : mdlCHGSJIS
'* outline: 入力データのコード4桁を変換TBLに従い変換する。
'*
'*
Private Sub mdlCHGSJIS()
    Dim lngTblNo As Long 'TBLの番号
    Dim lngTblSta As Long 'TBLの開始位置
    Dim lngTblEnd As Long 'TBL終了桁
    Dim lngFlgEnd As Integer 'TBL検索終了フラグ
    
    Call mdlSETTBL 'S-JIS変換TBLのセット    
    lngFlgEnd = 0
    lngTblSta = 1
    lngTblEnd = 4
    lngTblNo = 0
    
    '終了フラグが'0'かTBL_NOが14以下の間、TBL内で同じHEXコードを探し、同位置のOUT_TBLのHEXコードと置き換える。
    Do While lngFlgEnd = 0 And lngTblNo <= 14
        Do While Not Mid(strInTBL(lngTblNo), lngTblSta, lngTblEnd) = "FFFF"
            If Mid(strInTBL(lngTblNo), lngTblSta, lngTblEnd) = strHexData Then
                strHexData = Mid(strOutTBL(lngTblNo), lngTblSta, lngTblEnd)
                lngFlgEnd = 1
                Exit Do
            Else
                lngTblSta = lngTblSta + lngTblEnd
            End If
        Loop
        lngTblNo = lngTblNo + 1
        lngTblSta = 1
    Loop
End Sub


Private Sub mdlSETTBL()
    '入力TBLセット
    strInTBL(0)= "F040F041F042F043F044F045F046F047F048F049F04AF04BF04CF04DF04EF04FF050F051F052F053F054F055F056F057F058F059F05AF05BF05CF05DF05EF05FF060F061F062F063F064F065F066F067F068F069F06AF06BF06CF06DF06EF06FF070F071F072F073F074F075F076F077F078F079F07AF07BF07CF07DF07EFFFF"
    strInTBL(1) = "F080F081F082F083F084F085F086F087F088F089F08AF08BF08CF08DF08EF08FF090F091F092F093F094F095F096F097F098F099F09AF09BF09CF09DF09EFFFF"
    strInTBL(2) = "F09FF0A0F0A1F0A2F0A3F0A4F0A5F0A6F0A7F0A8F0A9F0AAF0ABF0ACF0ADF0AEF0AFF0B0F0B1F0B2F0B3F0B4F0B5F0B6F0B7F0B8F0B9F0BAF0BBF0BCF0BDF0BEF0BFF0C0F0C1F0C2F0C3F0C4F0C5F0C6F0C7F0C8F0C9F0CAF0CBF0CCF0CDF0CEF0CFF0D0F0D1F0D2F0D3F0D4F0D5F0D6F0D7F0D8F0D9F0DAF0DBF0DCF0DDF0DEF0DFF0E0F0E1F0E2F0E3F0E4F0E5F0E6F0E7F0E8F0E9F0EAF0EBF0ECF0EDF0EEF0EFF0F0F0F1F0F2F0F3F0F4F0F5F0F6F0F7F0F8F0F9F0FAF0FBF0FCFFFF"
    strInTBL(3) = "F140F141F142F143F144F145F146F147F148F149F14AF14BF14CF14DF14EF14FF150F151F152F153F154F155F156F157F158F159F15AF15BF15CF15DF15EF15FF160F161F162F163F164F165F166F167F168F169F16AF16BF16CF16DF16EF16FF170F171F172F173F174F175F176F177F178F179F17AF17BF17CF17DF17EFFFF"
    strInTBL(4) = "F180F181F182F183F184F185F186F187F188F189F18AF18BF18CF18DF18EF18FF190F191F192F193F194F195F196F197F198F199F19AF19BF19CF19DF19EFFFF"
    strInTBL(5) = "F19FF1A0F1A1F1A2F1A3F1A4F1A5F1A6F1A7F1A8F1A9F1AAF1ABF1ACF1ADF1AEF1AFF1B0F1B1F1B2F1B3F1B4F1B5F1B6F1B7F1B8F1B9F1BAF1BBF1BCF1BDF1BEF1BFF1C0F1C1F1C2F1C3F1C4F1C5F1C6F1C7F1C8F1C9F1CAF1CBF1CCF1CDF1CEF1CFF1D0F1D1F1D2F1D3F1D4F1D5F1D6F1D7F1D8F1D9F1DAF1DBF1DCF1DDF1DEF1DFF1E0F1E1F1E2F1E3F1E4F1E5F1E6F1E7F1E8F1E9F1EAF1EBF1ECF1EDF1EEF1EFF1F0F1F1F1F2F1F3F1F4F1F5F1F6F1F7F1F8F1F9F1FAF1FBF1FCFFFF"
    strInTBL(6) = "FA40FA41FA42FA43FA44FA45FA46FA47FA48FA49FA4AFA4BFA4CFA4DFA4EFA4FFA50FA51FA52FA53FA54FA55FA56FA57FA58FA59FA5AFA5BFA5CFA5DFA5EFA5FFA60FA61FA62FA63FA64FA65FA66FA67FA68FA69FA6AFA6BFA6CFA6DFA6EFA6FFA70FA71FA72FA73FA74FA75FA76FA77FA78FA79FA7AFA7BFA7CFA7DFA7EFFFF"
    strInTBL(7) = "FA80FA81FA82FA83FA84FA85FA86FA87FA88FA89FA8AFA8BFA8CFA8DFA8EFA8FFA90FA91FA92FA93FA94FA95FA96FA97FA98FA99FA9AFA9BFA9CFA9DFA9EFFFF"
    strInTBL(8) = "FA9FFAA0FAA1FAA2FAA3FAA4FAA5FAA6FAA7FAA8FAA9FAAAFAABFAACFAADFAAEFAAFFAB0FAB1FAB2FAB3FAB4FAB5FAB6FAB7FAB8FAB9FABAFABBFABCFABDFABEFABFFAC0FAC1FAC2FAC3FAC4FAC5FAC6FAC7FAC8FAC9FACAFACBFACCFACDFACEFACFFAD0FAD1FAD2FAD3FAD4FAD5FAD6FAD7FAD8FAD9FADAFADBFADCFADDFADEFADFFAE0FAE1FAE2FAE3FAE4FAE5FAE6FAE7FAE8FAE9FAEAFAEBFAECFAEDFAEEFAEFFAF0FAF1FAF2FAF3FAF4FAF5FAF6FAF7FAF8FAF9FAFAFAFBFAFCFFFF"
    strInTBL(9) = "FB40FB41FB42FB43FB44FB45FB46FB47FB48FB49FB4AFB4BFB4CFB4DFB4EFB4FFB50FB51FB52FB53FB54FB55FB56FB57FB58FB59FB5AFB5BFB5CFB5DFB5EFB5FFB60FB61FB62FB63FB64FB65FB66FB67FB68FB69FB6AFB6BFB6CFB6DFB6EFB6FFB70FB71FB72FB73FB74FB75FB76FB77FB78FB79FB7AFB7BFB7CFB7DFB7EFFFF"
    strInTBL(10) = "FB80FB81FB82FB83FB84FB85FB86FB87FB88FB89FB8AFB8BFB8CFB8DFB8EFB8FFB90FB91FB92FB93FB94FB95FB96FB97FB98FB99FB9AFB9BFB9CFB9DFB9EFFFF"
    strInTBL(11) = "FB9FFBA0FBA1FBA2FBA3FBA4FBA5FBA6FBA7FBA8FBA9FBAAFBABFBACFBADFBAEFBAFFBB0FBB1FBB2FBB3FBB4FBB5FBB6FBB7FBB8FBB9FBBAFBBBFBBCFBBDFBBEFBBFFBC0FBC1FBC2FBC3FBC4FBC5FBC6FBC7FBC8FBC9FBCAFBCBFBCCFBCDFBCEFBCFFBD0FBD1FBD2FBD3FBD4FBD5FBD6FBD7FBD8FBD9FBDAFBDBFBDCFBDDFBDEFBDFFBE0FBE1FBE2FBE3FBE4FBE5FBE6FBE7FBE8FBE9FBEAFBEBFBECFBEDFBEEFBEFFBF0FBF1FBF2FBF3FBF4FBF5FBF6FBF7FBF8FBF9FBFAFBFBFBFCFFFF"
    strInTBL(12) = "FC40FC41FC42FC43FC44FC45FC46FC47FC48FC49FC4AFC4BFC4CFC4DFC4EFC4FFC50FC51FC52FC53FC54FC55FC56FC57FC58FC59FC5AFC5BFC5CFC5DFC5EFC5FFC60FC61FC62FC63FC64FC65FC66FC67FC68FC69FC6AFC6BFC6CFC6DFC6EFC6FFC70FC71FC72FC73FC74FC75FC76FC77FC78FC79FC7AFC7BFC7CFC7DFC7EFFFF"
    strInTBL(13) = "FC80FC81FC82FC83FC84FC85FC86FC87FC88FC89FC8AFC8BFC8CFC8DFC8EFC8FFC90FC91FC92FC93FC94FC95FC96FC97FC98FC99FC9AFC9BFC9CFC9DFC9EFFFF"
    strInTBL(14) = "FC9FFCA0FCA1FCA2FCA3FCA4FCA5FCA6FCA7FCA8FCA9FCAAFCABFCACFCADFCAEFCAFFCB0FCB1FCB2FCB3FCB4FCB5FCB6FCB7FCB8FCB9FCBAFCBBFCBCFCBDFCBEFCBFFCC0FCC1FCC2FCC3FCC4FCC5FCC6FCC7FCC8FCC9FCCAFCCBFCCCFCCDFCCEFCCFFCD0FCD1FCD2FCD3FCD4FCD5FCD6FCD7FCD8FCD9FCDAFCDBFCDCFCDDFCDEFCDFFCE0FCE1FCE2FCE3FCE4FCE5FCE6FCE7FCE8FCE9FCEAFCEBFCECFCEDFCEEFCEFFCF0FCF1FCF2FCF3FCF4FCF5FCF6FCF7FCF8FCF9FCFAFCFBFCFCFFFF"
    
    '出力TBLセット
    strOutTBL(0) = "EB40EB41EB42EB43EB44EB45EB46EB47EB48EB49EB4AEB4BEB4CEB4DEB4EEB4FEB50EB51EB52EB53EB54EB55EB56EB57EB58EB59EB5AEB5BEB5CEB5DEB5EEB5FEB60EB61EB62EB63EB64EB65EB66EB67EB68EB69EB6AEB6BEB6CEB6DEB6EEB6FEB70EB71EB72EB73EB74EB75EB76EB77EB78EB79EB7AEB7BEB7CEB7DEB7EFFFF"
    strOutTBL(1) = "EB80EB81EB82EB83EB84EB85EB86EB87EB88EB89EB8AEB8BEB8CEB8DEB8EEB8FEB90EB91EB92EB93EB94EB95EB96EB97EB98EB99EB9AEB9BEB9CEB9DEB9EFFFF"
    strOutTBL(2) = "EB9FEBA0EBA1EBA2EBA3EBA4EBA5EBA6EBA7EBA8EBA9EBAAEBABEBACEBADEBAEEBAFEBB0EBB1EBB2EBB3EBB4EBB5EBB6EBB7EBB8EBB9EBBAEBBBEBBCEBBDEBBEEBBFEBC0EBC1EBC2EBC3EBC4EBC5EBC6EBC7EBC8EBC9EBCAEBCBEBCCEBCDEBCEEBCFEBD0EBD1EBD2EBD3EBD4EBD5EBD6EBD7EBD8EBD9EBDAEBDBEBDCEBDDEBDEEBDFEBE0EBE1EBE2EBE3EBE4EBE5EBE6EBE7EBE8EBE9EBEAEBEBEBECEBEDEBEEEBEFEBEBEBF1EBF2EBF3EBF4EBF5EBF6EBF7EBF8EBF9EBFAEBFBEBFCFFFF"
    strOutTBL(3) = "EC40EC41EC42EC43EC44EC45EC46EC47EC48EC49EC4AEC4BEC4CEC4DEC4EEC4FEC50EC51EC52EC53EC54EC55EC56EC57EC58EC59EC5AEC5BEC5CEC5DEC5EEC5FEC60EC61EC62EC63EC64EC65EC66EC67EC68EC69EC6AEC6BEC6CEC6DEC6EEC6FEC70EC71EC72EC73EC74EC75EC76EC77EC78EC79EC7AEC7BEC7CEC7DEC7EFFFF"
    strOutTBL(4) = "EC80EC81EC82EC83EC84EC85EC86EC87EC88EC89EC8AEC8BEC8CEC8DEC8EEC8FEC90EC91EC92EC93EC94EC95EC96EC97EC98EC99EC9AEC9BEC9CEC9DEC9EFFFF"
    strOutTBL(5) = "EC9FECA0ECA1ECA2ECA3ECA4ECA5ECA6ECA7ECA8ECA9ECAAECABECACECADECAEECAFECB0ECB1ECB2ECB3ECB4ECB5ECB6ECB7ECB8ECB9ECBAECBBECBCECBDECBEECBFECC0ECC1ECC2ECC3ECC4ECC5ECC6ECC7ECC8ECC9ECCAECCBECCCECCDECCEECCFECD0ECD1ECD2ECD3ECD4ECD5ECD6ECD7ECD8ECD9ECDAECDBECDCECDDECDEECDFECE0ECE1ECE2ECE3ECE4ECE5ECE6ECE7ECE8ECE9ECEAECEBECECECEDECEEECEFECF0ECECECF2ECF3ECF4ECF5ECF6ECF7ECF8ECF9ECFAECFBECFCFFFF"
    strOutTBL(6) = "ED40ED41ED42ED43ED44ED45ED46ED47ED48ED49ED4AED4BED4CED4DED4EED4FED50ED51ED52ED53ED54ED55ED56ED57ED58ED59ED5AED5BED5CED5DED5EED5FED60ED61ED62ED63ED64ED65ED66ED67ED68ED69ED6AED6BED6CED6DED6EED6FED70ED71ED72ED73ED74ED75ED76ED77ED78ED79ED7AED7BED7CED7DED7EFFFF"
    strOutTBL(7) = "ED80ED81ED82ED83ED84ED85ED86ED87ED88ED89ED8AED8BED8CED8DED8EED8FED90ED91ED92ED93ED94ED95ED96ED97ED98ED99ED9AED9BED9CED9DED9EFFFF"
    strOutTBL(8) = "ED9FEDA0EDA1EDA2EDA3EDA4EDA5EDA6EDA7EDA8EDA9EDAAEDABEDACEDADEDAEEDAFEDB0EDB1EDB2EDB3EDB4EDB5EDB6EDB7EDB8EDB9EDBAEDBBEDBCEDBDEDBEEDBFEDC0EDC1EDC2EDC3EDC4EDC5EDC6EDC7EDC8EDC9EDCAEDCBEDCCEDCDEDCEEDCFEDD0EDD1EDD2EDD3EDD4EDD5EDD6EDD7EDD8EDD9EDDAEDDBEDDCEDDDEDDEEDDFEDE0EDE1EDE2EDE3EDE4EDE5EDE6EDE7EDE8EDE9EDEAEDEBEDECEDEDEDEEEDEFEDF0EDF1EDF2EDF3EDF4EDF5EDF6EDF7EDF8EDF9EDEDEDFBEDFCFFFF"
    strOutTBL(9) = "EE40EE41EE42EE43EE44EE45EE46EE47EE48EE49EE4AEE4BEE4CEE4DEE4EEE4FEE50EE51EE52EE53EE54EE55EE56EE57EE58EE59EE5AEE5BEE5CEE5DEE5EEE5FEE60EE61EE62EE63EE64EE65EE66EE67EE68EE69EE6AEE6BEE6CEE6DEE6EEE6FEE70EE71EE72EE73EE74EE75EE76EE77EE78EE79EE7AEE7BEE7CEE7DEE7EFFFF"
    strOutTBL(10) = "EE80EE81EE82EE83EE84EE85EE86EE87EE88EE89EE8AEE8BEE8CEE8DEE8EEE8FEE90EE91EE92EE93EE94EE95EE96EE97EE98EE99EE9AEE9BEE9CEE9DEE9EFFFF"
    strOutTBL(11) = "EE9FEEA0EEA1EEA2EEA3EEA4EEA5EEA6EEA7EEA8EEA9EEAAEEABEEACEEADEEAEEEAFEEB0EEB1EEB2EEB3EEB4EEB5EEB6EEB7EEB8EEB9EEBAEEBBEEBCEEBDEEBEEEBFEEC0EEC1EEC2EEC3EEC4EEC5EEC6EEC7EEC8EEC9EECAEECBEECCEECDEECEEECFEED0EED1EED2EED3EED4EED5EED6EED7EED8EED9EEDAEEDBEEDCEEDDEEDEEEDFEEE0EEE1EEE2EEE3EEE4EEE5EEE6EEE7EEE8EEE9EEEAEEEBEEECEEEDEEEEEEEFEEF0EEF1EEF2EEF3EEF4EEF5EEF6EEF7EEF8EEF9EEFAEEFBEEFCFFFF"
    strOutTBL(12) = "EF40EF41EF42EF43EF44EF45EF46EF47EF48EF49EF4AEF4BEF4CEF4DEF4EEF4FEF50EF51EF52EF53EF54EF55EF56EF57EF58EF59EF5AEF5BEF5CEF5DEF5EEF5FEF60EF61EF62EF63EF64EF65EF66EF67EF68EF69EF6AEF6BEF6CEF6DEF6EEF6FEF70EF71EF72EF73EF74EF75EF76EF77EF78EF79EF7AEF7BEF7CEF7DEF7EFFFF"
    strOutTBL(13) = "EF80EF81EF82EF83EF84EF85EF86EF87EF88EF89EF8AEF8BEF8CEF8DEF8EEF8FEF90EF91EF92EF93EF94EF95EF96EF97EF98EF99EF9AEF9BEF9CEF9DEF9EFFFF"
    strOutTBL(14) = "EF9FEFA0EFA1EFA2EFA3EFA4EFA5EFA6EFA7EFA8EFA9EFAAEFABEFACEFADEFAEEFAFEFB0EFB1EFB2EFB3EFB4EFB5EFB6EFB7EFB8EFB9EFBAEFBBEFBCEFBDEFBEEFBFEFC0EFC1EFC2EFC3EFC4EFC5EFC6EFC7EFC8EFC9EFCAEFCBEFCCEFCDEFCEEFCFEFD0EFD1EFD2EFD3EFD4EFD5EFD6EFD7EFD8EFD9EFDAEFDBEFDCEFDDEFDEEFDFEFE0EFE1EFE2EFE3EFE4EFE5EFE6EFE7EFE8EFE9EFEAEFEBEFECEFEDEFEEEFEFEFF0EFF1EFF2EFF3EFF4EFF5EFF6EFF7EFF8EFF9EFFAEFFBEFFCFFFF"
    
End Sub

以上です。
かなり無理やりなコーディングですが、この方法以外思いつかなかったので・・・。
解決策、他に良い方法があれば御教授ください。

どうか宜しくお願いいたします。

投稿時間: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

投稿時間:2004/02/25(Wed) 16:59
投稿者名:澤田
Eメール:
URL :
タイトル:
【追加質問】文字コード変換について
ak様、判り易いサンプルありがとうございます。
いただいたサンプルを実行してみたところ、SELECT CASEのところで、
入力コードが左右反転してしまっていて&HF040に引っかからなかった
ので、
iValue = CInt("&H" + RightB(Hex(iValue), 4) + LeftB(Hex(iValue), 4))
で左右反転をさせ、SELECT CASEにひっかけて、判定後
iRet = CInt("&H" + RightB(Hex(iRet), 4) + LeftB(Hex(iRet), 4))
とし、元に戻したところ、うまくコード変換することが出来ました。

すごく助かりました。
本当にありがとうございます。

ところで、新たな疑問が出来ました。
書き忘れていたのですが、入力出力とも1,2バイト混在なのです。
入力データで
/*****************/

1
20

/*****************/

を読むと、

/*****************/
あレ&#62863;」20モィあ
/*****************/
と出力されました。

調べると、以下の現象が起きていました。
 ・"0D0A"(改行コード)が"A0D"で取得されていました。
  左右反転だと"0A0D"が正常だと思うのですが、前0(ゼロ)が
  きられているように見えます。
 ・"310D0A"(1 + 改行コード + 2)が"D31" "320A"で取得され
  ていました。
  本来なら"3100" "0A0D"と読ませたいのですが・・・

以上、1バイトコードの制御をしていない為の現象だとはわかる
のですが、そもそもなぜ文字コードが左右反転するのか、前0(ゼロ)
が削除されるのかが理解できません。
またバイナリで処理をする場合、1バイトか2バイトかはどのよう
にして見分ければよいのでしょうか?
INPUTで1文字ずつ読んでそれをINT型に変換すればよいのでしょうか?

初歩的な入出力の問題で申し訳ありませんが、ご教授いただけます
でしょうか。

よろしくお願い致します。

> こんにちは。
>
> >・入力ファイルをバイナリで読む。
> >・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

投稿時間:2004/02/25(Wed) 17:39
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Re: 【追加質問】文字コード変換について
> そもそもなぜ文字コードが左右反転するのか、
リトルエンディアンだから……とか?

> 前0(ゼロ)が削除されるのかが理解できません。
「Hex(10)」は、単に「A」に変換されます。
「000A」でも「0A」でもありません。

先頭に0を付加させたいなら、
  A = Right("00" & Hex(値), 2)    '2桁の16進数表記(00〜FF)にする場合
  B = Right("0000" & Hex(値), 4)  '4桁の16進数表記(0000〜FFFF)にする場合
という感じで処理すれば良いかと思います。

投稿時間:2004/02/26(Thu) 09:27
投稿者名:澤田
Eメール:cs8h_trmr@hotmail.com
URL :
タイトル:
【解決】文字コード変換について
返答遅れてすいません。
魔界の仮面弁士様ありがとうございます。

その他疑問点は色々あるのですが、自分で何とかなりそうなのでがんばってみます。
調べてみてわからなかったらまた質問させてください。

有難うございました。
助かりました。

> > そもそもなぜ文字コードが左右反転するのか、
> リトルエンディアンだから……とか?
>
> > 前0(ゼロ)が削除されるのかが理解できません。
> 「Hex(10)」は、単に「A」に変換されます。
> 「000A」でも「0A」でもありません。
>
> 先頭に0を付加させたいなら、
>   A = Right("00" & Hex(値), 2)    '2桁の16進数表記(00〜FF)にする場合
>   B = Right("0000" & Hex(値), 4)  '4桁の16進数表記(0000〜FFFF)にする場合
> という感じで処理すれば良いかと思います。