dos.pp 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993,98 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. {
  15. If you want to link to the C library, define crtlib.
  16. You can set it here, but it should be set through the makefile
  17. }
  18. {.$DEFINE CRTLIB}
  19. Const
  20. {Max FileName Length for files}
  21. FileNameLen=255;
  22. {Bitmasks for CPU Flags}
  23. fcarry = $0001;
  24. fparity = $0004;
  25. fauxiliary = $0010;
  26. fzero = $0040;
  27. fsign = $0080;
  28. foverflow = $0800;
  29. {Bitmasks for file attribute}
  30. readonly = $01;
  31. hidden = $02;
  32. sysfile = $04;
  33. volumeid = $08;
  34. directory = $10;
  35. archive = $20;
  36. anyfile = $3F;
  37. {File Status}
  38. fmclosed = $D7B0;
  39. fminput = $D7B1;
  40. fmoutput = $D7B2;
  41. fminout = $D7B3;
  42. Type
  43. ComStr = String[FileNameLen];
  44. PathStr = String[FileNameLen];
  45. DirStr = String[FileNameLen];
  46. NameStr = String[FileNameLen];
  47. ExtStr = String[FileNameLen];
  48. {$PACKRECORDS 1}
  49. SearchRec = Record
  50. {Fill : array[1..21] of byte; Fill replaced with below}
  51. SearchNum : LongInt; {to track which search this is}
  52. SearchPos : LongInt; {directory position}
  53. DirPtr : LongInt; {directory pointer for reading directory}
  54. SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
  55. SearchAttr : Byte; {attribute we are searching for}
  56. Fill : Array[1..07] of Byte; {future use}
  57. {End of fill}
  58. Attr : Byte; {attribute of found file}
  59. Time : LongInt; {last modify date of found file}
  60. Size : LongInt; {file size of found file}
  61. Reserved : Word; {future use}
  62. Name : String[FileNameLen]; {name of found file}
  63. SearchSpec : String[FileNameLen]; {search pattern}
  64. NamePos : Word; {end of path, start of name position}
  65. End;
  66. {
  67. filerec.inc contains the definition of the filerec.
  68. textrec.inc contains the definition of the textrec.
  69. It is in a separate file to make it available in other units without
  70. having to use the DOS unit for it.
  71. }
  72. {$i filerec.inc}
  73. {$i textrec.inc}
  74. Registers = record
  75. case i : integer of
  76. 0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
  77. 1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
  78. 2 : (eax, ebx, ecx, edx, ebp, esi, edi : longint);
  79. End;
  80. DateTime = record
  81. Year,
  82. Month,
  83. Day,
  84. Hour,
  85. Min,
  86. Sec : word;
  87. End;
  88. Var
  89. DosError : integer;
  90. {Utils}
  91. function weekday(y,m,d : longint) : longint;
  92. Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
  93. Function DTToUnixDate(DT: DateTime): LongInt;
  94. {Info/Date/Time}
  95. Function DosVersion: Word;
  96. Procedure GetDate(var year, month, mday, wday: word);
  97. Procedure GetTime(var hour, minute, second, sec100: word);
  98. procedure SetDate(year,month,day: word);
  99. Procedure SetTime(hour,minute,second,sec100: word);
  100. Procedure UnpackTime(p: longint; var t: datetime);
  101. Procedure PackTime(var t: datetime; var p: longint);
  102. {Exec}
  103. Procedure Exec(const path: pathstr; const comline: comstr);
  104. Function DosExitCode: word;
  105. {Disk}
  106. Procedure AddDisk(const path:string);
  107. Function DiskFree(drive: byte) : longint;
  108. Function DiskSize(drive: byte) : longint;
  109. Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
  110. Procedure FindNext(var f: searchRec);
  111. Procedure FindClose(Var f: SearchRec);
  112. {File}
  113. Procedure GetFAttr(var f; var attr: word);
  114. Procedure GetFTime(var f; var time: longint);
  115. Function FSearch(path: pathstr; dirlist: string): pathstr;
  116. Function FExpand(const path: pathstr): pathstr;
  117. Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
  118. {Environment}
  119. Function EnvCount: longint;
  120. Function EnvStr(index: integer): string;
  121. Function GetEnv (envvar: string): string;
  122. {Do Nothing Functions, no Linux version}
  123. Procedure Intr(intno: byte; var regs: registers);
  124. Procedure MSDos(var regs: registers);
  125. Procedure SwapVectors;
  126. Procedure GetIntVec(intno: byte; var vector: pointer);
  127. Procedure SetIntVec(intno: byte; vector: pointer);
  128. Procedure Keep(exitcode: word);
  129. Procedure SetFAttr(var f; attr: word);
  130. Procedure SetFTime(var f; time: longint);
  131. Procedure GetCBreak(var breakvalue: boolean);
  132. Procedure SetCBreak(breakvalue: boolean);
  133. Procedure GetVerify(var verify: boolean);
  134. Procedure SetVerify(verify: boolean);
  135. Implementation
  136. Uses
  137. Strings
  138. {$ifndef crtlib}
  139. ,linux
  140. {$endif}
  141. ;
  142. {******************************************************************************
  143. --- Link C Lib if set ---
  144. ******************************************************************************}
  145. type
  146. RtlInfoType = Record
  147. FMode,
  148. FInode,
  149. FUid,
  150. FGid,
  151. FSize,
  152. FMTime : LongInt;
  153. End;
  154. {$IFDEF CRTLIB}
  155. {Links to C library}
  156. Procedure _rtl_getenv(target: pchar; st: pchar); [ C ];
  157. Procedure _rtl_envstr(i: longint; st: pchar); [ C ];
  158. Function _rtl_envcnt: longint; [ C ];
  159. Procedure _rtl_gettime(gt: longint); [ C ];
  160. Procedure _rtl_getversion(rel: pchar); [ C ];
  161. Function _rtl_exec(cmdline: pchar; var exitst: integer): integer; [ C ];
  162. Procedure _rtl_closedir(dirptr: longint); [ C ];
  163. Procedure _rtl_seekdir(dirptr: longint; seekpos: longint); [ C ];
  164. Function _rtl_telldir(dirptr: longint): longint; [ C ];
  165. Function _rtl_opendir(path: pchar): longint; [ C ];
  166. Procedure _rtl_readdir(dirptr: longint; dname: pchar); [ C ];
  167. Procedure _rtl_stat(path: pchar; infoptr: longint); [ C ];
  168. Procedure _rtl_fstat(fd: longint; infoptr: longint); [ C ];
  169. {$ENDIF CRTLIB}
  170. {******************************************************************************
  171. --- Info / Date / Time ---
  172. ******************************************************************************}
  173. Const
  174. {Date Calculation}
  175. C1970 = 2440588;
  176. D0 = 1461;
  177. D1 = 146097;
  178. D2 = 1721119;
  179. type
  180. {$PACKRECORDS 1}
  181. GTRec = Record
  182. Year,
  183. Month,
  184. MDay,
  185. WDay,
  186. Hour,
  187. Minute,
  188. Second : Word;
  189. End;
  190. Function DosVersion:Word;
  191. Var
  192. Buffer : Array[0..255] of Char;
  193. Tmp2,
  194. TmpStr : String[40];
  195. TmpPos,
  196. SubRel,
  197. Rel : LongInt;
  198. info : utsname;
  199. Begin
  200. {$IFDEF CRTLIB}
  201. _rtl_getversion(buffer);
  202. {$ELSE}
  203. UName(info);
  204. Move(info.release,buffer[0],40);
  205. {$ENDIF}
  206. TmpStr:=StrPas(Buffer);
  207. SubRel:=0;
  208. TmpPos:=Pos('.',TmpStr);
  209. if TmpPos>0 then
  210. begin
  211. Tmp2:=Copy(TmpStr,TmpPos+1,40);
  212. Delete(TmpStr,TmpPos,40);
  213. end;
  214. TmpPos:=Pos('.',Tmp2);
  215. if TmpPos>0 then
  216. Delete(Tmp2,TmpPos,40);
  217. Val(TmpStr,Rel);
  218. Val(Tmp2,SubRel);
  219. DosVersion:=Rel+(SubRel shl 8);
  220. End;
  221. function WeekDay (y,m,d:longint):longint;
  222. {
  223. Calculates th day of the week. returns -1 on error
  224. }
  225. var
  226. u,v : longint;
  227. begin
  228. if (m<1) or (m>12) or (y<1600) or (y>4000) or
  229. (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
  230. ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
  231. WeekDay:=-1
  232. else
  233. begin
  234. u:=m;
  235. v:=y;
  236. if m<3 then
  237. begin
  238. inc(u,12);
  239. dec(v);
  240. end;
  241. WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
  242. end;
  243. end;
  244. Procedure GetDate(Var Year, Month, MDay, WDay: Word);
  245. {$IFDEF CRTLIB}
  246. Var
  247. gt : GTRec;
  248. {$ENDIF}
  249. Begin
  250. {$IFDEF CRTLIB}
  251. _rtl_gettime(longint(@gt));
  252. Year:=gt.year+1900;
  253. Month:=gt.month+1;
  254. MDay:=gt.mday;
  255. WDay:=gt.wday;
  256. {$ELSE}
  257. Linux.GetDate(Year,Month,MDay);
  258. Wday:=weekday(Year,Month,MDay);
  259. {$ENDIF}
  260. end;
  261. Procedure SetDate(Year, Month, Day: Word);
  262. Begin
  263. {!!}
  264. End;
  265. Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
  266. {$IFDEF CRTLIB}
  267. Var
  268. gt : GTRec;
  269. {$ENDIF}
  270. Begin
  271. {$IFDEF CRTLIB}
  272. _rtl_gettime(longint(@gt));
  273. Hour := GT.Hour;
  274. Minute := GT.Minute;
  275. Second := GT.Second;
  276. {$ELSE}
  277. Linux.GetTime(Hour,Minute,Second);
  278. {$ENDIF}
  279. Sec100 := 0;
  280. end;
  281. Procedure SetTime(Hour, Minute, Second, Sec100: Word);
  282. Begin
  283. {!!}
  284. End;
  285. Procedure packtime(var t : datetime;var p : longint);
  286. Begin
  287. 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);
  288. End;
  289. Procedure unpacktime(p : longint;var t : datetime);
  290. Begin
  291. t.sec:=(p and 31) shl 1;
  292. t.min:=(p shr 5) and 63;
  293. t.hour:=(p shr 11) and 31;
  294. t.day:=(p shr 16) and 31;
  295. t.month:=(p shr 21) and 15;
  296. t.year:=(p shr 25)+1980;
  297. End;
  298. Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
  299. Begin
  300. EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
  301. End;
  302. Function DTToUnixDate(DT: DateTime): LongInt;
  303. Begin
  304. DTToUnixDate:=LocalToEpoch(dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
  305. End;
  306. {******************************************************************************
  307. --- Exec ---
  308. ******************************************************************************}
  309. var
  310. LastDosExitCode: word;
  311. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  312. var
  313. {$IFDEF CRTLIB}
  314. Buf : Array[0..512] of Char;
  315. i : Integer;
  316. {$ELSE}
  317. pid : longint;
  318. status : integer;
  319. {$ENDIF}
  320. Begin
  321. {$IFDEF CRTLIB}
  322. i:=Length(Path);
  323. Move(Path[1],Buf[0],i);
  324. Buf[i]:=' ';
  325. Move(ComLine[1],Buf[i+1],Length(ComLine));
  326. Buf[i+Length(ComLine)+1]:=#0;
  327. i:=0;
  328. LastDosExitCode := _rtl_exec(pchar(@buf), i);
  329. Doserror:=i;
  330. {$ELSE}
  331. pid:=Fork;
  332. if pid=0 then
  333. begin
  334. {The child does the actual exec, and then exits}
  335. Execl (Path+' '+ComLine);
  336. {If the execve fails, we return an exitvalue of 127, to let it be known}
  337. halt (127)
  338. end
  339. else
  340. if pid=-1 then {Fork failed}
  341. begin
  342. DosError:=8;
  343. exit
  344. end;
  345. {We're in the parent, let's wait.}
  346. Waitpid (pid,@status,0);
  347. if status=127 then {The child couldn't execve !!}
  348. DosError:=8 {We set this error, erroneously, since we cannot get to the real error}
  349. else
  350. begin
  351. LastDosExitCode:=status shr 8;
  352. DosError:=0
  353. end;
  354. {$ENDIF}
  355. End;
  356. Function DosExitCode: Word;
  357. Begin
  358. DosExitCode:=LastDosExitCode;
  359. End;
  360. {******************************************************************************
  361. --- Disk ---
  362. ******************************************************************************}
  363. {
  364. The Diskfree and Disksize functions need a file on the specified drive, since this
  365. is required for the statfs system call.
  366. These filenames are set in drivestr[0..26], and have been preset to :
  367. 0 - '.' (default drive - hence current dir is ok.)
  368. 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
  369. 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
  370. 3 - '/' (C: equivalent of dos is the root partition)
  371. 4..26 (can be set by you're own applications)
  372. ! Use AddDisk() to Add new drives !
  373. They both return -1 when a failure occurs.
  374. }
  375. var
  376. Drives : byte;
  377. DriveStr : array[0..26] of pchar;
  378. Procedure AddDisk(const path:string);
  379. begin
  380. if not (DriveStr[Drives]=nil) then
  381. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  382. GetMem(DriveStr[Drives],length(Path)+1);
  383. StrPCopy(DriveStr[Drives],path);
  384. inc(Drives);
  385. if Drives>26 then
  386. Drives:=4;
  387. end;
  388. Function DiskFree(Drive: Byte): Longint;
  389. {$IFNDEF CRTLIB}
  390. var
  391. fs : statfs;
  392. {$ENDIF}
  393. Begin
  394. {$IFNDEF CRTLIB}
  395. if (not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs) then
  396. Diskfree:=fs.bavail*fs.bsize
  397. else
  398. Diskfree:=-1;
  399. {$ENDIF}
  400. End;
  401. Function DiskSize(Drive: Byte): Longint;
  402. {$IFNDEF CRTLIB}
  403. var
  404. fs : statfs;
  405. {$ENDIF}
  406. Begin
  407. {$IFNDEF CRTLIB}
  408. if (not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs) then
  409. DiskSize:=fs.blocks*fs.bsize
  410. else
  411. DiskSize:=-1;
  412. {$ENDIF}
  413. End;
  414. {******************************************************************************
  415. --- Findfirst FindNext ---
  416. ******************************************************************************}
  417. Const
  418. RtlFindSize = 15;
  419. Type
  420. RtlFindRecType = Record
  421. SearchNum,
  422. DirPtr,
  423. LastUsed : LongInt;
  424. End;
  425. Var
  426. RtlFindRecs : Array[0..RtlFindSize-1] of RtlFindRecType;
  427. CurrSearchNum : LongInt;
  428. Procedure FindClose(Var f: SearchRec);
  429. {
  430. Closes dirptr if it is open
  431. }
  432. Var
  433. i : longint;
  434. Begin
  435. if f.SearchType=0 then
  436. begin
  437. i:=0;
  438. repeat
  439. if (RtlFindRecs[i].SearchNum=f.SearchNum) then
  440. break;
  441. inc(i);
  442. until (i>=RtlFindSize);
  443. If i<RtlFindSize Then
  444. Begin
  445. RtlFindRecs[i].SearchNum:=0;
  446. if f.dirptr>0 then
  447. begin
  448. {$IFDEF CRTLIB}
  449. _rtl_closeDir(f.dirptr);
  450. {$ELSE}
  451. closedir(pdir(f.dirptr));
  452. {$ENDIF}
  453. end;
  454. End;
  455. end;
  456. f.dirptr:=0;
  457. End;
  458. Function FindGetFileInfo(const s:string;var f:SearchRec):boolean;
  459. var
  460. DT : DateTime;
  461. Info : RtlInfoType;
  462. {$IFDEF CRTLIB}
  463. buf : array[0..255] of char;
  464. {$ELSE}
  465. st : stat;
  466. {$ENDIF}
  467. begin
  468. FindGetFileInfo:=false;
  469. {$IFDEF CRTLIB}
  470. move(s[1],buf,length(s));
  471. buf[length(s)]:=#0;
  472. _rtl_stat(@buf, LongInt(@Info));
  473. {$ELSE}
  474. if not Fstat(s,st) then
  475. exit;
  476. info.FSize:=st.Size;
  477. info.FMTime:=st.mtime;
  478. if (st.mode and STAT_IFMT)=STAT_IFDIR then
  479. info.fmode:=$10
  480. else
  481. info.fmode:=$20;
  482. if (st.mode and STAT_IWUSR)=0 then
  483. info.fmode:=info.fmode or 1;
  484. {$ENDIF}
  485. If ((Info.FMode and Not(f.searchattr))=0) Then
  486. Begin
  487. f.Name:=Copy(s,f.NamePos+1,255);
  488. f.Attr:=Info.FMode;
  489. f.Size:=Info.FSize;
  490. UnixDateToDT(Info.FMTime, DT);
  491. PackTime(DT,f.Time);
  492. FindGetFileInfo:=true;
  493. End;
  494. end;
  495. Function FindLastUsed: Longint;
  496. {
  497. Find unused or least recently used dirpointer slot in findrecs array
  498. }
  499. Var
  500. BestMatch,i : Longint;
  501. Found : Boolean;
  502. Begin
  503. BestMatch:=0;
  504. i:=0;
  505. Found:=False;
  506. While (i < RtlFindSize) And (Not Found) Do
  507. Begin
  508. If (RtlFindRecs[i].SearchNum = 0) Then
  509. Begin
  510. BestMatch := i;
  511. Found := True;
  512. End
  513. Else
  514. Begin
  515. If RtlFindRecs[i].LastUsed > RtlFindRecs[BestMatch].LastUsed Then
  516. BestMatch := i;
  517. End;
  518. Inc(i);
  519. End;
  520. FindLastUsed := BestMatch;
  521. End;
  522. Procedure FindNext(Var f: SearchRec);
  523. {
  524. re-opens dir if not already in array and calls FindWorkProc
  525. }
  526. Var
  527. DirName : Array[0..256] of Char;
  528. i,
  529. ArrayPos : Longint;
  530. FName,
  531. SName : string;
  532. Found,
  533. Finished : boolean;
  534. {$IFNDEF CRTLIB}
  535. p : PDirEnt;
  536. {$ENDIF}
  537. Begin
  538. If f.SearchType=0 Then
  539. Begin
  540. ArrayPos:=0;
  541. For i:=0 to RtlFindSize-1 Do
  542. Begin
  543. If RtlFindRecs[i].SearchNum = f.SearchNum Then
  544. ArrayPos:=i;
  545. Inc(RtlFindRecs[i].LastUsed);
  546. End;
  547. If ArrayPos=0 Then
  548. Begin
  549. If f.NamePos = 0 Then
  550. Begin
  551. DirName[0] := '.';
  552. DirName[1] := '/';
  553. DirName[2] := #0;
  554. End
  555. Else
  556. Begin
  557. Move(f.SearchSpec[1], DirName[0], f.NamePos);
  558. DirName[f.NamePos] := #0;
  559. End;
  560. {$IFDEF CRTLIB}
  561. f.DirPtr := _rtl_opendir(DirName);
  562. {$ELSE}
  563. f.DirPtr := longint(opendir(@(DirName)));
  564. {$ENDIF}
  565. If f.DirPtr > 0 Then
  566. begin
  567. ArrayPos:=FindLastUsed;
  568. If RtlFindRecs[ArrayPos].SearchNum > 0 Then
  569. Begin
  570. {$IFDEF CRTLIB}
  571. _rtl_closeDir(rtlfindrecs[arraypos].dirptr);
  572. {$ELSE}
  573. CloseDir(pdir(rtlfindrecs[arraypos].dirptr));
  574. {$ENDIF}
  575. End;
  576. RtlFindRecs[ArrayPos].SearchNum := f.SearchNum;
  577. RtlFindRecs[ArrayPos].DirPtr := f.DirPtr;
  578. if f.searchpos>0 then
  579. begin
  580. {$IFDEF CRTLIB}
  581. _rtl_seekdir(f.dirptr, f.searchpos);
  582. {$ELSE}
  583. seekdir(pdir(f.dirptr), f.searchpos);
  584. {$ENDIF}
  585. end;
  586. end;
  587. End;
  588. RtlFindRecs[ArrayPos].LastUsed:=0;
  589. end;
  590. {Main loop}
  591. SName:=Copy(f.SearchSpec,f.NamePos+1,255);
  592. Found:=False;
  593. Finished:=(f.dirptr=0);
  594. While Not Finished Do
  595. Begin
  596. {$IFDEF CRTLIB}
  597. _rtl_readdir(f.dirptr, @FBuf);
  598. FName:=StrPas(FBuf[0]);
  599. {$ELSE}
  600. p:=readdir(pdir(f.dirptr));
  601. if p=nil then
  602. FName:=''
  603. else
  604. FName:=Strpas(@p^.name);
  605. {$ENDIF}
  606. If FName='' Then
  607. Finished:=True
  608. Else
  609. Begin
  610. If FNMatch(SName,FName) Then
  611. Begin
  612. Found:=FindGetFileInfo(Copy(f.SearchSpec,1,f.NamePos)+FName,f);
  613. if Found then
  614. Finished:=true;
  615. End;
  616. End;
  617. End;
  618. {Shutdown}
  619. If Found Then
  620. Begin
  621. {$IFDEF CRTLIB}
  622. f.searchpos:=_rtl_telldir(f.dirptr);
  623. {$ELSE}
  624. f.searchpos:=telldir(pdir(f.dirptr));
  625. {$ENDIF}
  626. DosError:=0;
  627. End
  628. Else
  629. Begin
  630. FindClose(f);
  631. DosError:=18;
  632. End;
  633. End;
  634. Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
  635. {
  636. opens dir and calls FindWorkProc
  637. }
  638. Begin
  639. if Path='' then
  640. begin
  641. DosError:=3;
  642. exit;
  643. end;
  644. {Create Info}
  645. f.SearchSpec := Path;
  646. f.SearchAttr := Attr;
  647. f.NamePos := Length(f.SearchSpec);
  648. while (f.NamePos>0) and (f.SearchSpec[f.NamePos]<>'/') do
  649. dec(f.NamePos);
  650. {Wildcards?}
  651. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  652. begin
  653. if FindGetFileInfo(Path,f) then
  654. DosError:=0
  655. else
  656. begin
  657. if ErrNo=Sys_ENOENT then
  658. DosError:=3
  659. else
  660. DosError:=18;
  661. end;
  662. f.DirPtr:=0;
  663. f.SearchType:=1;
  664. f.searchnum:=-1;
  665. end
  666. else
  667. {Find Entry}
  668. begin
  669. Inc(CurrSearchNum);
  670. f.SearchNum:=CurrSearchNum;
  671. f.SearchType:=0;
  672. FindNext(f);
  673. end;
  674. End;
  675. {******************************************************************************
  676. --- File ---
  677. ******************************************************************************}
  678. Procedure FSplit(Path: PathStr; Var Dir: DirStr; Var Name: NameStr;Var Ext: ExtStr);
  679. Begin
  680. Linux.FSplit(Path,Dir,Name,Ext);
  681. End;
  682. Function FExpand(Const Path: PathStr): PathStr;
  683. Begin
  684. FExpand:=Linux.FExpand(Path);
  685. End;
  686. Function FSearch(path : pathstr;dirlist : string) : pathstr;
  687. Begin
  688. FSearch:=Linux.FSearch(path,dirlist);
  689. End;
  690. Procedure GetFAttr(var f; var attr : word);
  691. Var
  692. {$IFDEF CRTLIB}
  693. Info: RtlInfoType;
  694. {$ELSE}
  695. info : stat;
  696. {$ENDIF}
  697. LinAttr : longint;
  698. Begin
  699. {$IFDEF CRTLIB}
  700. _rtl_fstat(word(f), longint(@Info));
  701. attr := info.fmode;
  702. {$ELSE}
  703. if not FStat(strpas(@textrec(f).name),info) then
  704. begin
  705. Attr:=0;
  706. DosError:=3;
  707. exit;
  708. end
  709. else
  710. LinAttr:=Info.Mode;
  711. if S_ISDIR(LinAttr) then
  712. Attr:=$10
  713. else
  714. Attr:=$20;
  715. if not Access(strpas(@textrec(f).name),W_OK) then
  716. Attr:=Attr or $1;
  717. if (not S_ISDIR(LinAttr)) and (filerec(f).name[0]='.') then
  718. Attr:=Attr or $2;
  719. {$Endif}
  720. end;
  721. Procedure getftime (var f; var time : longint);
  722. Var
  723. {$IFDEF CRTLIB}
  724. Info: RtlInfoType;
  725. {$ELSE}
  726. info : stat;
  727. {$ENDIF}
  728. DT: DateTime;
  729. Begin
  730. doserror:=0;
  731. {$IFDEF CRTLIB}
  732. _rtl_fstat(word(f), longint(@Info));
  733. UnixDateToDT(Info.FMTime, DT);
  734. {$ELSE}
  735. if not fstat(filerec(f).handle,info) then
  736. begin
  737. Time:=0;
  738. doserror:=3;
  739. exit
  740. end
  741. else
  742. UnixDateToDT(Info.mTime,DT);
  743. {$ENDIF}
  744. PackTime(DT,Time);
  745. End;
  746. {******************************************************************************
  747. --- Environment ---
  748. ******************************************************************************}
  749. Function EnvCount: Longint;
  750. var
  751. envcnt : longint;
  752. p : ppchar;
  753. Begin
  754. {$IFDEF CRTLIB}
  755. EnvCount := _rtl_envcnt;
  756. {$ELSE}
  757. envcnt:=0;
  758. p:=envp; {defined in syslinux}
  759. while (p^<>nil) do
  760. begin
  761. inc(envcnt);
  762. p:=p+4
  763. end;
  764. EnvCount := envcnt
  765. {$ENDIF}
  766. End;
  767. Function EnvStr(Index: Integer): String;
  768. Var
  769. {$IFDEF CRTLIB}
  770. Buffer: Array[0..255] of Char;
  771. {$ELSE}
  772. i : longint;
  773. p : ppchar;
  774. {$ENDIF}
  775. Begin
  776. {$IFDEF CRTLIB}
  777. Buffer[0]:=#0; {Be sure there is at least nothing}
  778. _rtl_envstr(index, buffer);
  779. EnvStr:=StrPas(Buffer);
  780. {$ELSE}
  781. p:=envp; {defined in syslinux}
  782. i:=1;
  783. while (i<Index) and (p^<>nil) do
  784. begin
  785. inc(i);
  786. p:=p+4;
  787. end;
  788. if p=nil then
  789. envstr:=''
  790. else
  791. envstr:=strpas(p^)
  792. {$ENDIF}
  793. End;
  794. Function GetEnv(EnvVar: String): String;
  795. var
  796. {$IFDEF CRTLIB}
  797. Buffer,
  798. OutStr : Array[0..255] of Char;
  799. {$ELSE}
  800. p : pchar;
  801. {$ENDIF}
  802. Begin
  803. {$IFDEF CRTLIB}
  804. Move(EnvVar[1],Buffer,Length(EnvVar));
  805. Buffer[Length(EnvVar)]:=#0;
  806. OutStr[0]:=#0;
  807. _rtl_getenv(buffer,outstr);
  808. GetEnv:=StrPas(Buffer);
  809. {$ELSE}
  810. p:=Linux.GetEnv(EnvVar);
  811. if p=nil then
  812. GetEnv:=''
  813. else
  814. GetEnv:=StrPas(p);
  815. {$ENDIF}
  816. End;
  817. {******************************************************************************
  818. --- Do Nothing Procedures/Functions ---
  819. ******************************************************************************}
  820. Procedure Intr (intno: byte; var regs: registers);
  821. Begin
  822. {! No Linux equivalent !}
  823. End;
  824. Procedure msdos(var regs : registers);
  825. Begin
  826. {! No Linux equivalent !}
  827. End;
  828. Procedure getintvec(intno : byte;var vector : pointer);
  829. Begin
  830. {! No Linux equivalent !}
  831. End;
  832. Procedure setintvec(intno : byte;vector : pointer);
  833. Begin
  834. {! No Linux equivalent !}
  835. End;
  836. Procedure SwapVectors;
  837. Begin
  838. {! No Linux equivalent !}
  839. End;
  840. Procedure keep(exitcode : word);
  841. Begin
  842. {! No Linux equivalent !}
  843. End;
  844. Procedure setftime(var f; time : longint);
  845. Begin
  846. {! No Linux equivalent !}
  847. End;
  848. Procedure setfattr (var f;attr : word);
  849. Begin
  850. {! No Linux equivalent !}
  851. End;
  852. Procedure GetCBreak(Var BreakValue: Boolean);
  853. Begin
  854. {! No Linux equivalent !}
  855. breakvalue:=true
  856. End;
  857. Procedure SetCBreak(BreakValue: Boolean);
  858. Begin
  859. {! No Linux equivalent !}
  860. End;
  861. Procedure GetVerify(Var Verify: Boolean);
  862. Begin
  863. {! No Linux equivalent !}
  864. Verify:=true;
  865. End;
  866. Procedure SetVerify(Verify: Boolean);
  867. Begin
  868. {! No Linux equivalent !}
  869. End;
  870. {******************************************************************************
  871. --- Initialization ---
  872. ******************************************************************************}
  873. Begin
  874. {$IFNDEF CRTLIB}
  875. {drivestr needs initialisation}
  876. AddDisk('.');
  877. AddDisk('/fd0/.');
  878. AddDisk('/fd1/.');
  879. AddDisk('/.');
  880. {$ENDIF}
  881. End.
  882. {
  883. $Log$
  884. Revision 1.1 1998-03-25 11:18:43 root
  885. Initial revision
  886. Revision 1.11 1998/03/10 14:46:09 michael
  887. + better checking in weekday function
  888. Revision 1.10 1998/01/27 17:47:42 peter
  889. * Speeeeedup of Findfirst with no wildcards
  890. Revision 1.9 1998/01/26 12:01:28 michael
  891. + Added log at the end
  892. Working file: rtl/linux/dos.pp
  893. description:
  894. ----------------------------
  895. revision 1.8
  896. date: 1998/01/19 16:21:33; author: peter; state: Exp; lines: +58 -117
  897. + Weekday from mailinglist which is a lot smaller and faster
  898. * FExpand now uses the FExpand from linux.pp
  899. ----------------------------
  900. revision 1.7
  901. date: 1998/01/19 10:03:00; author: michael; state: Exp; lines: +6 -1
  902. * BugFix for findfirst/findnext routines. (From Peter Vreman)
  903. ----------------------------
  904. revision 1.6
  905. date: 1998/01/13 17:14:37; author: michael; state: Exp; lines: +3 -3
  906. + Entered new FStat call using File or Text var.
  907. + GetTme call in DOS now refers to Linux.gettime !
  908. ----------------------------
  909. revision 1.5
  910. date: 1998/01/09 13:12:38; author: michael; state: Exp; lines: +20 -20
  911. * Fixed some bugs that showed when writing examples (From Peter Vreman)
  912. ----------------------------
  913. revision 1.4
  914. date: 1997/12/10 12:22:26; author: michael; state: Exp; lines: +2 -2
  915. + changed longint(f) to word(f) in getfattr;
  916. ----------------------------
  917. revision 1.3
  918. date: 1997/12/04 13:43:50; author: michael; state: Exp; lines: +23 -15
  919. * changed attribute and time functions.
  920. ----------------------------
  921. revision 1.2
  922. date: 1997/12/01 12:31:14; author: michael; state: Exp; lines: +14 -21
  923. + Added copyright reference in header.
  924. ----------------------------
  925. revision 1.1
  926. date: 1997/11/27 08:33:54; author: michael; state: Exp;
  927. Initial revision
  928. ----------------------------
  929. revision 1.1.1.1
  930. date: 1997/11/27 08:33:54; author: michael; state: Exp; lines: +0 -0
  931. FPC RTL CVS start
  932. =============================================================================
  933. Date Version Who Comments
  934. 1996 0.8 Michael Initial implementation
  935. 11/97 0.9 Peter Vreman <[email protected]>
  936. Unit now depends on the
  937. linux unit only.
  938. Cleaned up code.
  939. }