dos.pp 23 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042
  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. {$ifdef HASTHREADVAR}
  227. threadvar
  228. {$else HASTHREADVAR}
  229. var
  230. {$endif HASTHREADVAR}
  231. LastDosExitCode: word;
  232. 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}
  233. var r,s : cint;
  234. begin
  235. repeat
  236. s:=$7F00;
  237. r:=sys_WaitPid(Pid,s,0);
  238. until (r<>-1) or (Errno<>Sys_EINTR);
  239. { When r = -1 or r = 0, no status is available, so there was an error. }
  240. if (r=-1) or (r=0) then
  241. InternalWaitProcess:=-1 { return -1 to indicate an error }
  242. else
  243. begin
  244. { process terminated normally }
  245. if wifexited(s)<>0 then
  246. begin
  247. { get status code }
  248. InternalWaitProcess := wexitstatus(s);
  249. exit;
  250. end;
  251. { process terminated due to a signal }
  252. if wifsignaled(s)<>0 then
  253. begin
  254. { get signal number }
  255. InternalWaitProcess := wstopsig(s);
  256. exit;
  257. end;
  258. InternalWaitProcess:=-1;
  259. end;
  260. end;
  261. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  262. var
  263. pid : pid_t;
  264. tmp : string;
  265. p : ppchar;
  266. count: longint;
  267. // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
  268. F: File;
  269. Begin
  270. {$IFOPT I+}
  271. {$DEFINE IOCHECK}
  272. {$ENDIF}
  273. {$I-}
  274. { verify if the file to execute exists }
  275. Assign(F,Path);
  276. Reset(F,1);
  277. if IOResult <> 0 then
  278. { file not found }
  279. begin
  280. DosError := 2;
  281. exit;
  282. end
  283. else
  284. Close(F);
  285. {$IFDEF IOCHECK}
  286. {$I+}
  287. {$UNDEF IOCHECK}
  288. {$ENDIF}
  289. LastDosExitCode:=0;
  290. { Fork the process }
  291. pid:=sys_Fork;
  292. if pid=0 then
  293. begin
  294. {The child does the actual execution, and then exits}
  295. tmp := Path+' '+ComLine;
  296. p:=StringToPPChar(tmp,count);
  297. if (p<>nil) and (p^<>nil) then
  298. begin
  299. sys_Execve(p^,p,Envp);
  300. end;
  301. {If the execve fails, we return an exitvalue of 127, to let it be known}
  302. sys_exit(127);
  303. end
  304. else
  305. if pid=-1 then {Fork failed - parent only}
  306. begin
  307. DosError:=8;
  308. exit
  309. end;
  310. {We're in the parent, let's wait.}
  311. LastDosExitCode:=InternalWaitProcess(pid); // WaitPid and result-convert
  312. if (LastDosExitCode>=0) and (LastDosExitCode<>127) then DosError:=0 else
  313. DosError:=8; // perhaps one time give an better error
  314. End;
  315. Function DosExitCode: Word;
  316. Begin
  317. DosExitCode:=LastDosExitCode;
  318. End;
  319. {$ENDIF}
  320. {******************************************************************************
  321. --- Disk ---
  322. ******************************************************************************}
  323. Procedure AddDisk(const path:string);
  324. begin
  325. if not (DriveStr[Drives]=nil) then
  326. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  327. GetMem(DriveStr[Drives],length(Path)+1);
  328. StrPCopy(DriveStr[Drives],path);
  329. inc(Drives);
  330. if Drives>26 then
  331. Drives:=4;
  332. end;
  333. {******************************************************************************
  334. --- Findfirst FindNext ---
  335. ******************************************************************************}
  336. Function FNMatch(const Pattern,Name:string):Boolean;
  337. Var
  338. LenPat,LenName : longint;
  339. Function DoFNMatch(i,j:longint):Boolean;
  340. Var
  341. Found : boolean;
  342. Begin
  343. Found:=true;
  344. While Found and (i<=LenPat) Do
  345. Begin
  346. Case Pattern[i] of
  347. '?' : Found:=(j<=LenName);
  348. '*' : Begin
  349. {find the next character in pattern, different of ? and *}
  350. while Found and (i<LenPat) do
  351. begin
  352. inc(i);
  353. case Pattern[i] of
  354. '*' : ;
  355. '?' : begin
  356. inc(j);
  357. Found:=(j<=LenName);
  358. end;
  359. else
  360. Found:=false;
  361. end;
  362. end;
  363. {Now, find in name the character which i points to, if the * or ?
  364. wasn't the last character in the pattern, else, use up all the
  365. chars in name}
  366. Found:=true;
  367. if (i<=LenPat) then
  368. begin
  369. repeat
  370. {find a letter (not only first !) which maches pattern[i]}
  371. while (j<=LenName) and (name[j]<>pattern[i]) do
  372. inc (j);
  373. if (j<LenName) then
  374. begin
  375. if DoFnMatch(i+1,j+1) then
  376. begin
  377. i:=LenPat;
  378. j:=LenName;{we can stop}
  379. Found:=true;
  380. end
  381. else
  382. inc(j);{We didn't find one, need to look further}
  383. end;
  384. until (j>=LenName);
  385. end
  386. else
  387. j:=LenName;{we can stop}
  388. end;
  389. else {not a wildcard character in pattern}
  390. Found:=(j<=LenName) and (pattern[i]=name[j]);
  391. end;
  392. inc(i);
  393. inc(j);
  394. end;
  395. DoFnMatch:=Found and (j>LenName);
  396. end;
  397. Begin {start FNMatch}
  398. LenPat:=Length(Pattern);
  399. LenName:=Length(Name);
  400. FNMatch:=DoFNMatch(1,1);
  401. End;
  402. Procedure FindClose(Var f: SearchRec);
  403. {
  404. Closes dirptr if it is open
  405. }
  406. Begin
  407. { could already have been closed }
  408. if assigned(f.dirptr) then
  409. sys_closedir(pdir(f.dirptr));
  410. f.dirptr := nil;
  411. End;
  412. { Returns a filled in searchRec structure }
  413. { and TRUE if the specified file in s is }
  414. { found. }
  415. Function FindGetFileInfo(s:string;var f:SearchRec):boolean;
  416. var
  417. DT : DateTime;
  418. st : stat;
  419. Fmode : byte;
  420. res: string; { overlaid variable }
  421. Dir : DirsTr;
  422. Name : NameStr;
  423. Ext: ExtStr;
  424. begin
  425. FindGetFileInfo:=false;
  426. res := s + #0;
  427. if sys_stat(@res[1],st)<>0 then
  428. exit;
  429. if S_ISDIR(st.st_mode) then
  430. fmode:=directory
  431. else
  432. fmode:=0;
  433. if (st.st_mode and S_IWUSR)=0 then
  434. fmode:=fmode or readonly;
  435. FSplit(s,Dir,Name,Ext);
  436. if Name[1]='.' then
  437. fmode:=fmode or hidden;
  438. If ((FMode and Not(f.searchattr))=0) Then
  439. Begin
  440. if Ext <> '' then
  441. res := Name + Ext
  442. else
  443. res := Name;
  444. f.Name:=res;
  445. f.Attr:=FMode;
  446. f.Size:=longint(st.st_size);
  447. UnixDateToDT(st.st_mtime, DT);
  448. PackTime(DT,f.Time);
  449. FindGetFileInfo:=true;
  450. End;
  451. end;
  452. Procedure FindNext(Var f: SearchRec);
  453. {
  454. re-opens dir if not already in array and calls FindWorkProc
  455. }
  456. Var
  457. FName,
  458. SName : string;
  459. Found,
  460. Finished : boolean;
  461. p : PDirEnt;
  462. Begin
  463. {Main loop}
  464. SName:=f.SearchSpec;
  465. Found:=False;
  466. Finished:=(f.dirptr=nil);
  467. While Not Finished Do
  468. Begin
  469. p:=sys_readdir(pdir(f.dirptr));
  470. if p=nil then
  471. begin
  472. FName:=''
  473. end
  474. else
  475. FName:=Strpas(@p^.d_name);
  476. If FName='' Then
  477. Finished:=True
  478. Else
  479. Begin
  480. If FNMatch(SName,FName) Then
  481. Begin
  482. Found:=FindGetFileInfo(f.SearchDir+FName,f);
  483. if Found then
  484. begin
  485. Finished:=true;
  486. end;
  487. End;
  488. End;
  489. End;
  490. {Shutdown}
  491. If Found Then
  492. Begin
  493. DosError:=0;
  494. End
  495. Else
  496. Begin
  497. FindClose(f);
  498. { FindClose() might be called thereafter also... }
  499. f.dirptr := nil;
  500. DosError:=18;
  501. End;
  502. End;
  503. Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
  504. {
  505. opens dir
  506. }
  507. var
  508. res: string;
  509. Dir : DirsTr;
  510. Name : NameStr;
  511. Ext: ExtStr;
  512. Begin
  513. { initialize f.dirptr because it is used }
  514. { to see if we need to close the dir stream }
  515. f.dirptr := nil;
  516. if Path='' then
  517. begin
  518. DosError:=3;
  519. exit;
  520. end;
  521. {We always also search for readonly and archive, regardless of Attr:}
  522. f.SearchAttr := Attr or archive or readonly;
  523. {Wildcards?}
  524. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  525. begin
  526. if FindGetFileInfo(Path,f) then
  527. DosError:=0
  528. else
  529. begin
  530. if ErrNo=Sys_ENOENT then
  531. DosError:=3
  532. else
  533. DosError:=18;
  534. end;
  535. f.DirPtr:=nil;
  536. end
  537. else
  538. {Find Entry}
  539. begin
  540. FSplit(Path,Dir,Name,Ext);
  541. if Ext <> '' then
  542. res := Name + Ext
  543. else
  544. res := Name;
  545. f.SearchSpec := res;
  546. { if dir is an empty string }
  547. { then this indicates that }
  548. { use the current working }
  549. { directory. }
  550. if dir = '' then
  551. dir := './';
  552. f.SearchDir := Dir;
  553. { add terminating null character }
  554. Dir := Dir + #0;
  555. f.dirptr := sys_opendir(@Dir[1]);
  556. if not assigned(f.dirptr) then
  557. begin
  558. DosError := 8;
  559. exit;
  560. end;
  561. FindNext(f);
  562. end;
  563. End;
  564. {******************************************************************************
  565. --- File ---
  566. ******************************************************************************}
  567. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  568. Var
  569. DotPos,SlashPos,i : longint;
  570. Begin
  571. SlashPos:=0;
  572. DotPos:=256;
  573. i:=Length(Path);
  574. While (i>0) and (SlashPos=0) Do
  575. Begin
  576. If (DotPos=256) and (Path[i]='.') Then
  577. begin
  578. DotPos:=i;
  579. end;
  580. If (Path[i]='/') Then
  581. SlashPos:=i;
  582. Dec(i);
  583. End;
  584. Ext:=Copy(Path,DotPos,255);
  585. Dir:=Copy(Path,1,SlashPos);
  586. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  587. End;
  588. {
  589. function FExpand (const Path: PathStr): PathStr;
  590. - declared in fexpand.inc
  591. }
  592. (*
  593. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  594. *)
  595. const
  596. LFNSupport = true;
  597. FileNameCaseSensitive = true;
  598. {$I fexpand.inc}
  599. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  600. {
  601. Searches for a file 'path' in the list of direcories in 'dirlist'.
  602. returns an empty string if not found. Wildcards are NOT allowed.
  603. If dirlist is empty, it is set to '.'
  604. }
  605. Var
  606. NewDir : PathStr;
  607. p1 : Longint;
  608. Info : Stat;
  609. buffer : array[0..FileNameLen+1] of char;
  610. Begin
  611. Move(path[1], Buffer, Length(path));
  612. Buffer[Length(path)]:=#0;
  613. if (length(Path)>0) and (path[1]='/') and (sys_stat(pchar(@Buffer),info)=0) then
  614. begin
  615. FSearch:=path;
  616. exit;
  617. end;
  618. {Replace ':' with ';'}
  619. for p1:=1to length(dirlist) do
  620. if dirlist[p1]=':' then
  621. dirlist[p1]:=';';
  622. {Check for WildCards}
  623. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  624. FSearch:='' {No wildcards allowed in these things.}
  625. Else
  626. Begin
  627. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  628. Repeat
  629. p1:=Pos(';',DirList);
  630. If p1=0 Then
  631. p1:=255;
  632. NewDir:=Copy(DirList,1,P1 - 1);
  633. if NewDir[Length(NewDir)]<>'/' then
  634. NewDir:=NewDir+'/';
  635. NewDir:=NewDir+Path;
  636. Delete(DirList,1,p1);
  637. Move(NewDir[1], Buffer, Length(NewDir));
  638. Buffer[Length(NewDir)]:=#0;
  639. if sys_stat(pchar(@Buffer),Info)=0 then
  640. Begin
  641. If Pos('./',NewDir)=1 Then
  642. Delete(NewDir,1,2);
  643. {DOS strips off an initial .\}
  644. End
  645. Else
  646. NewDir:='';
  647. Until (DirList='') or (Length(NewDir) > 0);
  648. FSearch:=NewDir;
  649. End;
  650. End;
  651. Procedure GetFAttr(var f; var attr : word);
  652. Var
  653. info : stat;
  654. LinAttr : mode_t;
  655. Begin
  656. DosError:=0;
  657. if sys_stat(@textrec(f).name,info)<>0 then
  658. begin
  659. Attr:=0;
  660. DosError:=3;
  661. exit;
  662. end
  663. else
  664. LinAttr:=Info.st_Mode;
  665. if S_ISDIR(LinAttr) then
  666. Attr:=directory
  667. else
  668. Attr:=0;
  669. if sys_Access(@textrec(f).name,W_OK)<>0 then
  670. Attr:=Attr or readonly;
  671. if (filerec(f).name[0]='.') then
  672. Attr:=Attr or hidden;
  673. end;
  674. Procedure getftime (var f; var time : longint);
  675. Var
  676. Info: stat;
  677. DT: DateTime;
  678. Begin
  679. doserror:=0;
  680. if sys_fstat(filerec(f).handle,info)<>0 then
  681. begin
  682. Time:=0;
  683. doserror:=3;
  684. exit
  685. end
  686. else
  687. UnixDateToDT(Info.st_mtime,DT);
  688. PackTime(DT,Time);
  689. End;
  690. {******************************************************************************
  691. --- Environment ---
  692. ******************************************************************************}
  693. Function EnvCount: Longint;
  694. var
  695. envcnt : longint;
  696. p : ppchar;
  697. Begin
  698. envcnt:=0;
  699. p:=envp; {defined in syslinux}
  700. while (p^<>nil) do
  701. begin
  702. inc(envcnt);
  703. inc(p);
  704. end;
  705. EnvCount := envcnt
  706. End;
  707. Function EnvStr (Index: longint): String;
  708. Var
  709. i : longint;
  710. p : ppchar;
  711. Begin
  712. p:=envp; {defined in syslinux}
  713. i:=1;
  714. envstr:='';
  715. if (index < 1) or (index > EnvCount) then
  716. exit;
  717. while (i<Index) and (p^<>nil) do
  718. begin
  719. inc(i);
  720. inc(p);
  721. end;
  722. if p<>nil then
  723. envstr:=strpas(p^)
  724. End;
  725. Function GetEnv(EnvVar:string):string;
  726. {
  727. Searches the environment for a string with name p and
  728. returns a pchar to it's value.
  729. A pchar is used to accomodate for strings of length > 255
  730. }
  731. var
  732. ep : ppchar;
  733. found : boolean;
  734. p1 : pchar;
  735. Begin
  736. EnvVar:=EnvVar+'='; {Else HOST will also find HOSTNAME, etc}
  737. ep:=envp;
  738. found:=false;
  739. if ep<>nil then
  740. begin
  741. while (not found) and (ep^<>nil) do
  742. begin
  743. if strlcomp(@EnvVar[1],(ep^),length(EnvVar))=0 then
  744. found:=true
  745. else
  746. inc(ep);
  747. end;
  748. end;
  749. if found then
  750. p1:=ep^+length(EnvVar)
  751. else
  752. p1:=nil;
  753. if p1 = nil then
  754. GetEnv := ''
  755. else
  756. GetEnv := StrPas(p1);
  757. end;
  758. {******************************************************************************
  759. --- Do Nothing Procedures/Functions ---
  760. ******************************************************************************}
  761. Procedure Intr (intno: byte; var regs: registers);
  762. Begin
  763. {! No POSIX equivalent !}
  764. End;
  765. Procedure msdos(var regs : registers);
  766. Begin
  767. {! No POSIX equivalent !}
  768. End;
  769. Procedure getintvec(intno : byte;var vector : pointer);
  770. Begin
  771. {! No POSIX equivalent !}
  772. End;
  773. Procedure setintvec(intno : byte;vector : pointer);
  774. Begin
  775. {! No POSIX equivalent !}
  776. End;
  777. Procedure SwapVectors;
  778. Begin
  779. {! No POSIX equivalent !}
  780. End;
  781. Procedure keep(exitcode : word);
  782. Begin
  783. {! No POSIX equivalent !}
  784. End;
  785. Procedure setftime(var f; time : longint);
  786. Begin
  787. {! No POSIX equivalent !}
  788. End;
  789. Procedure setfattr (var f;attr : word);
  790. Begin
  791. {! No POSIX equivalent !}
  792. End;
  793. Procedure GetCBreak(Var BreakValue: Boolean);
  794. Begin
  795. {! No POSIX equivalent !}
  796. breakvalue:=true
  797. End;
  798. Procedure SetCBreak(BreakValue: Boolean);
  799. Begin
  800. {! No POSIX equivalent !}
  801. End;
  802. Procedure GetVerify(Var Verify: Boolean);
  803. Begin
  804. {! No POSIX equivalent !}
  805. Verify:=true;
  806. End;
  807. Procedure SetVerify(Verify: Boolean);
  808. Begin
  809. {! No POSIX equivalent !}
  810. End;
  811. { Include timezone routines }
  812. {$i timezone.inc}
  813. {******************************************************************************
  814. --- Initialization ---
  815. ******************************************************************************}
  816. Initialization
  817. InitLocalTime;
  818. finalization
  819. DoneLocalTime;
  820. end.
  821. {
  822. $Log$
  823. Revision 1.9 2004-02-17 17:37:26 daniel
  824. * Enable threadvars again
  825. Revision 1.8 2004/02/16 22:16:57 hajny
  826. * LastDosExitCode changed back from threadvar temporarily
  827. Revision 1.7 2004/02/15 21:26:37 hajny
  828. * overloaded ExecuteProcess added, EnvStr param changed to longint
  829. Revision 1.6 2004/02/09 12:03:16 michael
  830. + Switched to single interface in dosh.inc
  831. Revision 1.5 2003/12/03 20:53:22 olle
  832. * files are not pretended to have attr ARCHIVE anymore
  833. * files with attr READONLY and ARCHIVE are always returned by FindFirst etc
  834. * made code more conformant with unix/dos.pp
  835. Revision 1.4 2003/01/08 22:32:28 marco
  836. * Small fixes and quick merge with 1.0.x. At least the compiler builds now,
  837. but it could crash hard, since there are lots of unimplemented funcs.
  838. Revision 1.1.2.14 2001/12/09 03:31:35 carl
  839. * Exec() fixed (was full of bugs) : No DosError=2 report fixed, status code error fixed.
  840. + MAX_DRIVES constant added
  841. Revision 1.1.2.13 2001/12/03 03:12:28 carl
  842. * update for new posix prototype (caused problem with other OS)
  843. readdir / closedir
  844. Revision 1.1.2.12 2001/09/28 01:11:14 carl
  845. * bugfix of pchar move in FSearch() (would give wrong results)
  846. Revision 1.1.2.11 2001/08/21 10:48:46 carl
  847. + add goto on
  848. Revision 1.1.2.10 2001/08/15 01:04:38 carl
  849. * instead include posix unit
  850. * corrected bug in DateNum type (should be time_t)
  851. Revision 1.1.2.9 2001/08/13 09:37:17 carl
  852. * changed prototype of sys_readdir
  853. Revision 1.1.2.8 2001/08/12 15:12:30 carl
  854. + added timezone information
  855. * bugfix of overflow in conversion of epoch to local
  856. * bugfix of index verification in getenv
  857. Revision 1.1.2.7 2001/08/08 01:58:18 carl
  858. * bugfix of problem with FindFirst() / FindNext()
  859. Revision 1.1.2.5 2001/08/04 05:24:21 carl
  860. + implemented FindFirst / FindNext (untested)
  861. + Exec()
  862. + split
  863. + Timezone support reinstated
  864. Revision 1.1.2.4 2001/07/08 04:46:01 carl
  865. * waitpid is now portable
  866. + fnmatch()
  867. Revision 1.1.2.3 2001/07/07 15:42:29 carl
  868. * compiler error corrections
  869. Revision 1.1.2.2 2001/07/07 03:49:53 carl
  870. + more POSIX compliance stuff
  871. Revision 1.1.2.1 2001/07/06 11:21:49 carl
  872. + add files for POSIX
  873. }