dos.pp 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman,
  5. members of the Free Pascal development team
  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 Dos;
  13. Interface
  14. Const
  15. FileNameLen = 255;
  16. Type
  17. SearchRec =
  18. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  19. packed
  20. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  21. Record
  22. {Fill : array[1..21] of byte; Fill replaced with below}
  23. SearchNum : LongInt; {to track which search this is}
  24. SearchPos : LongInt; {directory position}
  25. DirPtr : Pointer; {directory pointer for reading directory}
  26. SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
  27. SearchAttr : Byte; {attribute we are searching for}
  28. Fill : Array[1..07] of Byte; {future use}
  29. {End of fill}
  30. Attr : Byte; {attribute of found file}
  31. Time : LongInt; {last modify date of found file}
  32. Size : LongInt; {file size of found file}
  33. Reserved : Word; {future use}
  34. Name : String[FileNameLen]; {name of found file}
  35. SearchSpec : String[FileNameLen]; {search pattern}
  36. NamePos : Word; {end of path, start of name position}
  37. End;
  38. {$DEFINE HAS_FILENAMELEN}
  39. {$i dosh.inc}
  40. {Extra Utils}
  41. function weekday(y,m,d : longint) : longint;
  42. Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
  43. Function DTToUnixDate(DT: DateTime): LongInt;
  44. {Disk}
  45. Procedure AddDisk(const path:string);
  46. Implementation
  47. Uses
  48. Strings,Unix,BaseUnix,{$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF};
  49. {$DEFINE HAS_GETMSCOUNT}
  50. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  51. {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
  52. {$I dos.inc}
  53. {******************************************************************************
  54. --- Link C Lib if set ---
  55. ******************************************************************************}
  56. type
  57. RtlInfoType = Record
  58. FMode,
  59. FInode,
  60. FUid,
  61. FGid,
  62. FSize,
  63. FMTime : LongInt;
  64. End;
  65. {******************************************************************************
  66. --- Info / Date / Time ---
  67. ******************************************************************************}
  68. Const
  69. {Date Calculation}
  70. C1970 = 2440588;
  71. D0 = 1461;
  72. D1 = 146097;
  73. D2 = 1721119;
  74. type
  75. GTRec = packed Record
  76. Year,
  77. Month,
  78. MDay,
  79. WDay,
  80. Hour,
  81. Minute,
  82. Second : Word;
  83. End;
  84. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  85. Var
  86. Century,XYear: LongInt;
  87. Begin
  88. If Month<=2 Then
  89. Begin
  90. Dec(Year);
  91. Inc(Month,12);
  92. End;
  93. Dec(Month,3);
  94. Century:=(longint(Year Div 100)*D1) shr 2;
  95. XYear:=(longint(Year Mod 100)*D0) shr 2;
  96. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  97. End;
  98. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  99. {
  100. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  101. (seconds since 00:00, january 1 1970, corrected for local time zone)
  102. }
  103. Begin
  104. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  105. (LongInt(Hour)*3600)+(Longint(Minute)*60)+Second-TZSeconds;
  106. End;
  107. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  108. Var
  109. YYear,XYear,Temp,TempMonth : LongInt;
  110. Begin
  111. Temp:=((JulianDN-D2) shl 2)-1;
  112. JulianDN:=Temp Div D1;
  113. XYear:=(Temp Mod D1) or 3;
  114. YYear:=(XYear Div D0);
  115. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  116. Day:=((Temp Mod 153)+5) Div 5;
  117. TempMonth:=Temp Div 153;
  118. If TempMonth>=10 Then
  119. Begin
  120. inc(YYear);
  121. dec(TempMonth,12);
  122. End;
  123. inc(TempMonth,3);
  124. Month := TempMonth;
  125. Year:=YYear+(JulianDN*100);
  126. end;
  127. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  128. {
  129. Transforms Epoch time into local time (hour, minute,seconds)
  130. }
  131. Var
  132. DateNum: LongInt;
  133. Begin
  134. inc(Epoch,TZSeconds);
  135. Datenum:=(Epoch Div 86400) + c1970;
  136. JulianToGregorian(DateNum,Year,Month,day);
  137. Epoch:=Abs(Epoch Mod 86400);
  138. Hour:=Epoch Div 3600;
  139. Epoch:=Epoch Mod 3600;
  140. Minute:=Epoch Div 60;
  141. Second:=Epoch Mod 60;
  142. End;
  143. Function DosVersion:Word;
  144. Var
  145. Buffer : Array[0..255] of Char;
  146. Tmp2,
  147. TmpStr : String[40];
  148. TmpPos,
  149. SubRel,
  150. Rel : LongInt;
  151. info : utsname;
  152. Begin
  153. FPUName(info);
  154. Move(info.release,buffer[0],40);
  155. TmpStr:=StrPas(Buffer);
  156. SubRel:=0;
  157. TmpPos:=Pos('.',TmpStr);
  158. if TmpPos>0 then
  159. begin
  160. Tmp2:=Copy(TmpStr,TmpPos+1,40);
  161. Delete(TmpStr,TmpPos,40);
  162. end;
  163. TmpPos:=Pos('.',Tmp2);
  164. if TmpPos>0 then
  165. Delete(Tmp2,TmpPos,40);
  166. Val(TmpStr,Rel);
  167. Val(Tmp2,SubRel);
  168. DosVersion:=Rel+(SubRel shl 8);
  169. End;
  170. function WeekDay (y,m,d:longint):longint;
  171. {
  172. Calculates th day of the week. returns -1 on error
  173. }
  174. var
  175. u,v : longint;
  176. begin
  177. if (m<1) or (m>12) or (y<1600) or (y>4000) or
  178. (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
  179. ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
  180. WeekDay:=-1
  181. else
  182. begin
  183. u:=m;
  184. v:=y;
  185. if m<3 then
  186. begin
  187. inc(u,12);
  188. dec(v);
  189. end;
  190. WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
  191. end;
  192. end;
  193. Procedure GetDate(Var Year, Month, MDay, WDay: Word);
  194. var
  195. tz:timeval;
  196. hour,min,sec : word;
  197. begin
  198. fpgettimeofday(@tz,nil);
  199. EpochToLocal(tz.tv_sec,year,month,mday,hour,min,sec);
  200. Wday:=weekday(Year,Month,MDay);
  201. end;
  202. procedure SetTime(Hour,Minute,Second,sec100:word);
  203. var
  204. dow,Year, Month, Day : Word;
  205. tv : timeval;
  206. begin
  207. GetDate (Year, Month, Day,dow);
  208. tv.tv_sec:= LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) ;
  209. fpSettimeofday(@tv,nil);
  210. end;
  211. procedure SetDate(Year,Month,Day:Word);
  212. var
  213. Hour, Min, Sec, Sec100 : Word;
  214. tv : timeval;
  215. begin
  216. GetTime ( Hour, Min, Sec, Sec100 );
  217. tv.tv_sec:= LocalToEpoch ( Year, Month, Day, Hour, Min, Sec ) ;
  218. fpSettimeofday(@tv,nil);
  219. end;
  220. Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  221. var
  222. tv : timeval;
  223. begin
  224. tv.tv_sec:= LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) ;
  225. SetDatetime:=fpSettimeofday(@tv,nil)=0;
  226. end;
  227. Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
  228. var
  229. tz:timeval;
  230. year,month,day : word;
  231. begin
  232. fpgettimeofday(@tz,nil);
  233. EpochToLocal(tz.tv_sec,year,month,day,hour,minute,second);
  234. sec100:=tz.tv_usec div 10000;
  235. end;
  236. Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
  237. Begin
  238. EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
  239. End;
  240. Function DTToUnixDate(DT: DateTime): LongInt;
  241. Begin
  242. DTToUnixDate:=LocalToEpoch(dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
  243. End;
  244. function GetMsCount: int64;
  245. var
  246. tv : TimeVal;
  247. { tz : TimeZone;}
  248. begin
  249. FPGetTimeOfDay (@tv, nil {,tz});
  250. GetMsCount := tv.tv_Sec * 1000 + tv.tv_uSec div 1000;
  251. end;
  252. {******************************************************************************
  253. --- Exec ---
  254. ******************************************************************************}
  255. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  256. var
  257. pid : longint; // pid_t?
  258. cmdline2 : ppchar;
  259. commandline : ansistring;
  260. realpath : ansistring;
  261. // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
  262. Begin
  263. LastDosExitCode:=0;
  264. pid:=fpFork;
  265. if pid=0 then
  266. begin
  267. cmdline2:=nil;
  268. realpath:=path;
  269. if Comline<>'' Then
  270. begin
  271. CommandLine:=ComLine; // conversion must live till after fpexec!
  272. cmdline2:=StringtoPPChar(CommandLine,1);
  273. cmdline2^:=pchar(realPath);
  274. end
  275. else
  276. begin
  277. getmem(cmdline2,2*sizeof(pchar));
  278. cmdline2^:=pchar(realPath);
  279. cmdline2[1]:=nil;
  280. end;
  281. {The child does the actual exec, and then exits}
  282. fpExecv(pchar(realPath),cmdline2);
  283. {If the execve fails, we return an exitvalue of 127, to let it be known}
  284. fpExit(127);
  285. end
  286. else
  287. if pid=-1 then {Fork failed}
  288. begin
  289. DosError:=8;
  290. exit
  291. end;
  292. {We're in the parent, let's wait.}
  293. LastDosExitCode:=WaitProcess(pid); // WaitPid and result-convert
  294. if (LastDosExitCode>=0) and (LastDosExitCode<>127) then
  295. DosError:=0
  296. else
  297. DosError:=8; // perhaps one time give an better error
  298. End;
  299. {******************************************************************************
  300. --- Disk ---
  301. ******************************************************************************}
  302. {
  303. The Diskfree and Disksize functions need a file on the specified drive, since this
  304. is required for the statfs system call.
  305. These filenames are set in drivestr[0..26], and have been preset to :
  306. 0 - '.' (default drive - hence current dir is ok.)
  307. 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
  308. 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
  309. 3 - '/' (C: equivalent of dos is the root partition)
  310. 4..26 (can be set by you're own applications)
  311. ! Use AddDisk() to Add new drives !
  312. They both return -1 when a failure occurs.
  313. }
  314. Const
  315. FixDriveStr : array[0..3] of pchar=(
  316. '.',
  317. '/fd0/.',
  318. '/fd1/.',
  319. '/.'
  320. );
  321. const
  322. Drives : byte = 4;
  323. var
  324. DriveStr : array[4..26] of pchar;
  325. Procedure AddDisk(const path:string);
  326. begin
  327. if not (DriveStr[Drives]=nil) then
  328. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  329. GetMem(DriveStr[Drives],length(Path)+1);
  330. StrPCopy(DriveStr[Drives],path);
  331. inc(Drives);
  332. if Drives>26 then
  333. Drives:=4;
  334. end;
  335. Function DiskFree(Drive: Byte): int64;
  336. var
  337. fs : tstatfs;
  338. Begin
  339. if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (StatFS(fixdrivestr[drive],fs)<>-1)) or
  340. ((not (drivestr[Drive]=nil)) and (StatFS(drivestr[drive],fs)<>-1)) then
  341. Diskfree:=int64(fs.bavail)*int64(fs.bsize)
  342. else
  343. Diskfree:=-1;
  344. End;
  345. Function DiskSize(Drive: Byte): int64;
  346. var
  347. fs : tstatfs;
  348. Begin
  349. if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (StatFS(fixdrivestr[drive],fs)<>-1)) or
  350. ((not (drivestr[Drive]=nil)) and (StatFS(drivestr[drive],fs)<>-1)) then
  351. DiskSize:=int64(fs.blocks)*int64(fs.bsize)
  352. else
  353. DiskSize:=-1;
  354. End;
  355. {******************************************************************************
  356. --- Findfirst FindNext ---
  357. ******************************************************************************}
  358. Function FNMatch(const Pattern,Name:string):Boolean;
  359. Var
  360. LenPat,LenName : longint;
  361. Function DoFNMatch(i,j:longint):Boolean;
  362. Var
  363. Found : boolean;
  364. Begin
  365. Found:=true;
  366. While Found and (i<=LenPat) Do
  367. Begin
  368. Case Pattern[i] of
  369. '?' : Found:=(j<=LenName);
  370. '*' : Begin
  371. {find the next character in pattern, different of ? and *}
  372. while Found do
  373. begin
  374. inc(i);
  375. if i>LenPat then Break;
  376. case Pattern[i] of
  377. '*' : ;
  378. '?' : begin
  379. if j>LenName then begin DoFNMatch:=false; Exit; end;
  380. inc(j);
  381. end;
  382. else
  383. Found:=false;
  384. end;
  385. end;
  386. Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
  387. {Now, find in name the character which i points to, if the * or ?
  388. wasn't the last character in the pattern, else, use up all the
  389. chars in name}
  390. Found:=false;
  391. if (i<=LenPat) then
  392. begin
  393. repeat
  394. {find a letter (not only first !) which maches pattern[i]}
  395. while (j<=LenName) and (name[j]<>pattern[i]) do
  396. inc (j);
  397. if (j<LenName) then
  398. begin
  399. if DoFnMatch(i+1,j+1) then
  400. begin
  401. i:=LenPat;
  402. j:=LenName;{we can stop}
  403. Found:=true;
  404. Break;
  405. end else
  406. inc(j);{We didn't find one, need to look further}
  407. end else
  408. if j=LenName then
  409. begin
  410. Found:=true;
  411. Break;
  412. end;
  413. { This 'until' condition must be j>LenName, not j>=LenName.
  414. That's because when we 'need to look further' and
  415. j = LenName then loop must not terminate. }
  416. until (j>LenName);
  417. end else
  418. begin
  419. j:=LenName;{we can stop}
  420. Found:=true;
  421. end;
  422. end;
  423. else {not a wildcard character in pattern}
  424. Found:=(j<=LenName) and (pattern[i]=name[j]);
  425. end;
  426. inc(i);
  427. inc(j);
  428. end;
  429. DoFnMatch:=Found and (j>LenName);
  430. end;
  431. Begin {start FNMatch}
  432. LenPat:=Length(Pattern);
  433. LenName:=Length(Name);
  434. FNMatch:=DoFNMatch(1,1);
  435. End;
  436. Const
  437. RtlFindSize = 15;
  438. Type
  439. RtlFindRecType = Record
  440. DirPtr : Pointer;
  441. SearchNum,
  442. LastUsed : LongInt;
  443. End;
  444. Var
  445. RtlFindRecs : Array[1..RtlFindSize] of RtlFindRecType;
  446. CurrSearchNum : LongInt;
  447. Procedure FindClose(Var f: SearchRec);
  448. {
  449. Closes dirptr if it is open
  450. }
  451. Var
  452. i : longint;
  453. Begin
  454. if f.SearchType=0 then
  455. begin
  456. i:=1;
  457. repeat
  458. if (RtlFindRecs[i].SearchNum=f.SearchNum) then
  459. break;
  460. inc(i);
  461. until (i>RtlFindSize);
  462. If i<=RtlFindSize Then
  463. Begin
  464. RtlFindRecs[i].SearchNum:=0;
  465. if f.dirptr<>nil then
  466. fpclosedir(pdir(f.dirptr)^);
  467. End;
  468. end;
  469. f.dirptr:=nil;
  470. End;
  471. Function FindGetFileInfo(const s:string;var f:SearchRec):boolean;
  472. var
  473. DT : DateTime;
  474. Info : RtlInfoType;
  475. st : baseunix.stat;
  476. begin
  477. FindGetFileInfo:=false;
  478. if not fpstat(s,st)>=0 then
  479. exit;
  480. info.FSize:=st.st_Size;
  481. info.FMTime:=st.st_mtime;
  482. if (st.st_mode and STAT_IFMT)=STAT_IFDIR then
  483. info.fmode:=$10
  484. else
  485. info.fmode:=$0;
  486. if (st.st_mode and STAT_IWUSR)=0 then
  487. info.fmode:=info.fmode or 1;
  488. if s[f.NamePos+1]='.' then
  489. info.fmode:=info.fmode or $2;
  490. If ((Info.FMode and Not(f.searchattr))=0) Then
  491. Begin
  492. f.Name:=Copy(s,f.NamePos+1,255);
  493. f.Attr:=Info.FMode;
  494. f.Size:=Info.FSize;
  495. UnixDateToDT(Info.FMTime, DT);
  496. PackTime(DT,f.Time);
  497. FindGetFileInfo:=true;
  498. End;
  499. end;
  500. Function FindLastUsed: Longint;
  501. {
  502. Find unused or least recently used dirpointer slot in findrecs array
  503. }
  504. Var
  505. BestMatch,i : Longint;
  506. Found : Boolean;
  507. Begin
  508. BestMatch:=1;
  509. i:=1;
  510. Found:=False;
  511. While (i <= RtlFindSize) And (Not Found) Do
  512. Begin
  513. If (RtlFindRecs[i].SearchNum = 0) Then
  514. Begin
  515. BestMatch := i;
  516. Found := True;
  517. End
  518. Else
  519. Begin
  520. If RtlFindRecs[i].LastUsed > RtlFindRecs[BestMatch].LastUsed Then
  521. BestMatch := i;
  522. End;
  523. Inc(i);
  524. End;
  525. FindLastUsed := BestMatch;
  526. End;
  527. Procedure FindNext(Var f: SearchRec);
  528. {
  529. re-opens dir if not already in array and calls FindWorkProc
  530. }
  531. Var
  532. DirName : Array[0..256] of Char;
  533. i,
  534. ArrayPos : Longint;
  535. FName,
  536. SName : string;
  537. Found,
  538. Finished : boolean;
  539. p : pdirent;
  540. Begin
  541. If f.SearchType=0 Then
  542. Begin
  543. ArrayPos:=0;
  544. For i:=1 to RtlFindSize Do
  545. Begin
  546. If RtlFindRecs[i].SearchNum = f.SearchNum Then
  547. ArrayPos:=i;
  548. Inc(RtlFindRecs[i].LastUsed);
  549. End;
  550. If ArrayPos=0 Then
  551. Begin
  552. If f.NamePos = 0 Then
  553. Begin
  554. DirName[0] := '.';
  555. DirName[1] := '/';
  556. DirName[2] := #0;
  557. End
  558. Else
  559. Begin
  560. Move(f.SearchSpec[1], DirName[0], f.NamePos);
  561. DirName[f.NamePos] := #0;
  562. End;
  563. f.DirPtr := fpopendir(@(DirName));
  564. If f.DirPtr <> nil Then
  565. begin
  566. ArrayPos:=FindLastUsed;
  567. If RtlFindRecs[ArrayPos].SearchNum > 0 Then
  568. FpCloseDir((pdir(rtlfindrecs[arraypos].dirptr)^));
  569. RtlFindRecs[ArrayPos].SearchNum := f.SearchNum;
  570. RtlFindRecs[ArrayPos].DirPtr := f.DirPtr;
  571. if f.searchpos>0 then
  572. seekdir(pdir(f.dirptr), f.searchpos);
  573. end;
  574. End;
  575. if ArrayPos>0 then
  576. RtlFindRecs[ArrayPos].LastUsed:=0;
  577. end;
  578. {Main loop}
  579. SName:=Copy(f.SearchSpec,f.NamePos+1,255);
  580. Found:=False;
  581. Finished:=(f.dirptr=nil);
  582. While Not Finished Do
  583. Begin
  584. p:=fpreaddir(pdir(f.dirptr)^);
  585. if p=nil then
  586. FName:=''
  587. else
  588. FName:=Strpas(@p^.d_name);
  589. If FName='' Then
  590. Finished:=True
  591. Else
  592. Begin
  593. If FNMatch(SName,FName) Then
  594. Begin
  595. Found:=FindGetFileInfo(Copy(f.SearchSpec,1,f.NamePos)+FName,f);
  596. if Found then
  597. Finished:=true;
  598. End;
  599. End;
  600. End;
  601. {Shutdown}
  602. If Found Then
  603. Begin
  604. f.searchpos:=telldir(pdir(f.dirptr));
  605. DosError:=0;
  606. End
  607. Else
  608. Begin
  609. FindClose(f);
  610. DosError:=18;
  611. End;
  612. End;
  613. Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
  614. {
  615. opens dir and calls FindWorkProc
  616. }
  617. Begin
  618. fillchar(f,sizeof(f),0);
  619. if Path='' then
  620. begin
  621. DosError:=3;
  622. exit;
  623. end;
  624. {Create Info}
  625. f.SearchSpec := Path;
  626. {We always also search for readonly and archive, regardless of Attr:}
  627. f.SearchAttr := Attr or archive or readonly;
  628. f.SearchPos := 0;
  629. f.NamePos := Length(f.SearchSpec);
  630. while (f.NamePos>0) and (f.SearchSpec[f.NamePos]<>'/') do
  631. dec(f.NamePos);
  632. {Wildcards?}
  633. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  634. begin
  635. if FindGetFileInfo(Path,f) then
  636. DosError:=0
  637. else
  638. begin
  639. { According to tdos2 test it should return 18
  640. if ErrNo=Sys_ENOENT then
  641. DosError:=3
  642. else }
  643. DosError:=18;
  644. end;
  645. f.DirPtr:=nil;
  646. f.SearchType:=1;
  647. f.searchnum:=-1;
  648. end
  649. else
  650. {Find Entry}
  651. begin
  652. Inc(CurrSearchNum);
  653. f.SearchNum:=CurrSearchNum;
  654. f.SearchType:=0;
  655. FindNext(f);
  656. end;
  657. End;
  658. {******************************************************************************
  659. --- File ---
  660. ******************************************************************************}
  661. Function FSearch(path : pathstr;dirlist : string) : pathstr;
  662. Var
  663. info : BaseUnix.stat;
  664. Begin
  665. if (length(Path)>0) and (path[1]='/') and (fpStat(path,info)>=0) and (not fpS_ISDIR(Info.st_Mode)) then
  666. FSearch:=path
  667. else
  668. FSearch:=Unix.FSearch(path,dirlist);
  669. End;
  670. Procedure GetFAttr(var f; var attr : word);
  671. Var
  672. info : baseunix.stat;
  673. LinAttr : longint;
  674. Begin
  675. DosError:=0;
  676. if FPStat(@textrec(f).name,info)<0 then
  677. begin
  678. Attr:=0;
  679. DosError:=3;
  680. exit;
  681. end
  682. else
  683. LinAttr:=Info.st_Mode;
  684. if fpS_ISDIR(LinAttr) then
  685. Attr:=$10
  686. else
  687. Attr:=$0;
  688. if fpAccess(@textrec(f).name,W_OK)<0 then
  689. Attr:=Attr or $1;
  690. if filerec(f).name[0]='.' then
  691. Attr:=Attr or $2;
  692. end;
  693. Procedure getftime (var f; var time : longint);
  694. Var
  695. Info: baseunix.stat;
  696. DT: DateTime;
  697. Begin
  698. doserror:=0;
  699. if fpfstat(filerec(f).handle,info)<0 then
  700. begin
  701. Time:=0;
  702. doserror:=6;
  703. exit
  704. end
  705. else
  706. UnixDateToDT(Info.st_mTime,DT);
  707. PackTime(DT,Time);
  708. End;
  709. Procedure setftime(var f; time : longint);
  710. Var
  711. utim: utimbuf;
  712. DT: DateTime;
  713. Begin
  714. doserror:=0;
  715. with utim do
  716. begin
  717. actime:=fptime;
  718. UnPackTime(Time,DT);
  719. modtime:=DTToUnixDate(DT);
  720. end;
  721. if fputime(@filerec(f).name,@utim)<0 then
  722. begin
  723. Time:=0;
  724. doserror:=3;
  725. end;
  726. End;
  727. {******************************************************************************
  728. --- Environment ---
  729. ******************************************************************************}
  730. Function EnvCount: Longint;
  731. var
  732. envcnt : longint;
  733. p : ppchar;
  734. Begin
  735. envcnt:=0;
  736. p:=envp; {defined in syslinux}
  737. while (p^<>nil) do
  738. begin
  739. inc(envcnt);
  740. inc(p);
  741. end;
  742. EnvCount := envcnt
  743. End;
  744. Function EnvStr (Index: longint): String;
  745. Var
  746. i : longint;
  747. p : ppchar;
  748. Begin
  749. if Index <= 0 then
  750. envstr:=''
  751. else
  752. begin
  753. p:=envp; {defined in syslinux}
  754. i:=1;
  755. while (i<Index) and (p^<>nil) do
  756. begin
  757. inc(i);
  758. inc(p);
  759. end;
  760. if p=nil then
  761. envstr:=''
  762. else
  763. envstr:=strpas(p^)
  764. end;
  765. end;
  766. Function GetEnv(EnvVar: String): String;
  767. var
  768. p : pchar;
  769. Begin
  770. p:=BaseUnix.fpGetEnv(EnvVar);
  771. if p=nil then
  772. GetEnv:=''
  773. else
  774. GetEnv:=StrPas(p);
  775. End;
  776. Procedure setfattr (var f;attr : word);
  777. Begin
  778. {! No Unix equivalent !}
  779. { Fail for setting VolumeId }
  780. if (attr and VolumeID)<>0 then
  781. doserror:=5;
  782. End;
  783. {******************************************************************************
  784. --- Initialization ---
  785. ******************************************************************************}
  786. End.
  787. {
  788. $Log$
  789. Revision 1.44 2005-02-13 20:01:38 peter
  790. * include file cleanup
  791. Revision 1.43 2004/12/18 16:29:09 michael
  792. + Patch from Michalis Kamburelis so FSearch does not find a directory
  793. Revision 1.42 2004/12/05 21:04:56 hajny
  794. * compilation fix for dosh.inc changes
  795. Revision 1.41 2004/12/05 20:33:32 hajny
  796. * compilation fix for dosh.inc changes
  797. Revision 1.40 2004/12/05 16:44:43 hajny
  798. * GetMsCount added, platform independent routines moved to single include file
  799. Revision 1.39 2004/12/02 18:24:35 marco
  800. * fpsettimeofday.
  801. Revision 1.38 2004/10/31 17:11:52 marco
  802. * FPC_USE_LIBC fixes
  803. Revision 1.37 2004/10/31 16:20:58 peter
  804. * remove sysutils
  805. Revision 1.36 2004/10/30 20:55:54 marco
  806. * unix interface cleanup
  807. Revision 1.35 2004/09/25 15:09:57 peter
  808. * remove strpas() before syscalls so it chooses the pchar overload
  809. Revision 1.34 2004/08/14 14:22:17 florian
  810. * alignment for sparc fixed
  811. Revision 1.33 2004/07/25 22:46:34 olle
  812. * envstr now returns empty string when index out of bounds
  813. Revision 1.32 2004/03/14 18:42:39 peter
  814. * reset searchrec info in findfirst
  815. Revision 1.31 2004/03/04 22:15:16 marco
  816. * UnixType changes. Please report problems to me.
  817. Revision 1.30 2004/02/18 22:00:45 peter
  818. * dirptr changed to pointer
  819. Revision 1.29 2004/02/18 19:08:27 florian
  820. * fixed bootstrapping with 1.9.2
  821. Revision 1.28 2004/02/17 17:37:26 daniel
  822. * Enable threadvars again
  823. Revision 1.27 2004/02/16 22:18:44 hajny
  824. * LastDosExitCode changed back from threadvar temporarily
  825. Revision 1.26 2004/02/15 21:36:10 hajny
  826. * overloaded ExecuteProcess added, EnvStr param changed to longint
  827. Revision 1.25 2004/02/09 17:01:28 marco
  828. * fixes to get it working under FreeBSD, and probably Linux too
  829. Revision 1.24 2004/02/09 12:03:16 michael
  830. + Switched to single interface in dosh.inc
  831. Revision 1.23 2004/01/31 16:15:14 florian
  832. * packing of searchrec for arm fixed
  833. Revision 1.22 2003/12/29 21:15:04 jonas
  834. * fixed setftime (sorry Marco :)
  835. Revision 1.21 2003/12/03 20:17:03 olle
  836. * files are not pretended to have attr ARCHIVED anymore
  837. + FindFirst etc now also filters on attr HIDDEN
  838. * files with attr READONLY and ARCHIVE are always returned by FindFirst etc
  839. Revision 1.19 2003/10/17 22:13:30 olle
  840. * changed i386 to cpui386
  841. Revision 1.18 2003/09/27 12:51:33 peter
  842. * fpISxxx macros renamed to C compliant fpS_ISxxx
  843. Revision 1.17 2003/09/17 17:30:46 marco
  844. * Introduction of unixutil
  845. Revision 1.16 2003/09/14 20:15:01 marco
  846. * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
  847. Revision 1.15 2003/05/16 20:56:06 florian
  848. no message
  849. Revision 1.14 2003/05/14 13:51:03 florian
  850. * ifdef'd code which i386 specific
  851. Revision 1.13 2002/12/08 16:05:34 peter
  852. * small error code fixes so tdos2 passes
  853. Revision 1.12 2002/09/07 16:01:27 peter
  854. * old logs removed and tabs fixed
  855. }