fputils.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. Utilility routines used by the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPUtils;
  12. interface
  13. uses
  14. Sysutils,
  15. Objects;
  16. const
  17. dirsep = System.DirectorySeparator;
  18. {$ifdef Unix}
  19. listsep = [';',':'];
  20. exeext = '';
  21. pasext = '.pas';
  22. ppext = '.pp';
  23. {$else}
  24. {$ifdef HASAMIGA}
  25. listsep = [';'];
  26. exeext = '';
  27. pasext = '.pas';
  28. ppext = '.pp';
  29. {$else HASAMIGA}
  30. listsep = [';'];
  31. exeext = '.exe';
  32. pasext = '.pas';
  33. ppext = '.pp';
  34. {$endif HASAMIGA}
  35. {$endif}
  36. function SmartPath(Path: string): string;
  37. Function FixPath(s:string;allowdot:boolean):string;
  38. function FixFileName(const s:string):string;
  39. function MakeExeName(const fn:string):string;
  40. function Center(const S: string; Len: byte): string;
  41. function FitStr(const S: string; Len: byte): string;
  42. function KillTilde(S: string): string;
  43. function LowercaseStr(const S: string): string;
  44. {function DirOf(const S: string): string;
  45. function ExtOf(const S: string): string;
  46. function NameOf(const S: string): string;
  47. function NameAndExtOf(const S: string): string;}
  48. function StrToExtended(S: string): Extended;
  49. function Power(const A,B: double): double;
  50. function MatchesMask(What, Mask: string): boolean;
  51. function MatchesMaskList(What, MaskList: string): boolean;
  52. function MatchesFileList(What, FileList: string): boolean;
  53. function EatIO: integer;
  54. function RenameFile(const OldFileName,NewFileName: string): boolean;
  55. function LocateFile(FileList: string): string;
  56. function LocatePasFile(const FileName:string):string;
  57. function LocateExeFile(var FileName:string): boolean;
  58. function EraseFile(FileName: string): boolean;
  59. function GetStr(const P: PString): string;
  60. procedure ReplaceStr(var S: string; const What,NewS: string);
  61. procedure ReplaceStrI(var S: string; What: string; const NewS: string);
  62. const ListSeparator : char = ';';
  63. implementation
  64. uses Dos,
  65. WUtils,
  66. FPVars,FPSwitch;
  67. function IntToStr(L: longint): string;
  68. var S: string;
  69. begin
  70. Str(L,S);
  71. IntToStr:=S;
  72. end;
  73. function IntToStrZ(L: longint; MinLen: byte): string;
  74. var S: string;
  75. begin
  76. S:=IntToStr(L);
  77. if length(S)<MinLen then S:=CharStr('0',MinLen-length(S))+S;
  78. IntToStrZ:=S;
  79. end;
  80. function IntToStrL(L: longint; MinLen: byte): string;
  81. var S: string;
  82. begin
  83. S:=IntToStr(L);
  84. if length(S)<MinLen then S:=CharStr(' ',MinLen-length(S))+S;
  85. IntToStrL:=S;
  86. end;
  87. function SmartPath(Path: string): string;
  88. var S: string;
  89. begin
  90. GetDir(0,S);
  91. {$ifdef HASAMIGA}
  92. if (copy(S,length(S),1)<>DirSep) and (copy(S,length(S),1)<>DriveSeparator) then S:=S+DirSep;
  93. {$else}
  94. if copy(S,length(S),1)<>DirSep then S:=S+DirSep;
  95. {$endif}
  96. {$ifdef FSCaseInsensitive}
  97. if (LowerCaseStr(copy(Path,1,length(S)))=LowerCaseStr(S)) {and (Pos('\',copy(Path,length(S)+1,High(S)))=0)} then
  98. {$else}
  99. if (copy(Path,1,length(S))=S) {and (Pos('\',copy(Path,length(S)+1,High(S)))=0)} then
  100. {$endif}
  101. system.Delete(Path,1,length(S));
  102. SmartPath:=Path;
  103. end;
  104. Function FixPath(s:string;allowdot:boolean):string;
  105. var
  106. i : longint;
  107. begin
  108. for i:=1 to length(s) do
  109. if s[i] in ['/','\'] then
  110. s[i]:=DirSep;
  111. if (length(s)>0) and (s[length(s)]<>DirSep) and
  112. (s[length(s)]<>':') then
  113. s:=s+DirSep;
  114. if (not allowdot) and (s='.'+DirSep) then
  115. s:='';
  116. FixPath:=s;
  117. end;
  118. function FixFileName(const s:string):string;
  119. var
  120. i : longint;
  121. {$ifdef Unix}
  122. NoPath : boolean;
  123. {$endif}
  124. begin
  125. {$ifdef Unix}NoPath:=true;{$endif}
  126. for i:=length(s) downto 1 do
  127. begin
  128. case s[i] of
  129. {$ifdef Unix}
  130. '/','\' : begin
  131. FixFileName[i]:='/';
  132. NoPath:=false; {Skip lowercasing path: 'X11'<>'x11' }
  133. end;
  134. 'A'..'Z' : if NoPath then
  135. FixFileName[i]:=char(byte(s[i])+ord('a')-ord('A'))
  136. else
  137. FixFileName[i]:=s[i];
  138. {$else}
  139. '/' : FixFileName[i]:='\';
  140. 'A'..'Z' : FixFileName[i]:=char(byte(s[i])+32);
  141. {$endif}
  142. else
  143. FixFileName[i]:=s[i];
  144. end;
  145. end;
  146. FixFileName[0]:=s[0];
  147. end;
  148. function MakeExeName(const fn:string):string;
  149. var
  150. d : DirStr;
  151. n : NameStr;
  152. e : ExtStr;
  153. begin
  154. FSplit(fn,d,n,e);
  155. MakeExeName:=d+n+ExeExt;
  156. end;
  157. function Center(const S: string; Len: byte): string;
  158. begin
  159. Center:=LExpand(S+CharStr(' ',Max(0,(Len-length(S)) div 2)),Len);
  160. end;
  161. function FitStr(const S: string; Len: byte): string;
  162. begin
  163. FitStr:=RExpand(copy(S,1,Len),Len);
  164. end;
  165. function KillTilde(S: string): string;
  166. var P: longint;
  167. begin
  168. repeat
  169. P:=Pos('~',S);
  170. if P>0 then
  171. Delete(S,P,1);
  172. until P=0;
  173. KillTilde:=S;
  174. end;
  175. function LowerCaseStr(const S: string): string;
  176. var
  177. I: Longint;
  178. begin
  179. for I:=1 to length(S) do
  180. if S[I] in ['A'..'Z'] then
  181. LowerCaseStr[I]:=chr(ord(S[I])+32)
  182. else
  183. LowerCaseStr[I]:=S[I];
  184. LowercaseStr[0]:=S[0];
  185. end;
  186. {function DirOf(const S: string): string;
  187. var D: DirStr; E: ExtStr; N: NameStr;
  188. begin
  189. FSplit(S,D,N,E);
  190. if (D<>'') and (D[Length(D)]<>DirSep) then
  191. DirOf:=D+DirSep
  192. else
  193. DirOf:=D;
  194. end;
  195. function ExtOf(const S: string): string;
  196. var D: DirStr; E: ExtStr; N: NameStr;
  197. begin
  198. FSplit(S,D,N,E);
  199. ExtOf:=E;
  200. end;
  201. function NameOf(const S: string): string;
  202. var D: DirStr; E: ExtStr; N: NameStr;
  203. begin
  204. FSplit(S,D,N,E);
  205. NameOf:=N;
  206. end;
  207. function NameAndExtOf(const S: string): string;
  208. var D: DirStr; E: ExtStr; N: NameStr;
  209. begin
  210. FSplit(S,D,N,E);
  211. NameAndExtOf:=N+E;
  212. end; }
  213. function StrToExtended(S: string): Extended;
  214. var R : Extended;
  215. C : integer;
  216. begin
  217. Val(S,R,C);
  218. StrToExtended:=R;
  219. end;
  220. function Power(const A,B: double): double;
  221. begin
  222. if A=0 then Power:=0
  223. else Power:=exp(B*ln(A));
  224. end;
  225. function MatchesMask(What, Mask: string): boolean;
  226. function upper(const s : string) : string;
  227. var
  228. i : Sw_integer;
  229. begin
  230. for i:=1 to length(s) do
  231. if s[i] in ['a'..'z'] then
  232. upper[i]:=char(byte(s[i])-32)
  233. else
  234. upper[i]:=s[i];
  235. upper[0]:=s[0];
  236. end;
  237. Function CmpStr(const hstr1,hstr2:string):boolean;
  238. var
  239. found : boolean;
  240. i1,i2 : Sw_integer;
  241. begin
  242. i1:=0;
  243. i2:=0;
  244. found:=true;
  245. while found and (i1<length(hstr1)) and (i2<=length(hstr2)) do
  246. begin
  247. if found then
  248. inc(i2);
  249. inc(i1);
  250. case hstr1[i1] of
  251. '?' :
  252. found:=true;
  253. '*' :
  254. begin
  255. found:=true;
  256. if (i1=length(hstr1)) then
  257. i2:=length(hstr2)
  258. else
  259. if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
  260. begin
  261. if i2<length(hstr2) then
  262. dec(i1)
  263. end
  264. else
  265. if i2>1 then
  266. dec(i2);
  267. end;
  268. else
  269. found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
  270. end;
  271. end;
  272. if found then
  273. found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
  274. CmpStr:=found;
  275. end;
  276. var
  277. D1,D2 : DirStr;
  278. N1,N2 : NameStr;
  279. E1,E2 : Extstr;
  280. begin
  281. {$ifdef Unix}
  282. FSplit(What,D1,N1,E1);
  283. FSplit(Mask,D2,N2,E2);
  284. {$else}
  285. FSplit(Upper(What),D1,N1,E1);
  286. FSplit(Upper(Mask),D2,N2,E2);
  287. {$endif}
  288. MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
  289. end;
  290. function MatchesMaskList(What, MaskList: string): boolean;
  291. var P: integer;
  292. Match: boolean;
  293. begin
  294. Match:=false;
  295. if What<>'' then
  296. repeat
  297. P:=Pos(ListSeparator, MaskList);
  298. if P=0 then
  299. P:=length(MaskList)+1;
  300. Match:=MatchesMask(What,copy(MaskList,1,P-1));
  301. Delete(MaskList,1,P);
  302. until Match or (MaskList='');
  303. MatchesMaskList:=Match;
  304. end;
  305. function MatchesFileList(What, FileList: string): boolean;
  306. var P: integer;
  307. Match: boolean;
  308. WD,FD : record D: DirStr; N: NameStr; E: ExtStr; end;
  309. F: string;
  310. begin
  311. Match:=false;
  312. FSplit(What,WD.D,WD.N,WD.E);
  313. if What<>'' then
  314. repeat
  315. P:=Pos(ListSeparator, FileList);
  316. if P=0 then P:=length(FileList)+1;
  317. F:=copy(FileList,1,P-1);
  318. FSplit(F,FD.D,FD.N,FD.E);
  319. Match:=MatchesMask(WD.D+WD.N,FD.D+FD.N) and
  320. MatchesMask(WD.E,FD.E);
  321. Delete(FileList,1,P);
  322. until Match or (FileList='');
  323. MatchesFileList:=Match;
  324. end;
  325. function EatIO: integer;
  326. begin
  327. EatIO:=IOResult;
  328. end;
  329. function RenameFile(const OldFileName,NewFileName: string): boolean;
  330. var f: file;
  331. begin
  332. Assign(f,OldFileName);
  333. Rename(f,NewFileName);
  334. RenameFile:=(EatIO=0);
  335. end;
  336. function LocateFile(FileList: string): string;
  337. var FilePath: string;
  338. function CheckFile(Path,Name: string): boolean;
  339. var OK: boolean;
  340. begin
  341. Path:=CompleteDir(Path);
  342. Path:=Path+Name;
  343. OK:=ExistsFile(Path);
  344. if OK then FilePath:=Path;
  345. CheckFile:=OK;
  346. end;
  347. function LocateSingleFile(FileName: string): boolean;
  348. var OK: boolean;
  349. begin
  350. OK:=CheckFile(FExpand('.'),FileName);
  351. if OK=false then OK:=CheckFile(StartupDir,FileName);
  352. if OK=false then OK:=CheckFile(IDEDir,FileName);
  353. LocateSingleFile:=OK;
  354. end;
  355. var P: integer;
  356. begin
  357. FilePath:='';
  358. if FileList<>'' then
  359. repeat
  360. P:=Pos(ListSeparator,FileList); if P=0 then P:=length(FileList)+1;
  361. LocateSingleFile(copy(FileList,1,P-1));
  362. Delete(FileList,1,P);
  363. until (FilePath<>'') or (FileList='');
  364. LocateFile:=FilePath;
  365. end;
  366. function LocatePasFile(const FileName:string):string;
  367. var
  368. s : string;
  369. begin
  370. LocatePasFile:=FileName;
  371. if ExistsFile(FileName) or (ExtOf(FileName)<>'') then
  372. exit;
  373. S:=FileName+PPExt;
  374. if ExistsFile(S) then
  375. begin
  376. LocatePasFile:=S;
  377. exit;
  378. end;
  379. S:=FileName+PasExt;
  380. if ExistsFile(S) then
  381. begin
  382. LocatePasFile:=S;
  383. exit;
  384. end;
  385. end;
  386. function LocateExeFile(var FileName:string): boolean;
  387. var
  388. dir : string;
  389. s : ansistring;
  390. i : longint;
  391. begin
  392. LocateExeFile:=False;
  393. if ExistsFile(FileName) then
  394. begin
  395. LocateExeFile:=true;
  396. Exit;
  397. end;
  398. S:=sysutils.GetEnvironmentVariable('PATH');
  399. While Length(S)>0 do
  400. begin
  401. i:=1;
  402. While (i<=Length(S)) and not (S[i] in ListSep) do
  403. Inc(i);
  404. Dir:=CompleteDir(Copy(S,1,i-1));
  405. if i<Length(S) then
  406. Delete(S,1,i)
  407. else
  408. S:='';
  409. if ExistsFile(Dir+FileName) then
  410. Begin
  411. FileName:=Dir+FileName;
  412. LocateExeFile:=true;
  413. Exit;
  414. End;
  415. end;
  416. end;
  417. function GetStr(const P: PString): string;
  418. begin
  419. if P=nil then GetStr:='' else GetStr:=P^;
  420. end;
  421. function EraseFile(FileName: string): boolean;
  422. var f: file;
  423. begin
  424. if FileName='' then Exit;
  425. {$I-}
  426. Assign(f,FileName);
  427. Erase(f);
  428. {$I+}
  429. EraseFile:=(EatIO=0);
  430. end;
  431. procedure ReplaceStr(var S: string; const What,NewS: string);
  432. var I : Sw_integer;
  433. begin
  434. repeat
  435. I:=Pos(What,S);
  436. if I>0 then
  437. begin
  438. Delete(S,I,length(What));
  439. Insert(NewS,S,I);
  440. end;
  441. until I=0;
  442. end;
  443. procedure ReplaceStrI(var S: string; What: string; const NewS: string);
  444. var I : integer;
  445. UpcaseS: string;
  446. begin
  447. UpcaseS:=UpcaseStr(S); What:=UpcaseStr(What);
  448. repeat
  449. I:=Pos(What,UpcaseS);
  450. if I>0 then
  451. begin
  452. Delete(S,I,length(What));
  453. Insert(NewS,S,I);
  454. Delete(UpcaseS,I,length(What));
  455. Insert(NewS,UpcaseS,I);
  456. end;
  457. until I=0;
  458. end;
  459. END.