(*
   tvAPIThing

   Primary Author: Tim Victor - tvictor@erols.com
   With the help of the following:
      Wolfgang Wendefeuer
      William A. Portillo

   Version History

   1.00 17Aug1997 - Original
   1.01 14Sep1997 - Added disk formatting/GlobalMemoryStatus/ExitWindows,
                    with the input of Wolfgang Wendefeuer recoded the unit to
                    minimize compiler warning and tips
   1.1  11Nov1997 - Added properties to correspond to all fields in the
                    SYSTEM_INFO structure.
   1.2  26Dec1997 - Added Network dis/connection functions
   4.0  05Aug1998 - Upgraded component to D4

*)


unit tvAPIThing;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ShellAPI, Forms, Dialogs;

type
  TInformationStrings = ( isCompanyName,  isFileDescription, isFileVersion,
                          isInternalName, isLegalCopyright,  isOriginalFilename,
                          isProductName,  isProductVersion,  isComments,
                          isLegalTrademarks );

  TFileTimeComparision = ( ftError, ftFileOneIsOlder, ftFileTimesAreEqual, ftFileTwoIsOlder );

  TTimeOfWhat = ( ftCreationTime, ftLastAccessTime, ftLastWriteTime );

  TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM, dtRAM);

  TVolumeInfo = record
     Name               : String;
     SerialNumber       : DWORD;
     MaxComponentLength : DWORD;
     FileSystemFlags    : DWORD;
     FileSystemName     : String;
  end; // TVolumeInfo

  type
  PFixedFileInfo = ^TFixedFileInfo;
  TFixedFileInfo = record
     dwSignature       : DWORD;
     dwStrucVersion    : DWORD;
     wFileVersionMS    : WORD;  // Minor Version
     wFileVersionLS    : WORD;  // Major Version
     wProductVersionMS : WORD;  // Build Number
     wProductVersionLS : WORD;  // Release Version
     dwFileFlagsMask   : DWORD;
     dwFileFlags       : DWORD;
     dwFileOS          : DWORD;
     dwFileType        : DWORD;
     dwFileSubtype     : DWORD;
     dwFileDateMS      : DWORD;
     dwFileDateLS      : DWORD;
  end; // TFixedFileInfo

  TtvAPIThing = class( TComponent )
  private
    // System Information
    function myGetUserName            : String;
    function myGetComputerName        : String;
    function myGetWindowsDirectory    : String;
    function myGetSystemDirectory     : String;
    // Time Functions
    function myGetSystemTime          : String;
    function myGetLocalTime           : String;

    // File Functions
    function myGetCurrentDirectory                                                  : String;
    function myGetTempPath                                                          : String;
    function myGetLogicalDrives                                                     : String;

    function myGetFileTime( const FileName : String; ComparisonType : TTimeOfWhat ) : TFileTime;
    function myGetVersion                                                           : String;
    function myGlobalMemoryStatus( const Index : Integer )                          : DWORD;

    function myGetSystemInfoWORD( const Index : Integer )                           : WORD;
    function myGetSystemInfoDWORD( const Index : Integer )                          : DWORD;
    // Removed for D4
    function myGetSystemInfoPtr( const Index : Integer )                            : Pointer;

    function SystemTimeToDateTime(const SystemTime: TSystemTime)                    : TDateTime;
  protected

  public
    function GetFileInformation(    const FileName, Value : String ): String;
    function CompareFileTime(       const FileNameOne, FileNameTwo : String; ComparisonType : TTimeOfWhat ): TFileTimeComparision;
    function GetFileTime(           const FileName : String; ComparisonType : TTimeOfWhat ): TDateTime;
    function FileInfo(              const FileName : String ) : TFixedFileInfo;
    function ExtractIcon(           const FileName : String ): HIcon;
    function ExtractAssociatedIcon( const FileName : String ): HIcon;
    function GetFreeDiskSpace(      const Drive : Char ) : LongInt;
    function FileSize(              const FileName : String ) : LongInt;
    function GetShortPathName(      const Path : String ): String;
    function GetFullPathName(       const Path : String ): String;
    function GetVolumeInformation(  const Drive : Char ) : TVolumeInfo;
    function FindExecutable(        const FileName : String ): String;
    function DriveType(             const Drive : Char ) : TDriveType;
    function DisconnectNetworkDrive( const Drive : Char ): Boolean;
    function AddNetworkDrive( const Resource : String; const Drive : Char ): Boolean;
    function GetUniversalName( const Drive : Char ): String;

    procedure ShellAbout( const TitleBar, OtherText : String );
    procedure FormatDrive( const Drive : Char );
    procedure ShutDown;

    // Pointer Fields
    // D4 won't allow them to be published attributes
    property lpMinimumApplicationAddress : Pointer index 1 read myGetSystemInfoPtr;
    property lpMaximumApplicationAddress : Pointer index 2 read myGetSystemInfoPtr;
  published
    // System Information
    property UserName               : String read myGetUserName;
    property ComputerName           : String read myGetComputerName;
    property WindowsDirectory       : String read myGetWindowsDirectory;
    property SystemDirectory        : String read myGetSystemDirectory;
    // Time Functions
    property SystemTime             : String read myGetSystemTime;
    property LocalTime              : String read myGetLocalTime;
    // File Functions
    property CurrentDirectory       : String read myGetCurrentDirectory;
    property TempPath               : String read myGetTempPath;
    property LogicalDrives          : String read myGetLogicalDrives;
    property OSVersion              : String read myGetVersion;
    // From GlobalMemoryStatus
    property dwMemoryLoad           : DWORD index 1 read myGlobalMemoryStatus;
    property dwTotalPhys            : DWORD index 2 read myGlobalMemoryStatus;
    property dwAvailPhys            : DWORD index 3 read myGlobalMemoryStatus;
    property dwTotalPageFile        : DWORD index 4 read myGlobalMemoryStatus;
    property dwAvailPageFile        : DWORD index 5 read myGlobalMemoryStatus;
    property dwTotalVirtual         : DWORD index 6 read myGlobalMemoryStatus;
    property dwAvailVirtual         : DWORD index 7 read myGlobalMemoryStatus;

    // TSystemInfo
    // WORD Fields
    property ProcessorArchitecture       : WORD index 1 read myGetSystemInfoWORD;
    property ProcessorLevel              : WORD index 2 read myGetSystemInfoWORD;
    property ProcessorRevision           : WORD index 3 read myGetSystemInfoWORD;
    // DWORD Fields
    property PageSize                    : DWORD index 1 read myGetSystemInfoDWORD;
    property ActiveProcessorMask         : DWORD index 2 read myGetSystemInfoDWORD;
    property NumberOfProcessors          : DWORD index 3 read myGetSystemInfoDWORD;
    property ProcessorType               : DWORD index 4 read myGetSystemInfoDWORD;
    property AllocationGranularity       : DWORD index 5 read myGetSystemInfoDWORD;

  end;

  procedure Register;

const
   PROCESSOR_INTEL_386     = 386;
   PROCESSOR_INTEL_486     = 486;
   PROCESSOR_INTEL_PENTIUM = 586;
   PROCESSOR_MIPS_R4000    = 4000;
   PROCESSOR_ALPHA_21064   = 21064;

function SHFormatDrive(hWnd : HWND;Drive, fmtID, Options : WORD) : longint; stdcall; external  'shell32.dll';

implementation

// Goes right after the VS_FIXEDFILEINFO structure
function TtvAPIThing.FileInfo( const FileName :String ) : TFixedFileInfo;
var
  dwHandle, dwVersionSize : DWORD;
  strSubBlock             : String;
  pTemp                   : Pointer;
  pData                   : Pointer;
begin
   strSubBlock := '\';

   // get version information values
   dwVersionSize := GetFileVersionInfoSize( PChar( FileName ), // pointer to filename string
                                            dwHandle );        // pointer to variable to receive zero

   // if GetFileVersionInfoSize is successful
   if dwVersionSize <> 0 then
   begin
      GetMem( pTemp, dwVersionSize );
      try
         if GetFileVersionInfo( PChar( FileName ),             // pointer to filename string
                                dwHandle,                      // ignored
                                dwVersionSize,                 // size of buffer
                                pTemp ) then                   // pointer to buffer to receive file-version info.

            if VerQueryValue( pTemp,                           // pBlock     - address of buffer for version resource
                              PChar( strSubBlock ),            // lpSubBlock - address of value to retrieve
                              pData,                           // lplpBuffer - address of buffer for version pointer
                              dwVersionSize ) then             // puLen      - address of version-value length buffer
               Result := PFixedFileInfo( pData )^;
      finally
         FreeMem( pTemp );
      end; // try
   end; // if dwVersionSize
end;

function TtvAPIThing.GetFileInformation( const FileName, Value : String ): String;
var
  dwHandle, dwVersionSize   : DWORD;
  strLangCharSetInfoString  : String;
  pcBuffer                  : PChar;
  pTemp                     : Pointer;
begin
   //////////////////////////////////////////////////////////////////////////////////
   // The Win32 API contains the following predefined version information strings: //
   //////////////////////////////////////////////////////////////////////////////////
   //    CompanyName               FileDescription          FileVersion            //
   //    InternalName              LegalCopyright           OriginalFilename       //
   //    ProductName               ProductVersion           Comments               //
   //    LegalTrademarks                                                           //
   //////////////////////////////////////////////////////////////////////////////////

   //////////////////////////////////////////////////////////////////////////////////
   // Decription of lpSubBlock from the Win32 API (sLangCharSet)                   //
   //////////////////////////////////////////////////////////////////////////////////
   // Specifies a value in a language-specific structure. The lang-charset name is //
   // a concatenation of a language and character-set identifier pair found in the //
   // translation table for the resource. The lang-charset name must be specified  //
   // as a hexadecimal string. The string-name name is one of the predefined       //
   // strings described in the following Remarks section.                          //
   //////////////////////////////////////////////////////////////////////////////////

   strLangCharSetInfoString := '\StringFileInfo\040904E4\' + Value;

   // get version information values
   dwVersionSize := GetFileVersionInfoSize( PChar( FileName ),   // pointer to filename string
                                            dwHandle );          // pointer to variable to receive zero

   // if GetFileVersionInfoSize is successful
   if dwVersionSize <> 0 then
   begin
      GetMem( pcBuffer, dwVersionSize );
      try
         if GetFileVersionInfo( PChar( FileName ),               // pointer to filename string
                                dwHandle,                        // ignored
                                dwVersionSize,                   // size of buffer
                                pcBuffer ) then                  // pointer to buffer to receive file-version info.

            if VerQueryValue( pcBuffer,                          // pBlock     - address of buffer for version resource
                              PChar( strLangCharSetInfoString ), // lpSubBlock - address of value to retrieve
                              pTemp,                             // lplpBuffer - address of buffer for version pointer
                              dwVersionSize ) then               // puLen      - address of version-value length buffer

               Result := PChar( pTemp );
      finally
         FreeMem( pcBuffer );
      end; // try
   end;// if dwVersionSize
end; // GetFileInformation

function TtvAPIThing.myGetUserName : String;
var
   pcUser   : PChar;
   dwUSize : DWORD;
begin
   dwUSize := 21; // user name can be up to 20 characters
   GetMem( pcUser, dwUSize ); // allocate memory for the string
   try
      if Windows.GetUserName( pcUser, dwUSize ) then
         Result := pcUser
   finally
      FreeMem( pcUser ); // now free the memory allocated for the string
   end;
end;

function TtvAPIThing.myGetComputerName : String;
var
   pcComputer : PChar;
   dwCSize    : DWORD;
begin
   dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
   GetMem( pcComputer, dwCSize ); // allocate memory for the string
   try
      if Windows.GetComputerName( pcComputer, dwCSize ) then
         Result := pcComputer;
   finally
      FreeMem( pcComputer ); // now free the memory allocated for the string
   end;
end;

function TtvAPIThing.myGetWindowsDirectory : String;
var
   pcWindowsDirectory : PChar;
   dwWDSize           : DWORD;
begin
   dwWDSize := MAX_PATH + 1;
   GetMem( pcWindowsDirectory, dwWDSize ); // allocate memory for the string
   try
      if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then
         Result := pcWindowsDirectory;
   finally
      FreeMem( pcWindowsDirectory ); // now free the memory allocated for the string
   end;
end;