{
Copyright (C) 1998-99 Free Software Foundation, Inc.

Author: Frank Heckenbach <frank@pascal.gnu.de>

Partly BP compatible WinDos unit

This unit supports some, but not all, of the routines and declarations
of BP's WinDos unit. The following routines and declarations are not
supported, and most likely will never be in a portable way, for some
reasons.

Interrupts are Dos and CPU specific:

  type TRegisters
  constants fCarry, fParity, fAuxiliary, fZero, fSign, fOverflow
  procedure Intr(IntNo: Byte; var Regs: TRegisters);
  procedure MsDos(var Regs: TRegisters);
  procedure GetIntVec(IntNo: Byte; var Vector: Pointer);
  procedure SetIntVec(IntNo: Byte; Vector: Pointer);

The format of the return value of this function is Dos specific. Though
most other system have versions numbers as well, returning them here
would usually not do what is expected, e.g. testing if certain Dos
features are present by comparing the version number:

  function DosVersion: Word;

Changing the system date and time is a system administration task, and
nothing for normal user programs. IOW, these routines simply don't
belong in such a unit:

  procedure SetTime(Hour, Minute, Second, Sec100: Word);
  procedure SetDate(Year, Month, Day: Word);

The CBreak and Verify flags are Dos specific:

  procedure GetCBreak(var Break: Boolean);
  procedure SetCBreak(Break: Boolean);
  procedure GetVerify(var Verify: Boolean);
  procedure SetVerify(Verify: Boolean);

The internal structure of file variables is different in GPC. (As far
as TFDDs are concerned, something compatible on a higher level might
get built into GPC):

  types TFileRec, TTextRec
  constants fmClosed, fmInput, fmOutput, fmInOut


This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Library General Public License as published by
the Free Software Foundation, version 2.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
License for more details.

You should have received a copy of the GNU Library General Public License
along with this library; see the file COPYING.LIB.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.
}

unit WinDos;

interface

uses GPC, Dos;

const
  { File attribute constants }
  faReadOnly  = ReadOnly;
  faHidden    = Hidden;    { set for dot files except '.' and '..' }
  faSysFile   = SysFile;   { not supported }
  faVolumeID  = VolumeID;  { not supported }
  faDirectory = Directory;
  faArchive   = Archive;   { means: not executable }
  faAnyFile   = AnyFile;

  { Maximum file name component string lengths }
  fsPathName  = 79;
  fsDirectory = 67;
  fsFileName  = 8;
  fsExtension = 4;

  { FileSplit return flags }
  fcExtension = 1;
  fcFileName  = 2;
  fcDirectory = 4;
  fcWildcards = 8;

type
  PTextBuf = ^TTextBuf;
  TTextBuf = TextBuf;

  { Search record used by FindFirst and FindNext }
  TSearchRec = {$ifdef _Borland_16_Bit_} packed {$endif} record
                 Fill : SearchRecFill;
                 Attr : Byte8;
                 Time : Int32;
                 {$ifdef _Borland_16_Bit_}
                 Size : Int32;
                 Name : packed array [0..12] of Char;
                 {$else}
                 Size : LongInt;
                 Name : TStringBuf;
                 {$endif}
                 Reserved : SearchRec
               end;

  { Date and time record used by PackTime and UnpackTime }
  TDateTime = DateTime;

var
  { Error status variable }
  DosError : external Integer;

procedure GetDate (var Year, Month, Day, DayOfWeek : Word);  external;
procedure GetTime (var Hour, Minute, Second, Sec100 : Word); external;
function  DiskFree (Drive : Byte) : LongInt;                 external;
function  DiskSize (Drive : Byte) : LongInt;                 external;
procedure GetFAttr (var F : GPC_AnyFile; var Attr : Word);   external;
procedure SetFAttr (var F : GPC_AnyFile; Attr : Word);       external;
procedure GetFTime (var F : GPC_AnyFile; var Time : Int32);  external;
procedure SetFTime (var F : GPC_AnyFile; Time : Int32);      external;
procedure (*@@fjf260*)WFindFirst (Path : PChar; Attr : Word; var SR : TSearchRec);
procedure (*@@fjf260*)WFindNext  (var SR : TSearchRec);
procedure (*@@fjf260*)WFindClose (var SR : TSearchRec);
procedure UnpackTime (P : Int32; var T : TDateTime);         external;
procedure PackTime (const T : TDateTime; var P : Int32);     external;
function  FileSearch (Dest, Name, List : PChar) : PChar;
function  FileExpand (Dest, Name : PChar) : PChar;
function  FileSplit (Path, Dir, Name, Ext : PChar) : Word;
function  GetCurDir (Dir : PChar; Drive : Byte) : PChar;
procedure SetCurDir (Dir : PChar);
procedure CreateDir (Dir : PChar);
procedure RemoveDir (Dir : PChar);
function  GetArgCount : Integer;
function  GetArgStr (Dest : PChar; Index : Integer; MaxLen : Word) : PChar;
function  GetEnvVar (VarName : PChar) : PChar; asmname 'getenv';

implementation

procedure DosFindFirst (const Path : String; Attr : Word; var SR : SearchRec); asmname 'dos_findfirst';
procedure DosFindNext  (var SR : SearchRec);                                   asmname 'dos_findnext';
procedure DosFindClose (var SR : SearchRec);                                   asmname 'dos_findclose';

procedure ConvertSearchRec (var SR : TSearchRec);
begin
  SR.Attr := SR.Reserved.Attr;
  SR.Time := SR.Reserved.Time;
  SR.Size := SR.Reserved.Size;
  SR.Name := SR.Reserved.Name + #0
end;

procedure (*@@fjf260*)WFindFirst (Path : PChar; Attr : Word; var SR : TSearchRec);
begin
  DosFindFirst (CString2String (Path), Attr, SR.Reserved);
  if DosError = 0 then ConvertSearchRec (SR)
end;

procedure (*@@fjf260*)WFindNext (var SR : TSearchRec);
begin
  DosFindNext (SR.Reserved);
  if DosError = 0 then ConvertSearchRec (SR)
end;

procedure (*@@fjf260*)WFindClose (var SR : TSearchRec);
begin
  DosFindClose (SR.Reserved)
end;

function FileSearch (Dest, Name, List : PChar) : PChar;
begin
  FileSearch := StrLCopy (Dest, FSearch (CString2String (Name), CString2String (List)), fsPathName)
end;

function FileExpand (Dest, Name : PChar) : PChar;
begin
  FileExpand := StrLCopy (Dest, FExpand (CString2String (Name)), fsPathName)
end;

function FileSplit (Path, Dir, Name, Ext : PChar) = Result : Word;
var
  d : DirStr;
  n : NameStr;
  e : ExtStr;
  Dummy : CString;
begin
  FSplit (CString2String (Path), d, n, e);
  if Dir  <> nil then Dummy := StrCopy (Dir,  d);
  if Name <> nil then Dummy := StrCopy (Name, n);
  if Ext  <> nil then Dummy := StrCopy (Ext,  e);
  Result := 0;
  if d <> '' then Inc (Result, fcDirectory);
  if n <> '' then Inc (Result, fcFileName);
  if e <> '' then Inc (Result, fcExtension);
  if CharPos (WildCardChars, n + e) <> 0 then Inc (Result, fcWildcards)
end;

function GetCurDir (Dir : PChar; Drive : Byte) : PChar;
var Path : String (2);
begin
  if Drive = 0
    then Path := DirSelf
    else
      begin
        Path := 'a:';
        Inc (Path [1], Drive - 1)
      end;
  GetCurDir := StrLCopy (Dir, FExpand (Path), fsDirectory)
end;

procedure SetCurDir (Dir : PChar);
begin
  ChDir (CString2String (Dir))
end;

procedure CreateDir (Dir : PChar);
begin
  MkDir (CString2String (Dir))
end;

procedure RemoveDir (Dir : PChar);
begin
  RmDir (CString2String (Dir))
end;

function GetArgCount : Integer;
begin
  GetArgCount := ParamCount
end;

function GetArgStr (Dest : PChar; Index : Integer; MaxLen : Word) : PChar;
begin
  GetArgStr := StrLCopy (Dest, ParamStr (Index), MaxLen)
end;

end.
