dos.pp 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman,
  4. members of the Free Pascal development team
  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 Dos;
  12. Interface
  13. Const
  14. FileNameLen = 255;
  15. Type
  16. SearchRec =
  17. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  18. packed
  19. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  20. Record
  21. {Fill : array[1..21] of byte; Fill replaced with below}
  22. SearchPos : UInt64; {directory position}
  23. SearchNum : LongInt; {to track which search this is}
  24. DirPtr : Pointer; {directory pointer for reading directory}
  25. SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
  26. SearchAttr : Byte; {attribute we are searching for}
  27. Mode : Word;
  28. Fill : Array[1..1] 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; platform;
  42. Procedure WasiDateToDt(NanoSecsPast: UInt64; Var Dt: DateTime); platform;
  43. //Function DTToUnixDate(DT: DateTime): LongInt; platform;
  44. {Disk}
  45. //Function AddDisk(const path:string) : byte; platform;
  46. Implementation
  47. Uses
  48. WasiAPI;
  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: LongInt;
  59. {FInode,
  60. FUid,
  61. FGid,}
  62. FSize: __wasi_filesize_t;
  63. FMTime: __wasi_timestamp_t;
  64. End;
  65. {******************************************************************************
  66. --- Info / Date / Time ---
  67. ******************************************************************************}
  68. Function DosVersion:Word;
  69. Begin
  70. End;
  71. (*function WeekDay (y,m,d:longint):longint;
  72. {
  73. Calculates th day of the week. returns -1 on error
  74. }
  75. var
  76. u,v : longint;
  77. begin
  78. if (m<1) or (m>12) or (y<1600) or (y>4000) or
  79. (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
  80. ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
  81. WeekDay:=-1
  82. else
  83. begin
  84. u:=m;
  85. v:=y;
  86. if m<3 then
  87. begin
  88. inc(u,12);
  89. dec(v);
  90. end;
  91. WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
  92. end;
  93. end;*)
  94. Procedure GetDate(Var Year, Month, MDay, WDay: Word);
  95. begin
  96. end;
  97. procedure SetTime(Hour,Minute,Second,sec100:word);
  98. begin
  99. end;
  100. procedure SetDate(Year,Month,Day:Word);
  101. begin
  102. end;
  103. Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  104. begin
  105. end;
  106. Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
  107. begin
  108. end;
  109. Procedure WasiDateToDt(NanoSecsPast: UInt64; Var Dt: DateTime);
  110. const
  111. days_in_month: array [boolean, 1..12] of Byte =
  112. ((31,28,31,30,31,30,31,31,30,31,30,31),
  113. (31,29,31,30,31,30,31,31,30,31,30,31));
  114. var
  115. leap: Boolean;
  116. days_in_year: LongInt;
  117. Begin
  118. { todo: convert UTC to local time, as soon as we can get the local timezone
  119. from WASI: https://github.com/WebAssembly/WASI/issues/239 }
  120. NanoSecsPast:=NanoSecsPast div 1000000000;
  121. Dt.Sec:=NanoSecsPast mod 60;
  122. NanoSecsPast:=NanoSecsPast div 60;
  123. Dt.Min:=NanoSecsPast mod 60;
  124. NanoSecsPast:=NanoSecsPast div 60;
  125. Dt.Hour:=NanoSecsPast mod 24;
  126. NanoSecsPast:=NanoSecsPast div 24;
  127. Dt.Year:=1970;
  128. leap:=false;
  129. days_in_year:=365;
  130. while NanoSecsPast>=days_in_year do
  131. begin
  132. Dec(NanoSecsPast,days_in_year);
  133. Inc(Dt.Year);
  134. leap:=((Dt.Year mod 4)=0) and (((Dt.Year mod 100)<>0) or ((Dt.Year mod 400)=0));
  135. if leap then
  136. days_in_year:=366
  137. else
  138. days_in_year:=365;
  139. end;
  140. Dt.Month:=1;
  141. Inc(NanoSecsPast);
  142. while NanoSecsPast>days_in_month[leap,Dt.Month] do
  143. begin
  144. Dec(NanoSecsPast,days_in_month[leap,Dt.Month]);
  145. Inc(Dt.Month);
  146. end;
  147. Dt.Day:=Word(NanoSecsPast);
  148. End;
  149. Function DTToUnixDate(DT: DateTime): LongInt;
  150. Begin
  151. End;
  152. function GetMsCount: int64;
  153. begin
  154. end;
  155. {******************************************************************************
  156. --- Exec ---
  157. ******************************************************************************}
  158. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  159. Begin
  160. End;
  161. {******************************************************************************
  162. --- Disk ---
  163. ******************************************************************************}
  164. {
  165. The Diskfree and Disksize functions need a file on the specified drive, since this
  166. is required for the fpstatfs system call.
  167. These filenames are set in drivestr[0..26], and have been preset to :
  168. 0 - '.' (default drive - hence current dir is ok.)
  169. 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
  170. 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
  171. 3 - '/' (C: equivalent of dos is the root partition)
  172. 4..26 (can be set by you're own applications)
  173. ! Use AddDisk() to Add new drives !
  174. They both return -1 when a failure occurs.
  175. }
  176. Const
  177. FixDriveStr : array[0..3] of pchar=(
  178. '.',
  179. '/fd0/.',
  180. '/fd1/.',
  181. '/.'
  182. );
  183. const
  184. Drives : byte = 4;
  185. var
  186. DriveStr : array[4..26] of pchar;
  187. Function AddDisk(const path:string) : byte;
  188. begin
  189. { if not (DriveStr[Drives]=nil) then
  190. FreeMem(DriveStr[Drives]);
  191. GetMem(DriveStr[Drives],length(Path)+1);
  192. StrPCopy(DriveStr[Drives],path);
  193. AddDisk:=Drives;
  194. inc(Drives);
  195. if Drives>26 then
  196. Drives:=4;}
  197. end;
  198. Function DiskFree(Drive: Byte): int64;
  199. {var
  200. fs : tstatfs;}
  201. Begin
  202. { if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (fpStatFS(fixdrivestr[drive],@fs)<>-1)) or
  203. ((not (drivestr[Drive]=nil)) and (fpStatFS(drivestr[drive],@fs)<>-1)) then
  204. Diskfree:=int64(fs.bavail)*int64(fs.bsize)
  205. else
  206. Diskfree:=-1;}
  207. End;
  208. Function DiskSize(Drive: Byte): int64;
  209. {var
  210. fs : tstatfs;}
  211. Begin
  212. { if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (fpStatFS(fixdrivestr[drive],@fs)<>-1)) or
  213. ((not (drivestr[Drive]=nil)) and (fpStatFS(drivestr[drive],@fs)<>-1)) then
  214. DiskSize:=int64(fs.blocks)*int64(fs.bsize)
  215. else
  216. DiskSize:=-1;}
  217. End;
  218. Procedure FreeDriveStr;
  219. {var
  220. i: longint;}
  221. begin
  222. { for i:=low(drivestr) to high(drivestr) do
  223. if assigned(drivestr[i]) then
  224. begin
  225. freemem(drivestr[i]);
  226. drivestr[i]:=nil;
  227. end;}
  228. end;
  229. {******************************************************************************
  230. --- Findfirst FindNext ---
  231. ******************************************************************************}
  232. (*Function FNMatch(const Pattern,Name:string):Boolean;
  233. Var
  234. LenPat,LenName : longint;
  235. Function DoFNMatch(i,j:longint):Boolean;
  236. Var
  237. Found : boolean;
  238. Begin
  239. Found:=true;
  240. While Found and (i<=LenPat) Do
  241. Begin
  242. Case Pattern[i] of
  243. '?' : Found:=(j<=LenName);
  244. '*' : Begin
  245. {find the next character in pattern, different of ? and *}
  246. while Found do
  247. begin
  248. inc(i);
  249. if i>LenPat then Break;
  250. case Pattern[i] of
  251. '*' : ;
  252. '?' : begin
  253. if j>LenName then begin DoFNMatch:=false; Exit; end;
  254. inc(j);
  255. end;
  256. else
  257. Found:=false;
  258. end;
  259. end;
  260. Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
  261. {Now, find in name the character which i points to, if the * or ?
  262. wasn't the last character in the pattern, else, use up all the
  263. chars in name}
  264. Found:=false;
  265. if (i<=LenPat) then
  266. begin
  267. repeat
  268. {find a letter (not only first !) which maches pattern[i]}
  269. while (j<=LenName) and (name[j]<>pattern[i]) do
  270. inc (j);
  271. if (j<LenName) then
  272. begin
  273. if DoFnMatch(i+1,j+1) then
  274. begin
  275. i:=LenPat;
  276. j:=LenName;{we can stop}
  277. Found:=true;
  278. Break;
  279. end else
  280. inc(j);{We didn't find one, need to look further}
  281. end else
  282. if j=LenName then
  283. begin
  284. Found:=true;
  285. Break;
  286. end;
  287. { This 'until' condition must be j>LenName, not j>=LenName.
  288. That's because when we 'need to look further' and
  289. j = LenName then loop must not terminate. }
  290. until (j>LenName);
  291. end else
  292. begin
  293. j:=LenName;{we can stop}
  294. Found:=true;
  295. end;
  296. end;
  297. else {not a wildcard character in pattern}
  298. Found:=(j<=LenName) and (pattern[i]=name[j]);
  299. end;
  300. inc(i);
  301. inc(j);
  302. end;
  303. DoFnMatch:=Found and (j>LenName);
  304. end;
  305. Begin {start FNMatch}
  306. LenPat:=Length(Pattern);
  307. LenName:=Length(Name);
  308. FNMatch:=DoFNMatch(1,1);
  309. End;*)
  310. Const
  311. RtlFindSize = 15;
  312. Type
  313. RtlFindRecType = Record
  314. DirPtr : Pointer;
  315. SearchNum,
  316. LastUsed : LongInt;
  317. End;
  318. Var
  319. RtlFindRecs : Array[1..RtlFindSize] of RtlFindRecType;
  320. CurrSearchNum : LongInt;
  321. Procedure FindClose(Var f: SearchRec);
  322. {
  323. Closes dirptr if it is open
  324. }
  325. {Var
  326. i : longint;}
  327. Begin
  328. { if f.SearchType=0 then
  329. begin
  330. i:=1;
  331. repeat
  332. if (RtlFindRecs[i].SearchNum=f.SearchNum) then
  333. break;
  334. inc(i);
  335. until (i>RtlFindSize);
  336. If i<=RtlFindSize Then
  337. Begin
  338. RtlFindRecs[i].SearchNum:=0;
  339. if f.dirptr<>nil then
  340. fpclosedir(pdir(f.dirptr)^);
  341. End;
  342. end;
  343. f.dirptr:=nil;}
  344. End;
  345. Function FindGetFileInfo(const s:string;var f:SearchRec):boolean;
  346. var
  347. s_ansi: ansistring;
  348. DT : DateTime;
  349. Info : RtlInfoType;
  350. st : __wasi_filestat_t;
  351. fd : __wasi_fd_t;
  352. pr : PChar;
  353. begin
  354. FindGetFileInfo:=false;
  355. s_ansi:=s;
  356. if not ConvertToFdRelativePath(PChar(s_ansi),fd,pr) then
  357. exit;
  358. { todo: __WASI_LOOKUPFLAGS_SYMLINK_FOLLOW??? }
  359. if __wasi_path_filestat_get(fd,0,pr,StrLen(pr),@st)<>__WASI_ERRNO_SUCCESS then
  360. begin
  361. FreeMem(pr);
  362. exit;
  363. end;
  364. info.FSize:=st.size;
  365. info.FMTime:=st.mtim;
  366. if st.filetype=__WASI_FILETYPE_DIRECTORY then
  367. info.fmode:=$10
  368. else
  369. info.fmode:=$0;
  370. {if (st.st_mode and STAT_IWUSR)=0 then
  371. info.fmode:=info.fmode or 1;}
  372. if s[f.NamePos+1]='.' then
  373. info.fmode:=info.fmode or $2;
  374. If ((Info.FMode and Not(f.searchattr))=0) Then
  375. Begin
  376. f.Name:=Copy(s,f.NamePos+1,255);
  377. f.Attr:=Info.FMode;
  378. f.Size:=Info.FSize;
  379. {f.mode:=st.st_mode;}
  380. WasiDateToDT(Info.FMTime, DT);
  381. PackTime(DT,f.Time);
  382. FindGetFileInfo:=true;
  383. End;
  384. FreeMem(pr);
  385. end;
  386. Function FindLastUsed: Longint;
  387. {
  388. Find unused or least recently used dirpointer slot in findrecs array
  389. }
  390. {Var
  391. BestMatch,i : Longint;
  392. Found : Boolean;}
  393. Begin
  394. { BestMatch:=1;
  395. i:=1;
  396. Found:=False;
  397. While (i <= RtlFindSize) And (Not Found) Do
  398. Begin
  399. If (RtlFindRecs[i].SearchNum = 0) Then
  400. Begin
  401. BestMatch := i;
  402. Found := True;
  403. End
  404. Else
  405. Begin
  406. If RtlFindRecs[i].LastUsed > RtlFindRecs[BestMatch].LastUsed Then
  407. BestMatch := i;
  408. End;
  409. Inc(i);
  410. End;
  411. FindLastUsed := BestMatch;}
  412. End;
  413. Procedure FindNext(Var f: SearchRec);
  414. {
  415. re-opens dir if not already in array and calls FindWorkProc
  416. }
  417. {Var
  418. DirName : Array[0..256] of Char;
  419. i,
  420. ArrayPos : Longint;
  421. FName,
  422. SName : string;
  423. Found,
  424. Finished : boolean;
  425. p : pdirent;}
  426. Begin
  427. (* If f.SearchType=0 Then
  428. Begin
  429. ArrayPos:=0;
  430. For i:=1 to RtlFindSize Do
  431. Begin
  432. If RtlFindRecs[i].SearchNum = f.SearchNum Then
  433. ArrayPos:=i;
  434. Inc(RtlFindRecs[i].LastUsed);
  435. End;
  436. If ArrayPos=0 Then
  437. Begin
  438. If f.NamePos = 0 Then
  439. Begin
  440. DirName[0] := '.';
  441. DirName[1] := '/';
  442. DirName[2] := #0;
  443. End
  444. Else
  445. Begin
  446. Move(f.SearchSpec[1], DirName[0], f.NamePos);
  447. DirName[f.NamePos] := #0;
  448. End;
  449. f.DirPtr := fpopendir(@DirName[0]);
  450. If f.DirPtr <> nil Then
  451. begin
  452. ArrayPos:=FindLastUsed;
  453. If RtlFindRecs[ArrayPos].SearchNum > 0 Then
  454. FpCloseDir((pdir(rtlfindrecs[arraypos].dirptr)^));
  455. RtlFindRecs[ArrayPos].SearchNum := f.SearchNum;
  456. RtlFindRecs[ArrayPos].DirPtr := f.DirPtr;
  457. if f.searchpos>0 then
  458. seekdir(pdir(f.dirptr), f.searchpos);
  459. end;
  460. End;
  461. if ArrayPos>0 then
  462. RtlFindRecs[ArrayPos].LastUsed:=0;
  463. end;
  464. {Main loop}
  465. SName:=Copy(f.SearchSpec,f.NamePos+1,255);
  466. Found:=False;
  467. Finished:=(f.dirptr=nil);
  468. While Not Finished Do
  469. Begin
  470. p:=fpreaddir(pdir(f.dirptr)^);
  471. if p=nil then
  472. FName:=''
  473. else
  474. FName:=Strpas(@p^.d_name[0]);
  475. If FName='' Then
  476. Finished:=True
  477. Else
  478. Begin
  479. If FNMatch(SName,FName) Then
  480. Begin
  481. Found:=FindGetFileInfo(Copy(f.SearchSpec,1,f.NamePos)+FName,f);
  482. if Found then
  483. Finished:=true;
  484. End;
  485. End;
  486. End;
  487. {Shutdown}
  488. If Found Then
  489. Begin
  490. f.searchpos:=telldir(pdir(f.dirptr));
  491. DosError:=0;
  492. End
  493. Else
  494. Begin
  495. FindClose(f);
  496. DosError:=18;
  497. End;*)
  498. End;
  499. Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
  500. {
  501. opens dir and calls FindWorkProc
  502. }
  503. Begin
  504. fillchar(f,sizeof(f),0);
  505. if Path='' then
  506. begin
  507. DosError:=3;
  508. exit;
  509. end;
  510. {Create Info}
  511. f.SearchSpec := Path;
  512. {We always also search for readonly and archive, regardless of Attr:}
  513. f.SearchAttr := Attr or archive or readonly;
  514. f.SearchPos := 0;
  515. f.NamePos := Length(f.SearchSpec);
  516. while (f.NamePos>0) and (f.SearchSpec[f.NamePos] in ['/','\']) do
  517. dec(f.NamePos);
  518. {Wildcards?}
  519. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  520. begin
  521. if FindGetFileInfo(Path,f) then
  522. DosError:=0
  523. else
  524. begin
  525. { According to tdos2 test it should return 18
  526. if ErrNo=Sys_ENOENT then
  527. DosError:=3
  528. else }
  529. DosError:=18;
  530. end;
  531. f.DirPtr:=nil;
  532. f.SearchType:=1;
  533. f.searchnum:=-1;
  534. end
  535. else
  536. {Find Entry}
  537. begin
  538. Inc(CurrSearchNum);
  539. f.SearchNum:=CurrSearchNum;
  540. f.SearchType:=0;
  541. FindNext(f);
  542. end;
  543. End;
  544. {******************************************************************************
  545. --- File ---
  546. ******************************************************************************}
  547. Function FSearch(path : pathstr;dirlist : string) : pathstr;
  548. {Var
  549. info : BaseUnix.stat;}
  550. Begin
  551. { if (length(Path)>0) and (path[1]='/') and (fpStat(path,info)>=0) and (not fpS_ISDIR(Info.st_Mode)) then
  552. FSearch:=path
  553. else
  554. FSearch:=Unix.FSearch(path,dirlist);}
  555. End;
  556. Procedure GetFAttr(var f; var attr : word);
  557. (*Var
  558. info : baseunix.stat;
  559. LinAttr : longint;
  560. p : pchar;
  561. {$ifndef FPC_ANSI_TEXTFILEREC}
  562. r : RawByteString;
  563. {$endif not FPC_ANSI_TEXTFILEREC}*)
  564. Begin
  565. (* DosError:=0;
  566. {$ifdef FPC_ANSI_TEXTFILEREC}
  567. { encoding is already correct }
  568. p:=@textrec(f).name;
  569. {$else}
  570. r:=ToSingleByteFileSystemEncodedFileName(textrec(f).name);
  571. p:=pchar(r);
  572. {$endif}
  573. { use the pchar rather than the rawbytestring version so that we don't check
  574. a second time whether the string needs to be converted to the right code
  575. page
  576. }
  577. if FPStat(p,info)<0 then
  578. begin
  579. Attr:=0;
  580. DosError:=3;
  581. exit;
  582. end
  583. else
  584. LinAttr:=Info.st_Mode;
  585. if fpS_ISDIR(LinAttr) then
  586. Attr:=$10
  587. else
  588. Attr:=$0;
  589. if fpAccess(p,W_OK)<0 then
  590. Attr:=Attr or $1;
  591. if filerec(f).name[0]='.' then
  592. Attr:=Attr or $2;*)
  593. end;
  594. Procedure getftime (var f; var time : longint);
  595. Var
  596. res: __wasi_errno_t;
  597. Info: __wasi_filestat_t;
  598. DT: DateTime;
  599. Begin
  600. doserror:=0;
  601. res:=__wasi_fd_filestat_get(filerec(f).handle,@Info);
  602. if res<>__WASI_ERRNO_SUCCESS then
  603. begin
  604. Time:=0;
  605. case res of
  606. __WASI_ERRNO_ACCES,
  607. __WASI_ERRNO_NOTCAPABLE:
  608. doserror:=5;
  609. else
  610. doserror:=6;
  611. end;
  612. exit
  613. end
  614. else
  615. WasiDateToDt(Info.mtim,DT);
  616. PackTime(DT,Time);
  617. End;
  618. Procedure setftime(var f; time : longint);
  619. (*
  620. Var
  621. utim: utimbuf;
  622. DT: DateTime;
  623. p : pchar;
  624. {$ifndef FPC_ANSI_TEXTFILEREC}
  625. r : Rawbytestring;
  626. {$endif not FPC_ANSI_TEXTFILEREC}*)
  627. Begin
  628. (* doserror:=0;
  629. with utim do
  630. begin
  631. actime:=fptime;
  632. UnPackTime(Time,DT);
  633. modtime:=DTToUnixDate(DT);
  634. end;
  635. {$ifdef FPC_ANSI_TEXTFILEREC}
  636. { encoding is already correct }
  637. p:=@textrec(f).name;
  638. {$else}
  639. r:=ToSingleByteFileSystemEncodedFileName(textrec(f).name);
  640. p:=pchar(r);
  641. {$endif}
  642. { use the pchar rather than the rawbytestring version so that we don't check
  643. a second time whether the string needs to be converted to the right code
  644. page
  645. }
  646. if fputime(p,@utim)<0 then
  647. begin
  648. Time:=0;
  649. doserror:=3;
  650. end;*)
  651. End;
  652. {******************************************************************************
  653. --- Environment ---
  654. ******************************************************************************}
  655. Function EnvCount: Longint;
  656. var
  657. envcnt : longint;
  658. p : ppchar;
  659. Begin
  660. envcnt:=0;
  661. p:=envp; {defined in system}
  662. if p<>nil then
  663. while p^<>nil do
  664. begin
  665. inc(envcnt);
  666. inc(p);
  667. end;
  668. EnvCount := envcnt
  669. End;
  670. Function EnvStr (Index: longint): String;
  671. Var
  672. i : longint;
  673. p : ppchar;
  674. Begin
  675. if (Index <= 0) or (envp=nil) then
  676. envstr:=''
  677. else
  678. begin
  679. p:=envp; {defined in system}
  680. i:=1;
  681. while (i<Index) and (p^<>nil) do
  682. begin
  683. inc(i);
  684. inc(p);
  685. end;
  686. if p^=nil then
  687. envstr:=''
  688. else
  689. envstr:=strpas(p^)
  690. end;
  691. end;
  692. Function GetEnv(EnvVar: String): String;
  693. var
  694. hp : ppchar;
  695. hs : string;
  696. eqpos : longint;
  697. Begin
  698. getenv:='';
  699. hp:=envp;
  700. if hp<>nil then
  701. while assigned(hp^) do
  702. begin
  703. hs:=strpas(hp^);
  704. eqpos:=pos('=',hs);
  705. if copy(hs,1,eqpos-1)=envvar then
  706. begin
  707. getenv:=copy(hs,eqpos+1,length(hs)-eqpos);
  708. break;
  709. end;
  710. inc(hp);
  711. end;
  712. End;
  713. Procedure setfattr (var f;attr : word);
  714. Begin
  715. (* {! No Unix equivalent !}
  716. { Fail for setting VolumeId }
  717. if (attr and VolumeID)<>0 then
  718. doserror:=5;*)
  719. End;
  720. {******************************************************************************
  721. --- Initialization ---
  722. ******************************************************************************}
  723. //Finalization
  724. // FreeDriveStr;
  725. End.