dos.pp 24 KB

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