development/compilers/freepascal/rtl/unix/dos.pp

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