tvapithing.pas

del *.obj del *.dcu del *.~* del *.hpp del *.dcp del *.dpl del *.cesettings del *.log upx sy

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

function TtvAPIThing.myGetSystemTime : String;
var
   stSystemTime : TSystemTime;
begin
   Windows.GetSystemTime( stSystemTime );
   Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) );
end;

function TtvAPIThing.myGetLocalTime : String;
var
   stSystemTime : TSystemTime;
begin
   Windows.GetLocalTime( stSystemTime );
   Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) );
end;

function TtvAPIThing.CompareFileTime( const FileNameOne, FileNameTwo : String; ComparisonType : TTimeOfWhat ): TFileTimeComparision;
var
   FileOneFileTime : TFileTime;
   FileTwoFileTime : TFileTime;
begin
   Result := ftError;

   FileOneFileTime := myGetFileTime( FileNameOne, ComparisonType );
   FileTwoFileTime := myGetFileTime( FileNameTwo, ComparisonType );

   case Windows.CompareFileTime( FileOneFileTime, FileTwoFileTime ) of
      -1 : Result := ftFileOneIsOlder;
       0 : Result := ftFileTimesAreEqual;
       1 : Result := ftFileTwoIsOlder;
   end;

end;

function TtvAPIThing.GetFileTime( const FileName : String; ComparisonType : TTimeOfWhat ): TDateTime;
var
   SystemTime : TSystemTime;
   FileTime   : TFileTime;
begin
   Result := StrToDate( '12/31/9999' );

   FileTime := myGetFileTime( FileName, ComparisonType );
   if FileTimeToSystemTime( FileTime, SystemTime ) then
      // Convert to TDateTime and return
      Result := SystemTimeToDateTime( SystemTime );
end;

function TtvAPIThing.myGetFileTime( const FileName : String; ComparisonType : TTimeOfWhat ) : TFileTime;
var
   FileTime, LocalFileTime : TFileTime;
   hFile                   : THandle;
begin
   // initialize TFileTime record in case of error
   Result.dwLowDateTime := 0;
   Result.dwHighDateTime := 0;
   hFile := FileOpen( FileName, fmShareDenyNone );
   try
      if hFile <> 0 then
      begin
         case ComparisonType of
            ftCreationTime   : Windows.GetFileTime( hFile, @FileTime, nil, nil );
            ftLastAccessTime : Windows.GetFileTime( hFile, nil, @FileTime, nil );
            ftLastWriteTime  : Windows.GetFileTime( hFile, nil, nil, @FileTime );
         end; // case FileTimeOf

         // Change the file time to local time
         FileTimeToLocalFileTime( FileTime, LocalFileTime );
         Result := LocalFileTime;
      end; // if hFile <> 0
   finally
      FileClose( hFile );
   end; // try
end;

procedure TtvAPIThing.ShellAbout( const TitleBar, OtherText : String );
begin
   ShellAPI.ShellAbout( Application.Handle,
                        PChar( TitleBar ),
                        PChar( OtherText ),
                        Application.Icon.Handle );
end;

function TtvAPIThing.ExtractIcon( const FileName : String ): HIcon;
begin
   Result := ShellAPI.ExtractIcon( Application.Handle,
                                   PChar( FileName ),
                                   0 );
end;

function TtvAPIThing.ExtractAssociatedIcon( const FileName : String ): HIcon;
var
   wIndex  : WORD;
   pcFileName : Pchar;
begin
   // with help from:
   // William A. Portillo.
   //[e-mail]
   GetMem( pcFileName, MAX_PATH + 1 ); // Allocate memory for our pointer
   try
      StrPCopy( pcFilename, FileName ); // Copy the Filename into the Pchar var
      Result := ShellAPI.ExtractAssociatedIcon( Application.Handle,
                                                pcFileName,
                                                wIndex );
   finally
      // free allocated memory
      FreeMem( pcFileName );
   end; // try
end;

function TtvAPIThing.GetFreeDiskSpace( const Drive : Char ) : LongInt;
var
   lpRootPathName          : PChar;	// address of root path
   lpSectorsPerCluster     : DWORD;	// address of sectors per cluster
   lpBytesPerSector        : DWORD;	// address of bytes per sector
   lpNumberOfFreeClusters  : DWORD;	// address of number of free clusters
   lpTotalNumberOfClusters : DWORD;	// address of total number of clusters
begin
      lpRootPathName := PChar( Drive + ':\' );
      if Windows.GetDiskFreeSpace( lpRootPathName,
                                   lpSectorsPerCluster,
                                   lpBytesPerSector,
                                   lpNumberOfFreeClusters,
                                   lpTotalNumberOfClusters ) then
         Result := lpNumberOfFreeClusters * lpBytesPerSector * lpSectorsPerCluster
      else
         Result := -1;
end;

function TtvAPIThing.myGetCurrentDirectory: String;
var
   nBufferLength : DWORD; // size, in characters, of directory buffer
   lpBuffer 	 : PChar; // address of buffer for current directory
begin
   nBufferLength := MAX_PATH + 1;
   GetMem( lpBuffer, nBufferLength );
   try
      if Windows.GetCurrentDirectory( nBufferLength, lpBuffer ) > 0 then
         Result := lpBuffer;
   finally
      FreeMem( lpBuffer );
   end; // try
end;

function TtvAPIThing.FileSize( const FileName : String ) : LongInt;
var
   hFile          : THandle; // handle of file to get size of
   lpFileSizeHigh : DWORD;   // address of high-order WORD for file size
begin
   Result := -1;
   hFile := FileOpen( FileName, fmShareDenyNone );
   try
      if hFile <> 0 then
         Result := Windows.GetFileSize( hFile, @lpFileSizeHigh );
   finally
      FileClose( hFile );
   end; // try
end;

function TtvAPIThing.GetShortPathName( const Path : String ): String;
var
   lpszShortPath : PChar; // points to a buffer to receive the null-terminated short form of the path
begin
   GetMem( lpszShortPath, MAX_PATH + 1 );
   try
      Windows.GetShortPathName( PChar( Path ), lpszShortPath, MAX_PATH + 1 );
      Result := lpszShortPath;
   finally
      FreeMem( lpszShortPath );
   end;
end;

function TtvAPIThing.myGetTempPath: String;
var
    nBufferLength : DWORD; // size, in characters, of the buffer
    lpBuffer      : PChar; // address of buffer for temp. path
begin
   nBufferLength := MAX_PATH + 1; // initialize
   GetMem( lpBuffer, nBufferLength );
   try
      if GetTempPath( nBufferLength, lpBuffer ) <> 0 then
         Result := StrPas( lpBuffer )
      else
         Result := '';
   finally
      FreeMem( lpBuffer );
   end;
end;

function TtvAPIThing.GetVolumeInformation( const Drive : Char ) : TVolumeInfo;
var
   lpRootPathName           : PChar; // address of root directory of the file system
   lpVolumeNameBuffer       : PChar; // address of name of the volume
   nVolumeNameSize          : DWORD; // length of lpVolumeNameBuffer
   lpVolumeSerialNumber     : DWORD; // address of volume serial number
   lpMaximumComponentLength : DWORD; // address of system's maximum filename length
   lpFileSystemFlags        : DWORD; // address of file system flags
   lpFileSystemNameBuffer   : PChar; // address of name of file system
   nFileSystemNameSize      : DWORD; // length of lpFileSystemNameBuffer
begin
   GetMem( lpVolumeNameBuffer, MAX_PATH + 1 );
   GetMem( lpFileSystemNameBuffer, MAX_PATH + 1 );
   try
      nVolumeNameSize     := MAX_PATH + 1;
      nFileSystemNameSize := MAX_PATH + 1;

      lpRootPathName := PChar( Drive + ':\' );
      if Windows.GetVolumeInformation( lpRootPathName,
                                       lpVolumeNameBuffer,
                                       nVolumeNameSize,
                                       @lpVolumeSerialNumber,
                                       lpMaximumComponentLength,
                                       lpFileSystemFlags,
                                       lpFileSystemNameBuffer,
                                       nFileSystemNameSize ) then
      begin
      (*
         // to check disk flags do the following
         if (lpFileSystemFlags and FS_CASE_IS_PRESERVED) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10'FS_CASE_IS_PRESERVED'
            else
               flags := 'FS_CASE_IS_PRESERVED';

         if (lpFileSystemFlags and FS_CASE_SENSITIVE) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10'FS_CASE_SENSITIVE'
            else
               flags := 'FS_CASE_SENSITIVE';

         if (lpFileSystemFlags and FS_UNICODE_STORED_ON_DISK) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10'FS_UNICODE_STORED_ON_DISK'
            else
               flags := 'FS_UNICODE_STORED_ON_DISK';

         if (lpFileSystemFlags and FS_PERSISTENT_ACLS) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10'FS_PERSISTENT_ACLS'
            else
               flags := 'FS_PERSISTENT_ACLS';

         if (lpFileSystemFlags and FS_FILE_COMPRESSION) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10'FS_FILE_COMPRESSION'
            else
               flags := 'FS_FILE_COMPRESSION';

         if (lpFileSystemFlags and FS_VOL_IS_COMPRESSED) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10'FS_VOL_IS_COMPRESSED'
            else
               flags := 'FS_VOL_IS_COMPRESSED';
         *)

         with Result do
         begin
            Name               := lpVolumeNameBuffer;
            SerialNumber       := lpVolumeSerialNumber;
            MaxComponentLength := lpMaximumComponentLength;
            FileSystemFlags    := lpFileSystemFlags;
            FileSystemName     := lpFileSystemNameBuffer;
         end; // with Result
      end // if
      else
      begin
         with Result do
         begin
            Name               := '';
            SerialNumber       := 0;
            MaxComponentLength := 0;
            FileSystemFlags    := 0;
            FileSystemName     := '';
         end; // with Result
      end; // else
   finally
      FreeMem( lpVolumeNameBuffer );
      FreeMem( lpFileSystemNameBuffer );
   end; // try
end;

function TtvAPIThing.GetFullPathName( const Path : String ): String;
var
   nBufferLength : DWORD; // size, in characters, of path buffer
   lpBuffer      : PChar; // address of path buffer
   lpFilePart    : PChar; // address of filename in path
begin
   nBufferLength := MAX_PATH + 1;
   GetMem( lpBuffer, MAX_PATH + 1 );