dos.pp 22 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051
  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.SearchPos:=0;
  648. f.NamePos := Length(f.SearchSpec);
  649. while (f.NamePos>0) and (f.SearchSpec[f.NamePos]<>'/') do
  650. dec(f.NamePos);
  651. {Wildcards?}
  652. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  653. begin
  654. if FindGetFileInfo(Path,f) then
  655. DosError:=0
  656. else
  657. begin
  658. if ErrNo=Sys_ENOENT then
  659. DosError:=3
  660. else
  661. DosError:=18;
  662. end;
  663. f.DirPtr:=0;
  664. f.SearchType:=1;
  665. f.searchnum:=-1;
  666. end
  667. else
  668. {Find Entry}
  669. begin
  670. Inc(CurrSearchNum);
  671. f.SearchNum:=CurrSearchNum;
  672. f.SearchType:=0;
  673. FindNext(f);
  674. end;
  675. End;
  676. {******************************************************************************
  677. --- File ---
  678. ******************************************************************************}
  679. Procedure FSplit(Path: PathStr; Var Dir: DirStr; Var Name: NameStr;Var Ext: ExtStr);
  680. Begin
  681. Linux.FSplit(Path,Dir,Name,Ext);
  682. End;
  683. Function FExpand(Const Path: PathStr): PathStr;
  684. Begin
  685. FExpand:=Linux.FExpand(Path);
  686. End;
  687. Function FSearch(path : pathstr;dirlist : string) : pathstr;
  688. Begin
  689. FSearch:=Linux.FSearch(path,dirlist);
  690. End;
  691. Procedure GetFAttr(var f; var attr : word);
  692. Var
  693. {$IFDEF CRTLIB}
  694. Info: RtlInfoType;
  695. {$ELSE}
  696. info : stat;
  697. {$ENDIF}
  698. LinAttr : longint;
  699. Begin
  700. {$IFDEF CRTLIB}
  701. _rtl_fstat(word(f), longint(@Info));
  702. attr := info.fmode;
  703. {$ELSE}
  704. if not FStat(strpas(@textrec(f).name),info) then
  705. begin
  706. Attr:=0;
  707. DosError:=3;
  708. exit;
  709. end
  710. else
  711. LinAttr:=Info.Mode;
  712. if S_ISDIR(LinAttr) then
  713. Attr:=$10
  714. else
  715. Attr:=$20;
  716. if not Access(strpas(@textrec(f).name),W_OK) then
  717. Attr:=Attr or $1;
  718. if (not S_ISDIR(LinAttr)) and (filerec(f).name[0]='.') then
  719. Attr:=Attr or $2;
  720. {$Endif}
  721. end;
  722. Procedure getftime (var f; var time : longint);
  723. Var
  724. {$IFDEF CRTLIB}
  725. Info: RtlInfoType;
  726. {$ELSE}
  727. info : stat;
  728. {$ENDIF}
  729. DT: DateTime;
  730. Begin
  731. doserror:=0;
  732. {$IFDEF CRTLIB}
  733. _rtl_fstat(word(f), longint(@Info));
  734. UnixDateToDT(Info.FMTime, DT);
  735. {$ELSE}
  736. if not fstat(filerec(f).handle,info) then
  737. begin
  738. Time:=0;
  739. doserror:=3;
  740. exit
  741. end
  742. else
  743. UnixDateToDT(Info.mTime,DT);
  744. {$ENDIF}
  745. PackTime(DT,Time);
  746. End;
  747. {******************************************************************************
  748. --- Environment ---
  749. ******************************************************************************}
  750. Function EnvCount: Longint;
  751. var
  752. envcnt : longint;
  753. p : ppchar;
  754. Begin
  755. {$IFDEF CRTLIB}
  756. EnvCount := _rtl_envcnt;
  757. {$ELSE}
  758. envcnt:=0;
  759. p:=envp; {defined in syslinux}
  760. while (p^<>nil) do
  761. begin
  762. inc(envcnt);
  763. p:=p+4
  764. end;
  765. EnvCount := envcnt
  766. {$ENDIF}
  767. End;
  768. Function EnvStr(Index: Integer): String;
  769. Var
  770. {$IFDEF CRTLIB}
  771. Buffer: Array[0..255] of Char;
  772. {$ELSE}
  773. i : longint;
  774. p : ppchar;
  775. {$ENDIF}
  776. Begin
  777. {$IFDEF CRTLIB}
  778. Buffer[0]:=#0; {Be sure there is at least nothing}
  779. _rtl_envstr(index, buffer);
  780. EnvStr:=StrPas(Buffer);
  781. {$ELSE}
  782. p:=envp; {defined in syslinux}
  783. i:=1;
  784. while (i<Index) and (p^<>nil) do
  785. begin
  786. inc(i);
  787. p:=p+4;
  788. end;
  789. if p=nil then
  790. envstr:=''
  791. else
  792. envstr:=strpas(p^)
  793. {$ENDIF}
  794. End;
  795. Function GetEnv(EnvVar: String): String;
  796. var
  797. {$IFDEF CRTLIB}
  798. Buffer,
  799. OutStr : Array[0..255] of Char;
  800. {$ELSE}
  801. p : pchar;
  802. {$ENDIF}
  803. Begin
  804. {$IFDEF CRTLIB}
  805. Move(EnvVar[1],Buffer,Length(EnvVar));
  806. Buffer[Length(EnvVar)]:=#0;
  807. OutStr[0]:=#0;
  808. _rtl_getenv(buffer,outstr);
  809. GetEnv:=StrPas(Buffer);
  810. {$ELSE}
  811. p:=Linux.GetEnv(EnvVar);
  812. if p=nil then
  813. GetEnv:=''
  814. else
  815. GetEnv:=StrPas(p);
  816. {$ENDIF}
  817. End;
  818. {******************************************************************************
  819. --- Do Nothing Procedures/Functions ---
  820. ******************************************************************************}
  821. Procedure Intr (intno: byte; var regs: registers);
  822. Begin
  823. {! No Linux equivalent !}
  824. End;
  825. Procedure msdos(var regs : registers);
  826. Begin
  827. {! No Linux equivalent !}
  828. End;
  829. Procedure getintvec(intno : byte;var vector : pointer);
  830. Begin
  831. {! No Linux equivalent !}
  832. End;
  833. Procedure setintvec(intno : byte;vector : pointer);
  834. Begin
  835. {! No Linux equivalent !}
  836. End;
  837. Procedure SwapVectors;
  838. Begin
  839. {! No Linux equivalent !}
  840. End;
  841. Procedure keep(exitcode : word);
  842. Begin
  843. {! No Linux equivalent !}
  844. End;
  845. Procedure setftime(var f; time : longint);
  846. Begin
  847. {! No Linux equivalent !}
  848. End;
  849. Procedure setfattr (var f;attr : word);
  850. Begin
  851. {! No Linux equivalent !}
  852. End;
  853. Procedure GetCBreak(Var BreakValue: Boolean);
  854. Begin
  855. {! No Linux equivalent !}
  856. breakvalue:=true
  857. End;
  858. Procedure SetCBreak(BreakValue: Boolean);
  859. Begin
  860. {! No Linux equivalent !}
  861. End;
  862. Procedure GetVerify(Var Verify: Boolean);
  863. Begin
  864. {! No Linux equivalent !}
  865. Verify:=true;
  866. End;
  867. Procedure SetVerify(Verify: Boolean);
  868. Begin
  869. {! No Linux equivalent !}
  870. End;
  871. {******************************************************************************
  872. --- Initialization ---
  873. ******************************************************************************}
  874. Begin
  875. {$IFNDEF CRTLIB}
  876. {drivestr needs initialisation}
  877. AddDisk('.');
  878. AddDisk('/fd0/.');
  879. AddDisk('/fd1/.');
  880. AddDisk('/.');
  881. {$ENDIF}
  882. End.
  883. {
  884. $Log$
  885. Revision 1.3 1998-05-06 12:35:26 michael
  886. + Removed log from before restored version.
  887. Revision 1.2 1998/05/04 17:40:43 peter
  888. * findfirst did some strange init with searchpos
  889. Revision 1.1.1.1 1998/03/25 11:18:43 root
  890. * Restored version
  891. }