ホーム >プログラム >Delphi 6 ローテクTips

Unicodeファイル名対応LoadFromFile SaveToFile

このページはUnicodeデータの読み書きではなく、Unicode文字がファイル名にあるテキストファイルの読み書きをしようというページです。
Unicodeデータの読み書きが必要な場合はUnicode対応LoadFromFile SaveToFileをどうぞ。

始めに

例えばQueensrÿche.m3uというファイルを読み込もうと思ってもLoadFromFileではできませんしSaveToFileの場合はQueensryche.m3uという別のファイル名に変わって保存されてしまいます。
ということで、WindowsAPIを使って作ってみました。

参考サイト

ソースコード

function gpcWStrSaveToFile(slList: TStrings; const sWFile: WideString);
//Unicodeファイル名対応のSaveToFile
//対応するのはファイル名のみ。リストそのものはString
var
  li_Size, li_Write: DWORD;
  lh_Handle: THandle;
  ls_Text: String;
begin
  lh_Handle := CreateFileW(PWideChar(sWFile),     //ファイル名
                           GENERIC_WRITE,         //アクセスモード
                           0,                     //共有モード
                           nil,                  //セキュリティ
                           CREATE_ALWAYS,         //作成方法
                           FILE_ATTRIBUTE_NORMAL, //ファイル属性
                           0);                    //テンプレート
  if (lh_Handle <> INVALID_HANDLE_VALUE) then begin
    try
      li_Size := Length(slList.Text);
      ls_Text := slList.Text;
      WriteFile(lh_Handle, PAnsiChar(ls_Text)^, li_Size, li_Write, nil);
    finally
      CloseHandle(lh_Handle);
    end;
  end;
end;


function gpcWStrLoadFromFile(slList: TStrings; const sWFile: WideString);
//Unicodeファイル名対応のLoadFromFile
//対応するのはファイル名のみ。リストそのものはString
var
  li_Size, li_Write: DWORD;
  lh_Handle: THandle;
  lp_Buff: PChar;
begin
  lh_Handle := CreateFileW(PWideChar(sWFile),     //ファイル名
                           GENERIC_READ,          //アクセスモード
                           FILE_SHARE_READ,       //共有モード
                           nil,                  //セキュリティ
                           OPEN_EXISTING,         //作成方法
                           FILE_ATTRIBUTE_NORMAL, //ファイル属性
                           0);                    //テンプレート
  if (lh_Handle <> INVALID_HANDLE_VALUE) then begin
    try
      li_Size := GetFileSize(lh_Handle, nil);
      lp_Buff := AllocMem(li_Size + 1);
      try
        if (ReadFile(lh_Handle, lp_Buff^, li_Size, li_Write, nil)) then begin
          slList.Text := AnsiString(lp_Buff);
        end;
      finally
        FreeMem(lp_Buff);
      end;
    finally
      CloseHandle(lh_Handle);
    end;
  end;
end;

一応これでちゃんと読み書きできているのですが、正直 PAnsiChar(ls_Text)^ とか lp_Buff^ とか何のことやら良く分かっていません。
自分で書いといてなんですが、あれこれやった結果これでいけちゃった…というのが真相です。

制限

この関数で読み込み、保存できるのはString(AnsiString)です。
残念ながらUnicode(WideString)はそのままでは読み込み、保存できません。
が、UTF-8を利用することでUnicodeな文字列を読み込み、保存することもできるようになります。

Unicodeデータの読み書きに対応したUnicode対応LoadFromFile SaveToFileはわりとややこしい実装になっているので簡便にすませるにはUTF-8を利用してUnicodeの読み書きを行うのが良いでしょう。

以前のもの

余談ですが、ファイルの読み書きのAPIを使う前には短いファイル名とテンポラリファイルを使って実現させていました。
せっかくがんばって書いたのに陽の目をみないというのも(私が)不憫なので置いておきます。

まずは下請けとなる関数を二つ。

function gfnbIsUnicode(const sWSrc: WideString): Boolean;
//sWSrcにウムラウトのようなUnicode文字があればTrueを返す
//http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
begin
  WideCharToMultiByte(CP_ACP, $400, PWideChar(sWSrc), -1, nil, 0, nil, @Result);
end;
function gfnsTempFileNameGet(sWPath, sWTemp: WideString): WideString;
//テンポラリーファイル名を返す
const
  lcs_PREFIX = 'tmp';
var
  lp_PWBuff: PWideChar;
begin
  if (sWPath = '') then begin
    //sWPathが空の時はカレントディレクトリ
    sWPath := '.';
  end else begin
    //ディレクトリが存在しなければ作成する
    if not(gfnbDirExists(sWPath)) then CreateDirectoryW(PWideChar(sWPath), nil);
  end;
  if (sWTemp = '') then begin
    sWTemp := lcs_PREFIX;
  end;

  lp_PWBuff := AllocMem((MAX_PATH + 1) * 2);
  try
    if (GetTempFileNameW(PWideChar(sWPath), PWideChar(Copy(sWTemp, 1, 3)), 0, lp_PWBuff) > 0) then begin
      Result := WideString(lp_PWBuff);
    end else begin
      Result := '';
    end;
  finally
    FreeMem(lp_PWBuff);
  end;
end;

で、本体。

function gpcWStrSaveToFile(slList: TStrings; const sWFile, sWTmpDir: WideString);
//Unicodeファイル名対応のSaveToFile
//テンポラリーファイルを使って保存
var
  ls_WShortFile, ls_WPath, ls_WName: WideString;
  ls_WCurrentDir: WideString;
  ls_TempFile: String;
begin
  //ファイルが存在しなければ後々楽なように作成しておく
  if not(gfnbFileExists(sWFile)) then begin
    ls_WPath := gfnsFilePathGet(sWFile);
    if not(gfnbDirExists(ls_WPath)) then CreateDirectoryW(PWideChar(ls_WPath), nil);
    CloseHandle(CreateFileW(PWideChar(sWFile), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
  end;

  //Unicodeが含まれているかどうかテスト
  if (gfnbIsUnicode(sWFile)) then begin
    //短いファイル名に変更してテスト
    ls_WShortFile := gfnsShortFileNameGet(sWFile);
    if (gfnbIsUnicode(ls_WShortFile)) then begin
      //カレントディレクトリを退避
      ls_WCurrentDir := gfnsCurrentDirGet;
      //パスとファイル名に分けてテスト
      gpcFilePathNameDiv(ls_WShortFile, ls_WPath, ls_WName);
      if (gfnbIsUnicode(ls_WName)) then begin
        //実行ファイルのあるディレクトリにテンポラリファイルを作る
        SetCurrentDirectoryW(PWideChar(gfnsFilePathGet(gfnsExeNameGet)));
        ls_TempFile := gfnsTempFileNameGet(sWTmpDir, '');
        //テンポラリファイルが空ということは作成に失敗したということ
        if (ls_TempFile = '') then begin
          MessageBoxW(
            Application.Handle,
            PWideChar(WideFormat(
              'テンポラリファイルの作成ができませんでした'#13'%s' +
              '上記ファイルにデータは保存されていません',
              [sWFile])
            ),
            'ファイル書き込みエラー',
            MB_APPLMODAL or MB_ICONSTOP or MB_OK
          );
        end else begin
          try
            //テンポラリファイルに保存
            slList.SaveToFile(ls_TempFile);
            //テンポラリファイルを保存ファイルにコピー
            CopyFileW(PWideChar(WideString(ls_TempFile)), PWideChar(sWFile), False);
            DeleteFile(PChar(ls_TempFile));
            if (gfnbFileExists(ls_TempFile)) then begin
              MessageBoxW(
                Application.Handle,
                PWideChar(WideFormat(
                  'テンポラリファイルの削除ができませんでした'#13'%s' +
                  '上記ファイルが残ったままになっています',
                  [ls_TempFile])
                ),
                'ファイル書き込みエラー',
                MB_APPLMODAL or MB_ICONSTOP or MB_OK
              );
            end;
          except
            //(多分) SaveToFile のエラー
            on EErr: Exception do begin
              MessageBoxW(
                Application.Handle,
                PWideChar(WideFormat(
                  'テンポラリファイルを使ってデータを保存しようとしましたが失敗しました'#13'%s' +
                  '上記ファイルにデータは保存されていません',
                  [ls_TempFile])),
                'ファイル書き込みエラー',
                MB_APPLMODAL or MB_ICONSTOP or MB_OK
              );
            end;
          end;
        end;
      end else begin
        //ファイル名にUnicodeはないのでディレクトリを移動するだけでよい
        SetCurrentDirectoryW(PWideChar(ls_WPath));
        slList.SaveToFile(ls_WName);
      end;
      //カレントディレクトリを戻す
      SetCurrentDirectoryW(PWideChar(ls_WCurrentDir));
    end else begin
      //短いファイル名にしたらUnicodeはなくなった
      slList.SaveToFile(ls_WShortFile);
    end;
  end else begin
    //Unicodeは含まれていないので普通にセーブ
    slList.SaveToFile(sWFile);
  end;
end;


function gpcWStrLoadFromFile(slList: TStrings; const sWFile, sWTmpDir: WideString); overload;
//Unicodeファイル名対応LoadFromFile
//テンポラリーファイルを使って読み込み
var
  ls_SWFile, ls_WPath, ls_WName: WideString;
  ls_WCurrentDir: WideString;
  ls_TempFile: String;
begin
  slList.Clear;
  //そもそもファイルがないのだから読み込みは行えない
  if not(gfnbFileExists(sWFile)) then Exit;

  //Unicodeが含まれているかどうかテスト
  if not(gfnbIsUnicode(sWFile)) then begin
    //Unicodeはないのでそのまま読み込み
    slList.LoadFromFile(sWFile);
  end else begin
    //短いファイル名に変更してテスト
    ls_SWFile := gfnsShortFileNameGet(sWFile);
    if not(gfnbIsUnicode(ls_SWFile)) then begin
      //短いファイル名にしたらUnicodeはなくなったので短いファイル名で読み込み
      slList.LoadFromFile(ls_SWFile);
    end else begin
      //カレントディレクトリを退避
      ls_WCurrentDir := gfnsCurrentDirGet;
      //パスとファイル名に分けてテスト
      gpcFilePathNameDiv(ls_SWFile, ls_WPath, ls_WName);
      if not(gfnbIsUnicode(ls_WName)) then begin
        //ファイル名にUnicodeはないのでディレクトリを移動するだけでよい
        SetCurrentDirectoryW(PWideChar(ls_WPath));
        slList.LoadFromFile(ls_WName);  //←短いファイル名
      end else begin
        //それでもUnicodeがあったのでテンポラリファイルを介して読み込む
        //カレントディレクトリをプログラムのあるフォルダに移動
        SetCurrentDirectoryW(PWideChar(gfnsFilePathGet(gfnsExeNameGet)));
        ls_TempFile := gfnsTempFileNameGet(sWTmpDir, '');
        //テンポラリファイルが空ということは作成に失敗したということ
        if (ls_TempFile = '') then begin
          MessageBoxW(
            Application.Handle,
            PWideChar(WideFormat(
              'テンポラリファイルの作成ができませんでした'#13'%s' +
              '上記ファイルのデータは読み込まれていません',
              [sWFile])
            ),
            'ファイル読み込みエラー',
            MB_APPLMODAL or MB_ICONSTOP or MB_OK
          );
        end else begin
          try
            //読み出しファイルをテンポラリファイルにコピー
            CopyFileW(PWideChar(sWFile), PWideChar(WideString(ls_TempFile)), False);
            slList.LoadFromFile(ls_TempFile);
            //テンポラリファイルの後始末
            DeleteFile(PChar(ls_TempFile));
            if (gfnbFileExists(ls_TempFile)) then begin
              MessageBoxW(
                Application.Handle,
                PWideChar(WideFormat(
                  'テンポラリファイルの削除ができませんでした'#13'%s' +
                  '上記ファイルが残ったままになっています',
                  [ls_TempFile])
                ),
                'ファイル読み込みエラー',
                MB_APPLMODAL or MB_ICONSTOP or MB_OK
              );
            end;
          except
            //(多分) LoadFromFile のエラー
            on EErr: Exception do begin
              MessageBoxW(
                Application.Handle,
                PWideChar(WideFormat(
                  'テンポラリファイルを使ってデータを読み込もうとしましたが失敗しました'#13'%s' +
                  '上記ファイルのデータは読み込まれていません',
                  [ls_TempFile])),
                'ファイル読み込みエラー',
                MB_APPLMODAL or MB_ICONSTOP or MB_OK
              );
            end;
          end;
        end;
      end;
      //カレントディレクトリを戻す
      SetCurrentDirectoryW(PWideChar(ls_WCurrentDir));
    end;
  end;
end;