Unicodeファイル名対応LoadFromFile SaveToFile

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;

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;