PathFunc.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969
  1. unit PathFunc;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2026 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. This unit provides some path-related functions.
  8. The string comparison functions (including PathCompare, PathEndsWith, PathHasSubstringAt,
  9. PathSame, PathStartsWith, PathStrCompare, PathStrFind) all ignore case by
  10. default, and use a locale-independent "ordinal" comparison, which is important
  11. when comparing filenames/paths. Despite the "Path" prefix, however, the
  12. functions can be used to compare any kind of text, not just filenames/paths.
  13. About super paths (extended-length paths):
  14. PathHasInvalidCharacters considers all super paths as invalid.
  15. PathSame and Path(Str)Compare do not consider a super path and its normal
  16. version to be the same.
  17. }
  18. interface
  19. function AddBackslash(const S: String): String;
  20. function PathChangeExt(const Filename, Extension: String): String;
  21. function PathCharCompare(const S1, S2: PChar): Boolean;
  22. function PathCharIsDriveLetter(const C: Char): Boolean;
  23. function PathCharIsSlash(const C: Char): Boolean;
  24. function PathCharIsTrailByte(const S: String; const Index: Integer): Boolean;
  25. function PathCharLength(const S: String; const Index: Integer): Integer;
  26. function PathCombine(const Dir, Filename: String): String;
  27. function PathCompare(const S1, S2: String; const IgnoreCase: Boolean = True): Integer;
  28. function PathConvertNormalToSuper(const Filename: String; out SuperFilename: String;
  29. const Expand: Boolean): Boolean;
  30. function PathConvertSuperToNormal(const Filename: String): String;
  31. function PathDrivePartLength(const Filename: String): Integer;
  32. function PathDrivePartLengthEx(const Filename: String;
  33. const IncludeSignificantSlash: Boolean): Integer;
  34. function PathEndsWith(const S, AEndsWith: String;
  35. const IgnoreCase: Boolean = True): Boolean;
  36. function PathExpand(const Filename: String): String; overload;
  37. function PathExpand(const Filename: String; out ExpandedFilename: String): Boolean; overload;
  38. function PathExtensionPos(const Filename: String): Integer;
  39. function PathExtractDir(const Filename: String): String;
  40. function PathExtractDrive(const Filename: String): String;
  41. function PathExtractExt(const Filename: String): String;
  42. function PathExtractName(const Filename: String): String;
  43. function PathExtractPath(const Filename: String): String;
  44. function PathHasInvalidCharacters(const S: String;
  45. const AllowDriveLetterColon: Boolean): Boolean;
  46. function PathHasSubstringAt(const S, Substring: String; const Offset: Integer;
  47. const IgnoreCase: Boolean = True): Boolean;
  48. function PathIsRooted(const Filename: String): Boolean;
  49. function PathLastChar(const S: String): PChar;
  50. function PathLastDelimiter(const Delimiters, S: string): Integer;
  51. function PathLowercase(const S: String): String;
  52. function PathNormalizeSlashes(S: String): String;
  53. function PathPathPartLength(const Filename: String;
  54. const IncludeSlashesAfterPath: Boolean): Integer;
  55. function PathPos(Ch: Char; const S: String): Integer;
  56. function PathSame(const S1, S2: String): Boolean;
  57. function PathStartsWith(const S, AStartsWith: String;
  58. const IgnoreCase: Boolean = True): Boolean;
  59. function PathStrCompare(const S1: PChar; const S1Length: Integer;
  60. const S2: PChar; const S2Length: Integer;
  61. const IgnoreCase: Boolean = True): Integer;
  62. function PathStrFind(const SSource: PChar; const SSourceLength: Integer;
  63. const SValue: PChar; const SValueLength: Integer;
  64. const IgnoreCase: Boolean = True): Integer;
  65. function PathStrNextChar(const S: PChar): PChar;
  66. function PathStrPrevChar(const Start, Current: PChar): PChar;
  67. function PathStrScan(const S: PChar; const C: Char): PChar;
  68. function RemoveBackslash(const S: String): String;
  69. function RemoveBackslashUnlessRoot(const S: String): String;
  70. function ValidateAndCombinePath(const ADestDir, AFilename: String;
  71. out AResultingPath: String): Boolean; overload;
  72. function ValidateAndCombinePath(const ADestDir, AFilename: String): Boolean; overload;
  73. implementation
  74. {$ZEROBASEDSTRINGS OFF}
  75. uses
  76. Windows, SysUtils;
  77. function AddBackslash(const S: String): String;
  78. { Returns S plus a trailing backslash, unless S is an empty string or already
  79. ends in a backslash/slash. }
  80. begin
  81. if (S <> '') and not PathCharIsSlash(PathLastChar(S)^) then
  82. Result := S + '\'
  83. else
  84. Result := S;
  85. end;
  86. function PathCharLength(const S: String; const Index: Integer): Integer;
  87. { Returns the length in characters of the character at Index in S. }
  88. begin
  89. Result := 1;
  90. end;
  91. function PathCharIsDriveLetter(const C: Char): Boolean;
  92. begin
  93. Result := CharInSet(C, ['A'..'Z', 'a'..'z']);
  94. end;
  95. function PathCharIsSlash(const C: Char): Boolean;
  96. { Returns True if C is a backslash or slash. }
  97. begin
  98. Result := (C = '\') or (C = '/');
  99. end;
  100. function PathCharIsTrailByte(const S: String; const Index: Integer): Boolean;
  101. { Returns False if S[Index] is a single byte character or a lead byte.
  102. Returns True otherwise (i.e. it must be a trail byte). }
  103. var
  104. I: Integer;
  105. begin
  106. I := 1;
  107. while I <= Index do begin
  108. if I = Index then begin
  109. Result := False;
  110. Exit;
  111. end;
  112. Inc(I, PathCharLength(S, I));
  113. end;
  114. Result := True;
  115. end;
  116. function PathCharCompare(const S1, S2: PChar): Boolean;
  117. { Compares two first characters, and returns True if they are equal. }
  118. begin
  119. const N = PathStrNextChar(S1) - S1;
  120. if N = PathStrNextChar(S2) - S2 then begin
  121. for var I := 0 to N-1 do begin
  122. if S1[I] <> S2[I] then begin
  123. Result := False;
  124. Exit;
  125. end;
  126. end;
  127. Result := True;
  128. end else
  129. Result := False;
  130. end;
  131. function PathChangeExt(const Filename, Extension: String): String;
  132. { Takes Filename, removes any existing extension, then adds the extension
  133. specified by Extension and returns the resulting string. }
  134. var
  135. I: Integer;
  136. begin
  137. I := PathExtensionPos(Filename);
  138. if I = 0 then
  139. Result := Filename + Extension
  140. else
  141. Result := Copy(Filename, 1, I - 1) + Extension;
  142. end;
  143. function PathCombine(const Dir, Filename: String): String;
  144. { Combines a directory and filename into a path.
  145. If Dir is empty, it just returns Filename.
  146. If Filename is empty, it returns an empty string (ignoring Dir).
  147. If Filename begins with a drive letter or slash, it returns Filename
  148. (ignoring Dir).
  149. If Dir specifies only a drive letter and colon ('c:'), it returns
  150. Dir + Filename.
  151. Otherwise, it returns the equivalent of AddBackslash(Dir) + Filename. }
  152. var
  153. I: Integer;
  154. begin
  155. if (Dir = '') or (Filename = '') or PathIsRooted(Filename) then
  156. Result := Filename
  157. else begin
  158. I := PathCharLength(Dir, 1) + 1;
  159. if ((I = Length(Dir)) and (Dir[I] = ':')) or
  160. PathCharIsSlash(PathLastChar(Dir)^) then
  161. Result := Dir + Filename
  162. else
  163. Result := Dir + '\' + Filename;
  164. end;
  165. end;
  166. function PathCompare(const S1, S2: String; const IgnoreCase: Boolean = True): Integer;
  167. { Compares two strings (typically filenames, but they don't have to be) and
  168. returns 0 for "equal", <0 for "less than", or >0 for "greater than".
  169. An ordinal comparison is used, ignoring case by default. }
  170. begin
  171. Result := PathStrCompare(PChar(S1), Length(S1), PChar(S2), Length(S2),
  172. IgnoreCase);
  173. end;
  174. function PathConvertNormalToSuper(const Filename: String; out SuperFilename: String;
  175. const Expand: Boolean): Boolean;
  176. { Does not fail if the specified path already is an extended-length path. }
  177. begin
  178. if Expand then begin
  179. if not PathExpand(Filename, SuperFilename) then
  180. Exit(False);
  181. end else
  182. SuperFilename := Filename;
  183. if Length(SuperFilename) >= 3 then begin
  184. if PathStartsWith(SuperFilename, '\\?\') then
  185. Exit(True);
  186. if PathStartsWith(SuperFilename, '\\.\') then begin
  187. SuperFilename[3] := '?';
  188. Exit(True);
  189. end;
  190. if PathCharIsDriveLetter(SuperFilename[1]) and
  191. (SuperFilename[2] = ':') and (SuperFilename[3] = '\') then begin
  192. Insert('\\?\', SuperFilename, 1);
  193. Exit(True);
  194. end;
  195. if (SuperFilename[1] = '\') and (SuperFilename[2] = '\') then begin
  196. SuperFilename := '\\?\UNC\' + Copy(SuperFilename, 3, Maxint);
  197. Exit(True);
  198. end;
  199. end;
  200. Result := False;
  201. end;
  202. function PathConvertSuperToNormal(const Filename: String): String;
  203. { Attempts to convert a "\\?\"-prefixed path to normal form, and returns the
  204. new path. If the path cannot be converted, then Filename is returned
  205. unchanged.
  206. Reasons why a path cannot be converted include:
  207. - The path doesn't start with "\\?\" (i.e., it's already in normal form)
  208. - The prefix isn't followed by a drive letter and colon, or "UNC\".
  209. ("\\?\GLOBALROOT\" isn't supported.)
  210. - The path contains forward slashes or repeated backslashes (not counting
  211. the leading "\\"). Super paths shouldn't have them.
  212. Examples of conversions:
  213. \\?\C: -> C:\
  214. \\?\C:\ -> C:\
  215. \\?\C:\xxx -> C:\xxx
  216. \\?\UNC\server\share -> \\server\share
  217. }
  218. begin
  219. if PathStartsWith(Filename, '\\?\UNC\') then
  220. Exit('\\' + Copy(Filename, 9, Maxint));
  221. const Len = Length(Filename);
  222. if (Len >= 6) and PathStartsWith(Filename, '\\?\') and
  223. PathCharIsDriveLetter(Filename[5]) and
  224. (Filename[6] = ':') then begin
  225. { "\\?\C:\" or "\\?\C:\xxx" }
  226. if (Len >= 7) and (Filename[7] = '\') then
  227. Exit(Copy(Filename, 5, Maxint));
  228. { "\\?\C:" -- in this case we need to append "\" so the result is "C:\" }
  229. if Len = 6 then
  230. Exit(Copy(Filename, 5, Maxint) + '\');
  231. { "\\?\C:xxx" -- not valid, can't convert }
  232. end;
  233. Result := Filename;
  234. end;
  235. function PathDrivePartLength(const Filename: String): Integer;
  236. begin
  237. Result := PathDrivePartLengthEx(Filename, False);
  238. end;
  239. function PathDrivePartLengthEx(const Filename: String;
  240. const IncludeSignificantSlash: Boolean): Integer;
  241. { Returns length of the drive portion of Filename, or 0 if there is no drive
  242. portion.
  243. If IncludeSignificantSlash is True, the drive portion can include a trailing
  244. slash if it is significant to the meaning of the path (i.e. 'x:' and 'x:\'
  245. are not equivalent, nor are '\' and '').
  246. If IncludeSignificantSlash is False, the function works as follows:
  247. 'x:file' -> 2 ('x:')
  248. 'x:\file' -> 2 ('x:')
  249. '\\server\share\file' -> 14 ('\\server\share')
  250. '\file' -> 0 ('')
  251. If IncludeSignificantSlash is True, the function works as follows:
  252. 'x:file' -> 2 ('x:')
  253. 'x:\file' -> 3 ('x:\')
  254. '\\server\share\file' -> 14 ('\\server\share')
  255. '\file' -> 1 ('\')
  256. }
  257. var
  258. Len, I: Integer;
  259. begin
  260. Len := Length(Filename);
  261. { Standard UNC path:
  262. \\server\share
  263. Super/device-namespace drives:
  264. \\?\C:
  265. \\.\C:
  266. \\?\C:\ (trailing slash kept when IncludeSignificantSlash is True)
  267. \\.\C:\
  268. Super/device-namespace UNC paths (4 components):
  269. \\?\UNC\server\share
  270. \\.\UNC\server\share }
  271. if (Len >= 2) and PathCharIsSlash(Filename[1]) and PathCharIsSlash(Filename[2]) then begin
  272. { For consistency with the behavior of Windows' GetFullPathName function,
  273. we don't collapse 3 leading slashes into 2. Instead, a leading "\\\" is
  274. treated like "\\<empty computer name>\".
  275. PathNormalizeSlashes works the same way. }
  276. var FirstComponentIsNamespace := False;
  277. var SecondComponentIsDrive := False;
  278. var MaxComponents := 2;
  279. var CurComponent := 0;
  280. var ComponentStartIndex := 3;
  281. I := ComponentStartIndex;
  282. while I <= Len do begin
  283. if PathCharIsSlash(Filename[I]) then begin
  284. const ComponentLen = I - ComponentStartIndex;
  285. case CurComponent of
  286. 0: begin
  287. if (ComponentLen = 1) and
  288. CharInSet(Filename[ComponentStartIndex], ['?', '.']) then
  289. FirstComponentIsNamespace := True;
  290. end;
  291. 1: if FirstComponentIsNamespace then begin
  292. if ComponentLen = 2 then begin
  293. if PathCharIsDriveLetter(Filename[ComponentStartIndex]) and
  294. (Filename[ComponentStartIndex+1] = ':') then
  295. SecondComponentIsDrive := True;
  296. end
  297. else if ComponentLen = 3 then begin
  298. if PathHasSubstringAt(Filename, 'UNC', ComponentStartIndex - Low(Filename)) then
  299. Inc(MaxComponents, 2);
  300. end;
  301. end;
  302. end;
  303. Inc(CurComponent);
  304. if CurComponent >= MaxComponents then begin
  305. if SecondComponentIsDrive and IncludeSignificantSlash then
  306. Inc(I);
  307. Break;
  308. end;
  309. repeat
  310. Inc(I);
  311. { And skip any additional consecutive slashes: }
  312. until (I > Len) or not PathCharIsSlash(Filename[I]);
  313. ComponentStartIndex := I;
  314. end
  315. else
  316. Inc(I, PathCharLength(Filename, I));
  317. end;
  318. Result := I - 1;
  319. Exit;
  320. end;
  321. { \ }
  322. { Note: Test this before 'x:' since '\:stream' means access stream 'stream'
  323. on the root directory of the current drive, not access drive '\:' }
  324. if (Len >= 1) and PathCharIsSlash(Filename[1]) then begin
  325. if IncludeSignificantSlash then
  326. Result := 1
  327. else
  328. Result := 0;
  329. Exit;
  330. end;
  331. { x: }
  332. if Len > 0 then begin
  333. I := PathCharLength(Filename, 1) + 1;
  334. if (I <= Len) and (Filename[I] = ':') then begin
  335. if IncludeSignificantSlash and (I < Len) and PathCharIsSlash(Filename[I+1]) then
  336. Result := I+1
  337. else
  338. Result := I;
  339. Exit;
  340. end;
  341. end;
  342. Result := 0;
  343. end;
  344. function PathIsRooted(const Filename: String): Boolean;
  345. { Returns True if Filename begins with a slash or drive ('x:').
  346. Equivalent to: PathDrivePartLengthEx(Filename, True) <> 0 }
  347. var
  348. Len, I: Integer;
  349. begin
  350. Result := False;
  351. Len := Length(Filename);
  352. if Len > 0 then begin
  353. { \ or \\ }
  354. if PathCharIsSlash(Filename[1]) then
  355. Result := True
  356. else begin
  357. { x: }
  358. I := PathCharLength(Filename, 1) + 1;
  359. if (I <= Len) and (Filename[I] = ':') then
  360. Result := True;
  361. end;
  362. end;
  363. end;
  364. function PathPathPartLength(const Filename: String;
  365. const IncludeSlashesAfterPath: Boolean): Integer;
  366. { Returns length of the path portion of Filename, or 0 if there is no path
  367. portion.
  368. Note these differences from Delphi's ExtractFilePath function:
  369. - The result will never be less than what PathDrivePartLength returns.
  370. If you pass a UNC root path, e.g. '\\server\share', it will return the
  371. length of the entire string, NOT the length of '\\server\'.
  372. - If you pass in a filename with a reference to an NTFS alternate data
  373. stream, e.g. 'abc:def', it will return the length of the entire string,
  374. NOT the length of 'abc:'. }
  375. var
  376. LastCharToKeep, Len, I: Integer;
  377. begin
  378. Result := PathDrivePartLengthEx(Filename, True);
  379. LastCharToKeep := Result;
  380. Len := Length(Filename);
  381. I := Result + 1;
  382. while I <= Len do begin
  383. if PathCharIsSlash(Filename[I]) then begin
  384. if IncludeSlashesAfterPath then
  385. Result := I
  386. else
  387. Result := LastCharToKeep;
  388. Inc(I);
  389. end
  390. else begin
  391. Inc(I, PathCharLength(Filename, I));
  392. LastCharToKeep := I-1;
  393. end;
  394. end;
  395. end;
  396. function PathEndsWith(const S, AEndsWith: String;
  397. const IgnoreCase: Boolean = True): Boolean;
  398. { Returns True if S ends with (or is equal to) AEndsWith.
  399. An ordinal comparison is used, ignoring case by default. }
  400. begin
  401. Result := PathHasSubstringAt(S, AEndsWith, Length(S) - Length(AEndsWith),
  402. IgnoreCase);
  403. end;
  404. function PathIsEmptyOrOnlySpaces(const S: String): Boolean;
  405. { Internally used by the PathExpand functions. }
  406. begin
  407. for var I := Low(S) to High(S) do
  408. if S[I] <> ' ' then
  409. Exit(False);
  410. Result := True;
  411. end;
  412. function PathExpand(const Filename: String; out ExpandedFilename: String): Boolean;
  413. { This is a wrapper around Windows' GetFullPathName function, which takes a
  414. possibly relative path and returns a fully qualified path. Other changes,
  415. not documented but believed to be consistent across Windows versions, are
  416. made as well:
  417. - Forward slashes are changed to backslashes
  418. - Repeated slashes are collapsed into one, except for a leading '\\'.
  419. (But there's a quirk: see comments in PathNormalizeSlashes.)
  420. - Unless the last (or only) component is '.' or '..' exactly, any number of
  421. dots and spaces at the end of the path are removed. Also, a single dot at
  422. the end of preceding components may be removed.
  423. (See comments in PathHasInvalidCharacters for details.)
  424. - Paths with certain device names as the only component, or in some cases
  425. as the last component, are changed to '\\.\<device name>', except when the
  426. path has the '\\?\' prefix.
  427. For example, if the last component is 'NUL', the whole path is changed to
  428. '\\.\NUL'.
  429. - '\\.' is changed to '\\.\' and '\\?' is changed to '\\?\'
  430. (but '\\X' is *not* changed to '\\X\')
  431. Returns True if successful, or False on failure.
  432. Failure is known to occur in these cases (there could be more):
  433. - Filename is an empty string or contains only spaces
  434. - Filename or the resulting path exceeds 32K characters
  435. Super paths are supposed to be in canonical form already, absolute with no
  436. forward slashes or repeated backslashes. Although they can be passed to
  437. GetFullPathName anyway, there's a downside: GetFullPathName removes all
  438. trailing dots and spaces from the path. Files should never be *created* with
  439. trailing dots or spaces (because they can only be accessed with super
  440. paths), but removing them may interfere with opening or deleting such
  441. files. }
  442. var
  443. Buf: array[0..$7FFF] of Char;
  444. begin
  445. { Length limits observed on Windows 11 25H2:
  446. - GetFullPathName fails with ERROR_FILENAME_EXCED_RANGE [sic] if lpFileName
  447. is more than $7FFE characters long (not counting null terminator).
  448. - GetFullPathName fails with ERROR_INVALID_NAME if the resulting path
  449. would be more than $7FFE characters long (not counting null terminator),
  450. even if the buffer is much larger than that. }
  451. { GetFullPathName fails if passed an empty string or a string with only
  452. spaces. Just in case that behavior were to change in the future, we avoid
  453. relying on it and do our own check for these cases here.
  454. (GetFullPathName does not fail if passed invalid dots like '...' or dots
  455. and spaces like '.. '; the result is as if '.\' was passed.) }
  456. if PathIsEmptyOrOnlySpaces(Filename) then
  457. Exit(False);
  458. var FilePart: PChar;
  459. const Res = GetFullPathName(PChar(Filename), SizeOf(Buf) div SizeOf(Buf[0]),
  460. Buf, FilePart);
  461. Result := (Res > 0) and (Res < SizeOf(Buf) div SizeOf(Buf[0]));
  462. if Result then begin
  463. SetString(ExpandedFilename, Buf, Res);
  464. { Memory usage optimization: Most of the time, no changes are made to the
  465. path. When that is the case, return a reference to the passed-in string
  466. so that there aren't two identical strings on the heap. }
  467. if ExpandedFilename = Filename then
  468. ExpandedFilename := Filename;
  469. end;
  470. end;
  471. function PathExpand(const Filename: String): String;
  472. { Like the other PathExpand overload, but handles failures internally by
  473. either returning an empty string (when Filename is empty or only spaces) or
  474. raising an exception (currently the only known case is when Filename or the
  475. resulting path exceeds 32K characters). }
  476. begin
  477. { GetFullPathName fails if passed an empty string or a string with only
  478. spaces. For backward compatibility with callers that may not be expecting
  479. an exception in these cases, we handle both by returning an empty string
  480. instead of raising an exception.
  481. Delphi's ExpandFileName returns an empty string for any failure.
  482. Prior to IS 7, PathExpand returned the original Filename for any failure. }
  483. if PathIsEmptyOrOnlySpaces(Filename) then
  484. Exit('');
  485. if not PathExpand(Filename, Result) then
  486. raise Exception.CreateFmt('PathExpand: GetFullPathName failed (length: %d)',
  487. [Length(Filename)]);
  488. end;
  489. function PathExtensionPos(const Filename: String): Integer;
  490. { Returns index of the last '.' character in the filename portion of Filename,
  491. or 0 if there is no '.' in the filename portion.
  492. Note: Filename is assumed to NOT include an NTFS alternate data stream name
  493. (i.e. 'filename:stream'). }
  494. var
  495. Len, I: Integer;
  496. begin
  497. Result := 0;
  498. Len := Length(Filename);
  499. I := PathPathPartLength(Filename, True) + 1;
  500. while I <= Len do begin
  501. if Filename[I] = '.' then begin
  502. Result := I;
  503. Inc(I);
  504. end
  505. else
  506. Inc(I, PathCharLength(Filename, I));
  507. end;
  508. end;
  509. function PathExtractDir(const Filename: String): String;
  510. { Like PathExtractPath, but strips any trailing slashes, unless the resulting
  511. path is the root directory of a drive (i.e. 'C:\' or '\'). }
  512. var
  513. I: Integer;
  514. begin
  515. I := PathPathPartLength(Filename, False);
  516. Result := Copy(Filename, 1, I);
  517. end;
  518. function PathExtractDrive(const Filename: String): String;
  519. { Returns the drive portion of Filename (either 'x:' or '\\server\share'),
  520. or an empty string if there is no drive portion. }
  521. var
  522. L: Integer;
  523. begin
  524. L := PathDrivePartLength(Filename);
  525. if L = 0 then
  526. Result := ''
  527. else
  528. Result := Copy(Filename, 1, L);
  529. end;
  530. function PathExtractExt(const Filename: String): String;
  531. { Returns the extension portion of the last component of Filename (e.g. '.txt')
  532. or an empty string if there is no extension. }
  533. var
  534. I: Integer;
  535. begin
  536. I := PathExtensionPos(Filename);
  537. if I = 0 then
  538. Result := ''
  539. else
  540. Result := Copy(Filename, I, Maxint);
  541. end;
  542. function PathExtractName(const Filename: String): String;
  543. { Returns the filename portion of Filename (e.g. 'filename.txt'). If Filename
  544. ends in a slash or consists only of a drive part or is empty, the result will
  545. be an empty string.
  546. This function is essentially the opposite of PathExtractPath. }
  547. var
  548. I: Integer;
  549. begin
  550. I := PathPathPartLength(Filename, True);
  551. Result := Copy(Filename, I + 1, Maxint);
  552. end;
  553. function PathExtractPath(const Filename: String): String;
  554. { Returns the path portion of Filename (e.g. 'c:\dir\'). If Filename contains
  555. no drive part or slash, the result will be an empty string.
  556. This function is essentially the opposite of PathExtractName. }
  557. var
  558. I: Integer;
  559. begin
  560. I := PathPathPartLength(Filename, True);
  561. Result := Copy(Filename, 1, I);
  562. end;
  563. function PathHasInvalidCharacters(const S: String;
  564. const AllowDriveLetterColon: Boolean): Boolean;
  565. { Checks the specified path for characters that are never allowed in paths,
  566. or characters and path components that are accepted by the system but might
  567. present a security problem (such as '..' and sometimes ':').
  568. Specifically, True is returned if S includes any of the following:
  569. - Control characters (0-31)
  570. - One of these characters: /*?"<>|
  571. (This means forward slashes and the prefixes '\\?\' and '\??\' are never
  572. allowed.)
  573. - Colons (':'), except when AllowDriveLetterColon=True and the string's
  574. first character is a letter and the second character is the only colon.
  575. (This blocks NTFS alternate data stream names.)
  576. - A component with a trailing dot or space
  577. Due to the last rule above, '.' and '..' components are never allowed, nor
  578. are components like these:
  579. 'file '
  580. 'file.'
  581. 'file. . .'
  582. 'file . . '
  583. When expanding paths (with no '\\?\' prefix used), Windows 11 23H2 silently
  584. removes all trailing dots and spaces from the end of the string. Therefore,
  585. if used at the end of a path, all of the above cases yield just 'file'.
  586. On preceding components of the path, nothing is done with spaces; if there
  587. is exactly one dot at the end, it is removed (e.g., 'dir.\file' becomes
  588. 'dir\file'), while multiple dots are left untouched ('dir..\file' doesn't
  589. change).
  590. By rejecting trailing dots and spaces up front, we avoid all that weirdness
  591. and the problems that could arise from it.
  592. Since ':' is considered invalid (except in the one case noted above), it's
  593. not possible to sneak in disallowed dots/spaces by including an NTFS
  594. alternate data stream name. The function will return True in these cases:
  595. '..:streamname'
  596. 'file :streamname'
  597. }
  598. begin
  599. Result := True;
  600. for var I := Low(S) to High(S) do begin
  601. var C := S[I];
  602. if Ord(C) < 32 then
  603. Exit;
  604. case C of
  605. #32, '.':
  606. begin
  607. if (I = High(S)) or PathCharIsSlash(S[I+1]) then
  608. Exit;
  609. end;
  610. ':':
  611. begin
  612. { The A-Z check ensures that '.:streamname', ' :streamname', and
  613. '\:streamname' are disallowed. }
  614. if not AllowDriveLetterColon or (I <> Low(S)+1) or
  615. not PathCharIsDriveLetter(S[Low(S)]) then
  616. Exit;
  617. end;
  618. '/', '*', '?', '"', '<', '>', '|': Exit;
  619. end;
  620. end;
  621. Result := False;
  622. end;
  623. function PathHasSubstringAt(const S, Substring: String; const Offset: Integer;
  624. const IgnoreCase: Boolean = True): Boolean;
  625. { Returns True if Substring exists in S at the specified zero-based offset
  626. from the beginning of S.
  627. An ordinal comparison is used, ignoring case by default.
  628. Passing an out-of-range Offset value is allowed/safe. False is returned if
  629. Offset is negative or if checking for Substring at Offset would go beyond
  630. the end of S (partially or fully).
  631. If Substring is empty and Offset = Length(S), then True is returned because
  632. that is not considered going *beyond* the end of S. }
  633. begin
  634. if Offset < 0 then
  635. Exit(False);
  636. const SubstringLen = Length(Substring);
  637. if Offset > Length(S) - SubstringLen then
  638. Exit(False);
  639. Result := (PathStrCompare(PChar(S) + Offset, SubstringLen, PChar(Substring),
  640. SubstringLen, IgnoreCase) = 0);
  641. end;
  642. function PathLastChar(const S: String): PChar;
  643. { Returns pointer to last character in the string. Returns nil if the string is
  644. empty. }
  645. begin
  646. if S = '' then
  647. Result := nil
  648. else
  649. Result := @S[High(S)];
  650. end;
  651. function PathLastDelimiter(const Delimiters, S: string): Integer;
  652. { Returns the index of the last occurrence in S of one of the characters in
  653. Delimiters, or 0 if none were found.
  654. Note: S is allowed to contain null characters. }
  655. var
  656. P, E: PChar;
  657. begin
  658. Result := 0;
  659. if (S = '') or (Delimiters = '') then
  660. Exit;
  661. P := Pointer(S);
  662. E := P + Length(S);
  663. while P < E do begin
  664. if P^ <> #0 then begin
  665. if StrScan(PChar(Pointer(Delimiters)), P^) <> nil then
  666. Result := Integer((P - PChar(Pointer(S))) + 1);
  667. P := PathStrNextChar(P);
  668. end
  669. else
  670. Inc(P);
  671. end;
  672. end;
  673. function PathLowercase(const S: String): String;
  674. { Converts the specified path name to lowercase }
  675. begin
  676. Result := AnsiLowerCase(S);
  677. end;
  678. function PathPos(Ch: Char; const S: String): Integer;
  679. var
  680. Len, I: Integer;
  681. begin
  682. Len := Length(S);
  683. I := 1;
  684. while I <= Len do begin
  685. if S[I] = Ch then begin
  686. Result := I;
  687. Exit;
  688. end;
  689. Inc(I, PathCharLength(S, I));
  690. end;
  691. Result := 0;
  692. end;
  693. function PathNormalizeSlashes(S: String): String;
  694. { Returns S minus any superfluous slashes, and with any forward slashes
  695. converted to backslashes. For example, if S is 'C:\\\some//path', it returns
  696. 'C:\some\path'.
  697. If the string starts with two slashes ('\\') then those two characters are
  698. ignored when collapsing repeated slashes. So:
  699. \\server\share -> \\server\share (unchanged)
  700. \\\server\share -> \\\server\share (unchanged)
  701. \\\\server\share -> \\\server\share (one backslash removed)
  702. Note that paths with 3+ leading slashes don't actually work. But Windows'
  703. GetFullPathName function, used by PathExpand, collapses slashes the same
  704. way. Best to be consistent. }
  705. begin
  706. const Len = Length(S);
  707. var I: Integer;
  708. for I := 1 to Len do
  709. if S[I] = '/' then
  710. S[I] := '\';
  711. var EndIndex := 2;
  712. if (Len >= 2) and (S[1] = '\') and (S[2] = '\') then
  713. Inc(EndIndex, 2);
  714. for I := Len downto EndIndex do
  715. if (S[I] = '\') and (S[I-1] = '\') then
  716. Delete(S, I, 1);
  717. Result := S;
  718. end;
  719. function PathSame(const S1, S2: String): Boolean;
  720. { Returns True if the specified strings (typically filenames) are equal.
  721. An ordinal comparison is used, ignoring case.
  722. Like PathCompare, but faster for checking equality as it returns False
  723. immediately if the strings are different lengths. }
  724. begin
  725. Result := (Length(S1) = Length(S2)) and (PathCompare(S1, S2) = 0);
  726. end;
  727. function PathStartsWith(const S, AStartsWith: String;
  728. const IgnoreCase: Boolean = True): Boolean;
  729. { Returns True if S starts with (or is equal to) AStartsWith.
  730. An ordinal comparison is used, ignoring case by default. }
  731. begin
  732. Result := PathHasSubstringAt(S, AStartsWith, 0, IgnoreCase);
  733. end;
  734. { Use our own CompareStringOrdinal declaration. The one in the Windows unit is
  735. "delayload" (yuck), and the bIgnoreCase parameter type differs between
  736. Delphi 11 and 12 (BOOL vs. DWORD). }
  737. function CompareStringOrdinal_static(lpString1: LPCWSTR; cchCount1: Integer;
  738. lpString2: LPCWSTR; cchCount2: Integer; bIgnoreCase: BOOL): Integer; stdcall;
  739. external kernel32 name 'CompareStringOrdinal';
  740. function PathStrCompare(const S1: PChar; const S1Length: Integer;
  741. const S2: PChar; const S2Length: Integer;
  742. const IgnoreCase: Boolean = True): Integer;
  743. { Compares two strings and returns 0 for "equal", <0 for "less than", or
  744. >0 for "greater than".
  745. An ordinal comparison is used, ignoring case by default.
  746. A length of -1 may be passed if a string is null-terminated; in that case,
  747. the length is determined automatically. }
  748. begin
  749. { As documented, CompareStringOrdinal only allows 1 for TRUE in the
  750. bIgnoreCase parameter. "BOOL(Byte(IgnoreCase))" ensures we pass 1, not the
  751. usual -1 Delphi passes when a Boolean is implicitly converted to BOOL. }
  752. const CompareResult = CompareStringOrdinal_static(S1, S1Length, S2, S2Length,
  753. BOOL(Byte(IgnoreCase)));
  754. case CompareResult of
  755. 0: raise Exception.CreateFmt('PathStrCompare: CompareStringOrdinal failed (%u)',
  756. [GetLastError]);
  757. 1..3: ;
  758. else
  759. raise Exception.CreateFmt('PathStrCompare: CompareStringOrdinal result invalid (%d)',
  760. [CompareResult]);
  761. end;
  762. Result := CompareResult - 2;
  763. end;
  764. { Use our own FindStringOrdinal declaration. The one in the Windows unit is
  765. "delayload" (yuck). }
  766. function FindStringOrdinal_static(dwFindStringOrdinalFlags: DWORD;
  767. lpStringSource: LPCWSTR; cchSource: Integer;
  768. lpStringValue: LPCWSTR; cchValue: Integer; bIgnoreCase: BOOL): Integer; stdcall;
  769. external kernel32 name 'FindStringOrdinal';
  770. function PathStrFind(const SSource: PChar; const SSourceLength: Integer;
  771. const SValue: PChar; const SValueLength: Integer;
  772. const IgnoreCase: Boolean = True): Integer;
  773. { Locates a value in a string, starting with the first character of the string.
  774. Returns a 0-based index if found, and -1 otherwise.
  775. An ordinal comparison is used, ignoring case by default.
  776. A length of -1 may be passed if a string is null-terminated; in that case,
  777. the length is determined automatically. }
  778. begin
  779. { This is not documented for FindStringOrdinal, but like CompareStringOrdinal
  780. it only allows 1 for TRUE in the bIgnoreCase parameter. See above. }
  781. const CompareResult = FindStringOrdinal_static(FIND_FROMSTART, SSource, SSourceLength,
  782. SValue, SValueLength, BOOL(Byte(IgnoreCase)));
  783. if CompareResult = -1 then begin
  784. const LastError = GetLastError;
  785. if LastError <> ERROR_SUCCESS then
  786. raise Exception.CreateFmt('PathStrFind: FindStringOrdinal failed (%u)',
  787. [LastError]);
  788. end else if not ((CompareResult >= 0) and (CompareResult < SSourceLength)) then
  789. raise Exception.CreateFmt('PathStrFind: FindStringOrdinal result invalid (%d)',
  790. [CompareResult]);
  791. Result := CompareResult;
  792. end;
  793. function PathStrNextChar(const S: PChar): PChar;
  794. { Returns pointer to the character after S, unless S points to a null (#0). }
  795. begin
  796. Result := S;
  797. if Result^ <> #0 then
  798. Inc(Result);
  799. end;
  800. function PathStrPrevChar(const Start, Current: PChar): PChar;
  801. { Returns pointer to the character before Current, unless Current = Start. }
  802. begin
  803. Result := Current;
  804. if Result > Start then
  805. Dec(Result);
  806. end;
  807. function PathStrScan(const S: PChar; const C: Char): PChar;
  808. { Returns pointer to first occurrence of C in S, or nil if there are no
  809. occurrences. As with StrScan, specifying #0 for the search character is legal. }
  810. begin
  811. Result := S;
  812. while Result^ <> C do begin
  813. if Result^ = #0 then begin
  814. Result := nil;
  815. Break;
  816. end;
  817. Result := PathStrNextChar(Result);
  818. end;
  819. end;
  820. function RemoveBackslash(const S: String): String;
  821. { Returns S minus any trailing slashes. Use of this function is discouraged;
  822. use RemoveBackslashUnlessRoot instead when working with file system paths. }
  823. var
  824. I: Integer;
  825. begin
  826. I := Length(S);
  827. while (I > 0) and PathCharIsSlash(PathStrPrevChar(Pointer(S), @S[I+1])^) do
  828. Dec(I);
  829. if I = Length(S) then
  830. Result := S
  831. else
  832. Result := Copy(S, 1, I);
  833. end;
  834. function RemoveBackslashUnlessRoot(const S: String): String;
  835. { Returns S minus any trailing slashes, unless S specifies the root directory
  836. of a drive (i.e. 'C:\' or '\'), in which case it leaves 1 slash. }
  837. var
  838. DrivePartLen, I: Integer;
  839. begin
  840. DrivePartLen := PathDrivePartLengthEx(S, True);
  841. I := Length(S);
  842. while (I > DrivePartLen) and PathCharIsSlash(PathStrPrevChar(Pointer(S), @S[I+1])^) do
  843. Dec(I);
  844. if I = Length(S) then
  845. Result := S
  846. else
  847. Result := Copy(S, 1, I);
  848. end;
  849. function ValidateAndCombinePath(const ADestDir, AFilename: String;
  850. out AResultingPath: String): Boolean;
  851. { Combines ADestDir and AFilename without allowing a result outside of
  852. ADestDir and without allowing other security problems.
  853. Returns True if all security checks pass, with the combination of ADestDir
  854. and AFilename in AResultingPath.
  855. ADestDir is assumed to be normalized already and have a trailing backslash.
  856. AFilename may be a file or directory name. }
  857. begin
  858. { - Don't allow empty names
  859. - Don't allow forward slashes or repeated slashes
  860. - Don't allow rooted (non-relative to current directory) names
  861. - Don't allow trailing slash
  862. - Don't allow invalid characters/dots/spaces (this catches '..') }
  863. Result := False;
  864. if (AFilename <> '') and
  865. (AFilename = PathNormalizeSlashes(AFilename)) and
  866. not PathIsRooted(AFilename) and
  867. not PathCharIsSlash(AFilename[High(AFilename)]) and
  868. not PathHasInvalidCharacters(AFilename, False) then begin
  869. { Our validity checks passed. Now pass the combined path to PathExpand
  870. (GetFullPathName) to see if it thinks the path needs normalization.
  871. If the returned path isn't exactly what was passed in, then consider
  872. the name invalid.
  873. One way that can happen is if the path ends in an MS-DOS device name:
  874. PathExpand('c:\path\NUL') returns '\\.\NUL'. Obviously we don't want
  875. devices being opened, so that must be rejected. }
  876. var CombinedPath := ADestDir + AFilename;
  877. var TestExpandedPath: String;
  878. if PathExpand(CombinedPath, TestExpandedPath) and
  879. (CombinedPath = TestExpandedPath) then begin
  880. AResultingPath := CombinedPath;
  881. Result := True;
  882. end;
  883. end;
  884. end;
  885. function ValidateAndCombinePath(const ADestDir, AFilename: String): Boolean;
  886. begin
  887. var ResultingPath: String;
  888. Result := ValidateAndCombinePath(ADestDir, AFilename, ResultingPath);
  889. end;
  890. end.