{ -----------------------------------
長いファイル名、短いファイル名相互変換関数
2002/06/05
  作成されていた
2003/03/17
  関数の説明を記述、全体的にコメントなどを修正
  GetShortFullPathName/GetLongFullPathNameは
  不要なのでimplementationだけに実装して
  interfaceにはGetLongFileName/GetShortFileNameを
  準備した。
//----------------------------------- }
unit LongShortFileName;

interface

uses
  Windows,
  SysUtils;

function GetLongFileName(const ShortFileName:string):string;
function GetShortFileName(const ShortFileName:string):string;

function IsSameFileName(A, B: String): Boolean;

procedure testFolderFileMake;
procedure testFileDirectoryExists;
procedure testGetLongFileName;
procedure testGetLongFullPathName;
procedure testGetShortFileName;
procedure testGetShortFullPathName;

implementation

uses
  StringUnitLight,
  XPtest;


{-------------------------------
//  短いファイル名を得る関数
    TailShortName
    GetShortDirName
    GetShortFullPathName
備考:       FDelphiより引用
            結局再帰の実装がいまいちなので
            GetShortFileName関数に置き換えられる
履歴:       2003/03/17
//------------------------------}
function TailShortName(FullPathName: String; Attr: integer): String;
var
  SearchRec: TSearchRec;
  aPath: string;
begin
  Result:=ExtractFilename(FullPathName);
  if FindFirst(FullPathName,Attr,SearchRec)=0 then begin
    aPath:=SearchRec.FindData.cAlternateFileName;
    if AnsiCompareText(aPath,Result)<>0 then
      if Pos('~',aPath)=0 then aPath:=Result;
                  {ゴミデータの時は使わない}
    Result:=aPath;
  end else
    Result:='';
  FindClose(SearchRec);
end; {TailShortName}

function GetShortDirName(DirName:String): String;
var
  ShortDirName: String;
begin
  if Length(Dirname)=3 then
    Result:=Dirname
  else begin
    ShortDirName:=
      TailShortName(DirName,faDirectory+faHidden+faSysFile);
    DirName:=ExtractFileDir(DirName);
    Result:=IncludeTrailingPathDelimiter(GetShortDirName(Dirname))+ ShortDirName;
  end;
end; {GetShortDirName}

function GetShortFullPathName(LongFullPath:String): String;
{LongFullPathはディレクトリー名でもよい}
var
  aDir: String;
begin
  Result := '';
  if (not FileExists(LongFullPath)) then
  begin
    LongFullPath := ExcludeTrailingPathDelimiter(LongFullPath);
    if (not DirectoryExists(LongFullPath)) then
      exit
    else
      Result := GetShortDirName(LongFullPath);
  end;
  //↑いろいろな形式のFileNameに対応

  aDir:=GetShortDirName(ExtractFileDir(LongFullPath));
  if ExtractFilename(LongFullPath)='' then
    Result:=aDir
  else
    Result:= IncludeTrailingPathDelimiter(aDir) +
      TailShortName(LongFullPath,faAnyfile);
end; {GetShortFullPathName}

procedure testGetShortFullPathName;
begin
  //通常の変換
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT',
    GetShortFullPathName('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt') );
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1',
    GetShortFullPathName('C:\Temp\AA  AA\BB B\CC   CCC') );

  //変換させない
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT',
    GetShortFullPathName('C:\Temp\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT') );
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1',
    GetShortFullPathName('C:\Temp\AAAA~1\BBB~1\CCCCC~1') );

  //存在しないファイルとフォルダ
  Check('', GetShortFullPathName('C:\TempTempTemp'));
  Check('', GetShortFullPathName('C:\Temp\a.txt'));
end;
//------------------------------


{-------------------------------
//  長いファイル名を得る関数
    TailLongName
    GetLongDirName
    GetLongFullPathName
備考:       FDelphiより引用
            結局再帰の実装がいまいちなので
            GetLongFileName関数に置き換えられる
履歴:       2003/03/17
//------------------------------}
function TailLongName(FullPathName: String; Attr: integer): String;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(FullPathName,Attr,SearchRec)=0 then
    Result:=SearchRec.Name
  else
    Result:='';
  FindClose(SearchRec);
end; {TailLongName}

function GetLongDirName(DirName:String): String;
var
  LongDirName: String;
begin
  if Length(Dirname)=3 then
    Result:=Dirname
  else begin
    LongDirName:=
      TailLongName(DirName,faDirectory+faHidden+faSysFile);
    DirName:=ExtractFileDir(DirName);
    Result:= IncludeTrailingPathDelimiter(GetLongDirName(Dirname))+LongDirName;
  end;
end; {GetLongDirName}

function GetLongFullPathName(ShortFullPath:String): String;
{ShortFullPathはディレクトリー名でもよい}
Var
  aDir: String;
begin
  Result := '';
  if (not FileExists(ShortFullPath)) then
  begin
    ShortFullPath := ExcludeTrailingPathDelimiter(ShortFullPath);
    if (not DirectoryExists(ShortFullPath)) then
      exit
    else
      Result := GetLongDirName(ShortFullPath);
  end;
  //↑いろいろな形式のFileNameに対応

  aDir:=GetLongDirName(ExtractFileDir(ShortFullPath));
  if ExtractFilename(ShortFullPath)='' then
    Result:=aDir
  else
    Result:= IncludeTrailingPathDelimiter(aDir)+
      TailLongName(ShortFullPath,faAnyfile);
end; {GetLongFullPathName}

procedure testGetLongFullPathName;
begin
  //通常の変換
  Check('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt',
    GetLongFullPathName('C:\TEMP\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT') );
  Check('C:\Temp\AA  AA\BB B\CC   CCC',
    GetLongFullPathName('C:\TEMP\AAAA~1\BBB~1\CCCCC~1') );

  //変換させない
  Check('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt',
    GetLongFullPathName('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt') );
  Check('C:\Temp\AA  AA\BB B\CC   CCC',
    GetLongFullPathName('C:\Temp\AA  AA\BB B\CC   CCC') );

  //存在しないファイルとフォルダ
  Check('', GetLongFullPathName('C:\TempTempTemp'));
  Check('', GetLongFullPathName('C:\Temp\a.txt'));
end;
//------------------------------


(*-----------------------------------
FDelphiで使われている
PutYemMark は IncludeTrailingPathDelimiter
RemoveYemMark は ExcludeTrailingPathDelimiter
で置き換えられます。

//ファイル名の末尾に'\'を追加する関数
function PutYenMark(vDir: TFilename): TFilename;
begin
  Result := vDir;
  if not IsPathDelimiter(Result, Length(Result)) then Result := Result + '\';
end; {MBCS2バイト文字に対応}

//ファイル名の末尾から'\'を取り除く関数
function RemoveYenMark(FolderName: TFileName): TFileName;
begin
  Result := FolderName;
  if IsPathDelimiter(Result, Length(Result)) then
  begin  {最後の区切り文字\が文字列と同じ長さのとこにある場合}
    Result := Copy(FolderName, 1, Length(FolderName)-1); {右から一つ削除}
  end;
end; {MBCS2バイト文字に対応}
//-----------------------------------*)


{-------------------------------
//ロングファイル名/ショートファイル名を取得する
    GetLongFileName
    GetShortFileName
備考:       DelphiML検索ワード「ロングファイル」
            2chの情報
            結局、FDelphiのコードよりこちらの方が
            短くてよいだろう
履歴:       2003/03/17
              存在しないファイルを変換した場合
              空文字を返すように修正
//------------------------------}
function GetLongFileName(const ShortFileName:string):string;
var
  Path:string;
  SearchRec:TSearchRec;
begin
  Result := '';
  if ShortFileName = '' then Exit;

  if FileExists(ShortFileName)
    or DirectoryExists(ShortFileName) then
  begin
    Result := ExcludeTrailingPathDelimiter( ShortFileName );
    if ( Length( Result ) = 2 ) and ( Result[2] = ':' ) then Exit;
    if SysUtils.FindFirst( Result, faAnyFile, SearchRec )=0 then
    begin
      Path := GetLongFileName( ExtractFileDir( Result ) );
      Path := IncludeTrailingPathDelimiter( Path );
      Result := Path + SearchRec.Name;
    end;
    SysUtils.FindClose( SearchRec );
  end;
end;

function GetShortFileName(const ShortFileName:string):string;
var
  Path:string;
  SearchRec:TSearchRec;
begin
  Result := '';
  if ShortFileName = '' then Exit;

  if FileExists(ShortFileName)
    or DirectoryExists(ShortFileName) then
  begin
    Result := ExcludeTrailingPathDelimiter( ShortFileName );
    if ( Length( Result ) = 2 ) and ( Result[2] = ':' ) then Exit;
    if SysUtils.FindFirst( Result, faAnyFile, SearchRec )=0 then
    begin
      Path := GetShortFileName( ExtractFileDir( Result ) );
      Path := IncludeTrailingPathDelimiter( Path );
      if SearchRec.FindData.cAlternateFileName <> '' then
        Result := Path + SearchRec.FindData.cAlternateFileName
      else
        Result := Path + SearchRec.Name;
    end;
    SysUtils.FindClose( SearchRec );
  end;
end;
//------------------------------

procedure testFolderFileMake;
var
  F: File;
  Str: String;
  FileName: String;
begin
  Str := '逝ってヨシ';
  FileName := 'C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt';

  {↓テスト用テキストファイルを作成}
  ForceDirectories(ExtractFileDir(FileName));
  AssignFile(F, FileName);
  Rewrite(F, Length(Str));
  try
    if Length(Str) > 0 then
      BlockWrite(F, PChar(Str)^, 1);
  finally
    CloseFile(F);
  end;

end;

procedure testFileDirectoryExists;
begin
  Check(True, DirectoryExists('C:\Temp'));
  Check(True, DirectoryExists('C:\Temp\'));

  Check(True, FileExists('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt'));
  Check(True, FileExists('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt'));
end;

procedure testGetLongFileName;
begin
  //通常の変換
  Check('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt',
    GetLongFileName('C:\TEMP\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT') );
  Check('C:\Temp\AA  AA\BB B\CC   CCC',
    GetLongFileName('C:\TEMP\AAAA~1\BBB~1\CCCCC~1') );

  //変換させない
  Check('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt',
    GetLongFileName('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt') );
  Check('C:\Temp\AA  AA\BB B\CC   CCC',
    GetLongFileName('C:\Temp\AA  AA\BB B\CC   CCC') );

  //存在しないファイルとフォルダ
  Check('', GetLongFileName('C:\TempTempTemp'));
  Check('', GetLongFileName('C:\Temp\a.txt'));
end;

procedure testGetShortFileName;
begin
  //通常の変換
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT',
    GetShortFileName('C:\Temp\AA  AA\BB B\CC   CCC\itteyoshi.txt') );
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1',
    GetShortFileName('C:\Temp\AA  AA\BB B\CC   CCC') );

  //変換させない
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT',
    GetShortFileName('C:\Temp\AAAA~1\BBB~1\CCCCC~1\ITTEYO~1.TXT') );
  Check('C:\Temp\AAAA~1\BBB~1\CCCCC~1',
    GetShortFileName('C:\Temp\AAAA~1\BBB~1\CCCCC~1') );

  //存在しないファイルとフォルダ
  Check('', GetShortFileName('C:\TempTempTemp'));
  Check('', GetShortFileName('C:\Temp\a.txt'));
end;
//-----------------------------------*)


{-------------------------------
//ファイル名を比較して
機能:       文字列が同一のファイルを示しているのかどうかを
            判断します。
戻り値:     true:同じファイル false:異なるファイル
備考:       存在するファイルしか同一かどうか判断できません。
            A,Bは短いファイル名でも長いファイル名でもOKです。
履歴:       2002/02/11
//------------------------------}
function IsSameFileName(A, B: String): Boolean;
var
  OldMode: UINT;// エラーモード保持用
begin
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  if FileExists(A) and FileExists(B) then
  begin
    A := GetLongFileName(A);
    B := GetLongFileName(B);

    if SameText(A, B) then
    begin
      Result := True;
    end else
    begin
      Result := False;
    end;

  end else
  begin
    Result := False;
  end;
  SetErrorMode(OldMode);
end;
//------------------------------


end.