cfileutl.pas 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208
  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 cfileutl;
  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. 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. { get current dir }
  827. CurrentDir:=GetCurrentDir;
  828. repeat
  829. { get currpath }
  830. if addfirst then
  831. begin
  832. j:=length(s);
  833. while (j>0) and (s[j]<>';') do
  834. dec(j);
  835. currPath:= TrimSpace(Copy(s,j+1,length(s)-j));
  836. DePascalQuote(currPath);
  837. currPath:=FixPath(currPath,false);
  838. if j=0 then
  839. s:=''
  840. else
  841. System.Delete(s,j,length(s)-j+1);
  842. end
  843. else
  844. begin
  845. j:=Pos(';',s);
  846. if j=0 then
  847. j:=255;
  848. currPath:= TrimSpace(Copy(s,1,j-1));
  849. DePascalQuote(currPath);
  850. currPath:=SrcPath+FixPath(currPath,false);
  851. System.Delete(s,1,j);
  852. end;
  853. { fix pathname }
  854. if currPath='' then
  855. currPath:= CurDirRelPath(source_info)
  856. else
  857. begin
  858. currPath:=FixPath(ExpandFileName(currpath),false);
  859. if (CurrentDir<>'') and (Copy(currPath,1,length(CurrentDir))=CurrentDir) then
  860. begin
  861. {$if defined(amiga) and defined(morphos)}
  862. currPath:= CurrentDir+Copy(currPath,length(CurrentDir)+1,255);
  863. {$else}
  864. currPath:= CurDirRelPath(source_info)+Copy(currPath,length(CurrentDir)+1,255);
  865. {$endif}
  866. end;
  867. end;
  868. { wildcard adding ? }
  869. staridx:=pos('*',currpath);
  870. if staridx>0 then
  871. begin
  872. prefix:=ExtractFilePath(Copy(currpath,1,staridx));
  873. suffix:=Copy(currpath,staridx+1,length(currpath));
  874. subdirfound:=false;
  875. {$ifdef usedircache}
  876. if DirCache.FindFirst(Prefix+AllFilesMask,dir) then
  877. begin
  878. repeat
  879. if (dir.attr and faDirectory)<>0 then
  880. begin
  881. subdirfound:=true;
  882. currpath:=prefix+dir.name+suffix;
  883. if (suffix='') or PathExists(currpath,true) then
  884. begin
  885. hp:=Find(currPath);
  886. if not assigned(hp) then
  887. AddCurrPath;
  888. end;
  889. end;
  890. until not DirCache.FindNext(dir);
  891. end;
  892. DirCache.FindClose(dir);
  893. {$else usedircache}
  894. if findfirst(prefix+AllFilesMask,faDirectory,dir) = 0 then
  895. begin
  896. repeat
  897. if (dir.name<>'.') and
  898. (dir.name<>'..') and
  899. ((dir.attr and faDirectory)<>0) then
  900. begin
  901. subdirfound:=true;
  902. currpath:=prefix+dir.name+suffix;
  903. if (suffix='') or PathExists(currpath,false) then
  904. begin
  905. hp:=Find(currPath);
  906. if not assigned(hp) then
  907. AddCurrPath;
  908. end;
  909. end;
  910. until findnext(dir) <> 0;
  911. end;
  912. FindClose(dir);
  913. {$endif usedircache}
  914. if not subdirfound then
  915. WarnNonExistingPath(currpath);
  916. end
  917. else
  918. begin
  919. if PathExists(currpath,true) then
  920. AddCurrPath
  921. else
  922. WarnNonExistingPath(currpath);
  923. end;
  924. until (s='');
  925. end;
  926. procedure TSearchPathList.AddList(list:TSearchPathList;addfirst:boolean);
  927. var
  928. s : TCmdStr;
  929. hl : TSearchPathList;
  930. hp,hp2 : TCmdStrListItem;
  931. begin
  932. if list.empty then
  933. exit;
  934. { create temp and reverse the list }
  935. if addfirst then
  936. begin
  937. hl:=TSearchPathList.Create;
  938. hp:=TCmdStrListItem(list.first);
  939. while assigned(hp) do
  940. begin
  941. hl.insert(hp.Str);
  942. hp:=TCmdStrListItem(hp.next);
  943. end;
  944. while not hl.empty do
  945. begin
  946. s:=hl.GetFirst;
  947. Remove(s);
  948. Insert(s);
  949. end;
  950. hl.Free;
  951. end
  952. else
  953. begin
  954. hp:=TCmdStrListItem(list.first);
  955. while assigned(hp) do
  956. begin
  957. hp2:=Find(hp.Str);
  958. { Check if already in path, then we don't add it }
  959. if not assigned(hp2) then
  960. Concat(hp.Str);
  961. hp:=TCmdStrListItem(hp.next);
  962. end;
  963. end;
  964. end;
  965. function TSearchPathList.FindFile(const f :TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  966. Var
  967. p : TCmdStrListItem;
  968. begin
  969. FindFile:=false;
  970. p:=TCmdStrListItem(first);
  971. while assigned(p) do
  972. begin
  973. result:=FileExistsNonCase(p.Str,f,allowcache,FoundFile);
  974. if result then
  975. exit;
  976. p:=TCmdStrListItem(p.next);
  977. end;
  978. { Return original filename if not found }
  979. FoundFile:=f;
  980. end;
  981. function FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  982. Var
  983. singlepathstring : TCmdStr;
  984. i : longint;
  985. begin
  986. if PathSeparator <> ';' then
  987. for i:=1 to length(path) do
  988. if path[i]=PathSeparator then
  989. path[i]:=';';
  990. FindFile:=false;
  991. repeat
  992. i:=pos(';',path);
  993. if i=0 then
  994. i:=Succ (Length (Path));
  995. singlepathstring:=FixPath(copy(path,1,i-1),false);
  996. delete(path,1,i);
  997. result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
  998. if result then
  999. exit;
  1000. until path='';
  1001. FoundFile:=f;
  1002. end;
  1003. {
  1004. function FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;
  1005. Var
  1006. singlepathstring : TCmdStr;
  1007. startpc,pc : pchar;
  1008. begin
  1009. FindFilePchar:=false;
  1010. if Assigned (Path) then
  1011. begin
  1012. pc:=path;
  1013. repeat
  1014. startpc:=pc;
  1015. while (pc^<>PathSeparator) and (pc^<>';') and (pc^<>#0) do
  1016. inc(pc);
  1017. SetLength(singlepathstring, pc-startpc);
  1018. move(startpc^,singlepathstring[1],pc-startpc);
  1019. singlepathstring:=FixPath(ExpandFileName(singlepathstring),false);
  1020. result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
  1021. if result then
  1022. exit;
  1023. if (pc^=#0) then
  1024. break;
  1025. inc(pc);
  1026. until false;
  1027. end;
  1028. foundfile:=f;
  1029. end;
  1030. }
  1031. function FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
  1032. var
  1033. Path : TCmdStr;
  1034. found : boolean;
  1035. begin
  1036. found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),'.;'+exepath,allowcache,foundfile);
  1037. if not found then
  1038. begin
  1039. {$ifdef macos}
  1040. Path:=GetEnvironmentVariable('Commands');
  1041. {$else}
  1042. Path:=GetEnvironmentVariable('PATH');
  1043. {$endif}
  1044. found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),Path,allowcache,foundfile);
  1045. end;
  1046. FindExe:=found;
  1047. end;
  1048. function GetShortName(const n:TCmdStr):TCmdStr;
  1049. {$ifdef win32}
  1050. var
  1051. hs,hs2 : TCmdStr;
  1052. i : longint;
  1053. {$endif}
  1054. {$if defined(go32v2) or defined(watcom)}
  1055. var
  1056. hs : shortstring;
  1057. {$endif}
  1058. begin
  1059. GetShortName:=n;
  1060. {$ifdef win32}
  1061. hs:=n+#0;
  1062. { may become longer in case of e.g. ".a" -> "a~1" or so }
  1063. setlength(hs2,length(hs)*2);
  1064. i:=Windows.GetShortPathName(@hs[1],@hs2[1],length(hs)*2);
  1065. if (i>0) and (i<=length(hs)*2) then
  1066. begin
  1067. setlength(hs2,strlen(@hs2[1]));
  1068. GetShortName:=hs2;
  1069. end;
  1070. {$endif}
  1071. {$if defined(go32v2) or defined(watcom)}
  1072. hs:=n;
  1073. if Dos.GetShortName(hs) then
  1074. GetShortName:=hs;
  1075. {$endif}
  1076. end;
  1077. {****************************************************************************
  1078. Init / Done
  1079. ****************************************************************************}
  1080. procedure InitFileUtils;
  1081. begin
  1082. DirCache:=TDirectoryCache.Create;
  1083. end;
  1084. procedure DoneFileUtils;
  1085. begin
  1086. DirCache.Free;
  1087. end;
  1088. end.