2
0

sysutils.pp 25 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Florian Klaempfl
  4. member of the Free Pascal development team
  5. Sysutils unit for linux
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  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.
  11. **********************************************************************}
  12. unit sysutils;
  13. interface
  14. {$MODE objfpc}
  15. { force ansistrings }
  16. {$H+}
  17. {$if defined(BSD) and defined(FPC_USE_LIBC)}
  18. {$define USE_VFORK}
  19. {$endif}
  20. {$DEFINE OS_FILESETDATEBYNAME}
  21. {$DEFINE HAS_SLEEP}
  22. {$DEFINE HAS_OSERROR}
  23. {$DEFINE HAS_OSCONFIG}
  24. {$DEFINE HAS_TEMPDIR}
  25. {$DEFINE HASUNIX}
  26. {$DEFINE HASCREATEGUID}
  27. uses
  28. Unix,errors,sysconst,Unixtype;
  29. { Include platform independent interface part }
  30. {$i sysutilh.inc}
  31. Function AddDisk(const path:string) : Byte;
  32. { the following is Kylix compatibility stuff, it should be moved to a
  33. special compatibilty unit (FK) }
  34. const
  35. RTL_SIGINT = 0;
  36. RTL_SIGFPE = 1;
  37. RTL_SIGSEGV = 2;
  38. RTL_SIGILL = 3;
  39. RTL_SIGBUS = 4;
  40. RTL_SIGQUIT = 5;
  41. RTL_SIGLAST = RTL_SIGQUIT;
  42. RTL_SIGDEFAULT = -1;
  43. type
  44. TSignalState = (ssNotHooked, ssHooked, ssOverridden);
  45. function InquireSignal(RtlSigNum: Integer): TSignalState;
  46. procedure AbandonSignalHandler(RtlSigNum: Integer);
  47. procedure HookSignal(RtlSigNum: Integer);
  48. procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
  49. implementation
  50. Uses
  51. {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix, unixutil;
  52. function InquireSignal(RtlSigNum: Integer): TSignalState;
  53. begin
  54. end;
  55. procedure AbandonSignalHandler(RtlSigNum: Integer);
  56. begin
  57. end;
  58. procedure HookSignal(RtlSigNum: Integer);
  59. begin
  60. end;
  61. procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
  62. begin
  63. end;
  64. {$Define OS_FILEISREADONLY} // Specific implementation for Unix.
  65. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  66. {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
  67. { Include platform independent implementation part }
  68. {$i sysutils.inc}
  69. { Include SysCreateGUID function }
  70. {$i suuid.inc}
  71. Const
  72. {Date Translation}
  73. C1970=2440588;
  74. D0 = 1461;
  75. D1 = 146097;
  76. D2 =1721119;
  77. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  78. Var
  79. YYear,XYear,Temp,TempMonth : LongInt;
  80. Begin
  81. Temp:=((JulianDN-D2) shl 2)-1;
  82. JulianDN:=Temp Div D1;
  83. XYear:=(Temp Mod D1) or 3;
  84. YYear:=(XYear Div D0);
  85. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  86. Day:=((Temp Mod 153)+5) Div 5;
  87. TempMonth:=Temp Div 153;
  88. If TempMonth>=10 Then
  89. Begin
  90. inc(YYear);
  91. dec(TempMonth,12);
  92. End;
  93. inc(TempMonth,3);
  94. Month := TempMonth;
  95. Year:=YYear+(JulianDN*100);
  96. end;
  97. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  98. {
  99. Transforms Epoch time into local time (hour, minute,seconds)
  100. }
  101. Var
  102. DateNum: LongInt;
  103. Begin
  104. inc(Epoch,TZSeconds);
  105. Datenum:=(Epoch Div 86400) + c1970;
  106. JulianToGregorian(DateNum,Year,Month,day);
  107. Epoch:=Abs(Epoch Mod 86400);
  108. Hour:=Epoch Div 3600;
  109. Epoch:=Epoch Mod 3600;
  110. Minute:=Epoch Div 60;
  111. Second:=Epoch Mod 60;
  112. End;
  113. {****************************************************************************
  114. File Functions
  115. ****************************************************************************}
  116. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  117. Var
  118. DotPos,SlashPos,i : longint;
  119. Begin
  120. SlashPos:=0;
  121. DotPos:=256;
  122. i:=Length(Path);
  123. While (i>0) and (SlashPos=0) Do
  124. Begin
  125. If (DotPos=256) and (Path[i]='.') Then
  126. begin
  127. DotPos:=i;
  128. end;
  129. If (Path[i]='/') Then
  130. SlashPos:=i;
  131. Dec(i);
  132. End;
  133. Ext:=Copy(Path,DotPos,255);
  134. Dir:=Copy(Path,1,SlashPos);
  135. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  136. End;
  137. Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
  138. Var LinuxFlags : longint;
  139. BEGIN
  140. LinuxFlags:=0;
  141. Case (Mode and 3) of
  142. 0 : LinuxFlags:=LinuxFlags or O_RdOnly;
  143. 1 : LinuxFlags:=LinuxFlags or O_WrOnly;
  144. 2 : LinuxFlags:=LinuxFlags or O_RdWr;
  145. end;
  146. FileOpen:=fpOpen (FileName,LinuxFlags);
  147. //!! We need to set locking based on Mode !!
  148. end;
  149. Function FileCreate (Const FileName : String) : Longint;
  150. begin
  151. FileCreate:=fpOpen(FileName,O_RdWr or O_Creat or O_Trunc);
  152. end;
  153. Function FileCreate (Const FileName : String;Mode : Longint) : Longint;
  154. BEGIN
  155. FileCreate:=fpOpen(FileName,O_RdWr or O_Creat or O_Trunc,Mode);
  156. end;
  157. Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
  158. begin
  159. FileRead:=fpRead (Handle,Buffer,Count);
  160. end;
  161. Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
  162. begin
  163. FileWrite:=fpWrite (Handle,Buffer,Count);
  164. end;
  165. Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
  166. begin
  167. result:=longint(FileSeek(Handle,int64(FOffset),Origin));
  168. end;
  169. Function FileSeek (Handle : Longint; FOffset : Int64; Origin : Longint) : Int64;
  170. begin
  171. FileSeek:=fplSeek (Handle,FOffset,Origin);
  172. end;
  173. Procedure FileClose (Handle : Longint);
  174. begin
  175. fpclose(Handle);
  176. end;
  177. Function FileTruncate (Handle,Size: Longint) : boolean;
  178. begin
  179. FileTruncate:=fpftruncate(Handle,Size)>=0;
  180. end;
  181. Function UnixToWinAge(UnixAge : time_t): Longint;
  182. Var
  183. Y,M,D,hh,mm,ss : word;
  184. begin
  185. EpochToLocal(UnixAge,y,m,d,hh,mm,ss);
  186. Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
  187. end;
  188. Function FileAge (Const FileName : String): Longint;
  189. Var Info : Stat;
  190. begin
  191. If fpstat (FileName,Info)<0 then
  192. exit(-1)
  193. else
  194. Result:=UnixToWinAge(info.st_mtime);
  195. end;
  196. Function FileExists (Const FileName : String) : Boolean;
  197. Var Info : Stat;
  198. begin
  199. FileExists:=fpstat(filename,Info)>=0;
  200. end;
  201. Function DirectoryExists (Const Directory : String) : Boolean;
  202. Var Info : Stat;
  203. begin
  204. DirectoryExists:=(fpstat(Directory,Info)>=0) and fpS_ISDIR(Info.st_mode);
  205. end;
  206. Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
  207. begin
  208. Result:=faArchive;
  209. If fpS_ISDIR(Info.st_mode) then
  210. Result:=Result or faDirectory;
  211. If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
  212. Result:=Result or faHidden;
  213. If (Info.st_Mode and S_IWUSR)=0 Then
  214. Result:=Result or faReadOnly;
  215. If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
  216. Result:=Result or faSysFile;
  217. If fpS_ISLNK(Info.st_mode) Then
  218. Result:=Result or faSymLink;
  219. end;
  220. Function FNMatch(const Pattern,Name:string):Boolean;
  221. Var
  222. LenPat,LenName : longint;
  223. Function DoFNMatch(i,j:longint):Boolean;
  224. Var
  225. Found : boolean;
  226. Begin
  227. Found:=true;
  228. While Found and (i<=LenPat) Do
  229. Begin
  230. Case Pattern[i] of
  231. '?' : Found:=(j<=LenName);
  232. '*' : Begin
  233. {find the next character in pattern, different of ? and *}
  234. while Found do
  235. begin
  236. inc(i);
  237. if i>LenPat then Break;
  238. case Pattern[i] of
  239. '*' : ;
  240. '?' : begin
  241. if j>LenName then begin DoFNMatch:=false; Exit; end;
  242. inc(j);
  243. end;
  244. else
  245. Found:=false;
  246. end;
  247. end;
  248. Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
  249. {Now, find in name the character which i points to, if the * or ?
  250. wasn't the last character in the pattern, else, use up all the
  251. chars in name}
  252. Found:=false;
  253. if (i<=LenPat) then
  254. begin
  255. repeat
  256. {find a letter (not only first !) which maches pattern[i]}
  257. while (j<=LenName) and (name[j]<>pattern[i]) do
  258. inc (j);
  259. if (j<LenName) then
  260. begin
  261. if DoFnMatch(i+1,j+1) then
  262. begin
  263. i:=LenPat;
  264. j:=LenName;{we can stop}
  265. Found:=true;
  266. Break;
  267. end else
  268. inc(j);{We didn't find one, need to look further}
  269. end else
  270. if j=LenName then
  271. begin
  272. Found:=true;
  273. Break;
  274. end;
  275. { This 'until' condition must be j>LenName, not j>=LenName.
  276. That's because when we 'need to look further' and
  277. j = LenName then loop must not terminate. }
  278. until (j>LenName);
  279. end else
  280. begin
  281. j:=LenName;{we can stop}
  282. Found:=true;
  283. end;
  284. end;
  285. else {not a wildcard character in pattern}
  286. Found:=(j<=LenName) and (pattern[i]=name[j]);
  287. end;
  288. inc(i);
  289. inc(j);
  290. end;
  291. DoFnMatch:=Found and (j>LenName);
  292. end;
  293. Begin {start FNMatch}
  294. LenPat:=Length(Pattern);
  295. LenName:=Length(Name);
  296. FNMatch:=DoFNMatch(1,1);
  297. End;
  298. Type
  299. TUnixFindData = Record
  300. NamePos : LongInt; {to track which search this is}
  301. DirPtr : Pointer; {directory pointer for reading directory}
  302. SearchSpec : String;
  303. SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
  304. SearchAttr : Byte; {attribute we are searching for}
  305. End;
  306. PUnixFindData = ^TUnixFindData;
  307. Var
  308. CurrSearchNum : LongInt;
  309. Procedure FindClose(Var f: TSearchRec);
  310. var
  311. UnixFindData : PUnixFindData;
  312. Begin
  313. UnixFindData:=PUnixFindData(f.FindHandle);
  314. if UnixFindData=nil then
  315. exit;
  316. if UnixFindData^.SearchType=0 then
  317. begin
  318. if UnixFindData^.dirptr<>nil then
  319. fpclosedir(pdir(UnixFindData^.dirptr)^);
  320. end;
  321. Dispose(UnixFindData);
  322. f.FindHandle:=nil;
  323. End;
  324. Function FindGetFileInfo(const s:string;var f:TSearchRec):boolean;
  325. var
  326. st : baseunix.stat;
  327. WinAttr : longint;
  328. begin
  329. FindGetFileInfo:=false;
  330. if not fpstat(s,st)>=0 then
  331. exit;
  332. WinAttr:=LinuxToWinAttr(PChar(s),st);
  333. If (f.FindHandle = nil) or ((WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0) Then
  334. Begin
  335. f.Name:=ExtractFileName(s);
  336. f.Attr:=WinAttr;
  337. f.Size:=st.st_Size;
  338. f.Mode:=st.st_mode;
  339. f.Time:=UnixToWinAge(st.st_mtime);
  340. result:=true;
  341. End;
  342. end;
  343. Function FindNext (Var Rslt : TSearchRec) : Longint;
  344. {
  345. re-opens dir if not already in array and calls FindWorkProc
  346. }
  347. Var
  348. DirName : String;
  349. i,
  350. ArrayPos : Longint;
  351. FName,
  352. SName : string;
  353. Found,
  354. Finished : boolean;
  355. p : pdirent;
  356. UnixFindData : PUnixFindData;
  357. Begin
  358. Result:=-1;
  359. UnixFindData:=PUnixFindData(Rslt.FindHandle);
  360. if UnixFindData=nil then
  361. exit;
  362. if (UnixFindData^.SearchType=0) and
  363. (UnixFindData^.Dirptr=nil) then
  364. begin
  365. If UnixFindData^.NamePos = 0 Then
  366. DirName:='./'
  367. Else
  368. DirName:=Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos);
  369. UnixFindData^.DirPtr := fpopendir(Pchar(DirName));
  370. end;
  371. SName:=Copy(UnixFindData^.SearchSpec,UnixFindData^.NamePos+1,Length(UnixFindData^.SearchSpec));
  372. Found:=False;
  373. Finished:=(UnixFindData^.dirptr=nil);
  374. While Not Finished Do
  375. Begin
  376. p:=fpreaddir(pdir(UnixFindData^.dirptr)^);
  377. if p=nil then
  378. FName:=''
  379. else
  380. FName:=p^.d_name;
  381. If FName='' Then
  382. Finished:=True
  383. Else
  384. Begin
  385. If FNMatch(SName,FName) Then
  386. Begin
  387. Found:=FindGetFileInfo(Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos)+FName,Rslt);
  388. if Found then
  389. begin
  390. Result:=0;
  391. exit;
  392. end;
  393. End;
  394. End;
  395. End;
  396. End;
  397. Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
  398. {
  399. opens dir and calls FindWorkProc
  400. }
  401. var
  402. UnixFindData : PUnixFindData;
  403. Begin
  404. Result:=-1;
  405. fillchar(Rslt,sizeof(Rslt),0);
  406. if Path='' then
  407. exit;
  408. {Wildcards?}
  409. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  410. begin
  411. if FindGetFileInfo(Path,Rslt) then
  412. Result:=0;
  413. end
  414. else
  415. begin
  416. { Allocate UnixFindData }
  417. New(UnixFindData);
  418. FillChar(UnixFindData^,sizeof(UnixFindData^),0);
  419. Rslt.FindHandle:=UnixFindData;
  420. {Create Info}
  421. UnixFindData^.SearchSpec := Path;
  422. {We always also search for readonly and archive, regardless of Attr:}
  423. UnixFindData^.SearchAttr := Attr or faarchive or fareadonly;
  424. UnixFindData^.NamePos := Length(UnixFindData^.SearchSpec);
  425. while (UnixFindData^.NamePos>0) and (UnixFindData^.SearchSpec[UnixFindData^.NamePos]<>'/') do
  426. dec(UnixFindData^.NamePos);
  427. Result:=FindNext(Rslt);
  428. end;
  429. End;
  430. Function FileGetDate (Handle : Longint) : Longint;
  431. Var Info : Stat;
  432. begin
  433. If (fpFStat(Handle,Info))<0 then
  434. Result:=-1
  435. else
  436. Result:=Info.st_Mtime;
  437. end;
  438. Function FileSetDate (Handle,Age : Longint) : Longint;
  439. begin
  440. // Impossible under Linux from FileHandle !!
  441. FileSetDate:=-1;
  442. end;
  443. Function FileGetAttr (Const FileName : String) : Longint;
  444. Var Info : Stat;
  445. begin
  446. If FpStat (FileName,Info)<0 then
  447. Result:=-1
  448. Else
  449. Result:=LinuxToWinAttr(Pchar(ExtractFileName(FileName)),Info);
  450. end;
  451. Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
  452. begin
  453. Result:=-1;
  454. end;
  455. Function DeleteFile (Const FileName : String) : Boolean;
  456. begin
  457. Result:=fpUnLink (FileName)>=0;
  458. end;
  459. Function RenameFile (Const OldName, NewName : String) : Boolean;
  460. begin
  461. RenameFile:=BaseUnix.FpRename(OldNAme,NewName)>=0;
  462. end;
  463. Function FileIsReadOnly(const FileName: String): Boolean;
  464. begin
  465. Result := fpAccess(PChar(FileName),W_OK)<>0;
  466. end;
  467. Function FileSetDate (Const FileName : String;Age : Longint) : Longint;
  468. var
  469. t: TUTimBuf;
  470. begin
  471. Result := 0;
  472. t.actime := Age;
  473. t.modtime := Age;
  474. if fputime(PChar(FileName), @t) = -1 then
  475. Result := fpgeterrno;
  476. end;
  477. {****************************************************************************
  478. Disk Functions
  479. ****************************************************************************}
  480. {
  481. The Diskfree and Disksize functions need a file on the specified drive, since this
  482. is required for the statfs system call.
  483. These filenames are set in drivestr[0..26], and have been preset to :
  484. 0 - '.' (default drive - hence current dir is ok.)
  485. 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
  486. 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
  487. 3 - '/' (C: equivalent of dos is the root partition)
  488. 4..26 (can be set by you're own applications)
  489. ! Use AddDisk() to Add new drives !
  490. They both return -1 when a failure occurs.
  491. }
  492. Const
  493. FixDriveStr : array[0..3] of pchar=(
  494. '.',
  495. '/fd0/.',
  496. '/fd1/.',
  497. '/.'
  498. );
  499. var
  500. Drives : byte;
  501. DriveStr : array[4..26] of pchar;
  502. Function AddDisk(const path:string) : Byte;
  503. begin
  504. if not (DriveStr[Drives]=nil) then
  505. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  506. GetMem(DriveStr[Drives],length(Path)+1);
  507. StrPCopy(DriveStr[Drives],path);
  508. inc(Drives);
  509. if Drives>26 then
  510. Drives:=4;
  511. Result:=Drives;
  512. end;
  513. Function DiskFree(Drive: Byte): int64;
  514. var
  515. fs : tstatfs;
  516. Begin
  517. if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
  518. ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
  519. Diskfree:=int64(fs.bavail)*int64(fs.bsize)
  520. else
  521. Diskfree:=-1;
  522. End;
  523. Function DiskSize(Drive: Byte): int64;
  524. var
  525. fs : tstatfs;
  526. Begin
  527. if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
  528. ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
  529. DiskSize:=int64(fs.blocks)*int64(fs.bsize)
  530. else
  531. DiskSize:=-1;
  532. End;
  533. Function GetCurrentDir : String;
  534. begin
  535. GetDir (0,Result);
  536. end;
  537. Function SetCurrentDir (Const NewDir : String) : Boolean;
  538. begin
  539. {$I-}
  540. ChDir(NewDir);
  541. {$I+}
  542. result := (IOResult = 0);
  543. end;
  544. Function CreateDir (Const NewDir : String) : Boolean;
  545. begin
  546. {$I-}
  547. MkDir(NewDir);
  548. {$I+}
  549. result := (IOResult = 0);
  550. end;
  551. Function RemoveDir (Const Dir : String) : Boolean;
  552. begin
  553. {$I-}
  554. RmDir(Dir);
  555. {$I+}
  556. result := (IOResult = 0);
  557. end;
  558. {****************************************************************************
  559. Misc Functions
  560. ****************************************************************************}
  561. procedure Beep;
  562. begin
  563. end;
  564. {****************************************************************************
  565. Locale Functions
  566. ****************************************************************************}
  567. Function GetEpochTime: cint;
  568. {
  569. Get the number of seconds since 00:00, January 1 1970, GMT
  570. the time NOT corrected any way
  571. }
  572. begin
  573. GetEpochTime:=fptime;
  574. end;
  575. procedure GetTime(var hour,min,sec,msec,usec:word);
  576. {
  577. Gets the current time, adjusted to local time
  578. }
  579. var
  580. year,day,month:Word;
  581. tz:timeval;
  582. begin
  583. fpgettimeofday(@tz,nil);
  584. EpochToLocal(tz.tv_sec,year,month,day,hour,min,sec);
  585. msec:=tz.tv_usec div 1000;
  586. usec:=tz.tv_usec mod 1000;
  587. end;
  588. procedure GetTime(var hour,min,sec,sec100:word);
  589. {
  590. Gets the current time, adjusted to local time
  591. }
  592. var
  593. usec : word;
  594. begin
  595. gettime(hour,min,sec,sec100,usec);
  596. sec100:=sec100 div 10;
  597. end;
  598. Procedure GetTime(Var Hour,Min,Sec:Word);
  599. {
  600. Gets the current time, adjusted to local time
  601. }
  602. var
  603. msec,usec : Word;
  604. Begin
  605. gettime(hour,min,sec,msec,usec);
  606. End;
  607. Procedure GetDate(Var Year,Month,Day:Word);
  608. {
  609. Gets the current date, adjusted to local time
  610. }
  611. var
  612. hour,minute,second : word;
  613. Begin
  614. EpochToLocal(fptime,year,month,day,hour,minute,second);
  615. End;
  616. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  617. {
  618. Gets the current date, adjusted to local time
  619. }
  620. Begin
  621. EpochToLocal(fptime,year,month,day,hour,minute,second);
  622. End;
  623. Procedure GetLocalTime(var SystemTime: TSystemTime);
  624. var
  625. usecs : Word;
  626. begin
  627. GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond, usecs);
  628. GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
  629. // SystemTime.MilliSecond := 0;
  630. end ;
  631. Procedure InitAnsi;
  632. Var
  633. i : longint;
  634. begin
  635. { Fill table entries 0 to 127 }
  636. for i := 0 to 96 do
  637. UpperCaseTable[i] := chr(i);
  638. for i := 97 to 122 do
  639. UpperCaseTable[i] := chr(i - 32);
  640. for i := 123 to 191 do
  641. UpperCaseTable[i] := chr(i);
  642. Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  643. for i := 0 to 64 do
  644. LowerCaseTable[i] := chr(i);
  645. for i := 65 to 90 do
  646. LowerCaseTable[i] := chr(i + 32);
  647. for i := 91 to 191 do
  648. LowerCaseTable[i] := chr(i);
  649. Move (CPISO88591LCT,LowerCaseTable[192],SizeOf(CPISO88591UCT));
  650. end;
  651. Procedure InitInternational;
  652. begin
  653. InitInternationalGeneric;
  654. InitAnsi;
  655. end;
  656. function SysErrorMessage(ErrorCode: Integer): String;
  657. begin
  658. Result:=StrError(ErrorCode);
  659. end;
  660. {****************************************************************************
  661. OS utility functions
  662. ****************************************************************************}
  663. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  664. begin
  665. Result:=StrPas(BaseUnix.FPGetenv(PChar(EnvVar)));
  666. end;
  667. Function GetEnvironmentVariableCount : Integer;
  668. begin
  669. Result:=FPCCountEnvVar(EnvP);
  670. end;
  671. Function GetEnvironmentString(Index : Integer) : String;
  672. begin
  673. Result:=FPCGetEnvStrFromP(Envp,Index);
  674. end;
  675. {$define FPC_USE_FPEXEC} // leave the old code under IFDEF for a while.
  676. function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
  677. var
  678. pid : longint;
  679. e : EOSError;
  680. CommandLine: AnsiString;
  681. cmdline2 : ppchar;
  682. Begin
  683. { always surround the name of the application by quotes
  684. so that long filenames will always be accepted. But don't
  685. do it if there are already double quotes!
  686. }
  687. {$ifdef FPC_USE_FPEXEC} // Only place we still parse
  688. cmdline2:=nil;
  689. if Comline<>'' Then
  690. begin
  691. CommandLine:=ComLine;
  692. { Make an unique copy because stringtoppchar modifies the
  693. string }
  694. UniqueString(CommandLine);
  695. cmdline2:=StringtoPPChar(CommandLine,1);
  696. cmdline2^:=pchar(Path);
  697. end
  698. else
  699. begin
  700. getmem(cmdline2,2*sizeof(pchar));
  701. cmdline2^:=pchar(Path);
  702. cmdline2[1]:=nil;
  703. end;
  704. {$else}
  705. if Pos ('"', Path) = 0 then
  706. CommandLine := '"' + Path + '"'
  707. else
  708. CommandLine := Path;
  709. if ComLine <> '' then
  710. CommandLine := Commandline + ' ' + ComLine;
  711. {$endif}
  712. {$ifdef USE_VFORK}
  713. pid:=fpvFork;
  714. {$else USE_VFORK}
  715. pid:=fpFork;
  716. {$endif USE_VFORK}
  717. if pid=0 then
  718. begin
  719. {The child does the actual exec, and then exits}
  720. {$ifdef FPC_USE_FPEXEC}
  721. fpexecv(pchar(Path),Cmdline2);
  722. {$else}
  723. Execl(CommandLine);
  724. {$endif}
  725. { If the execve fails, we return an exitvalue of 127, to let it be known}
  726. fpExit(127);
  727. end
  728. else
  729. if pid=-1 then {Fork failed}
  730. begin
  731. e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
  732. e.ErrorCode:=-1;
  733. raise e;
  734. end;
  735. { We're in the parent, let's wait. }
  736. result:=WaitProcess(pid); // WaitPid and result-convert
  737. if (result<0) or (result=127) then
  738. begin
  739. E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
  740. E.ErrorCode:=result;
  741. Raise E;
  742. end;
  743. End;
  744. function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
  745. var
  746. pid : longint;
  747. e : EOSError;
  748. Begin
  749. pid:=fpFork;
  750. if pid=0 then
  751. begin
  752. {The child does the actual exec, and then exits}
  753. fpexecl(Path,Comline);
  754. { If the execve fails, we return an exitvalue of 127, to let it be known}
  755. fpExit(127);
  756. end
  757. else
  758. if pid=-1 then {Fork failed}
  759. begin
  760. e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
  761. e.ErrorCode:=-1;
  762. raise e;
  763. end;
  764. { We're in the parent, let's wait. }
  765. result:=WaitProcess(pid); // WaitPid and result-convert
  766. if (result<0) or (result=127) then
  767. begin
  768. E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
  769. E.ErrorCode:=result;
  770. raise E;
  771. end;
  772. End;
  773. procedure Sleep(milliseconds: Cardinal);
  774. Var
  775. timeout,timeoutresult : TTimespec;
  776. begin
  777. timeout.tv_sec:=milliseconds div 1000;
  778. timeout.tv_nsec:=1000*1000*(milliseconds mod 1000);
  779. fpnanosleep(@timeout,@timeoutresult);
  780. end;
  781. Function GetLastOSError : Integer;
  782. begin
  783. Result:=fpgetErrNo;
  784. end;
  785. { ---------------------------------------------------------------------
  786. Application config files
  787. ---------------------------------------------------------------------}
  788. Function GetHomeDir : String;
  789. begin
  790. Result:=GetEnvironmentVariable('HOME');
  791. If (Result<>'') then
  792. Result:=IncludeTrailingPathDelimiter(Result);
  793. end;
  794. { Follows base-dir spec,
  795. see [http://freedesktop.org/Standards/basedir-spec].
  796. Always ends with PathDelim. }
  797. Function XdgConfigHome : String;
  798. begin
  799. Result:=GetEnvironmentVariable('XDG_CONFIG_HOME');
  800. if (Result='') then
  801. Result:=GetHomeDir + '.config/'
  802. else
  803. Result:=IncludeTrailingPathDelimiter(Result);
  804. end;
  805. Function GetAppConfigDir(Global : Boolean) : String;
  806. begin
  807. If Global then
  808. Result:=SysConfigDir
  809. else
  810. Result:=XdgConfigHome + ApplicationName;
  811. end;
  812. Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
  813. begin
  814. if Global then
  815. begin
  816. Result:=IncludeTrailingPathDelimiter(SysConfigDir);
  817. if SubDir then
  818. Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
  819. Result:=Result+ApplicationName+ConfigExtension;
  820. end
  821. else
  822. begin
  823. if SubDir then
  824. begin
  825. Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
  826. Result:=Result+ApplicationName+ConfigExtension;
  827. end
  828. else
  829. begin
  830. Result:=XdgConfigHome + ApplicationName + ConfigExtension;
  831. end;
  832. end;
  833. end;
  834. {****************************************************************************
  835. Initialization code
  836. ****************************************************************************}
  837. Function GetTempDir(Global : Boolean) : String;
  838. begin
  839. If Assigned(OnGetTempDir) then
  840. Result:=OnGetTempDir(Global)
  841. else
  842. begin
  843. Result:=GetEnvironmentVariable('TEMP');
  844. If (Result='') Then
  845. Result:=GetEnvironmentVariable('TMP');
  846. if (Result='') then
  847. Result:='/tmp/' // fallback.
  848. end;
  849. if (Result<>'') then
  850. Result:=IncludeTrailingPathDelimiter(Result);
  851. end;
  852. {****************************************************************************
  853. Initialization code
  854. ****************************************************************************}
  855. Initialization
  856. InitExceptions; { Initialize exceptions. OS independent }
  857. InitInternational; { Initialize internationalization settings }
  858. SysConfigDir:='/etc'; { Initialize system config dir }
  859. Finalization
  860. DoneExceptions;
  861. end.