Software of the Month Club 1995 December/SOFM_Dec1995.bin/pc/os2/vpascal/examples/test/testdos.pas

Pascal/Delphi Source File | 1995-10-31 | 5.7 KB | 180 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 1.0.            █}
{█      Dos unit test example.                           █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995 B&M&T Corporation             █}
{█      ─────────────────────────────────────────────────█}
{█      Written by Vitaly Miryanov                       █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

program TestDos;

uses Dos, Use32;

var
  Ver,Attr,Attr1: Word;
  Y,M,D,DoW: Word;
  Y1,M1,D1,DoW1: Word;
  H,H1,S,S1,Hund,Hund1: Word;
  i: Integer;
  Size: Longint;
  Verify,Verify1: Boolean;
  F: Text;
  DT: DateTime;
  FTime: Longint;
  SR: SearchRec;
  FName: PathStr;
const
  Days: array [0..6] of String[9] =
    ('Sunday','Monday','Tuesday', 'Wednesday','Thursday','Friday', 'Saturday');
  OffOn : array [Boolean] of String[3] = ('off','on');

function ConvertTime(Hour,Minute,Second,Sec100: Word): String;
var
  I: Integer;
  S1,S2: String[20];
begin
  Str(Hour:2, S1);
  Str(Minute:2, S2);
  S1 := S1 + ':' + S2;
  Str(Second:2, S2);
  S1 := S1 + ':' + S2;
  Str(Sec100:2, S2);
  S1 := S1 + ':' + S2;
  for i := 1 to Length(S1) do if S1[i] = ' ' then S1[i] := '0';
  ConvertTime := S1;
end;

procedure TestFSplit(const FName: PathStr);
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(FName, Dir, Name, Ext);
  WriteLn('Full name: ',FName, ' Dir="',Dir, '" Name="',Name, '" Ext="',Ext,'"');
end;

begin
  { DosVersion }
  Ver := DosVersion;
  WriteLn('OS/2 version ', Lo(Ver) div 10, '.', Hi(Ver), ' is running.');
  { GetDate }
  GetDate(Y, M, D, DoW);
  WriteLn('Today is ', Days[DoW],', ', M:0, '/', D:0, '/', Y:0, '.');
  { SetDate }
  SetDate(2000, 1, 1);
  GetDate(Y1, M1, D1, DoW1);
  WriteLn('1/1/2000 is ', Days[DoW1], '.');
  SetDate(Y, M, D);
  { GetTime }
  GetTime(H, M, S, Hund);
  WriteLn('Current time is ', ConvertTime(H, M, S, Hund), '.');
  { SetTime }
  SetTime(0, 0, 0, 0);
  GetTime(H1, M1, S1, Hund1);
  WriteLn('Oooooorrrrrr, it''s time to sleep for a while: time is ', ConvertTime(H1, M1, S1, Hund1), '.');
  SetTime(H, M, S, Hund);
  { GetVerify/SetVerify }
  GetVerify(Verify);
  WriteLn('Write verify is ', OffOn[Verify],'.');
  Verify := not(Verify);
  Write('Turning write verify ', OffOn[Verify],' ... ');
  SetVerify(Verify);
  GetVerify(Verify1);
  if Verify = Verify1 then WriteLn(' done.')
                      else WriteLn(' failed.');
  SetVerify(not Verify);
  { DiskFree/DiskSize }
  for I := 3 to 26 do
  begin
    Size := DiskSize(i);
    if Size = -1 then Break;
    WriteLn('Drive ' , Chr(I + Ord('A') - 1), ':   '
          + 'Size = ', Size div 1024:9, 'K  '
          + 'Free = ', DiskFree(I) div 1024:9, 'K.');
  end;
  { GetFAttr/SetFAttr }
  Assign(F, 'C:\AUTOEXEC.BAT');
  GetFAttr(F, Attr1);
  WriteLn('Lets make our C:\AUTOEXEC.BAT file read only ...');
  if DosError = 0 then
  begin
    SetFAttr(F, Attr1 or ReadOnly);
    if DosError = 0 then
    begin
      GetFAttr(F, Attr);
      if DosError = 0 then
      begin
        Write('C:\AUTOEXEC.BAT attributes = ', Attr);
        if Attr and ReadOnly <> 0 then Write(' ReadOnly');
        if Attr and Hidden   <> 0 then Write(' Hidden');
        if Attr and SysFile  <> 0 then Write(' System');
        if Attr and Archive  <> 0 then Write(' Archive');
        WriteLn;
        SetFAttr(F,Attr1);
      end;
    end;
  end;
  if DosError <> 0 then WriteLn('Error getting/setting file attributes, EC =', DosError);
  { GetFTime/SetFTime }
  WriteLn('Creating temporary file TEST.$$$ ...');
  Assign(F,'TEST.$$$');
  Rewrite(F);                   { Create new file   }
  GetFTime(F, FTime);           { Get creation time }
  UnpackTime(FTime, DT);
  with DT do
  begin
    WriteLn('File datestamp is ', Month:0, '/', Day:0, '/', Year:0, '.');
    WriteLn('File timestamp is ', ConvertTime(Hour,Min,Sec,0), '.');
    Hour := 0;
    Min := 1;
    Sec := 0;
    PackTime(DT, FTime);
    WriteLn('Setting file timestamp to one minute after midnight');
    Reset(F);                   { Reopen file for reading }
    SetFTime(F, FTime);         { (Otherwise, close will update time) }
  end;
  Close(F);   { Close file }
  { FindFirst/FindNext/FindClose }
  WriteLn('List of all files and directories in the current directory');
  WriteLn('          Name       Size');
  FindFirst('*.*', AnyFile, SR);
  while DosError = 0 do
  begin
    WriteLn(SR.Name:14, SR.Size:11);
    FindNext(SR);
  end;
{$IFDEF OS2}
  FindClose(SR);
{$ENDIF}
  { FSearch/GetEnv }
  FName := FSearch('cmd.exe', GetEnv('Path'));
  if FName = '' then WriteLn('CMD.EXE is not found')
                else WriteLn('CMD.EXE full path is ', FName);
  { EnvStr/EnvCount }
  WriteLn('List of all environment variables');
  for I := 1 to EnvCount do WriteLn(I:0, ': ', EnvStr(I));
  { FExpand }
  WriteLn('Fully qualified name for the "..\.\QQ" is ', FExpand('..\.\qq'));
  WriteLn('Fully qualified name for the "QQ"      is ', FExpand('qq'));
  WriteLn('Fully qualified name for the "\QQ"     is ', FExpand('\qq'));
  WriteLn('Fully qualified name for the "C:QQ"    is ', FExpand('c:qq'));
  { FSplit }
  TestFSplit('D:\DIR\FILENAME.EXT');
  TestFSplit('D:\DIR.EXT\FILENAME');
  TestFSplit('DIR\FILENAME.EXT');
  TestFSplit('\FILENAME.EXT');
  TestFSplit('FILENAME.EXT');
  TestFSplit('FILENAME');
  { Exec/ExitCode }
  WriteLn('DIR *.* /P');
{$IFDEF OS2}
  ExecFlags := efAsync;
{$ENDIF}
  Exec(GetEnv('COMSPEC'), '/C dir *.* /P');
  WriteLn('ExitCode = ', DosExitCode);
end.