Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年12月13日] [更新 2014年04月16日]　Delphi サンプルプログラム集
   
887_ADODBStream を使用した文字コードの変換
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
887_ADODBStream.zip　[2,293 KB]　2014年04月16日版 (EXE 同梱)



  • 2014年04月16日
  • Windows 7 U64(SP1) + Delphi XE Pro で動作確認
  • キャンセル機能付きのサンプルは，TMemo にテキストを描画する速度と大差ないので削除
  • ADODBStream の生成を，ADOInt ユニットを使用する方法に変更



ADODB.Stream を使用した文字コードの変換


Microsoft Data Access Components(MDAC) が提供しているオブジェクトに ADO があります．
この ADO の ADODB.Stream を使用した文字コードの変換のサンプルです．ADODB.Stream を使用するには，uses に ADOInt を追加します．
MDAC は，Windows Vista では OS の一部として提供されるようになり，単独のインストールはできなくなっているようです．機能的には Ver2.8 相当のようです．
なお，このページのサンプルコードでは，Big-Endian への変換はできません．



Delphi 2009 以降では，テキストファイルの保存の時に TEncoding を使用して，コードページを指定することができます．また，以下のリンクの記事のように，指定コードページ (文字コード) の文字列型を定義して文字列を処理てきるようになり，文字コードの変換が簡単にできます．
本ページのようなサンプルコードを利用する必要性はほとんどないでしょう．





01_ADODB.Stream で使用可能な 文字コード ( コードページ ) 一覧


ADODB.Stream では，文字のコードページではなく，Charset の文字列を使用します．この Charset の一覧は，レジストリの次の場所にあります． 

    HKEY_CLASSES_ROOT\MIME\Database\Charset


本サンプルは，レジストリからこれらの値を取得して，各々のキーの内容を表示します．
また，各々 Charset に相当する言語名があれば，それを MLang の機能を使用して取得します．


  • 図1
  • ADODB.Stream で使用可能な文字セットがある場所

下図は実行結果です．上の TListBox の項目をクリックすると，その Charset の文字コードセット名等を，下の TMemo に表示します．


図2
設計時画面
図3
一覧表示
  • 上が Charset の一覧
  • 下は各 Charset のキー名とその値
  • 空欄は定義されていないもの
  • 言語名は Mlang から取得した値

リスト1
ADODB.Stream で使用可能な Charset の一覧 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Registry;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MultiLanguage_TLB;

{$R *.dfm}

//=============================================================================
//  ADODB.StreamのCharsetプロパティで使用可能なCharset名をリスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Registry      : TRegistry;
  RegKey        : String;
  slCharsetList : TStringList;
begin
  slCharsetList := TStringList.Create;
  slCharsetList.Clear;
  slCharsetList.Sorted := True;

  //レジストリから文字コードの情報を取得してリストに格納
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_CLASSES_ROOT;

    RegKey := '\mime\database\Charset\';
    Registry.OpenKey(RegKey, False);
    Registry.GetKeyNames(slCharsetList);
    Registry.CloseKey;
    Listbox1.Items.Assign(slCharsetList);
  finally
     Registry.Free;
     FreeAndNil(slCharsetList);
  end;
end;

//=============================================================================
//  Listbox1で選択したCharssetのレジストリ内の情報を取得して表示
//  MLangの機能を使用して言語名も取得
//
//  以下のキーがあるが，定義されていないものもある
//  CodePage
//  InternetEncoding
//  AliasForCharset
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  Registry   : TRegistry;
  RegKey     : String;
  AIndex     : Integer;
  TempStr    : String;
  CodePage   : Integer;
  IECodePage : Integer;
  MLang      : IMultiLanguage;
  MIMECPInfo : TMIMECPINFO;
  strLocale  : String;
begin
  AIndex := ListBox1.ItemIndex;
  if AIndex<0 then exit;

  Memo1.Lines.Clear;

  Memo1.Lines.Add('Charset          : ' + ListBox1.Items[ListBox1.ItemIndex]);

  RegKey   := '\mime\database\Charset\';
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_CLASSES_ROOT;
    try
      Registry.OpenKey(RegKey+ ListBox1.Items[AIndex], False);
      CodePage := Registry.ReadInteger('CodePage');
      Memo1.Lines.Add('CodePage         : ' + IntToStr(CodePage));
    except
      Memo1.Lines.Add('CodePage         : ');
    end;

    IECodePage := -1;
    try
      Registry.OpenKey(RegKey+ ListBox1.Items[AIndex], False);
      IECodePage := Registry.ReadInteger('InternetEncoding');
      Memo1.Lines.Add('InternetEncoding : ' + IntToStr(IECodePage));
    except
      Memo1.Lines.Add('InternetEncoding : ');
    end;

    try
      Registry.OpenKey(RegKey+ ListBox1.Items[AIndex], False);
      TempStr := Registry.ReadString('AliasForCharset');
      Memo1.Lines.Add('AliasForCharset  : ' + TempStr);
    except
      Memo1.Lines.Add('AliasForCharset  : ');
    end;

    Registry.CloseKey;

    //言語名があれば取得
    //InternetEncodingの値から取得
    if IECodePage >= 0 then begin
      //mlangのオブジェクトを生成
      MLang := CoCMultiLanguage.Create;
      try
        MLang.GetCodePageInfo(IECodePage, MIMECPInfo);
        strLocale := MIMECPInfo.wszDescription;
      finally
        MLang := nil;
      end;
    end;
    Memo1.Lines.Add('Locale           : ' + strLocale);
  finally
     Registry.Free;
  end;
end;

end.



02_ADODB.Stream を使用した文字コード変換サンプル


文字コード変換のテストプログラムです．添付のテキストファイル専用のコードとなっています．
変換元の文字コードが既知の場合の参考です．ファイルからテキストを読み出す時に，そのテキストの文字コードを指定して読み出します．保存の時も，変換後の文字コードを指定して保存します．



図4
設計時画面
図5
実行
  • [Read File] ボタンをクリックしてファイルを選択
  • [Read File]ボタンの下の表示は読出した文字コード
図6
添付のテスト用テキストファイル
  • 文字コードの名前にしている

リスト2
ADODB.Stream を使用した文字コード変換のテスト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ADOInt;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    Panel1: TPanel;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
  private
    { Private 宣言 }
    ADOReadStream : ADOInt._Stream;
    ReadFileName  : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ActiveX;

{$R *.dfm}

//=============================================================================
//  ADODB.Streamオブジェクトを生成して開く
//  ADOReadStream : テキストファイルから読出した内容を保持
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //変換元のテキストを読込むADOBD.Streamを生成して開く
  ADOReadStream := CoStream.Create;
  ADOReadStream.Open(EmptyParam, 0, adOpenStreamUnspecified, '', '');

  SpeedButton1.Enabled := False;
  SpeedButton2.Enabled := False;
  SpeedButton3.Enabled := False;
  SpeedButton5.Enabled := False;
  SpeedButton6.Enabled := False;
end;

//=============================================================================
//  使用したStreamオブジェクトを閉じて無効に
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ADOReadStream.Close;
  ADOReadStream := nil;
end;

//=============================================================================
//  OpenDialog1でテキストファイルを選択し
//  変換元のテキストをStreamオブジェクトに(ADOReadStream)に読込む
//  変換元のテキストファイルは，BeforeFileフォルダ
//  変換後のテキストファイルの保存先はChangedFileフォルダ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFileName : String;
begin
  OpenDialog1.InitialDir := ExpandFileName('../BeforeFile');

  if OpenDialog1.Execute then begin
    Update;
    Panel1.Caption := '';
    ReadFileName := OpenDialog1.FileName;

    //テストなのでファイル名に応じた変換元文字コードをセット
    AFileName := ExtractFileName(ReadFileName);
    if AFileName = 'EUC.txt'    then Panel1.Caption := 'euc-jp';
    if AFileName = 'JIS.txt'    then Panel1.Caption := 'iso-2022-jp';
    if AFileName = 'S-JIS.txt'  then Panel1.Caption := 'shift_jis';
    if AFileName = 'UNI-BE.txt' then Panel1.Caption := 'unicodeFFFE';
    if AFileName = 'UNI-LE.txt' then Panel1.Caption := 'unicode';
    if AFileName = 'UTF-8.txt'  then Panel1.Caption := 'utf-8';

    if Panel1.Caption = '' then begin
      Application.MessageBox('添付のファイル専用のテストです', '結果');
    end else begin
      //Streamオブジェクトは読みこむ前に文字コードを設定し読込み位置を0に
      ADOReadStream.Position := 0;
      ADOReadStream.Charset  := Panel1.Caption;
      ADOReadStream.LoadFromFile(ReadFileName);

      SpeedButton1.Enabled := True;
      SpeedButton2.Enabled := True;
      SpeedButton3.Enabled := True;
      SpeedButton5.Enabled := True;
      SpeedButton6.Enabled := True;
    end;
  end;
end;

//=============================================================================
//  ECUへの変換
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  ADOSaveStream : ADOInt._Stream;
  SaveFileName  : String;
begin
  //保存ファイル名を作成
  //読出したファイル名の後ろに_to_ECUを付加
  SaveFileName := ExpandFileName('../ChangedFile') + PathDelim
                  + ChangeFileExt(ExtractFileName(ReadFileName), '')
                  + '_to_ECU.txt';

  Screen.Cursor := crHourGlass;
  //変換先のADODB.Streamを生成して開く
  ADOSaveStream := CoStream.Create;
  try
　　ADOSaveStream.Open(EmptyParam, adModeUnknown, adOpenStreamUnspecified, '', '');
    //変換後のテキストを入れるStreamオブジェクトの設定
    //位置を0にして文字コードを設定
    ADOSaveStream.Position := 0;
    ADOSaveStream.Charset  := 'euc-jp';

    //変換元の読出し位置を0にする
    ADOReadStream.Position := 0;
    //CopyToメソッドを実行すると，出力先のStreamに変換された文字が格納される
    ADOReadStream.CopyTo(ADOSaveStream, -1);
    //保存する
    ADOSaveStream.SaveToFile(SaveFileName, adSaveCreateOverWrite);
  finally
    ADOSaveStream.Close;
    ADOSaveStream := nil;
    Screen.Cursor := crDefault;
  end;
end;

//=============================================================================
//  JISへの変換
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  ADOSaveStream : ADOInt._Stream;
  SaveFileName  : String;
begin
  //保存ファイル名を作成
  //読出したファイル名の後ろに_to_ECUを付加
  SaveFileName := ExpandFileName('../ChangedFile') + PathDelim
                  + ChangeFileExt(ExtractFileName(ReadFileName), '')
                  + '_to_JIS.txt';

  Screen.Cursor := crHourGlass;
  //変換先のADODB.Streamを生成して開く
  ADOSaveStream := CoStream.Create;
  try
　　ADOSaveStream.Open(EmptyParam, adModeUnknown, adOpenStreamUnspecified, '', '');
    //変換後のテキストを入れるStreamオブジェクトの設定
    //位置を0にして文字コードを設定
    ADOSaveStream.Position := 0;
    ADOSaveStream.Charset  := 'iso-2022-jp';

    //変換元の読出し位置を0にする
    ADOReadStream.Position := 0;
    //CopyToメソッドを実行すると，出力先のStreamに変換された文字が格納される
    ADOReadStream.CopyTo(ADOSaveStream, -1);
    //保存する
    ADOSaveStream.SaveToFile(SaveFileName, adSaveCreateOverWrite);
  finally
    ADOSaveStream.Close;
    ADOSaveStream := nil;
    Screen.Cursor := crDefault;
  end;
end;

//=============================================================================
//  Shit-JISへの変換
//=============================================================================
procedure TForm1.SpeedButton3Click(Sender: TObject);
var
  ADOSaveStream : ADOInt._Stream;
  SaveFileName  : String;
begin
  //保存ファイル名を作成
  //読出したファイル名の後ろに_to_ECUを付加
  SaveFileName := ExpandFileName('../ChangedFile') + PathDelim
                  + ChangeFileExt(ExtractFileName(ReadFileName), '')
                  + '_to_S-JIS.txt';

  Screen.Cursor := crHourGlass;
  //変換先のADODB.Streamを生成して開く
  ADOSaveStream := CoStream.Create;
  try
　　ADOSaveStream.Open(EmptyParam, adModeUnknown, adOpenStreamUnspecified, '', '');
    //変換後のテキストを入れるStreamオブジェクトの設定
    //位置を0にして文字コードを設定
    ADOSaveStream.Position := 0;
    ADOSaveStream.Charset  := 'shift_jis';

    //変換元の読出し位置を0にする
    ADOReadStream.Position := 0;
    //CopyToメソッドを実行すると，出力先のStreamに変換された文字が格納される
    ADOReadStream.CopyTo(ADOSaveStream, -1);
    //保存する
    ADOSaveStream.SaveToFile(SaveFileName, adSaveCreateOverWrite);
  finally
    ADOSaveStream.Close;
    ADOSaveStream := nil;
    Screen.Cursor := crDefault;
  end;
end;

//=============================================================================
//  UTF-16 Unicode(Little-Endian)への変換
//=============================================================================
procedure TForm1.SpeedButton5Click(Sender: TObject);
var
  ADOSaveStream : ADOInt._Stream;
  SaveFileName  : String;
begin
  //保存ファイル名を作成
  //読出したファイル名の後ろに_to_ECUを付加
  SaveFileName := ExpandFileName('../ChangedFile') + PathDelim
                  + ChangeFileExt(ExtractFileName(ReadFileName), '')
                  + '_to_UNI-LE.txt';

  Screen.Cursor := crHourGlass;
  //変換先のADODB.Streamを生成して開く
  ADOSaveStream := CoStream.Create;
  try
　　ADOSaveStream.Open(EmptyParam, adModeUnknown, adOpenStreamUnspecified, '', '');
    //変換後のテキストを入れるStreamオブジェクトの設定
    //位置を0にして文字コードを設定
    ADOSaveStream.Position := 0;
    ADOSaveStream.Charset  := 'unicode';

    //変換元の読出し位置を0にする
    ADOReadStream.Position := 0;
    //CopyToメソッドを実行すると，出力先のStreamに変換された文字が格納される
    ADOReadStream.CopyTo(ADOSaveStream, -1);
    //保存する
    ADOSaveStream.SaveToFile(SaveFileName, adSaveCreateOverWrite);
  finally
    ADOSaveStream.Close;
    ADOSaveStream := nil;
    Screen.Cursor := crDefault;
  end;
end;

//=============================================================================
//  UTF-8への変換
//=============================================================================
procedure TForm1.SpeedButton6Click(Sender: TObject);
var
  ADOSaveStream : ADOInt._Stream;
  SaveFileName  : String;
begin
  //保存ファイル名を作成
  //読出したファイル名の後ろに_to_ECUを付加
  SaveFileName := ExpandFileName('../ChangedFile') + PathDelim
                  + ChangeFileExt(ExtractFileName(ReadFileName), '')
                  + '_to_UTF-8.txt';

  Screen.Cursor := crHourGlass;
  //変換先のADODB.Streamを生成して開く
  ADOSaveStream := CoStream.Create;
  try
　　ADOSaveStream.Open(EmptyParam, adModeUnknown, adOpenStreamUnspecified, '', '');
    //変換後のテキストを入れるStreamオブジェクトの設定
    //位置を0にして文字コードを設定
    ADOSaveStream.Position := 0;
    ADOSaveStream.Charset  := 'utf-8';

    //変換元の読出し位置を0にする
    ADOReadStream.Position := 0;
    //CopyToメソッドを実行すると，出力先のStreamに変換された文字が格納される
    ADOReadStream.CopyTo(ADOSaveStream, -1);
    //保存する
    ADOSaveStream.SaveToFile(SaveFileName, adSaveCreateOverWrite);
  finally
    ADOSaveStream.Close;
    ADOSaveStream := nil;
    Screen.Cursor := crDefault;
  end;
end;

end.



03_文字コードの自動判定による変換


読み出すテキストの文字コードを自動判定するテストです．
Charset に _autodetect または _asutodetect_all を指定して読み出します．保存は上のサンプルと全く同じです．
文字のコードページの判定は，テキスト内の「文字コード」を判定していくことになりますが，調査する文字数が多いほど確実になります．おそらく _all というのは，全ての文字を調べ上げるのではないかと思われます．


図7
設計時画面
図8
実行
  • [Read File] ボタンをクリックしてファイルを選択

リスト3
文字コードの自動判定による文字コード変換
このコード以外は，上のサンプルと全く同じ		 
//=============================================================================
//  OpenDialog1でテキストファイルを選択し
//  変換元のテキストをStreamオブジェクトに(ADOReadStream)に読込む
//  変換元のテキストファイルは，BeforeFileフォルダ
//  変換後のテキストファイルの保存先はChangedFileフォルダ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExpandFileName('../BeforeFile');

  if OpenDialog1.Execute then begin
    Update;
    ReadFileName := OpenDialog1.FileName;

    //Streamオブジェクトは読みこむ前に文字コードを設定し読込み位置を0に
    ADOReadStream.Position := 0;
    if CheckBox1.Checked then begin
      ADOReadStream.Charset  := '_autodetect_all';
    end else begin
      ADOReadStream.Charset  := '_autodetect';
    end;
    ADOReadStream.LoadFromFile(ReadFileName);

    SpeedButton1.Enabled := True;
    SpeedButton2.Enabled := True;
    SpeedButton3.Enabled := True;
    SpeedButton5.Enabled := True;
    SpeedButton6.Enabled := True;
  end;
end;



04_任意の文字コードのテキストをコントロールに表示


コントロールに，読み出したテキストを表示する例です．実際には，コントロールの Text プロパティに等に代入する際に，そのコントロールの文字コードに変換されることになります．


図9
設計時画面
図10
添付のテキストファイルを表示

リスト4
コントロールに読み出したテキストを表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ADOInt, ActiveX;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ADODB.Stremを利用した文字コードの変換サンプル
//  直接コントロールに読み込む場合
//
//  OpenDialog1でテキストファイルを選択し
//  読み込むテキストファイルはBeforeFileフォルダ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADOReadStream : ADOInt._Stream;
  ReadFileName  : String;
begin
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Clear;

  OpenDialog1.InitialDir := ExpandFileName('../BeforeFile');

  if OpenDialog1.Execute then begin
    Update;
    Screen.Cursor := crHourGlass;
    ReadFileName := OpenDialog1.FileName;

    //変換元のADOBD.Streamを生成して開く
    ADOReadStream := CoStream.Create;
    try
      ADOReadStream.Open(EmptyParam, 0, adOpenStreamUnspecified, '', '');
      //文字コード指定
      if CheckBox1.Checked then begin
        ADOReadStream.Charset := '_autodetect_all';
      end else begin
        ADOReadStream.Charset := '_autodetect';
      end;

      //ファイルから読出す
      ADOReadStream.LoadFromFile(ReadFileName);
      //Memo1に表示(Memo1の文字コードに変換される)
      Memo1.Text := ADOReadStream.ReadText(-1);
    finally
      ADOReadStream.Close;
      ADOReadStream := nil;
      Screen.Cursor := crDefault;
    end;
  end;
  Memo1.Lines.EndUpdate;
end;

end.