OS/2 Shareware BBS: 10 Tools/10-Tools.zip/vp21beta.zip/OEXMPSRC.RAR/SYSLEVEL/SYSLVL.PAS

Pascal/Delphi Source File | 2000-08-15 | 5KB | 210 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 2.1             █}
{█      SysLevel example                                 █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1996-2000 vpascal.com              █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

program SysLvl;

{ This program performs a function identical to IBM's SysLevel }
{ command, but much faster than the original.                  }

{$IFNDEF OS2}
  !! This example is for OS/2 only
{$ENDIF}

{$PMTYPE VIO}

{$Delphi+,H-,Use32+}
{$M 60000}

uses
  VpSysLow, SysUtils, Os2Def, Os2Base, Crt, Dos, VPUtils;

const
  dirs: Longint = 0;
  SysFiles: Longint = 0;
  MaxStack = 500;

type
  StringList = Array[1..MaxStack] of String;
  pStringList = ^StringList;

var
  SysF: pStringList;
  y: Integer;

procedure ScanPath( Path : String );
var
  i, stop: Longint;
  s: SearchRec;
  DirStack: pStringList;

begin
  inc( Dirs );
  if Dirs mod 6 = 0 then
    begin
      gotoxy( 5, y );
      Write(dirs:6,'  ');
      if length(Path) <= 60 then
        Write( Path )
      else
        Write( copy( Path, Length(Path)-60, 60 ), '...' );
      clreol;
    end;

  FindFirst( Path+'\syslevel.*', AnyFile,  S );
  while DosError = 0 do
    begin
      Inc( SysFiles );
      gotoxy( 5, y+1 );Write('Files: ', SysFiles:3);
      SysF^[SysFiles] := path+'\'+s.Name;
      FindNext( s );
    end;
  FindClose( s );

  Stop := 0;
  DirStack := nil;
  FindFirst( Path+'\*', Must_Have_Directory, S );
  while ( DosError = 0 ) and ( Stop < MaxStack ) do
    begin
      if ( s.Name <> '.' ) and ( s.Name <> '..' ) then
        begin
          if DirStack = nil then
            New( DirStack );

          Inc( Stop );
          DirStack^[Stop] := s.Name;
        end;
      FindNext( s );
    end;
  FindClose( s );

  for i := 1 to Stop do
    ScanPath( Path+'\'+DirStack^[i] );

  if DirStack <> nil then
    Dispose( DirStack );
end;

procedure ShowSysFiles;
var
  Cnt, i: integer;
  f : File;
  Buf: Array[0..$200] of byte;
  bytes: Longint;
  pCurCSD : pChar;
  pOldCSD : pChar;
  pName   : pChar;
  pCompID : pChar;
  RevByte : Byte;
  pType   : pChar;
  Major   : Byte;
  Minor   : Byte;

begin
  ClrScr;
  Cnt := 0;
  FileMode := $40;
  for i := 1 to SysFiles do
    begin
      assign( f, SysF^[i] );
      {$I-}
      Reset( f, 1 );
      {$I+}
      If IOResult = 0 then
        begin
          Blockread( f, Buf, Sizeof(Buf), Bytes );
          if Bytes >= $96 then
            if ( Buf[0] = $FF ) and ( Buf[1] = $FF ) and
               ( 'SYSLEVEL' = strpas(@Buf[2]) ) then
              begin
                Inc( Cnt );
                Writeln( SysF^[i] );

                Major   := Buf[$28] shr 4;
                Minor   := ( Buf[$28] and $f )*10 or (Buf[$29] and $F);
                RevByte := Buf[$95];
                pCurCSD := @Buf[$2c]; pChar(pCurCSD+7)^ := #0;
                pOldCSD := @Buf[$34]; pChar(pOldCSD+7)^ := #0;
                pName   := @Buf[$3c];
                pCompID := @Buf[$8c]; pChar(pCompID+9)^ := #0;
                pType   := @Buf[$96];
                gotoxy( 20, WhereY );
                Writeln( pName );
                Write( Format( 'Version %d.%2.2d', [Major, Minor] ) );
                if RevByte <> 0 then
                  Write( '.',RevByte );
                Writeln( '     Component ID ',pCompID );
                if pType^ <> #0 then
                  Writeln( 'Type ',pType );
                Writeln( 'Current CSD level: ',pCurCSD );
                Writeln( 'Prior   CSD level: ',pOldCSD );
                Writeln;
              end;
          close( f );
        end;

      if wherey > 15 then
        begin
          while (wherey < 22) do
            writeln;
          Writeln( 'Press Enter (<─┘) to display next page.' );
          Writeln;
          writeln( '───────────────────────────────────────────────────────────────────────────' );
          write( ' Enter ' );
          readkey;
          clrscr;
        end;
    end;
end;

function GetLocalDrives: String;
  // Get a list of all local hard disk drive letters
var
  Drive: Char;

begin
  Result := '';
  For Drive := 'C' to 'Z' do
    If GetDriveType( Drive ) in [ dtHDFAT, dtHDHPFS ] then
      Result := Result + Drive;
end;

var
  s: String;
  i: integer;

begin
  Writeln('SysLevel v2.1     (C) 1996-2000 vpascal.com' );

  s := GetLocalDrives;

  Writeln;
  Writeln( 'Scanning drives "',s,'" for SYSLEVEL.*' );
  Writeln;

  try
    try
      New( SysF );
      y := WhereY;
      for i := 1 to Length(s) do
        ScanPath( s[i]+':' );

      ShowSysFiles;
    finally
      Dispose( SysF );
    end;
  except
    on e:Exception do
      begin
        Writeln;
        Writeln( 'Exception: ',E.Message );
        Writeln( 'SysLvl terminated.' );
      end;
  end;
end.