{ --▽---------------------------▼-- 長いファイル名、短いファイル名相互変換関数 2002/06/05 作成されていた 2003/03/17 関数の説明を記述、全体的にコメントなどを修正 GetShortFullPathName/GetLongFullPathNameは 不要なのでimplementationだけに実装して interfaceにはGetLongFileName/GetShortFileNameを 準備した。 2005/12/19 LongShortFileName.pasからFileNameUnit.pasに名前変更 2005/12/29 CheckUNCPathやCheckDrivePathを正しく実装 2006/12/24(日) ・CheckDrivePathをデバッグ ・PathLevel/CutPathLevelを実装 ・testTrailingPathDelimiterを追加 2007/07/22(日) 00:04 ・FileUnit.pasからExtractFolderFileName関数を移動 //--▲---------------------------△-- } unit FileNameUnit; interface uses Windows, SysUtils, ShellUnit, NetworkUnit, // StringUnitLight, ConstUnit, StringUnit, DelimitedTextUnit, // XPtest, uses_end; function GetLongFileName(const ShortFileName:string):string; function GetShortFileName(const LongFileName:string):string; procedure testGetLongFileName; procedure testGetShortFileName; function CheckSameFileName(A, B: String): Boolean; function CheckUNCPath(Path: String): Boolean; procedure testCheckUNCPath; function CheckDrivePath(Path: String): Boolean; procedure testCheckDrivePath; procedure MakeTestFolderFile; procedure DeleteTestFolderFile; procedure testFileDirectoryExists; function ExtractFileNameExcludeExt(const FileName: String): String; function ExtractFolderFileName(Path: String): String; function CheckSameExt(const Filename, Ext: String): Boolean; function PathLevel(Path: String): Integer; function CutPathLevel(Path: String; CutCount: Integer): String; procedure testTrailingPathDelimiter; function GetAbsolutePathFromRelativePath(BasePath, RelativePath: WideString): WideString; function GetRelativePathFromAbsolutePath(BasePath, AbsolutePath: WideString): WideString; function CheckPathFollowRule(Path: String): Boolean; forward; implementation {------------------------------- //ロングファイル名/ショートファイル名を取得する 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 LongFileName:string):string; var Path:string; SearchRec:TSearchRec; begin Result := ''; if LongFileName = '' then Exit; if FileExists(LongFileName) or DirectoryExists(LongFileName) then begin Result := ExcludeTrailingPathDelimiter( LongFileName ); 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 MakeTestFolderFile; 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 DeleteTestFolderFile; var FileName: String; begin FileName := 'C:\Temp\AA AA\BB B\CC CCC\itteyoshi.txt'; ForceDeleteFile(0, FileName); ForceDeleteFolder(0, ExtractFileDir(FileName)); ForceDeleteFolder(0, ExtractFileDir(ExtractFileDir(FileName))); ForceDeleteFolder(0, ExtractFileDir(ExtractFileDir(ExtractFileDir(FileName)))); end; procedure testGetLongFileName; begin MakeTestFolderFile; //通常の変換 // 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') ); // DeleteTestFolderFile; // // //存在しないファイルとフォルダ // Check('', GetLongFileName('C:\TempTempTemp')); // Check('', GetLongFileName('C:\Temp\a.txt')); end; procedure testGetShortFileName; begin MakeTestFolderFile; //通常の変換 // 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') ); // DeleteTestFolderFile; // // //存在しないファイルとフォルダ // Check('', GetShortFileName('C:\TempTempTemp')); // Check('', GetShortFileName('C:\Temp\a.txt')); end; //--△----------------------▲-- {------------------------------- //ファイル名を比較して 機能: 文字列が同一のファイルを示しているのかどうかを判断します。 存在するファイルしか同一かどうか判断できません。 A,Bは短いファイル名でも長いファイル名でもOKです。 戻り値: true:同じファイル false:異なるファイル 備考: ユニットSysUtilsのSameFileName関数で代用できるかもしれません 履歴: 2002/02/11 //--▼----------------------▽--} function CheckSameFileName(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; //--△----------------------▲-- {------------------------------- // DirectoryExists/FileExistsや ExtractFileDriveの動作を調査する 備考: 履歴: 2005/12/29 //--▼----------------------▽--} //の動作をテストする関数 procedure testFileDirectoryExists; begin // Check(True, DirectoryExists('C:\Temp')); // Check(True, DirectoryExists('C:\Temp\')); // Check(True, DirectoryExists('C:\')); // Check(True, DirectoryExists('C:')); // {↓マシン名はDirではない} // Check(False, DirectoryExists('\\'+GetMachineNetworkInfo.HostName)); // Check(True, DirectoryExists('\\'+GetMachineNetworkInfo.HostName+'\TEMP')); // {↑共有フォルダはDir} // // MakeTestFolderFile; // 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')); // DeleteTestFolderFile; end; procedure testExtractFileDrive; begin // Check('c:', ExtractFileDrive('c:\aaa\bbb.txt')); // Check('C:', ExtractFileDrive('C:\aaa\bbb.txt')); end; //--△----------------------▲-- {------------------------------- // UNC(=Universal Naming Convention)パスかどうかを判断する関数 機能: 文字列が3文字以上であって 先頭が『\\?』って形になっていて 途中でファイル禁止文字や『\\』がない かどうかを判断する関数 備考: 履歴: 2005/12/28 //--▼----------------------▽--} function CheckUNCPath(Path: String): Boolean; begin Result := False; if 3 <= Length(Path) then begin if (Path[1]=PathDelim) and (Path[2]=PathDelim) and (not (Path[3]=PathDelim)) then begin Result := True; end; end; if (Result = True) and (CheckPathFollowRule(Path)=False) then begin Result := False; end; end; procedure testCheckUNCPath; begin // Check(False, CheckUNCPath('c:\aaa\bbb.txt')); // Check(False, CheckUNCPath('c:\')); // Check(False, CheckUNCPath('c:')); // Check(True, CheckUNCPath('\\EXELION')); // Check(True, CheckUNCPath('\\Exelion\TEMP')); // Check(False, CheckUNCPath('\\')); end; //--△----------------------▲-- {------------------------------- // 通常のドライブパスかどうかを判断する関数 機能: 文字列が2文字以上であって 先頭が『X:』って形になっていて 途中でファイル禁止文字や『\\』がない かどうかを判断する関数 備考: 履歴: 2005/12/28 2006/12/24(日) 誤動作を若干修正 //--▼----------------------▽--} function CheckDrivePath(Path: String): Boolean; begin Result := False; if Length(Path)<=1 then begin Result := False; Exit; end; {↑一文字の場合はどうやってもパスにならない} if 2 <= Length(Path) then begin if (Path[2]=DriveDelim) and CheckWideCharInTable(WideChar(Path[1]), hanAlphaTbl) then begin Result := True; end else begin Result := False; Exit; end; end; if 3 <= Length(Path) then begin if Path[3]=PathDelim then begin Result := True; end else begin Result := False; Exit; end; end; if CheckPathFollowRule(Path)=False then begin Result := False; Exit; end; end; procedure testCheckDrivePath; begin // Check(True, CheckDrivePath('c:\aaa\bbb.txt')); // Check(True, CheckDrivePath('c:\')); // Check(True, CheckDrivePath('c:')); // Check(True, CheckDrivePath('D:\aaa\bbb.txt')); // Check(True, CheckDrivePath('D:\')); // Check(True, CheckDrivePath('D:')); // {↓二文字のドライブパスは受け付けない} // Check(False, CheckDrivePath('aa:')); // Check(False, CheckDrivePath('AA:')); // Check(False, CheckDrivePath('aa:\')); // Check(False, CheckDrivePath('AA:\')); // Check(False, CheckDrivePath('AA:\temp')); // Check(False, CheckDrivePath('abc:\abc')); // Check(False, CheckDrivePath('\\EXELION')); // Check(False, CheckDrivePath('\\Exelion\TEMP')); // Check(False, CheckDrivePath('\\')); // Check(False, CheckDrivePath('\:')); // Check(False, CheckDrivePath('\:\')); end; //--△----------------------▲-- {------------------------------- // CheckDrivePathとCheckUNCPathで使われる内部関数 機能: 文字列が1文字しかなかったり UNC指定以外の場所(つまり1文字目以外)で"\\"が使われていたり その他禁止文字が使われていたりして Pathがファイルパスとして成り立つかどうかを判断する関数 備考: 履歴: 2005/12/29 //--▼----------------------▽--} //function CheckPathFollowRule(Path: String): Boolean; //var // PathBackside: String; //begin // Result := True; // if Length(Path) <= 1 then // begin // Result := False; // Exit; // end; // // if 3 <= Length(Path) then // begin // PathBackside := Copy(Path, 3, Length(Path)); // if InStr('\\', PathBackside, 3, MaxInt) then // begin // Result := False; // Exit; // end; // // if CheckStrInTable(PathBackside, '/:,;*?"<>|') <> itAllExclude then // begin // Result := False; // Exit; // end; // end; //end; //function CheckPathFollowRule(Path: String): Boolean; //var // SearchIndex: Integer; //begin // Result := True; // // if 3 <= Length(Path) then // begin // if RangeAnsiPosForward(PathDelim + PathDelim, // Path, 2) <> 0 then // begin // {↑\\が2文字目以降に含まれているかどうか調べる} // Result := False; // Exit; // end; // end; // // if 2 <= Length(Path) then // begin // SearchIndex := AnsiPosForward(DriveDelim, Path); // if (SearchIndex <> 0) then // if (SearchIndex <> 2) then // begin // {↑:が2文字目に含まれているかどうか調べる} // Result := False; // Exit; // end; // end; // {↑2文字目の:以外は受け付けない} // // if 3 <= Length(Path) then // begin // if AnsiPosForward('...', Path) = 1 then // begin // {↑...の有無を調べている} // Result := False; // Exit; // end; // if AnsiPosForward(PathDelim + '...', Path) <> 0 then // begin // {↑...の有無を調べている} // Result := False; // Exit; // end; // end; // {※[A...]というファイルはOK} // // if 1 <= Length(Path) then // begin // if AnsiPosForward(PathDelim, Path) = 1 then // begin // if AnsiPosForward(PathDelim + PathDelim, Path) <> 1 then // begin // {↑先頭が\なのに\\じゃない場合はだめ} // Result := False; // Exit; // end; // end; // end; // // if CheckStrInTable(Path, '/*?"<>|') <> itAllExclude then // begin // Result := False; // Exit; // end; //end; {---------------------------------------- procedure testCheckFileFolderPath; begin Check(True, CheckPathFollowRule('c:\aaa\bbb.txt')); Check(True, CheckPathFollowRule('c:\')); Check(True, CheckPathFollowRule('c:')); Check(True, CheckPathFollowRule('\\EXELION')); Check(True, CheckPathFollowRule('\\Exelion\TEMP')); Check(True, CheckPathFollowRule('\\')); Check(False, CheckPathFollowRule('c:\aaa\\bbb.txt')); Check(False, CheckPathFollowRule('\\Exelion\\TEMP')); Check(True, CheckPathFollowRule('.')); Check(True, CheckPathFollowRule('.\')); Check(False, CheckPathFollowRule('.\\')); Check(True, CheckPathFollowRule('..\')); Check(True, CheckPathFollowRule('..\')); Check(False, CheckPathFollowRule('...')); Check(False, CheckPathFollowRule('...\')); Check(False, CheckPathFollowRule('...\abc')); Check(False, CheckPathFollowRule('...\abc\def')); Check(False, CheckPathFollowRule('...\abc\def\')); Check(False, CheckPathFollowRule('C:\test\...')); Check(False, CheckPathFollowRule('C:\test\...\')); Check(False, CheckPathFollowRule('C:\test\...\abc')); Check(False, CheckPathFollowRule('C:\test\...\abc\def')); Check(False, CheckPathFollowRule('C:\test\...\abc\def\')); Check(False, CheckPathFollowRule('C:\test\...txt')); Check(False, CheckPathFollowRule('C:\test\...txt\')); Check(False, CheckPathFollowRule('C:\test\...txt\abc')); Check(False, CheckPathFollowRule('C:\test\...txt\abc\def')); Check(False, CheckPathFollowRule('C:\test\...txt\abc\def\')); Check(True, CheckPathFollowRule('A...')); Check(True, CheckPathFollowRule('A...\')); Check(True, CheckPathFollowRule('A...\abc')); Check(True, CheckPathFollowRule('A...\abc\def')); Check(True, CheckPathFollowRule('A...\abc\def\')); Check(True, CheckPathFollowRule('C:\test\A...')); Check(True, CheckPathFollowRule('C:\test\A...\')); Check(True, CheckPathFollowRule('C:\test\A...\abc')); Check(True, CheckPathFollowRule('C:\test\A...\abc\def')); Check(True, CheckPathFollowRule('C:\test\A...\abc\def\')); Check(False, CheckPathFollowRule('/')); Check(False, CheckPathFollowRule('a/')); Check(False, CheckPathFollowRule('/a')); Check(False, CheckPathFollowRule('ab/')); Check(False, CheckPathFollowRule('a/b')); Check(False, CheckPathFollowRule('/ab')); end; //----------------------------------------} {リファクタリング中 仕様 ・パスとして正しいルールに含まれている時はTrue 正しくないならFalse ・\記号によって空文字を含む分割を行う。分割記号は含まない。 ・先頭に\\と連続している場合 つまり、空文字要素が先頭の2連続で続くのはOK 1つだけの空文字要素ならNotOK ・[:]が先頭要素の2文字目以外にあるとエラー >>でも「..\D:\という場合があるな…」>>対応した ・区切られた要素に空文字がある場合はエラー (つまり\\記号があった場合はエラー) ・区切られた要素に[...]で始まる内容があるとエラー ・区切られた要素に[/*?"<>|]が含まれているとエラー } function CheckPathFollowRule(Path: String): Boolean; var Split: TWordSplited; SearchStartIndex: Integer; FirstItemFlag: Boolean; // DriveItemIndex: Integer; i: Integer; begin Result := True; Split := TWordSplited.Create(ExcludeLastPathDelim(Path), [PathDelim], [sfinEmptyStr]); try if (Split.Count = 1) and (Split.Words[0] = EmptyStr) then begin Result := False; Exit; end; {↓空項目が許されるのは[\\abc]となっている時だけ それ以外は\が連続とみなされるので ファイルパスではない} SearchStartIndex := 0; if (2 <= Split.Count) and (Split.Words[0] = EmptyStr) then begin {↑↓0がEmptyStrで1がEmptyStrではないなら [\]が先頭に1文字の場合だから ファイルパスではない} if Split.Words[1] <> EmptyStr then begin Result := False; Exit; end else if Path = PathDelim + PathDelim then begin Result := False; Exit; end else begin SearchStartIndex := 2; end; end; for i := SearchStartIndex to Split.Count - 1 do begin if Split.Words[i] = EmptyStr then begin Result := False; Exit; end; end; FirstItemFlag := True; for i := 0 to Split.Count - 1 do begin if (Split.Words[i] = '.') or (Split.Words[i] = '..') then begin if FirstItemFlag then begin Continue; end else begin {↓先頭項目じゃないのに[.]や[..]なら ファイルパスではない(ことにする)} Result := False; Exit; end; end; if FirstItemFlag then begin FirstItemFlag := False; {↓最初の項目で[:]が含まれていて それが2文字目ではない場合はファイルパスではない} if InStr(DriveDelim, Split.Words[i]) then if not InStr(DriveDelim, Split.Words[i], 2, 1) then begin Result := False; Exit; end else begin {↓2文字目に[:]でも1文字目がアルファベットではないなら ファイルパスではない} if not (CheckStrInTable(Split.Words[i][1], hanAlphaTbl)=itAllInclude) then begin Result := False; Exit; end; end; end else begin {↓最初の項目以外で[:]が含まれているなら ファイルパスではない} if InStr(DriveDelim, Split.Words[i]) then begin Result := False; Exit; end; end; end; for i := 0 to Split.Count - 1 do begin if (Split.Words[i] = '.') or (Split.Words[i] = '..') then continue; {↓[.]や[..]以外で先頭に[.]がある場合は ファイルパスではない [A...]という項目はOK} if AnsiPosForward('.', Split.Words[i]) = 1 then begin Result := False; Exit; end; if CheckStrInTable(Path, '/*?"<>|') <> itAllExclude then begin Result := False; Exit; end; end; finally Split.Free; end; end; //--△----------------------▲-- {------------------------------- // ExtractFileNameExcludeExt 機能: 拡張子もディレクトリパスもない ファイル名を取得する 備考: ファイル名が正しくない場合 戻り値はChangeFileExtやExtractFileNameの処理に依存する 履歴: 2006/02/18 //--▼----------------------▽--} function ExtractFileNameExcludeExt(const FileName: String): String; begin Result := ChangeFileExt(ExtractFileName(FileName), ''); end; //--△----------------------▲-- {------------------------------- // パスの末尾から"AAA\BBB.txt"という形式で // フォルダ名\ファイル名、という形式で文字列を取り出す 備考: 履歴: 2005/11/08 //--▼----------------------▽--} function ExtractFolderFileName(Path: String): String; begin Result := IncludeTrailingPathDelimiter(ExtractFileName(ExtractFileDir(Path))) + ExtractFileName(Path); end; //--△----------------------▲-- {------------------------------- // ファイルパスの階層を調べる関数 機能: 備考: 履歴: 2006/12/24(日) 00:33 //--▼----------------------▽--} function PathLevel(Path: String): Integer; begin Result := -1; if CheckDrivePath(Path) then begin Result := WordCount(Path, [PathDelim], dmUserFriendly)-1; end else if CheckUNCPath(Path) then begin Result := WordCount(Path, [PathDelim], dmUserFriendly)-1; end else begin Exit; end; end; //--△----------------------▲-- {------------------------------- // ファイルパスの階層を切り取る関数 機能: 指定した階層(CutCount)分にフォルダを上に上がる関数 戻り値の最後には[\]記号がつく 備考: 履歴: 2006/12/24(日) 00:33 //--▼----------------------▽--} function CutPathLevel(Path: String; CutCount: Integer): String; var Level: Integer; i: Integer; begin Result := ''; if CutCount < 0 then Exit; if CutCount = 0 then begin Result := Path; Exit; end; Level := PathLevel(Path); if Level = -1 then Exit; if Level < CutCount then begin Exit; end else begin for i := 0 to Level - CutCount do begin Result := Result + WordGet(Path, [PathDelim], i, dmUserFriendly) + PathDelim; end; if CheckUNCPath(Path) then begin Result := StringOfChar(PathDelim, 2) + Result; end; end; end; //--△----------------------▲-- {------------------------------- // Include/ExcludeTrailingPathDelimiterの動作を調べるテスト 機能: 備考: 履歴: 2006/12/24(日) 00:33 //--▼----------------------▽--} procedure testTrailingPathDelimiter; begin // Check('C:\Temp\', IncludeTrailingPathDelimiter('C:\Temp\')); // Check('C:\Temp', ExcludeTrailingPathDelimiter('C:\Temp')); // Check('C:\', IncludeTrailingPathDelimiter('C:')); // Check('C:', ExcludeTrailingPathDelimiter('C:\')); end; //--△----------------------▲-- {------------------------------- // 拡張子の一致を調べる関数 機能: Extはピリオドを先頭に付けても付けなくてもよい 備考: ".pas"や".pas.bak"というような拡張子で一致を調べる事ができる 履歴: 2007/08/30(木) 15:09 //--▼----------------------▽--} function CheckSameExt(const Filename, Ext: String): Boolean; begin Result := WideStringLastCompareCase( IncludeFirstStr(Ext, '.'), Filename, True); end; //--△----------------------▲-- function GetAbsolutePathFromRelativePath(BasePath, RelativePath: WideString): WideString; var CurrentDirBuffer: WideString; MakeDirFlag: Boolean; WordSplited: TWordSplited; i: Integer; LastPathDelimFlag: Boolean; j: Integer; begin Result := ''; if (not CheckDrivePath(BasePath)) and (not CheckUNCPath(BasePath)) then begin // Exception.Create('指定された文字列はファイルパスに適合しません:'+BasePath); Exit; end; if not CheckPathFollowRule(RelativePath) then begin // Exception.Create('指定された文字列はファイルパスに適合しません:'+BasePath); Exit; end; case 2 of 1: begin CurrentDirBuffer := GetCurrentDir; if not DirectoryExists(BasePath) then begin MakeDirFlag := True; ForceDirectories(BasePath) end else begin MakeDirFlag := False; end; SetCurrentDir(BasePath); Result := ExpandFileName(RelativePath); if MakeDirFlag then begin ForceDeleteFolder(0, BasePath); end; SetCurrentDir(CurrentDirBuffer); end; 2: begin {TODO: ・Check...Pathに引っかかる場合は例外を発生させる ・\記号で分解する(空文字含む分解) ・分解した要素が0個ならエラー ・相対パス側を分解した要素の最初に空文字が来てもエラー (最後以外に空文字が来てもエラー) ・先頭に[.]が来ている場合 [..]単独なら一つ上 [.]単独なら処理なし [...]以上ならエラー [.x][..x][...x]などというファイルはエラー(存在しない) [A..]このようなファイルは存在する ・元のパスが[C:\TEST1\TEST2\]と[C:\TEST1\TEST2]は 最後の[\]の有無だけなので区別はしない ・最後の[\]を除外して、[\]で分解する [C:][TEST1][TEST2]となるので、 それを相対パスで[..]が来た場合削っていく ・テストファースト } BasePath := ExcludeLastPathDelim(BasePath); if IsLastStr(RelativePath, PathDelim) then LastPathDelimFlag := True else LastPathDelimFlag := False; WordSplited := TWordSplited.Create(ExcludeLastPathDelim(RelativePath), [PathDelim], [sfInEmptyStr]); try if WordSplited.Count = 0 then begin // Exception.Create('指定された文字列はファイルパスに適合しません:'+BasePath); Exit; end; for i := 0 to WordSplited.Count - 1 do begin // if WordSplited.Words[i] = EmptyStr then // begin //// Exception.Create('指定された文字列はファイルパスに適合しません:'+BasePath); // Exit; // end; if WordSplited.Words[i] = '..' then begin if BasePath = '' then begin // Exception.Create('指定された文字列はファイルパスに適合しません:'+BasePath); Exit; end; BasePath := CutPathLevel(BasePath, 1); j := i + 1; end else if WordSplited.Words[i] = '.' then begin j := i + 1; end else begin j := i; break; end; end; if BasePath <> '' then Result := IncludeLastPathDelim(BasePath); for i := j to WordSplited.Count - 1 do begin Result := Result + WordSplited.Words[i] + PathDelim; end; if LastPathDelimFlag then Result := IncludeLastPathDelim(Result) else Result := ExcludeLastPathDelim(Result); if not (CheckDrivePath(Result) or CheckUNCPath(Result)) then begin // Exception.Create('指定された文字列はファイルパスに適合しません:'+BasePath); Result := ''; Exit; end; finally WordSplited.Free; end; end; end; end; function GetRelativePathFromAbsolutePath(BasePath, AbsolutePath: WideString): WideString; begin Result := ''; if (not CheckDrivePath(BasePath)) and (not CheckUNCPath(BasePath)) then Exit; if (not CheckDrivePath(AbsolutePath)) and (not CheckUNCPath(AbsolutePath)) then Exit; BasePath := IncludeLastPathDelim(BasePath); Result := ExtractRelativePath(BasePath, AbsolutePath); end; //// BaseName : ベースとなる絶対パス //// SrcName : 変換したい相対パス //function ExtractFullPath(const BaseName, SrcName: string): string; // function AddFirstSlash(const Str: string): string; // begin // Result := Str; // if Copy(Result, 1, 1)<>'\' then // Result := '\' + Result; // end; // function DeleteFirstSlash(const Str: string): string; // begin // Result := Str; // if Copy(Result, 1, 1)='\' then // Result := Copy(Result, 2, MaxInt); // end; // function AddBackSlash(const Str: string): string; // begin // Result := Str; // if (Result<>'') and (Result[Length(Result)]<>'\') then // Result := Result + '\'; // end; // function ExtractFullPath2(const RelativePath: string): string; // var // SrcPath: string; // SrcDirs: array[0..129] of PChar; // SrcDirCount: Integer; // // procedure SplitDirs(var Path: string; var Dirs: array of PChar; // var DirCount: Integer); // var // I, J: Integer; // begin // I := 1; // J := 0; // while I <= Length(Path) do // begin // if Path[I] in LeadBytes then Inc(I) // else if Path[I] = '\' then { Do not localize } // begin // Path[I] := #0; // Dirs[J] := @Path[I + 1]; // Inc(J); // end; // Inc(I); // end; // DirCount := J - 1; // end; // // var // i: Integer; // DriveName: string; // begin // Result := ''; // // DriveName := ExtractFileDrive(RelativePath); // SrcPath := Copy(RelativePath, Length(DriveName)+1, MaxInt); // SplitDirs(SrcPath, SrcDirs, SrcDirCount); // // for i:=0 to SrcDirCount do // begin // if SrcDirs[i]='.' then // else if SrcDirs[i]='..' then // Result := ExtractFileDir(Result) // else begin // Result := AddBackSlash(Result) + SrcDirs[i]; // end; // end; // // Result := DriveName + AddFirstSlash(Result); // end; // //begin // if ExtractFileDrive(SrcName)<>'' then // begin // { SrcName にドライブ名が指定されているので BaseName は無視 } // Result := AddBackSlash(ExtractFullPath2(SrcName)); // end else // begin // Result := ExtractFullPath2(AddBackSlash(BaseName)+ // DeleteFirstSlash(SrcName)); // end; //end; //end; (*--▽---------------------------▼-- ◇絶対パスを取り出す関数 GetAbsolutePathFromRelativePath BasePath RelativePath 戻り値はFullPath BasePathはC:\か\\である必要あり RelativePathはパスである必要あり (ピリオドでスタートしてなくてもいい) SetCurrentDirと ExpandFileNameとでいいようだ。 存在しないフォルダの場合困るかもね。 相対パスを絶対パスに変換する http://www.wwlnk.com/boheme/delphi/tips/tec1600.htm 自作モノもある。 サンプル: "相対パスから絶対パスへ変換" file:///C:/Software/FirefoxPortable/Data/profile/ScrapBook/data/20100218100202/index.html ◇相対パスを取り出す関数 GetRelativePathFromAbsolutePath BasePath AbsolutePath 戻り値はRelativePath BasePathはC:\か\\である必要あり RelativePathはパスである必要あり (ピリオドでスタートしてなくてもいい) ExtractRelativePathでいいようだ。 二つのパスから相対パスを生成する http://www.wwlnk.com/boheme/delphi/tips/tec1590.htm //--▲---------------------------△--*) end.