📄 tvapithing.pas
字号:
(*
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;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -