FreeBASIC マニュアルのトップに戻る

FreeBASIC Encoding ShiftJIS

目次→ランタイム・ライブラリー参考→ファイル入出力関連→文字を符号化→ENCODING←オリジナル・ページ

ENCODING(付録) ShiftJIS 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい


 渡辺注:日本語(全角)文字列の文字コードの ShiftJIS ⇔ UNICODE(utf-16) 変換方法を紹介するために、このページを挿入しています。

 別に、Window9 の AsciiToUtf と UtfToAscii を使ったバージョン もあります。


 下の例は、文字コードの ShiftJIS のテキスト・ファイルを読み込みこんで、UNICODE(utf-16) に変換して、別名で、UNICODE(utf-16) のテキスト・ファイルとして保存します。
 そして、このUNICODE(utf-16) のテキスト・ファイルを読み込んで、確認のため、再度、別名で、ShiftJIS のテキスト・ファイルとして書き出します。

 最初に読み込んだ、ShiftJIS のテキスト・ファイルと、最後に書き出した ShiftJIS のテキスト・ファイルを比較して、差異の無いことを確認して下さい。

 文字コードの ShiftJIS ⇔ UNICODE(utf-16) 変換方法は、2ちゃんねるの、「デフォルトの名無し」さんに、教えて頂きました。

 下の例は、プログラムのコード中の文字(直定数)を使っていないので、このプログラムを、★UNICODE(utf-16)★で保存しても、 ★ShiftJIS★で保存しても、同じ働きをします。

 対象のテキスト・ファイルを選択するために、ファイルを開くダイアログを使っています。

'EncodingShiftJISFile2Unicode2ShiftJIS_Window9.bas

'' ★このプログラムは、★UNICODE(utf-16)★で保存しても、
'' ★ShiftJIS★で保存しても、同じ働きをします。★
''
'' このプログラムは、以下の動作を想定します。
''
'' 1) 指定した、ShiftJIS のテキスト・ファイルを読み込みます。
''    これを、UNICODE(utf-16) に変換して、ファイル出力します。
''
'' 2) 検証のため、UNICODE(utf-16) で出力したファイルを読み返します。
''    これを、ShiftJIS に再変換して、ファイル出力します。
''
'' 対象のテキスト・ファイルは、ファイルを開くダイアログで指定します。
'' ファイルを開くダイアログは、Window9 ライブラリを使っています。
'' http://free-basic.ru/window9lib/Window9.html
'' 変換後のファイルは、同じフォルダに別名で保存されます。

'************ ファイルを開くダイアログ部分に Window9 を使う *******************
#Include "window9.bi"


' ************ テキスト・ファイルを文字コード変換する部分********
#Include Once "windows.bi"
#Include Once "crt/stdlib.bi"

Extern "c"
Declare Function setlocale (ByVal As Integer, ByVal As ZString Ptr) As ZString Ptr
End Extern

Dim fName As String     '★拡張子無しのファイル名
Dim extension As String '★拡張子部分(例:.txt)
Dim e As Integer        'エラー
Dim FullPass As String  '対象ファイルのフルパス  

Dim MaxWString As Integer
Dim MaxString As Integer
Dim LenWString As Integer
Dim LenString As Integer  

Const twoByteLength As Integer = 3000 '1行の文字数を、全角3000文字と想定
Const oneByteLength As Integer = 6000 '1行の文字数を、半角6000文字と想定

'********************* Window9 のファイルを開くダイアログを使う *********************
   ''FileOpen
   FullPass = OpenFileRequester("ソートするファイルを指定","C:\test\","テキストファイル(*.txt;*.csv;*.htm*)"_
+Chr(0)+"*.txt;*.csv;*.htm*"+Chr(0)+"全てのファイル(*.*)"+Chr(0)+"*.*"+Chr(0))

   fName = Left(FullPass,InStrRev(FullPass,".") -1)  '対象のテキストファイルのフルパスの、拡張子無し部分
   extension = Right(FullPass,Len(FullPass) - InStrRev(FullPass,".") +1) '対象テキストファイルのドット付き拡張子部分


''
Scope
'************** ShiftJIS から UNICODE(utf-16) ************************
  Dim Japanese As String
  Dim JapaneseW As WString * twoByteLength '★一行の文字数を、全角3000文字(半角6000文字)までと想定
  
  setlocale(0, "jpn")
  
  '' ShiftJIS コードで、入力のためのファイルを開きます。
  Open fName & extension For Input  As #1
  
  '' utf-16 コードで出力するためのファイルを開きます。
  Open fName & "_UNICODE" & extension For Output Encoding "utf-16" As #2
  
  Do Until EOF( 1 )   
     '' 一行ずつテキストを読みます。
     Line Input #1, Japanese

     '日本語マルチバイトからワイドに変換
     MbsToWcs(@JapaneseW, Japanese, twoByteLength)
     'そして、出力します。
     Print #2, JapaneseW
     LenWString = Len(RTrim(JapaneseW))
     If MaxWString < LenWString Then
        MaxWString = LenWString
     EndIf

     JapaneseW = ""           '固定長なので、内容を消去します
  Loop
  
  Close #1
  Close #2
  
End Scope

''
''
Scope
'************** UNICODE(utf-16) から ShiftJIS ************************
  Dim JapaneseW2 As WString * twoByteLength
  Dim JapaneseF As String * oneByteLength '★固定長にする点が、ポイント★
  Dim Japanese As String
  
  e = Err
  Print e

  '' UNICODE(utf-16)で、入力のためのファイルを開きます。
  Open fName & "_UNICODE" & extension   For Input Encoding "utf-16" As #1
  '' 文字列は、UNICODE(utf-16)と認識されます。
  
  '' ShiftJIS コードで出力するためのファイルを開きます。
  Open fName & "_ShiftJIS" & extension   For Output As #2
  
  Do Until EOF( 1 )   
     '' 一行ずつテキストを読みます。
      Line Input #1, JapaneseW2

      'ワイドから、日本語マルチバイトに変換
      WcsToMbs(JapaneseF, @JapaneseW2, oneByteLength)
      Japanese = RTrim(JapaneseF)    '★右側の不要な空白とヌルを除外して可変長の String に移す★
     'そして、出力します。
      Print #2, Japanese
      LenString = Len(Japanese)
      If MaxString < LenString Then
         MaxString = LenString
      EndIf
      JapaneseF = ""                 '固定長なので、内容を消去します
  Loop
  
  Close #1
  Close #2
  
End Scope

''
Print "Expected MaxWString(twoByteLength) =" ; twoByteLength ; " Actual MaxWString=" ; MaxWString
Print "Expected MaxString (oneByteLength) =" ; oneByteLength ; " Actual MaxString =" ; MaxString
Print "処理を終了しました。何かキーを押して下さい。"

Sleep

 解説:
setlocale 関数に使う言語識別文字列は、以下の通りです。
http://msdn.microsoft.com/ja-jp/library/39cwe7zf(v=vs.80).aspx
オペレーティング システムがサポートしていない言語は setlocale で使用できません。
3 文字の言語文字列コードは Windows 98、Windows Me、Windows NT、Windows 2000、および Windows XP だけで有効です。
主言語副言語言語識別文字列
中国語中国語"chinese"
中国語中国語 (簡体字)"chinese-simplified" または "chs"
中国語中国語 (繁体字)"chinese-traditional" または "cht"
チェコ語チェコ語"csy" または "czech"
デンマーク語デンマーク語"dan" または "danish"
オランダ語オランダ語 (既定)"dutch" または "nld"
オランダ語オランダ語 (ベルギー)"belgian"、"dutch-belgian"、または "nlb"
英語英語 (既定)"english"
英語英語 (オーストラリア)"australian"、"ena"、または "english-aus"
英語英語 (カナダ)"canadian"、"enc"、または "english-can"
英語英語 (ニュージーランド)"english-nz" または "enz"
英語英語 (英国)"eng"、"english-uk"、または "uk"
英語英語 (米国)"american"、"american english"、"american-english"
、"english-american"、"english-us"、"english-usa"、"enu"、"us"、または "usa"
フィンランド語フィンランド語"fin" または "finnish"
フランス語フランス語 (既定)"fra" または "french"
フランス語フランス語 (ベルギー)"frb" または "french-belgian"
フランス語フランス語 (カナダ)"frc" または "french-canadian"
フランス語フランス語 (スイス)"french-swiss" または "frs"
ドイツ語ドイツ語 (既定)"deu" または "german"
ドイツ語ドイツ語 (オーストリア)"dea" または "german-austrian"
ドイツ語ドイツ語 (スイス)"des"、"german-swiss"、または "swiss"
ギリシャ語ギリシャ語"ell" または "greek"
ハンガリー語ハンガリー語"hun" または "hungarian"
アイスランド語アイスランド語"icelandic" または "isl"
イタリア語イタリア語 (既定)"ita" または "italian"
イタリア語イタリア語 (スイス)"italian-swiss" または "its"
日本語日本語"japanese" または "jpn"
韓国語韓国語"kor" または "korean"
ノルウェー語ノルウェー語 (既定)"norwegian"
ノルウェー語ノルウェー語 (ブークモール)"nor" または "norwegian-bokmal"
ノルウェー語ノルウェー語 (ニーノシク)"non" または "norwegian-nynorsk"
ポーランド語ポーランド語"plk" または "polish"
ポルトガル語ポルトガル語 (既定)"portuguese" または "ptg"
ポルトガル語ポルトガル語 (ブラジル)"portuguese-brazilian" または "ptb"
ロシア語ロシア語 (既定)"rus" または "russian"
スロバキア語スロバキア語"sky" または "slovak"
スペイン語スペイン語 (既定)"esp" または "spanish"
スペイン語スペイン語 (メキシコ)"esm" または "spanish-mexican"
スペイン語スペイン語 (現代)"esn" または "spanish-modern"
スウェーデン語スウェーデン語"sve" または "swedish"
トルコ語トルコ語"trk" または "turkish"


 下の例は、青空文庫のルビ表記を、html の「ルビタグ」に変換するものです。
' 変換前のテキスト(Shift-JIS の html) は、ファイル名を、「mae.html」 として、C ドライブの test フォルダに登録します。
' 変換後のテキスト(Shift-JIS の html) は、同一フォルダに、「ato_Riby.html」というファイル名で作られます。
 このプログラムは、ソース中の文字定数を「UNICODE」として扱うため、コード(.bas ファイル)は、UNICODE で保存して下さい。
サンプルのテキスト・ファイルと、ソースは、ここでダウンロードできます。→RubyTagForFB_UNICODE.zip


' ★このプログラム・コードは、★UNICODE★ で保存して下さい。★

#Include Once "windows.bi"
#Include Once "crt/stdlib.bi"

Extern "c"
Declare Function setlocale (ByVal As Integer, ByVal As ZString Ptr) As ZString Ptr
End Extern

setlocale(0, "jpn")
  

Dim InputFile As String
Dim OutputFile As String
Dim InputLine As String
Dim InputLineW As WString * 10000
Dim OutputLineF As String * 10000
Dim OutputLineW As WString * 10000
Dim OutputLine As String


Dim bodyFlag As Integer
Dim ProcessingLineCounter As Integer

Dim StartTime As Long
Dim EndTime As Long

Declare Sub HonbunSyori (OutputLineW As WString, InputLineW As WString)

   
'Width 120, 30 '幅を120、高さを30行に広げます

InputFile="c:\test\mae.html"
OutputFile="c:\test\ato_Ruby.html"

    
Print Time
StartTime=Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))


'********************************
'ファイルのオープン。
bodyFlag = 0
ProcessingLineCounter = 0

Open InputFile For Input As #1
Open OutputFile For Output As #2
'*************データの読み込み***********
While (Eof(1) = 0)
   ProcessingLineCounter = ProcessingLineCounter + 1
   Line Input #1, InputLine
    
    
   ''日本語マルチバイトからワイドに変換
   MbsToWcs(@InputLineW, InputLine, 10000)
     
   InputLineW = RTrim(InputLineW)
    

    
   OutputLineW = InputLineW
    
   If InStr (InputLineW, "</body>") > 0 Then
        bodyFlag = 0
   End If
    
   If bodyFlag = 1 Then
'       本文処理  '★★★★★★★★★
'        Print InputLineW & Space(Len(InputLineW))
        HonbunSyori (OutputLineW , InputLineW )
   End If
      
   If InStr (InputLineW, "<body") > 0 Then
        bodyFlag = 1
   End If
    
    
   'ワイドから、日本語マルチバイトに変換
   WcsToMbs(OutputLineF, @OutputLineW, 10000)
   OutputLine = RTrim(OutputLineF)    '★右側の不要な空白とヌルを除外★
   'そして、出力します。
   Print #2, OutputLine
    
   OutputLine = ""
   OutputLineF = ""
   InputLineW = ""
   OutputLineW = ""
    
   If (ProcessingLineCounter Mod 10) = 0 Then
       Print ProcessingLineCounter , " 行目を読込み" & Space(Len(" 行目を読込み"))
   End If
       
Wend

'**************終了処理*********************
Print ProcessingLineCounter , " 最終行まで読込み完了" & Space(Len(" 最終行まで読込み完了"))
Close #1: Close #2

   Print Time
EndTime = Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))
Print "処理が終了しました。" & Space(Len("処理が終了しました。"))
Print "処理時間は、" & Space(Len("処理時間は、"));EndTime-StartTime; "秒でした。" & Space(Len("秒でした。"))
Print "何かキーを押して下さい。" & Space(Len("何かキーを押して下さい。"))
Sleep




Sub HonbunSyori (OutputLineW As WString, InputLineW As WString)
   

   Dim InputLineNumber As Integer
   Dim Figure As Integer
   Dim BackgroundFlag As Integer
   Dim RubyNumber As Integer
   Dim KanjiFlag As Integer
   Dim RubyFlag As Integer
   Dim BackgroundNumber As Integer
   Dim KanjiNumber As Integer
   
   OutputLineW = ""
   BackgroundNumber = 0
   KanjiNumber = 0
   RubyNumber = 0
   KanjiFlag = 0
   RubyFlag = 0
   BackgroundFlag = 1               '行末に > がない場合を考慮
    
   InputLineNumber = Len(InputLineW)
    
   For Figure = InputLineNumber To 1 Step -1        '文字列の後ろから、処理していく点が、ミソ
       
      If Mid(InputLineW, Figure, 1) = ">" Then      'タグ内
         BackgroundFlag = 1
      End If
    
      If RubyFlag = 1 Then
         RubyNumber = RubyNumber + 1              'ルビの文字数を数えている
      ElseIf KanjiFlag = 1 Then
         KanjiNumber = KanjiNumber + 1            '漢字の文字数を数えている
      ElseIf BackgroundFlag = 1 Then
            BackgroundNumber = BackgroundNumber + 1  'タグの文字数を数えている
      End If
      
      
      If KanjiFlag = 1 And Mid(InputLineW, Figure, 1) = "》" Then  'ルビの開始 '★★2006年6月5日追加
      
         '#Ifdef __FB_WIN32__
         '   messagebox(NULL, InputLineW ,"",MB_OK)
         '#EndIf
        
         OutputLineW = "</rt><rp>)</rp></ruby><ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
         
         KanjiNumber = 0
         KanjiFlag = 0
         
         BackgroundNumber = 0
         RubyNumber = 0     '前回のRubyNumberをリセット
         BackgroundFlag = 0
         RubyFlag = 1
        
      ElseIf Mid (InputLineW, Figure, 1) = "》" Then               'ルビの開始
           
         '#Ifdef __FB_WIN32__
         '   messagebox(NULL, InputLineW ,"",MB_OK)
         '#EndIf
           
         OutputLineW = "</rt><rp>)</rp></ruby>" & Mid(InputLineW, Figure + 1, BackgroundNumber - 1) & OutputLineW
         BackgroundNumber = 0
         RubyNumber = 0     '前回のRubyNumberをリセット
         BackgroundFlag = 0
         RubyFlag = 1
         
      ElseIf Mid(InputLineW, Figure, 1) = "《" Then         'ルビの終了
         OutputLineW = "</rb><rp>(</rp><rt>" & Mid(InputLineW, Figure + 1, RubyNumber - 1) & OutputLineW
         KanjiNumber = 0     '前回のKanjiNumberをリセット
         RubyFlag = 0
         KanjiFlag = 1
         
      ElseIf KanjiFlag = 1 And (Mid(InputLineW, Figure, 1) = "|" _
      Or Mid(InputLineW, Figure, 1) = "│") Then      '"|"JIS 8162は記号の縦線。"│"JIS 84A0は罫線の縦線
         '★ガリバー対応★★★★2006年6月5日追加
         OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
         KanjiNumber = 0
         KanjiFlag = 0
         BackgroundFlag = 1
         
      ElseIf KanjiFlag = 1 And (Mid(InputLineW, Figure, 1) = "(" _
      Or Mid(InputLineW, Figure, 1) = ")") Then       '(例)1円山応挙《まるやまおうきょ》
         '★夜明け前対応★★★★2006年6月6日追加
         OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
         KanjiNumber = 0
         KanjiFlag = 0
         BackgroundFlag = 1
         BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す
         
'        ElseIf Mid(InputLineW, Figure + 1, 1) >= "亜" And KanjiNumber > 1 _
'        And Mid(InputLineW, Figure, 1) < "亜" Then  '★つぐみ対応★★★★2006年6月5日追加
        
      ElseIf Mid(InputLineW, Figure + 1, 1) > "ヶ" And KanjiNumber > 1 _
      And Mid(InputLineW, Figure, 1) <= "ヶ" Then  '★大丈夫対応★★★★2006年6月5日追加
         OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
         KanjiNumber = 0
         KanjiFlag = 0
         BackgroundFlag = 1
         BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す
         
      ElseIf RubyNumber > 0 And KanjiNumber = RubyNumber Then
         OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
         KanjiNumber = 0
         KanjiFlag = 0
         BackgroundFlag = 1
         BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す

      ElseIf KanjiFlag = 1 And Figure = 1 Then    '行頭のKanji
         '★夜明け前対応★★★★2006年6月8日追加
         OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure, KanjiNumber) & OutputLineW
         KanjiNumber = 0
         KanjiFlag = 0

      End If
    
'       If ProcessingLineCounter = 71 Then Stop  '●●▲●●
    
   Next Figure
    
   If BackgroundFlag = 1 And BackgroundNumber > 0 Then
      OutputLineW = Mid(InputLineW, Figure + 1, BackgroundNumber) & OutputLineW
   End If
    
End Sub

参照:
ファイル入出力関連に戻る
←リンク元に戻る プログラム開発関連に戻る

ページ歴史:2012-02-24
日本語著作者:WATANABE Makoto

ホームページのトップに戻る

表示-非営利-継承