dos.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2001 by members of the Free Pascal
  5. development team
  6. DOS unit template based on POSIX
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. Unit Dos;
  14. Interface
  15. {$goto on}
  16. Const
  17. FileNameLen=255;
  18. Type
  19. SearchRec = packed Record
  20. {Fill : array[1..21] of byte; Fill replaced with below}
  21. DirPtr : pointer; {directory pointer for reading directory}
  22. SearchAttr : Byte; {attribute we are searching for}
  23. Fill : Array[1..16] of Byte; {future use}
  24. {End of fill}
  25. Attr : Byte; {attribute of found file}
  26. Time : LongInt; {last modify date of found file}
  27. Size : LongInt; {file size of found file}
  28. Reserved : Word; {future use}
  29. Name : String[FileNameLen]; {name of found file}
  30. SearchSpec : String[FileNameLen]; {search pattern}
  31. SearchDir : String[FileNameLen]; { path we are searching in }
  32. End;
  33. Registers = packed record
  34. case i : integer of
  35. 0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
  36. 1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
  37. 2 : (eax, ebx, ecx, edx, ebp, esi, edi : longint);
  38. End;
  39. {$i dosh.inc}
  40. Procedure AddDisk(const path:string);
  41. Implementation
  42. Uses
  43. Strings,posix;
  44. { Used by AddDisk(), DiskFree() and DiskSize() }
  45. const
  46. Drives : byte = 4;
  47. MAX_DRIVES = 26;
  48. var
  49. DriveStr : array[4..MAX_DRIVES] of pchar;
  50. Function StringToPPChar(Var S:STring; var count : longint):ppchar;
  51. {
  52. Create a PPChar to structure of pchars which are the arguments specified
  53. in the string S. Especially usefull for creating an ArgV for Exec-calls
  54. }
  55. var
  56. nr : longint;
  57. Buf : ^char;
  58. p : ppchar;
  59. begin
  60. s:=s+#0;
  61. buf:=@s[1];
  62. nr:=0;
  63. while(buf^<>#0) do
  64. begin
  65. while (buf^ in [' ',#8,#10]) do
  66. inc(buf);
  67. inc(nr);
  68. while not (buf^ in [' ',#0,#8,#10]) do
  69. inc(buf);
  70. end;
  71. getmem(p,nr*4);
  72. StringToPPChar:=p;
  73. if p=nil then
  74. begin
  75. Errno:=sys_enomem;
  76. count := 0;
  77. exit;
  78. end;
  79. buf:=@s[1];
  80. while (buf^<>#0) do
  81. begin
  82. while (buf^ in [' ',#8,#10]) do
  83. begin
  84. buf^:=#0;
  85. inc(buf);
  86. end;
  87. p^:=buf;
  88. inc(p);
  89. p^:=nil;
  90. while not (buf^ in [' ',#0,#8,#10]) do
  91. inc(buf);
  92. end;
  93. count := nr;
  94. end;
  95. {$i dos.inc} { include OS specific stuff }
  96. {******************************************************************************
  97. --- Info / Date / Time ---
  98. ******************************************************************************}
  99. var
  100. TZSeconds : longint; { offset to add/ subtract from Epoch to get local time }
  101. tzdaylight : boolean;
  102. tzname : array[boolean] of pchar;
  103. type
  104. GTRec = packed Record
  105. Year,
  106. Month,
  107. MDay,
  108. WDay,
  109. Hour,
  110. Minute,
  111. Second : Word;
  112. End;
  113. Const
  114. {Date Calculation}
  115. C1970 = 2440588;
  116. D0 = 1461;
  117. D1 = 146097;
  118. D2 = 1721119;
  119. function WeekDay (y,m,d:longint):longint;
  120. {
  121. Calculates th day of the week. returns -1 on error
  122. }
  123. var
  124. u,v : longint;
  125. begin
  126. if (m<1) or (m>12) or (y<1600) or (y>4000) or
  127. (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
  128. ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
  129. WeekDay:=-1
  130. else
  131. begin
  132. u:=m;
  133. v:=y;
  134. if m<3 then
  135. begin
  136. inc(u,12);
  137. dec(v);
  138. end;
  139. WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
  140. end;
  141. end;
  142. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  143. Var
  144. YYear,XYear,Temp,TempMonth : LongInt;
  145. Begin
  146. Temp:=((JulianDN-D2) shl 2)-1;
  147. JulianDN:=Temp Div D1;
  148. XYear:=(Temp Mod D1) or 3;
  149. YYear:=(XYear Div D0);
  150. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  151. Day:=((Temp Mod 153)+5) Div 5;
  152. TempMonth:=Temp Div 153;
  153. If TempMonth>=10 Then
  154. Begin
  155. inc(YYear);
  156. dec(TempMonth,12);
  157. End;
  158. inc(TempMonth,3);
  159. Month := TempMonth;
  160. Year:=YYear+(JulianDN*100);
  161. end;
  162. Procedure EpochToLocal(epoch:time_t;var year,month,day,hour,minute,second:Word);
  163. {
  164. Transforms Epoch time into local time (hour, minute,seconds)
  165. }
  166. Var
  167. DateNum: time_t;
  168. Begin
  169. Epoch:=Epoch+TZSeconds;
  170. Datenum:=(Epoch Div 86400) + c1970;
  171. JulianToGregorian(DateNum,Year,Month,day);
  172. Epoch:=Abs(Epoch Mod 86400);
  173. Hour:=Epoch Div 3600;
  174. Epoch:=Epoch Mod 3600;
  175. Minute:=Epoch Div 60;
  176. Second:=Epoch Mod 60;
  177. End;
  178. Procedure GetDate(Var Year, Month, MDay, WDay: Word);
  179. var
  180. hour,minute,second : word;
  181. timeval : time_t;
  182. Begin
  183. timeval := sys_time(timeval);
  184. { convert the GMT time to local time }
  185. EpochToLocal(timeval,year,month,mday,hour,minute,second);
  186. Wday:=weekday(Year,Month,MDay);
  187. end;
  188. Procedure SetDate(Year, Month, Day: Word);
  189. Begin
  190. {!!}
  191. End;
  192. Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
  193. var
  194. timeval : time_t;
  195. year,month,day: word;
  196. Begin
  197. timeval := sys_time(timeval);
  198. EpochToLocal(timeval,year,month,day,hour,minute,second);
  199. Sec100 := 0;
  200. end;
  201. Procedure SetTime(Hour, Minute, Second, Sec100: Word);
  202. Begin
  203. {!!}
  204. End;
  205. Procedure packtime(var t : datetime;var p : longint);
  206. Begin
  207. p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
  208. End;
  209. Procedure unpacktime(p : longint;var t : datetime);
  210. Begin
  211. t.sec:=(p and 31) shl 1;
  212. t.min:=(p shr 5) and 63;
  213. t.hour:=(p shr 11) and 31;
  214. t.day:=(p shr 16) and 31;
  215. t.month:=(p shr 21) and 15;
  216. t.year:=(p shr 25)+1980;
  217. End;
  218. Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
  219. Begin
  220. EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
  221. End;
  222. {$ifndef DOS_HAS_EXEC}
  223. {******************************************************************************
  224. --- Exec ---
  225. ******************************************************************************}
  226. var
  227. LastDosExitCode: word;
  228. Function InternalWaitProcess(Pid:pid_t):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
  229. var r,s : cint;
  230. begin
  231. repeat
  232. s:=$7F00;
  233. r:=sys_WaitPid(Pid,s,0);
  234. until (r<>-1) or (Errno<>Sys_EINTR);
  235. { When r = -1 or r = 0, no status is available, so there was an error. }
  236. if (r=-1) or (r=0) then
  237. InternalWaitProcess:=-1 { return -1 to indicate an error }
  238. else
  239. begin
  240. { process terminated normally }
  241. if wifexited(s)<>0 then
  242. begin
  243. { get status code }
  244. InternalWaitProcess := wexitstatus(s);
  245. exit;
  246. end;
  247. { process terminated due to a signal }
  248. if wifsignaled(s)<>0 then
  249. begin
  250. { get signal number }
  251. InternalWaitProcess := wstopsig(s);
  252. exit;
  253. end;
  254. InternalWaitProcess:=-1;
  255. end;
  256. end;
  257. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  258. var
  259. pid : pid_t;
  260. tmp : string;
  261. p : ppchar;
  262. count: longint;
  263. // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
  264. F: File;
  265. Begin
  266. {$IFOPT I+}
  267. {$DEFINE IOCHECK}
  268. {$ENDIF}
  269. {$I-}
  270. { verify if the file to execute exists }
  271. Assign(F,Path);
  272. Reset(F,1);
  273. if IOResult <> 0 then
  274. { file not found }
  275. begin
  276. DosError := 2;
  277. exit;
  278. end
  279. else
  280. Close(F);
  281. {$IFDEF IOCHECK}
  282. {$I+}
  283. {$UNDEF IOCHECK}
  284. {$ENDIF}
  285. LastDosExitCode:=0;
  286. { Fork the process }
  287. pid:=sys_Fork;
  288. if pid=0 then
  289. begin
  290. {The child does the actual execution, and then exits}
  291. tmp := Path+' '+ComLine;
  292. p:=StringToPPChar(tmp,count);
  293. if (p<>nil) and (p^<>nil) then
  294. begin
  295. sys_Execve(p^,p,Envp);
  296. end;
  297. {If the execve fails, we return an exitvalue of 127, to let it be known}
  298. sys_exit(127);
  299. end
  300. else
  301. if pid=-1 then {Fork failed - parent only}
  302. begin
  303. DosError:=8;
  304. exit
  305. end;
  306. {We're in the parent, let's wait.}
  307. LastDosExitCode:=InternalWaitProcess(pid); // WaitPid and result-convert
  308. if (LastDosExitCode>=0) and (LastDosExitCode<>127) then DosError:=0 else
  309. DosError:=8; // perhaps one time give an better error
  310. End;
  311. Function DosExitCode: Word;
  312. Begin
  313. DosExitCode:=LastDosExitCode;
  314. End;
  315. {$ENDIF}
  316. {******************************************************************************
  317. --- Disk ---
  318. ******************************************************************************}
  319. Procedure AddDisk(const path:string);
  320. begin
  321. if not (DriveStr[Drives]=nil) then
  322. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  323. GetMem(DriveStr[Drives],length(Path)+1);
  324. StrPCopy(DriveStr[Drives],path);
  325. inc(Drives);
  326. if Drives>26 then
  327. Drives:=4;
  328. end;
  329. {******************************************************************************
  330. --- Findfirst FindNext ---
  331. ******************************************************************************}
  332. Function FNMatch(const Pattern,Name:string):Boolean;
  333. Var
  334. LenPat,LenName : longint;
  335. Function DoFNMatch(i,j:longint):Boolean;
  336. Var
  337. Found : boolean;
  338. Begin
  339. Found:=true;
  340. While Found and (i<=LenPat) Do
  341. Begin
  342. Case Pattern[i] of
  343. '?' : Found:=(j<=LenName);
  344. '*' : Begin
  345. {find the next character in pattern, different of ? and *}
  346. while Found and (i<LenPat) do
  347. begin
  348. inc(i);
  349. case Pattern[i] of
  350. '*' : ;
  351. '?' : begin
  352. inc(j);
  353. Found:=(j<=LenName);
  354. end;
  355. else
  356. Found:=false;
  357. end;
  358. end;
  359. {Now, find in name the character which i points to, if the * or ?
  360. wasn't the last character in the pattern, else, use up all the
  361. chars in name}
  362. Found:=true;
  363. if (i<=LenPat) then
  364. begin
  365. repeat
  366. {find a letter (not only first !) which maches pattern[i]}
  367. while (j<=LenName) and (name[j]<>pattern[i]) do
  368. inc (j);
  369. if (j<LenName) then
  370. begin
  371. if DoFnMatch(i+1,j+1) then
  372. begin
  373. i:=LenPat;
  374. j:=LenName;{we can stop}
  375. Found:=true;
  376. end
  377. else
  378. inc(j);{We didn't find one, need to look further}
  379. end;
  380. until (j>=LenName);
  381. end
  382. else
  383. j:=LenName;{we can stop}
  384. end;
  385. else {not a wildcard character in pattern}
  386. Found:=(j<=LenName) and (pattern[i]=name[j]);
  387. end;
  388. inc(i);
  389. inc(j);
  390. end;
  391. DoFnMatch:=Found and (j>LenName);
  392. end;
  393. Begin {start FNMatch}
  394. LenPat:=Length(Pattern);
  395. LenName:=Length(Name);
  396. FNMatch:=DoFNMatch(1,1);
  397. End;
  398. Procedure FindClose(Var f: SearchRec);
  399. {
  400. Closes dirptr if it is open
  401. }
  402. Begin
  403. { could already have been closed }
  404. if assigned(f.dirptr) then
  405. sys_closedir(pdir(f.dirptr));
  406. f.dirptr := nil;
  407. End;
  408. { Returns a filled in searchRec structure }
  409. { and TRUE if the specified file in s is }
  410. { found. }
  411. Function FindGetFileInfo(s:string;var f:SearchRec):boolean;
  412. var
  413. DT : DateTime;
  414. st : stat;
  415. Fmode : byte;
  416. res: string; { overlaid variable }
  417. Dir : DirsTr;
  418. Name : NameStr;
  419. Ext: ExtStr;
  420. begin
  421. FindGetFileInfo:=false;
  422. res := s + #0;
  423. if sys_stat(@res[1],st)<>0 then
  424. exit;
  425. if S_ISDIR(st.st_mode) then
  426. fmode:=directory
  427. else
  428. fmode:=0;
  429. if (st.st_mode and S_IWUSR)=0 then
  430. fmode:=fmode or readonly;
  431. FSplit(s,Dir,Name,Ext);
  432. if Name[1]='.' then
  433. fmode:=fmode or hidden;
  434. If ((FMode and Not(f.searchattr))=0) Then
  435. Begin
  436. if Ext <> '' then
  437. res := Name + Ext
  438. else
  439. res := Name;
  440. f.Name:=res;
  441. f.Attr:=FMode;
  442. f.Size:=longint(st.st_size);
  443. UnixDateToDT(st.st_mtime, DT);
  444. PackTime(DT,f.Time);
  445. FindGetFileInfo:=true;
  446. End;
  447. end;
  448. Procedure FindNext(Var f: SearchRec);
  449. {
  450. re-opens dir if not already in array and calls FindWorkProc
  451. }
  452. Var
  453. FName,
  454. SName : string;
  455. Found,
  456. Finished : boolean;
  457. p : PDirEnt;
  458. Begin
  459. {Main loop}
  460. SName:=f.SearchSpec;
  461. Found:=False;
  462. Finished:=(f.dirptr=nil);
  463. While Not Finished Do
  464. Begin
  465. p:=sys_readdir(pdir(f.dirptr));
  466. if p=nil then
  467. begin
  468. FName:=''
  469. end
  470. else
  471. FName:=Strpas(@p^.d_name);
  472. If FName='' Then
  473. Finished:=True
  474. Else
  475. Begin
  476. If FNMatch(SName,FName) Then
  477. Begin
  478. Found:=FindGetFileInfo(f.SearchDir+FName,f);
  479. if Found then
  480. begin
  481. Finished:=true;
  482. end;
  483. End;
  484. End;
  485. End;
  486. {Shutdown}
  487. If Found Then
  488. Begin
  489. DosError:=0;
  490. End
  491. Else
  492. Begin
  493. FindClose(f);
  494. { FindClose() might be called thereafter also... }
  495. f.dirptr := nil;
  496. DosError:=18;
  497. End;
  498. End;
  499. Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
  500. {
  501. opens dir
  502. }
  503. var
  504. res: string;
  505. Dir : DirsTr;
  506. Name : NameStr;
  507. Ext: ExtStr;
  508. Begin
  509. { initialize f.dirptr because it is used }
  510. { to see if we need to close the dir stream }
  511. f.dirptr := nil;
  512. if Path='' then
  513. begin
  514. DosError:=3;
  515. exit;
  516. end;
  517. {We always also search for readonly and archive, regardless of Attr:}
  518. f.SearchAttr := Attr or archive or readonly;
  519. {Wildcards?}
  520. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  521. begin
  522. if FindGetFileInfo(Path,f) then
  523. DosError:=0
  524. else
  525. begin
  526. if ErrNo=Sys_ENOENT then
  527. DosError:=3
  528. else
  529. DosError:=18;
  530. end;
  531. f.DirPtr:=nil;
  532. end
  533. else
  534. {Find Entry}
  535. begin
  536. FSplit(Path,Dir,Name,Ext);
  537. if Ext <> '' then
  538. res := Name + Ext
  539. else
  540. res := Name;
  541. f.SearchSpec := res;
  542. { if dir is an empty string }
  543. { then this indicates that }
  544. { use the current working }
  545. { directory. }
  546. if dir = '' then
  547. dir := './';
  548. f.SearchDir := Dir;
  549. { add terminating null character }
  550. Dir := Dir + #0;
  551. f.dirptr := sys_opendir(@Dir[1]);
  552. if not assigned(f.dirptr) then
  553. begin
  554. DosError := 8;
  555. exit;
  556. end;
  557. FindNext(f);
  558. end;
  559. End;
  560. {******************************************************************************
  561. --- File ---
  562. ******************************************************************************}
  563. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  564. Var
  565. DotPos,SlashPos,i : longint;
  566. Begin
  567. SlashPos:=0;
  568. DotPos:=256;
  569. i:=Length(Path);
  570. While (i>0) and (SlashPos=0) Do
  571. Begin
  572. If (DotPos=256) and (Path[i]='.') Then
  573. begin
  574. DotPos:=i;
  575. end;
  576. If (Path[i]='/') Then
  577. SlashPos:=i;
  578. Dec(i);
  579. End;
  580. Ext:=Copy(Path,DotPos,255);
  581. Dir:=Copy(Path,1,SlashPos);
  582. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  583. End;
  584. {
  585. function FExpand (const Path: PathStr): PathStr;
  586. - declared in fexpand.inc
  587. }
  588. (*
  589. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  590. *)
  591. const
  592. LFNSupport = true;
  593. FileNameCaseSensitive = true;
  594. {$I fexpand.inc}
  595. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  596. {
  597. Searches for a file 'path' in the list of direcories in 'dirlist'.
  598. returns an empty string if not found. Wildcards are NOT allowed.
  599. If dirlist is empty, it is set to '.'
  600. }
  601. Var
  602. NewDir : PathStr;
  603. p1 : Longint;
  604. Info : Stat;
  605. buffer : array[0..FileNameLen+1] of char;
  606. Begin
  607. Move(path[1], Buffer, Length(path));
  608. Buffer[Length(path)]:=#0;
  609. if (length(Path)>0) and (path[1]='/') and (sys_stat(pchar(@Buffer),info)=0) then
  610. begin
  611. FSearch:=path;
  612. exit;
  613. end;
  614. {Replace ':' with ';'}
  615. for p1:=1to length(dirlist) do
  616. if dirlist[p1]=':' then
  617. dirlist[p1]:=';';
  618. {Check for WildCards}
  619. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  620. FSearch:='' {No wildcards allowed in these things.}
  621. Else
  622. Begin
  623. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  624. Repeat
  625. p1:=Pos(';',DirList);
  626. If p1=0 Then
  627. p1:=255;
  628. NewDir:=Copy(DirList,1,P1 - 1);
  629. if NewDir[Length(NewDir)]<>'/' then
  630. NewDir:=NewDir+'/';
  631. NewDir:=NewDir+Path;
  632. Delete(DirList,1,p1);
  633. Move(NewDir[1], Buffer, Length(NewDir));
  634. Buffer[Length(NewDir)]:=#0;
  635. if sys_stat(pchar(@Buffer),Info)=0 then
  636. Begin
  637. If Pos('./',NewDir)=1 Then
  638. Delete(NewDir,1,2);
  639. {DOS strips off an initial .\}
  640. End
  641. Else
  642. NewDir:='';
  643. Until (DirList='') or (Length(NewDir) > 0);
  644. FSearch:=NewDir;
  645. End;
  646. End;
  647. Procedure GetFAttr(var f; var attr : word);
  648. Var
  649. info : stat;
  650. LinAttr : mode_t;
  651. Begin
  652. DosError:=0;
  653. if sys_stat(@textrec(f).name,info)<>0 then
  654. begin
  655. Attr:=0;
  656. DosError:=3;
  657. exit;
  658. end
  659. else
  660. LinAttr:=Info.st_Mode;
  661. if S_ISDIR(LinAttr) then
  662. Attr:=directory
  663. else
  664. Attr:=0;
  665. if sys_Access(@textrec(f).name,W_OK)<>0 then
  666. Attr:=Attr or readonly;
  667. if (filerec(f).name[0]='.') then
  668. Attr:=Attr or hidden;
  669. end;
  670. Procedure getftime (var f; var time : longint);
  671. Var
  672. Info: stat;
  673. DT: DateTime;
  674. Begin
  675. doserror:=0;
  676. if sys_fstat(filerec(f).handle,info)<>0 then
  677. begin
  678. Time:=0;
  679. doserror:=3;
  680. exit
  681. end
  682. else
  683. UnixDateToDT(Info.st_mtime,DT);
  684. PackTime(DT,Time);
  685. End;
  686. {******************************************************************************
  687. --- Environment ---
  688. ******************************************************************************}
  689. Function EnvCount: Longint;
  690. var
  691. envcnt : longint;
  692. p : ppchar;
  693. Begin
  694. envcnt:=0;
  695. p:=envp; {defined in syslinux}
  696. while (p^<>nil) do
  697. begin
  698. inc(envcnt);
  699. inc(p);
  700. end;
  701. EnvCount := envcnt
  702. End;
  703. Function EnvStr(Index: Integer): String;
  704. Var
  705. i : longint;
  706. p : ppchar;
  707. Begin
  708. p:=envp; {defined in syslinux}
  709. i:=1;
  710. envstr:='';
  711. if (index < 1) or (index > EnvCount) then
  712. exit;
  713. while (i<Index) and (p^<>nil) do
  714. begin
  715. inc(i);
  716. inc(p);
  717. end;
  718. if p<>nil then
  719. envstr:=strpas(p^)
  720. End;
  721. Function GetEnv(EnvVar:string):string;
  722. {
  723. Searches the environment for a string with name p and
  724. returns a pchar to it's value.
  725. A pchar is used to accomodate for strings of length > 255
  726. }
  727. var
  728. ep : ppchar;
  729. found : boolean;
  730. p1 : pchar;
  731. Begin
  732. EnvVar:=EnvVar+'='; {Else HOST will also find HOSTNAME, etc}
  733. ep:=envp;
  734. found:=false;
  735. if ep<>nil then
  736. begin
  737. while (not found) and (ep^<>nil) do
  738. begin
  739. if strlcomp(@EnvVar[1],(ep^),length(EnvVar))=0 then
  740. found:=true
  741. else
  742. inc(ep);
  743. end;
  744. end;
  745. if found then
  746. p1:=ep^+length(EnvVar)
  747. else
  748. p1:=nil;
  749. if p1 = nil then
  750. GetEnv := ''
  751. else
  752. GetEnv := StrPas(p1);
  753. end;
  754. {******************************************************************************
  755. --- Do Nothing Procedures/Functions ---
  756. ******************************************************************************}
  757. Procedure Intr (intno: byte; var regs: registers);
  758. Begin
  759. {! No POSIX equivalent !}
  760. End;
  761. Procedure msdos(var regs : registers);
  762. Begin
  763. {! No POSIX equivalent !}
  764. End;
  765. Procedure getintvec(intno : byte;var vector : pointer);
  766. Begin
  767. {! No POSIX equivalent !}
  768. End;
  769. Procedure setintvec(intno : byte;vector : pointer);
  770. Begin
  771. {! No POSIX equivalent !}
  772. End;
  773. Procedure SwapVectors;
  774. Begin
  775. {! No POSIX equivalent !}
  776. End;
  777. Procedure keep(exitcode : word);
  778. Begin
  779. {! No POSIX equivalent !}
  780. End;
  781. Procedure setftime(var f; time : longint);
  782. Begin
  783. {! No POSIX equivalent !}
  784. End;
  785. Procedure setfattr (var f;attr : word);
  786. Begin
  787. {! No POSIX equivalent !}
  788. End;
  789. Procedure GetCBreak(Var BreakValue: Boolean);
  790. Begin
  791. {! No POSIX equivalent !}
  792. breakvalue:=true
  793. End;
  794. Procedure SetCBreak(BreakValue: Boolean);
  795. Begin
  796. {! No POSIX equivalent !}
  797. End;
  798. Procedure GetVerify(Var Verify: Boolean);
  799. Begin
  800. {! No POSIX equivalent !}
  801. Verify:=true;
  802. End;
  803. Procedure SetVerify(Verify: Boolean);
  804. Begin
  805. {! No POSIX equivalent !}
  806. End;
  807. { Include timezone routines }
  808. {$i timezone.inc}
  809. {******************************************************************************
  810. --- Initialization ---
  811. ******************************************************************************}
  812. Initialization
  813. InitLocalTime;
  814. finalization
  815. DoneLocalTime;
  816. end.
  817. {
  818. $Log$
  819. Revision 1.6 2004-02-09 12:03:16 michael
  820. + Switched to single interface in dosh.inc
  821. Revision 1.5 2003/12/03 20:53:22 olle
  822. * files are not pretended to have attr ARCHIVE anymore
  823. * files with attr READONLY and ARCHIVE are always returned by FindFirst etc
  824. * made code more conformant with unix/dos.pp
  825. Revision 1.4 2003/01/08 22:32:28 marco
  826. * Small fixes and quick merge with 1.0.x. At least the compiler builds now,
  827. but it could crash hard, since there are lots of unimplemented funcs.
  828. Revision 1.1.2.14 2001/12/09 03:31:35 carl
  829. * Exec() fixed (was full of bugs) : No DosError=2 report fixed, status code error fixed.
  830. + MAX_DRIVES constant added
  831. Revision 1.1.2.13 2001/12/03 03:12:28 carl
  832. * update for new posix prototype (caused problem with other OS)
  833. readdir / closedir
  834. Revision 1.1.2.12 2001/09/28 01:11:14 carl
  835. * bugfix of pchar move in FSearch() (would give wrong results)
  836. Revision 1.1.2.11 2001/08/21 10:48:46 carl
  837. + add goto on
  838. Revision 1.1.2.10 2001/08/15 01:04:38 carl
  839. * instead include posix unit
  840. * corrected bug in DateNum type (should be time_t)
  841. Revision 1.1.2.9 2001/08/13 09:37:17 carl
  842. * changed prototype of sys_readdir
  843. Revision 1.1.2.8 2001/08/12 15:12:30 carl
  844. + added timezone information
  845. * bugfix of overflow in conversion of epoch to local
  846. * bugfix of index verification in getenv
  847. Revision 1.1.2.7 2001/08/08 01:58:18 carl
  848. * bugfix of problem with FindFirst() / FindNext()
  849. Revision 1.1.2.5 2001/08/04 05:24:21 carl
  850. + implemented FindFirst / FindNext (untested)
  851. + Exec()
  852. + split
  853. + Timezone support reinstated
  854. Revision 1.1.2.4 2001/07/08 04:46:01 carl
  855. * waitpid is now portable
  856. + fnmatch()
  857. Revision 1.1.2.3 2001/07/07 15:42:29 carl
  858. * compiler error corrections
  859. Revision 1.1.2.2 2001/07/07 03:49:53 carl
  860. + more POSIX compliance stuff
  861. Revision 1.1.2.1 2001/07/06 11:21:49 carl
  862. + add files for POSIX
  863. }