cfileutils.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
  3. This module provides some basic file/dir handling utils and classes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit cfileutils;
  18. {$i fpcdefs.inc}
  19. {$define usedircache}
  20. interface
  21. uses
  22. {$ifdef hasunix}
  23. Baseunix,unix,
  24. {$endif hasunix}
  25. {$ifdef win32}
  26. Windows,
  27. {$endif win32}
  28. {$if defined(go32v2) or defined(watcom)}
  29. Dos,
  30. {$endif}
  31. {$IFNDEF USE_FAKE_SYSUTILS}
  32. SysUtils,
  33. {$ELSE}
  34. fksysutl,
  35. {$ENDIF}
  36. GlobType,
  37. CUtils,CClasses,
  38. Systems;
  39. type
  40. TCachedDirectory = class(TFPHashObject)
  41. private
  42. FDirectoryEntries : TFPHashList;
  43. procedure FreeDirectoryEntries;
  44. function GetItemAttr(const AName: TCmdStr): byte;
  45. public
  46. constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
  47. destructor destroy;override;
  48. procedure Reload;
  49. function FileExists(const AName:TCmdStr):boolean;
  50. function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
  51. function DirectoryExists(const AName:TCmdStr):boolean;
  52. property DirectoryEntries:TFPHashList read FDirectoryEntries;
  53. end;
  54. TCachedSearchRec = record
  55. Name : TCmdStr;
  56. Attr : byte;
  57. Pattern : TCmdStr;
  58. CachedDir : TCachedDirectory;
  59. EntryIndex : longint;
  60. end;
  61. PCachedDirectoryEntry = ^TCachedDirectoryEntry;
  62. TCachedDirectoryEntry = record
  63. RealName: TCmdStr;
  64. Attr : byte;
  65. end;
  66. TDirectoryCache = class
  67. private
  68. FDirectories : TFPHashObjectList;
  69. function GetDirectory(const ADir:TCmdStr):TCachedDirectory;
  70. public
  71. constructor Create;
  72. destructor destroy;override;
  73. function FileExists(const AName:TCmdStr):boolean;
  74. function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
  75. function DirectoryExists(const AName:TCmdStr):boolean;
  76. function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
  77. function FindNext(var Res:TCachedSearchRec):boolean;
  78. function FindClose(var Res:TCachedSearchRec):boolean;
  79. end;
  80. TSearchPathList = class(TCmdStrList)
  81. procedure AddPath(s:TCmdStr;addfirst:boolean);overload;
  82. procedure AddPath(SrcPath,s:TCmdStr;addfirst:boolean);overload;
  83. procedure AddList(list:TSearchPathList;addfirst:boolean);
  84. function FindFile(const f : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  85. end;
  86. function bstoslash(const s : TCmdStr) : TCmdStr;
  87. {Gives the absolute path to the current directory}
  88. function GetCurrentDir:TCmdStr;
  89. {Gives the relative path to the current directory,
  90. with a trailing dir separator. E. g. on unix ./ }
  91. function CurDirRelPath(systeminfo: tsysteminfo): TCmdStr;
  92. function path_absolute(const s : TCmdStr) : boolean;
  93. Function PathExists (const F : TCmdStr;allowcache:boolean) : Boolean;
  94. Function FileExists (const F : TCmdStr;allowcache:boolean) : Boolean;
  95. function FileExistsNonCase(const path,fn:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  96. Function RemoveDir(d:TCmdStr):boolean;
  97. Function FixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
  98. function FixFileName(const s:TCmdStr):TCmdStr;
  99. function TargetFixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
  100. function TargetFixFileName(const s:TCmdStr):TCmdStr;
  101. procedure SplitBinCmd(const s:TCmdStr;var bstr: TCmdStr;var cstr:TCmdStr);
  102. function FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  103. { function FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;}
  104. function FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  105. function GetShortName(const n:TCmdStr):TCmdStr;
  106. procedure InitFileUtils;
  107. procedure DoneFileUtils;
  108. implementation
  109. uses
  110. Comphook,
  111. Globals;
  112. {$undef AllFilesMaskIsInRTL}
  113. {$if (FPC_VERSION > 2)}
  114. {$define AllFilesMaskIsInRTL}
  115. {$endif FPC_VERSION}
  116. {$if (FPC_VERSION = 2) and (FPC_RELEASE > 2)}
  117. {$define AllFilesMaskIsInRTL}
  118. {$endif}
  119. {$if (FPC_VERSION = 2) and (FPC_RELEASE = 2) and (FPC_PATCH > 0)}
  120. {$define AllFilesMaskIsInRTL}
  121. {$endif}
  122. {$ifndef AllFilesMaskIsInRTL}
  123. {$if defined(go32v2) or defined(watcom)}
  124. const
  125. AllFilesMask = '*.*';
  126. {$else}
  127. const
  128. AllFilesMask = '*';
  129. {$endif not (go32v2 or watcom)}
  130. {$endif not AllFilesMaskIsInRTL}
  131. var
  132. DirCache : TDirectoryCache;
  133. {****************************************************************************
  134. TCachedDirectory
  135. ****************************************************************************}
  136. constructor TCachedDirectory.create(AList:TFPHashObjectList;const AName:TCmdStr);
  137. begin
  138. inherited create(AList,AName);
  139. FDirectoryEntries:=TFPHashList.Create;
  140. end;
  141. destructor TCachedDirectory.destroy;
  142. begin
  143. FreeDirectoryEntries;
  144. FDirectoryEntries.Free;
  145. inherited destroy;
  146. end;
  147. procedure TCachedDirectory.FreeDirectoryEntries;
  148. var
  149. i: Integer;
  150. begin
  151. if not(tf_files_case_aware in source_info.flags) then
  152. exit;
  153. for i := 0 to DirectoryEntries.Count-1 do
  154. dispose(PCachedDirectoryEntry(DirectoryEntries[i]));
  155. end;
  156. function TCachedDirectory.GetItemAttr(const AName: TCmdStr): byte;
  157. var
  158. entry: PCachedDirectoryEntry;
  159. begin
  160. if not(tf_files_case_sensitive in source_info.flags) then
  161. if (tf_files_case_aware in source_info.flags) then
  162. begin
  163. entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
  164. if assigned(entry) then
  165. Result:=entry^.Attr
  166. else
  167. Result:=0;
  168. end
  169. else
  170. Result:=PtrUInt(DirectoryEntries.Find(Lower(AName)))
  171. else
  172. Result:=PtrUInt(DirectoryEntries.Find(AName));
  173. end;
  174. procedure TCachedDirectory.Reload;
  175. var
  176. dir : TSearchRec;
  177. entry : PCachedDirectoryEntry;
  178. begin
  179. FreeDirectoryEntries;
  180. DirectoryEntries.Clear;
  181. if findfirst(IncludeTrailingPathDelimiter(Name)+AllFilesMask,faAnyFile or faDirectory,dir) = 0 then
  182. begin
  183. repeat
  184. if ((dir.attr and faDirectory)<>faDirectory) or
  185. ((dir.Name<>'.') and
  186. (dir.Name<>'..')) then
  187. begin
  188. if not(tf_files_case_sensitive in source_info.flags) then
  189. if (tf_files_case_aware in source_info.flags) then
  190. begin
  191. new(entry);
  192. entry^.RealName:=Dir.Name;
  193. entry^.Attr:=Dir.Attr;
  194. DirectoryEntries.Add(Lower(Dir.Name),entry)
  195. end
  196. else
  197. DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
  198. else
  199. DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
  200. end;
  201. until findnext(dir) <> 0;
  202. end;
  203. findclose(dir);
  204. end;
  205. function TCachedDirectory.FileExists(const AName:TCmdStr):boolean;
  206. var
  207. Attr : Longint;
  208. begin
  209. Attr:=GetItemAttr(AName);
  210. if Attr<>0 then
  211. Result:=((Attr and faDirectory)=0)
  212. else
  213. Result:=false;
  214. end;
  215. function TCachedDirectory.FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
  216. var
  217. entry : PCachedDirectoryEntry;
  218. Attr : Longint;
  219. begin
  220. if (tf_files_case_aware in source_info.flags) then
  221. begin
  222. entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
  223. if assigned(entry) then
  224. begin
  225. Attr:=entry^.Attr;
  226. FoundName:=entry^.RealName
  227. end
  228. else
  229. Attr:=0;
  230. if Attr<>0 then
  231. Result:=((Attr and faDirectory)=0)
  232. else
  233. Result:=false
  234. end
  235. else
  236. { should not be called in this case, use plain FileExists }
  237. Result:=False;
  238. end;
  239. function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean;
  240. var
  241. Attr : Longint;
  242. begin
  243. Attr:=GetItemAttr(AName);
  244. if Attr<>0 then
  245. Result:=((Attr and faDirectory)=faDirectory)
  246. else
  247. Result:=false;
  248. end;
  249. {****************************************************************************
  250. TDirectoryCache
  251. ****************************************************************************}
  252. constructor TDirectoryCache.create;
  253. begin
  254. inherited create;
  255. FDirectories:=TFPHashObjectList.Create(true);
  256. end;
  257. destructor TDirectoryCache.destroy;
  258. begin
  259. FDirectories.Free;
  260. inherited destroy;
  261. end;
  262. function TDirectoryCache.GetDirectory(const ADir:TCmdStr):TCachedDirectory;
  263. var
  264. CachedDir : TCachedDirectory;
  265. DirName : TCmdStr;
  266. begin
  267. if ADir='' then
  268. DirName:='.'
  269. else
  270. DirName:=ADir;
  271. CachedDir:=TCachedDirectory(FDirectories.Find(DirName));
  272. if not assigned(CachedDir) then
  273. begin
  274. CachedDir:=TCachedDirectory.Create(FDirectories,DirName);
  275. CachedDir.Reload;
  276. end;
  277. Result:=CachedDir;
  278. end;
  279. function TDirectoryCache.FileExists(const AName:TCmdStr):boolean;
  280. var
  281. CachedDir : TCachedDirectory;
  282. begin
  283. Result:=false;
  284. CachedDir:=GetDirectory(ExtractFileDir(AName));
  285. if assigned(CachedDir) then
  286. Result:=CachedDir.FileExists(ExtractFileName(AName));
  287. end;
  288. function TDirectoryCache.FileExistsCaseAware(const AName:TCmdStr; out FoundName:TCmdStr):boolean;
  289. var
  290. CachedDir : TCachedDirectory;
  291. begin
  292. Result:=false;
  293. CachedDir:=GetDirectory(ExtractFileDir(AName));
  294. if assigned(CachedDir) then
  295. begin
  296. Result:=CachedDir.FileExistsCaseAware(ExtractFileName(AName),FoundName);
  297. if Result then
  298. FoundName:=ExtractFilePath(AName)+FoundName;
  299. end;
  300. end;
  301. function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean;
  302. var
  303. CachedDir : TCachedDirectory;
  304. begin
  305. Result:=false;
  306. CachedDir:=GetDirectory(ExtractFilePath(AName));
  307. if assigned(CachedDir) then
  308. Result:=CachedDir.DirectoryExists(ExtractFileName(AName));
  309. end;
  310. function TDirectoryCache.FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
  311. begin
  312. Res.Pattern:=ExtractFileName(APattern);
  313. Res.CachedDir:=GetDirectory(ExtractFilePath(APattern));
  314. Res.EntryIndex:=0;
  315. if assigned(Res.CachedDir) then
  316. Result:=FindNext(Res)
  317. else
  318. Result:=false;
  319. end;
  320. function TDirectoryCache.FindNext(var Res:TCachedSearchRec):boolean;
  321. var
  322. entry: PCachedDirectoryEntry;
  323. begin
  324. if Res.EntryIndex<Res.CachedDir.DirectoryEntries.Count then
  325. begin
  326. if (tf_files_case_aware in source_info.flags) then
  327. begin
  328. entry:=Res.CachedDir.DirectoryEntries[Res.EntryIndex];
  329. Res.Name:=entry^.RealName;
  330. Res.Attr:=entry^.Attr;
  331. end
  332. else
  333. begin
  334. Res.Name:=Res.CachedDir.DirectoryEntries.NameOfIndex(Res.EntryIndex);
  335. Res.Attr:=PtrUInt(Res.CachedDir.DirectoryEntries[Res.EntryIndex]);
  336. end;
  337. inc(Res.EntryIndex);
  338. Result:=true;
  339. end
  340. else
  341. Result:=false;
  342. end;
  343. function TDirectoryCache.FindClose(var Res:TCachedSearchRec):boolean;
  344. begin
  345. { nothing todo }
  346. result:=true;
  347. end;
  348. {****************************************************************************
  349. Utils
  350. ****************************************************************************}
  351. function bstoslash(const s : TCmdStr) : TCmdStr;
  352. {
  353. return TCmdStr s with all \ changed into /
  354. }
  355. var
  356. i : longint;
  357. begin
  358. setlength(bstoslash,length(s));
  359. for i:=1to length(s) do
  360. if s[i]='\' then
  361. bstoslash[i]:='/'
  362. else
  363. bstoslash[i]:=s[i];
  364. end;
  365. {Gives the absolute path to the current directory}
  366. var
  367. CachedCurrentDir : TCmdStr;
  368. function GetCurrentDir:TCmdStr;
  369. begin
  370. if CachedCurrentDir='' then
  371. begin
  372. GetDir(0,CachedCurrentDir);
  373. CachedCurrentDir:=FixPath(CachedCurrentDir,false);
  374. end;
  375. result:=CachedCurrentDir;
  376. end;
  377. {Gives the relative path to the current directory,
  378. with a trailing dir separator. E. g. on unix ./ }
  379. function CurDirRelPath(systeminfo: tsysteminfo): TCmdStr;
  380. begin
  381. if systeminfo.system <> system_powerpc_macos then
  382. CurDirRelPath:= '.'+systeminfo.DirSep
  383. else
  384. CurDirRelPath:= ':'
  385. end;
  386. function path_absolute(const s : TCmdStr) : boolean;
  387. {
  388. is path s an absolute path?
  389. }
  390. begin
  391. result:=false;
  392. {$if defined(unix)}
  393. if (length(s)>0) and (s[1]='/') then
  394. result:=true;
  395. {$elseif defined(amiga) or defined(morphos)}
  396. if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or (Pos(':',s) = length(s)) then
  397. result:=true;
  398. {$elseif defined(macos)}
  399. if IsMacFullPath(s) then
  400. result:=true;
  401. if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or
  402. ((length(s)>2) and (s[2]=':') and ((s[3]='\') or (s[3]='/'))) then
  403. result:=true;
  404. {$endif unix}
  405. end;
  406. Function FileExists ( Const F : TCmdStr;allowcache:boolean) : Boolean;
  407. begin
  408. {$ifdef usedircache}
  409. if allowcache then
  410. Result:=DirCache.FileExists(F)
  411. else
  412. {$endif usedircache}
  413. Result:=SysUtils.FileExists(F);
  414. if assigned(do_comment) then
  415. begin
  416. if Result then
  417. do_comment(V_Tried,'Searching file '+F+'... found')
  418. else
  419. do_comment(V_Tried,'Searching file '+F+'... not found');
  420. end;
  421. end;
  422. function FileExistsNonCase(const path,fn:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  423. var
  424. fn2 : TCmdStr;
  425. begin
  426. result:=false;
  427. if tf_files_case_sensitive in source_info.flags then
  428. begin
  429. {
  430. Search order for case sensitive systems:
  431. 1. NormalCase
  432. 2. lowercase
  433. 3. UPPERCASE
  434. }
  435. FoundFile:=path+fn;
  436. If FileExists(FoundFile,allowcache) then
  437. begin
  438. result:=true;
  439. exit;
  440. end;
  441. fn2:=Lower(fn);
  442. if fn2<>fn then
  443. begin
  444. FoundFile:=path+fn2;
  445. If FileExists(FoundFile,allowcache) then
  446. begin
  447. result:=true;
  448. exit;
  449. end;
  450. end;
  451. fn2:=Upper(fn);
  452. if fn2<>fn then
  453. begin
  454. FoundFile:=path+fn2;
  455. If FileExists(FoundFile,allowcache) then
  456. begin
  457. result:=true;
  458. exit;
  459. end;
  460. end;
  461. end
  462. else
  463. if tf_files_case_aware in source_info.flags then
  464. begin
  465. {
  466. Search order for case aware systems:
  467. 1. NormalCase
  468. }
  469. FoundFile:=path+fn;
  470. {$ifdef usedircache}
  471. if allowcache then
  472. begin
  473. result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
  474. if result then
  475. begin
  476. FoundFile:=fn2;
  477. exit;
  478. end;
  479. end
  480. else
  481. {$endif usedircache}
  482. If FileExists(FoundFile,allowcache) then
  483. begin
  484. { don't know the real name in this case }
  485. result:=true;
  486. exit;
  487. end;
  488. end
  489. else
  490. begin
  491. { None case sensitive only lowercase }
  492. FoundFile:=path+Lower(fn);
  493. If FileExists(FoundFile,allowcache) then
  494. begin
  495. result:=true;
  496. exit;
  497. end;
  498. end;
  499. { Set foundfile to something usefull }
  500. FoundFile:=fn;
  501. end;
  502. Function PathExists (const F : TCmdStr;allowcache:boolean) : Boolean;
  503. Var
  504. i: longint;
  505. hs : TCmdStr;
  506. begin
  507. if F = '' then
  508. begin
  509. result := true;
  510. exit;
  511. end;
  512. hs := ExpandFileName(F);
  513. I := Pos (DriveSeparator, hs);
  514. if (hs [Length (hs)] = DirectorySeparator) and
  515. (((I = 0) and (Length (hs) > 1)) or (I <> Length (hs) - 1)) then
  516. Delete (hs, Length (hs), 1);
  517. {$ifdef usedircache}
  518. if allowcache then
  519. Result:=DirCache.DirectoryExists(hs)
  520. else
  521. {$endif usedircache}
  522. Result:=SysUtils.DirectoryExists(hs);
  523. end;
  524. Function RemoveDir(d:TCmdStr):boolean;
  525. begin
  526. if d[length(d)]=source_info.DirSep then
  527. Delete(d,length(d),1);
  528. {$I-}
  529. rmdir(d);
  530. {$I+}
  531. RemoveDir:=(ioresult=0);
  532. end;
  533. Function FixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
  534. var
  535. i : longint;
  536. begin
  537. { Fix separator }
  538. for i:=1 to length(s) do
  539. if s[i] in ['/','\'] then
  540. s[i]:=source_info.DirSep;
  541. { Fix ending / }
  542. if (length(s)>0) and (s[length(s)]<>source_info.DirSep) and
  543. (s[length(s)]<>DriveSeparator) then
  544. s:=s+source_info.DirSep;
  545. { Remove ./ }
  546. if (not allowdot) and (s='.'+source_info.DirSep) then
  547. s:='';
  548. { return }
  549. if (tf_files_case_aware in source_info.flags) or
  550. (tf_files_case_sensitive in source_info.flags) then
  551. FixPath:=s
  552. else
  553. FixPath:=Lower(s);
  554. end;
  555. {Actually the version in macutils.pp could be used,
  556. but that would not work for crosscompiling, so this is a slightly modified
  557. version of it.}
  558. function TranslatePathToMac (const path: TCmdStr; mpw: Boolean): TCmdStr;
  559. function GetVolumeIdentifier: TCmdStr;
  560. begin
  561. GetVolumeIdentifier := '{Boot}'
  562. (*
  563. if mpw then
  564. GetVolumeIdentifier := '{Boot}'
  565. else
  566. GetVolumeIdentifier := macosBootVolumeName;
  567. *)
  568. end;
  569. var
  570. slashPos, oldpos, newpos, oldlen, maxpos: Longint;
  571. begin
  572. oldpos := 1;
  573. slashPos := Pos('/', path);
  574. if (slashPos <> 0) then {its a unix path}
  575. begin
  576. if slashPos = 1 then
  577. begin {its a full path}
  578. oldpos := 2;
  579. TranslatePathToMac := GetVolumeIdentifier;
  580. end
  581. else {its a partial path}
  582. TranslatePathToMac := ':';
  583. end
  584. else
  585. begin
  586. slashPos := Pos('\', path);
  587. if (slashPos <> 0) then {its a dos path}
  588. begin
  589. if slashPos = 1 then
  590. begin {its a full path, without drive letter}
  591. oldpos := 2;
  592. TranslatePathToMac := GetVolumeIdentifier;
  593. end
  594. else if (Length(path) >= 2) and (path[2] = ':') then {its a full path, with drive letter}
  595. begin
  596. oldpos := 4;
  597. TranslatePathToMac := GetVolumeIdentifier;
  598. end
  599. else {its a partial path}
  600. TranslatePathToMac := ':';
  601. end;
  602. end;
  603. if (slashPos <> 0) then {its a unix or dos path}
  604. begin
  605. {Translate "/../" to "::" , "/./" to ":" and "/" to ":" }
  606. newpos := Length(TranslatePathToMac);
  607. oldlen := Length(path);
  608. SetLength(TranslatePathToMac, newpos + oldlen); {It will be no longer than what is already}
  609. {prepended plus length of path.}
  610. maxpos := Length(TranslatePathToMac); {Get real maxpos, can be short if String is ShortString}
  611. {There is never a slash in the beginning, because either it was an absolute path, and then the}
  612. {drive and slash was removed, or it was a relative path without a preceding slash.}
  613. while oldpos <= oldlen do
  614. begin
  615. {Check if special dirs, ./ or ../ }
  616. if path[oldPos] = '.' then
  617. if (oldpos + 1 <= oldlen) and (path[oldPos + 1] = '.') then
  618. begin
  619. if (oldpos + 2 > oldlen) or (path[oldPos + 2] in ['/', '\']) then
  620. begin
  621. {It is "../" or ".." translates to ":" }
  622. if newPos = maxPos then
  623. begin {Shouldn't actually happen, but..}
  624. Exit('');
  625. end;
  626. newPos := newPos + 1;
  627. TranslatePathToMac[newPos] := ':';
  628. oldPos := oldPos + 3;
  629. continue; {Start over again}
  630. end;
  631. end
  632. else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in ['/', '\']) then
  633. begin
  634. {It is "./" or "." ignor it }
  635. oldPos := oldPos + 2;
  636. continue; {Start over again}
  637. end;
  638. {Collect file or dir name}
  639. while (oldpos <= oldlen) and not (path[oldPos] in ['/', '\']) do
  640. begin
  641. if newPos = maxPos then
  642. begin {Shouldn't actually happen, but..}
  643. Exit('');
  644. end;
  645. newPos := newPos + 1;
  646. TranslatePathToMac[newPos] := path[oldPos];
  647. oldPos := oldPos + 1;
  648. end;
  649. {When we come here there is either a slash or we are at the end.}
  650. if (oldpos <= oldlen) then
  651. begin
  652. if newPos = maxPos then
  653. begin {Shouldn't actually happen, but..}
  654. Exit('');
  655. end;
  656. newPos := newPos + 1;
  657. TranslatePathToMac[newPos] := ':';
  658. oldPos := oldPos + 1;
  659. end;
  660. end;
  661. SetLength(TranslatePathToMac, newpos);
  662. end
  663. else if (path = '.') then
  664. TranslatePathToMac := ':'
  665. else if (path = '..') then
  666. TranslatePathToMac := '::'
  667. else
  668. TranslatePathToMac := path; {its a mac path}
  669. end;
  670. function FixFileName(const s:TCmdStr):TCmdStr;
  671. var
  672. i : longint;
  673. begin
  674. if source_info.system = system_powerpc_MACOS then
  675. FixFileName:= TranslatePathToMac(s, true)
  676. else
  677. if (tf_files_case_aware in source_info.flags) or
  678. (tf_files_case_sensitive in source_info.flags) then
  679. begin
  680. setlength(FixFileName,length(s));
  681. for i:=1 to length(s) do
  682. begin
  683. case s[i] of
  684. '/','\' :
  685. FixFileName[i]:=source_info.dirsep;
  686. else
  687. FixFileName[i]:=s[i];
  688. end;
  689. end;
  690. end
  691. else
  692. begin
  693. setlength(FixFileName,length(s));
  694. for i:=1 to length(s) do
  695. begin
  696. case s[i] of
  697. '/','\' :
  698. FixFileName[i]:=source_info.dirsep;
  699. 'A'..'Z' :
  700. FixFileName[i]:=char(byte(s[i])+32);
  701. else
  702. FixFileName[i]:=s[i];
  703. end;
  704. end;
  705. end;
  706. end;
  707. Function TargetFixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
  708. var
  709. i : longint;
  710. begin
  711. { Fix separator }
  712. for i:=1 to length(s) do
  713. if s[i] in ['/','\'] then
  714. s[i]:=target_info.DirSep;
  715. { Fix ending / }
  716. if (length(s)>0) and (s[length(s)]<>target_info.DirSep) and
  717. (s[length(s)]<>':') then
  718. s:=s+target_info.DirSep;
  719. { Remove ./ }
  720. if (not allowdot) and (s='.'+target_info.DirSep) then
  721. s:='';
  722. { return }
  723. if (tf_files_case_aware in target_info.flags) or
  724. (tf_files_case_sensitive in target_info.flags) then
  725. TargetFixPath:=s
  726. else
  727. TargetFixPath:=Lower(s);
  728. end;
  729. function TargetFixFileName(const s:TCmdStr):TCmdStr;
  730. var
  731. i : longint;
  732. begin
  733. if target_info.system = system_powerpc_MACOS then
  734. TargetFixFileName:= TranslatePathToMac(s, true)
  735. else
  736. if (tf_files_case_aware in target_info.flags) or
  737. (tf_files_case_sensitive in target_info.flags) then
  738. begin
  739. setlength(TargetFixFileName,length(s));
  740. for i:=1 to length(s) do
  741. begin
  742. case s[i] of
  743. '/','\' :
  744. TargetFixFileName[i]:=target_info.dirsep;
  745. else
  746. TargetFixFileName[i]:=s[i];
  747. end;
  748. end;
  749. end
  750. else
  751. begin
  752. setlength(TargetFixFileName,length(s));
  753. for i:=1 to length(s) do
  754. begin
  755. case s[i] of
  756. '/','\' :
  757. TargetFixFileName[i]:=target_info.dirsep;
  758. 'A'..'Z' :
  759. TargetFixFileName[i]:=char(byte(s[i])+32);
  760. else
  761. TargetFixFileName[i]:=s[i];
  762. end;
  763. end;
  764. end;
  765. end;
  766. procedure SplitBinCmd(const s:TCmdStr;var bstr:TCmdStr;var cstr:TCmdStr);
  767. var
  768. i : longint;
  769. begin
  770. i:=pos(' ',s);
  771. if i>0 then
  772. begin
  773. bstr:=Copy(s,1,i-1);
  774. cstr:=Copy(s,i+1,length(s)-i);
  775. end
  776. else
  777. begin
  778. bstr:=s;
  779. cstr:='';
  780. end;
  781. end;
  782. procedure TSearchPathList.AddPath(s:TCmdStr;addfirst:boolean);
  783. begin
  784. AddPath('',s,AddFirst);
  785. end;
  786. procedure TSearchPathList.AddPath(SrcPath,s:TCmdStr;addfirst:boolean);
  787. var
  788. staridx,
  789. i,j : longint;
  790. prefix,
  791. suffix,
  792. CurrentDir,
  793. currPath : TCmdStr;
  794. subdirfound : boolean;
  795. {$ifdef usedircache}
  796. dir : TCachedSearchRec;
  797. {$else usedircache}
  798. dir : TSearchRec;
  799. {$endif usedircache}
  800. hp : TCmdStrListItem;
  801. procedure WarnNonExistingPath(const path : TCmdStr);
  802. begin
  803. if assigned(do_comment) then
  804. do_comment(V_Tried,'Path "'+path+'" not found');
  805. end;
  806. procedure AddCurrPath;
  807. begin
  808. if addfirst then
  809. begin
  810. Remove(currPath);
  811. Insert(currPath);
  812. end
  813. else
  814. begin
  815. { Check if already in path, then we don't add it }
  816. hp:=Find(currPath);
  817. if not assigned(hp) then
  818. Concat(currPath);
  819. end;
  820. end;
  821. begin
  822. if s='' then
  823. exit;
  824. { Support default macro's }
  825. DefaultReplacements(s);
  826. if PathSeparator <> ';' then
  827. for i:=1 to length(s) do
  828. if s[i]=PathSeparator then
  829. s[i]:=';';
  830. { get current dir }
  831. CurrentDir:=GetCurrentDir;
  832. repeat
  833. { get currpath }
  834. if addfirst then
  835. begin
  836. j:=length(s);
  837. while (j>0) and (s[j]<>';') do
  838. dec(j);
  839. currPath:= TrimSpace(Copy(s,j+1,length(s)-j));
  840. if j=0 then
  841. s:=''
  842. else
  843. System.Delete(s,j,length(s)-j+1);
  844. end
  845. else
  846. begin
  847. j:=Pos(';',s);
  848. if j=0 then
  849. j:=255;
  850. currPath:= TrimSpace(Copy(s,1,j-1));
  851. System.Delete(s,1,j);
  852. end;
  853. { fix pathname }
  854. DePascalQuote(currPath);
  855. currPath:=SrcPath+FixPath(currPath,false);
  856. if currPath='' then
  857. currPath:= CurDirRelPath(source_info)
  858. else
  859. begin
  860. currPath:=FixPath(ExpandFileName(currpath),false);
  861. if (CurrentDir<>'') and (Copy(currPath,1,length(CurrentDir))=CurrentDir) then
  862. begin
  863. {$if defined(amiga) and defined(morphos)}
  864. currPath:= CurrentDir+Copy(currPath,length(CurrentDir)+1,255);
  865. {$else}
  866. currPath:= CurDirRelPath(source_info)+Copy(currPath,length(CurrentDir)+1,255);
  867. {$endif}
  868. end;
  869. end;
  870. { wildcard adding ? }
  871. staridx:=pos('*',currpath);
  872. if staridx>0 then
  873. begin
  874. prefix:=ExtractFilePath(Copy(currpath,1,staridx));
  875. suffix:=Copy(currpath,staridx+1,length(currpath));
  876. subdirfound:=false;
  877. {$ifdef usedircache}
  878. if DirCache.FindFirst(Prefix+AllFilesMask,dir) then
  879. begin
  880. repeat
  881. if (dir.attr and faDirectory)<>0 then
  882. begin
  883. subdirfound:=true;
  884. currpath:=prefix+dir.name+suffix;
  885. if (suffix='') or PathExists(currpath,true) then
  886. begin
  887. hp:=Find(currPath);
  888. if not assigned(hp) then
  889. AddCurrPath;
  890. end;
  891. end;
  892. until not DirCache.FindNext(dir);
  893. end;
  894. DirCache.FindClose(dir);
  895. {$else usedircache}
  896. if findfirst(prefix+AllFilesMask,faDirectory,dir) = 0 then
  897. begin
  898. repeat
  899. if (dir.name<>'.') and
  900. (dir.name<>'..') and
  901. ((dir.attr and faDirectory)<>0) then
  902. begin
  903. subdirfound:=true;
  904. currpath:=prefix+dir.name+suffix;
  905. if (suffix='') or PathExists(currpath,false) then
  906. begin
  907. hp:=Find(currPath);
  908. if not assigned(hp) then
  909. AddCurrPath;
  910. end;
  911. end;
  912. until findnext(dir) <> 0;
  913. end;
  914. FindClose(dir);
  915. {$endif usedircache}
  916. if not subdirfound then
  917. WarnNonExistingPath(currpath);
  918. end
  919. else
  920. begin
  921. if PathExists(currpath,true) then
  922. AddCurrPath
  923. else
  924. WarnNonExistingPath(currpath);
  925. end;
  926. until (s='');
  927. end;
  928. procedure TSearchPathList.AddList(list:TSearchPathList;addfirst:boolean);
  929. var
  930. s : TCmdStr;
  931. hl : TSearchPathList;
  932. hp,hp2 : TCmdStrListItem;
  933. begin
  934. if list.empty then
  935. exit;
  936. { create temp and reverse the list }
  937. if addfirst then
  938. begin
  939. hl:=TSearchPathList.Create;
  940. hp:=TCmdStrListItem(list.first);
  941. while assigned(hp) do
  942. begin
  943. hl.insert(hp.Str);
  944. hp:=TCmdStrListItem(hp.next);
  945. end;
  946. while not hl.empty do
  947. begin
  948. s:=hl.GetFirst;
  949. Remove(s);
  950. Insert(s);
  951. end;
  952. hl.Free;
  953. end
  954. else
  955. begin
  956. hp:=TCmdStrListItem(list.first);
  957. while assigned(hp) do
  958. begin
  959. hp2:=Find(hp.Str);
  960. { Check if already in path, then we don't add it }
  961. if not assigned(hp2) then
  962. Concat(hp.Str);
  963. hp:=TCmdStrListItem(hp.next);
  964. end;
  965. end;
  966. end;
  967. function TSearchPathList.FindFile(const f :TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  968. Var
  969. p : TCmdStrListItem;
  970. begin
  971. FindFile:=false;
  972. p:=TCmdStrListItem(first);
  973. while assigned(p) do
  974. begin
  975. result:=FileExistsNonCase(p.Str,f,allowcache,FoundFile);
  976. if result then
  977. exit;
  978. p:=TCmdStrListItem(p.next);
  979. end;
  980. { Return original filename if not found }
  981. FoundFile:=f;
  982. end;
  983. function FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  984. Var
  985. singlepathstring : TCmdStr;
  986. i : longint;
  987. begin
  988. if PathSeparator <> ';' then
  989. for i:=1 to length(path) do
  990. if path[i]=PathSeparator then
  991. path[i]:=';';
  992. FindFile:=false;
  993. repeat
  994. i:=pos(';',path);
  995. if i=0 then
  996. i:=Succ (Length (Path));
  997. singlepathstring:=FixPath(copy(path,1,i-1),false);
  998. delete(path,1,i);
  999. result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
  1000. if result then
  1001. exit;
  1002. until path='';
  1003. FoundFile:=f;
  1004. end;
  1005. {
  1006. function FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;
  1007. Var
  1008. singlepathstring : TCmdStr;
  1009. startpc,pc : pchar;
  1010. begin
  1011. FindFilePchar:=false;
  1012. if Assigned (Path) then
  1013. begin
  1014. pc:=path;
  1015. repeat
  1016. startpc:=pc;
  1017. while (pc^<>PathSeparator) and (pc^<>';') and (pc^<>#0) do
  1018. inc(pc);
  1019. SetLength(singlepathstring, pc-startpc);
  1020. move(startpc^,singlepathstring[1],pc-startpc);
  1021. singlepathstring:=FixPath(ExpandFileName(singlepathstring),false);
  1022. result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
  1023. if result then
  1024. exit;
  1025. if (pc^=#0) then
  1026. break;
  1027. inc(pc);
  1028. until false;
  1029. end;
  1030. foundfile:=f;
  1031. end;
  1032. }
  1033. function FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  1034. var
  1035. Path : TCmdStr;
  1036. found : boolean;
  1037. begin
  1038. found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),'.;'+exepath,allowcache,foundfile);
  1039. if not found then
  1040. begin
  1041. {$ifdef macos}
  1042. Path:=GetEnvironmentVariable('Commands');
  1043. {$else}
  1044. Path:=GetEnvironmentVariable('PATH');
  1045. {$endif}
  1046. found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),Path,allowcache,foundfile);
  1047. end;
  1048. FindExe:=found;
  1049. end;
  1050. function GetShortName(const n:TCmdStr):TCmdStr;
  1051. {$ifdef win32}
  1052. var
  1053. hs,hs2 : TCmdStr;
  1054. i : longint;
  1055. {$endif}
  1056. {$if defined(go32v2) or defined(watcom)}
  1057. var
  1058. hs : shortstring;
  1059. {$endif}
  1060. begin
  1061. GetShortName:=n;
  1062. {$ifdef win32}
  1063. hs:=n+#0;
  1064. { may become longer in case of e.g. ".a" -> "a~1" or so }
  1065. setlength(hs2,length(hs)*2);
  1066. i:=Windows.GetShortPathName(@hs[1],@hs2[1],length(hs)*2);
  1067. if (i>0) and (i<=length(hs)*2) then
  1068. begin
  1069. setlength(hs2,strlen(@hs2[1]));
  1070. GetShortName:=hs2;
  1071. end;
  1072. {$endif}
  1073. {$if defined(go32v2) or defined(watcom)}
  1074. hs:=n;
  1075. if Dos.GetShortName(hs) then
  1076. GetShortName:=hs;
  1077. {$endif}
  1078. end;
  1079. {****************************************************************************
  1080. Init / Done
  1081. ****************************************************************************}
  1082. procedure InitFileUtils;
  1083. begin
  1084. DirCache:=TDirectoryCache.Create;
  1085. end;
  1086. procedure DoneFileUtils;
  1087. begin
  1088. DirCache.Free;
  1089. end;
  1090. end.