Software of the Month Club 1995 December/SOFM_Dec1995.bin/pc/os2/vpascal/source/rtl/dos.inc

Text File | 1995-10-31 | 7.8 KB | 239 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Runtime Library.  Version 1.0.    █}
{█      Dos/WinDos common procedures and functions       █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995 B&M&T Corporation             █}
{█      ─────────────────────────────────────────────────█}
{█      Written by Vitaly Miryanov                       █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{ Returns the OS/2 version number. The low byte of the result is the    }
{ major version number, and the high byte is the minor version number.  }
{ For example, OS/2 2.10 returns $0A14, i.e. 20 in the low byte, and 10 }
{ in the high byte.                                                     }

function DosVersion: Word;
var
  Version: array [0..1] of Longint;
begin
  DosQuerySysInfo(qsv_Version_Major,qsv_Version_Minor,Version,SizeOf(Version));
  DosVersion := Version[0] + Version[1] shl 8;
end;

{ Returns the current date set in the operating system. Ranges of the   }
{ values returned are: Year 1980-2099, Month 1-12, Day 1-31 and         }
{ DayOfWeek 0-6 (0 corresponds to Sunday).                              }

procedure GetDate(var Year,Month,Day,DayOfWeek: Word);
var
  DT: Os2Base.DateTime;
begin
  DosGetDateTime(DT);
  Year      := DT.Year;
  Month     := DT.Month;
  Day       := DT.Day;
  DayOfWeek := DT.WeekDay;
end;

{ Sets the current date set in the operating system. Valid parameter    }
{ ranges are: Year 1980-2099, Month 1-12 and Day 1-31. If the date is   }
{ not valid, the function call is ignored.                              }

procedure SetDate(Year,Month,Day: Word);
var
  DT: Os2Base.DateTime;
begin
  DosGetDateTime(DT);
  DT.Year    := Year;
  DT.Month   := Month;
  DT.Day     := Day;
  DosSetDateTime(DT);
end;

{ Returns the current time set in the operating system. Ranges of the   }
{ values returned are: Hour 0-23, Minute 0-59, Second 0-59 and Sec100   }
{ (hundredths of seconds) 0-99.                                         }

procedure GetTime(var Hour,Minute,Second,Sec100: Word);
var
  DT: Os2Base.DateTime;
begin
  DosGetDateTime(DT);
  Hour   := DT.Hours;
  Minute := DT.Minutes;
  Second := DT.Seconds;
  Sec100 := DT.Hundredths;
end;

{ Sets the time in the operating system. Valid parameter ranges are:    }
{ Hour 0-23, Minute 0-59, Second 0-59 and Sec100 (hundredths of seconds)}
{ 0-99. If the time is not valid, the function call is ignored.         }

procedure SetTime(Hour,Minute,Second,Sec100: Word);
var
  DT: Os2Base.DateTime;
begin
  DosGetDateTime(DT);
  DT.Hours      := Hour;
  DT.Minutes    := Minute;
  DT.Seconds    := Second;
  DT.Hundredths := Sec100;
  DosSetDateTime(DT);
end;

{ GetVerify returns the state of the verify flag in OS/2. When off      }
{ (False), disk writes are not verified. When on (True), all disk       }
{ writes are verified to insure proper writing.                         }

procedure GetVerify(var Verify: Boolean);
var
  Flag: Bool;
begin
  DosQueryVerify(Flag);
  Verify := Flag;
end;

{ SetVerify sets the state of the verify flag in OS/2.                  }

procedure SetVerify(Verify: Boolean);
begin
  DosSetVerify(Verify);
end;

{ Returns the number of free bytes on the specified drive number        }
{ (0=Default,1=A,2=B,..). Returns -1 if the drive number is invalid.    }

function DiskFree(Drive: Byte): Longint;
var
  Info: FsAllocate;
begin
  if DosQueryFSInfo(Drive, fsil_Alloc, Info, SizeOf(Info)) = 0
    then DiskFree := Info.cUnitAvail * Info.cSectorUnit * Info.cbSector
    else DiskFree := -1;
end;

{ Returns the size in bytes of the specified drive number (0=Default,   }
{ 1=A,2=B,..). Returns -1 if the drive number is invalid.               }

function DiskSize(Drive: Byte): Longint;
var
  Info: FsAllocate;
begin
  if DosQueryFSInfo(Drive, fsil_Alloc, Info, SizeOf(Info)) = 0
    then DiskSize := Info.cUnit * Info.cSectorUnit * Info.cbSector
    else DiskSize := -1;
end;

{ Returns the attributes of a file. F must be a file variable (typed,   }
{ untyped or textfile) which has been assigned a name. The attributes   }
{ are examined by ANDing with the attribute masks defined as constants  }
{ above. Errors are reported in DosError.                               }

procedure GetFAttr(var F; var Attr: Word);
var
  Info: FileStatus3;
begin
  DosError := DosQueryPathInfo(FileRec(F).Name,fil_Standard,Info,SizeOf(Info));
  If DosError = 0 then Attr := Info.attrFile else Attr := 0;
end;

{ Sets the attributes of a file. F must be a file variable (typed,      }
{ untyped or textfile) which has been assigned a name. The attribute    }
{ value is formed by adding (or ORing) the appropriate attribute masks  }
{ defined as constants above. Errors are reported in DosError.          }

procedure SetFAttr(var F; Attr: Word);
var
  Info: FileStatus3;
begin
  DosError := DosQueryPathInfo(FileRec(F).Name,fil_Standard,Info,SizeOf(Info));
  if DosError = 0 then
  begin
    Info.attrFile := Attr;
    DosError := DosSetPathInfo(FileRec(F).Name,fil_Standard,Info,SizeOf(Info),dspi_WrtThru);
  end;
end;

{ Type cast record }

type
  DateTimeRec = record
    FTime,FDate: SmallWord;
  end;

{ Returns the date and time a file was last written. F must be a file   }
{ variable (typed, untyped or textfile) which has been assigned and     }
{ opened. The Time parameter may be unpacked throgh a call to           }
{ UnpackTime. Errors are reported in DosError.                          }

procedure GetFTime(var F; var Time: Longint);
var
  Info: FileStatus3;
  FDateTime: DateTimeRec absolute Time;
begin
  DosError := DosQueryFileInfo(FileRec(F).Handle,fil_Standard,Info,SizeOf(Info));
  if DosError <> 0 then Time := 0
 else
  with FDateTime do
  begin
    FTime := Info.ftimeLastWrite;
    FDate := Info.fdateLastWrite;
  end
end;

{ Sets the date and time a file was last written. F must be a file      }
{ variable (typed, untyped or textfile) which has been assigned and     }
{ opened. The Time parameter may be created through a call to PackTime. }
{ Errors are reported in DosError.                                      }

procedure SetFTime(var F; Time: Longint);
var
  Info: FileStatus3;
  FDateTime: DateTimeRec absolute Time;
begin
  DosError := DosQueryFileInfo(FileRec(F).Handle,fil_Standard,Info,SizeOf(Info));
  if DosError <> 0 then Time := 0
 else
  with FDateTime do
  begin
    Info.ftimeLastWrite := FTime;
    Info.fdateLastWrite := FDate;
    DosError := DosSetFileInfo(FileRec(F).Handle,fil_Standard,Info,SizeOf(Info));
  end
end;

{ Converts a 4-byte packed date/time returned by FindFirst, FindNext or }
{ GetFTime into a DateTime record.                                      }

procedure UnpackTime(P: Longint; var T: DateTime);
var
  FDateTime: DateTimeRec absolute P;
begin
  with T,FDateTime do
  begin
    Year  :=  (FDate and mfdYear   ) shr sfdYear + 1980;
    Month :=  (FDate and mfdMonth  ) shr sfdMonth;
    Day   :=  (FDate and mfdDay    ) shr sfdDay;
    Hour  :=  (FTime and mftHours  ) shr sftHours;
    Min   :=  (FTime and mftMinutes) shr sftMinutes;
    Sec   := ((FTime and mftTwoSecs) shr sftTwoSecs) * 2;
  end;
end;

{ Converts a DateTime record into a 4-byte packed date/time used by     }
{ SetFTime.                                                             }

procedure PackTime(var T: DateTime; var P: Longint);
var
  FDateTime: DateTimeRec absolute P;
begin
  with T,FDateTime do
  begin
    FDate := (Year - 1980) shl sfdYear + Month shl sfdMonth + Day shl sfdDay;
    FTime := Hour shl sftHours + Min shl sftMinutes + (Sec div 2) shl sftTwoSecs;
  end;
end;