{ GetWallpaperInfo 返回系統的墻紙信息 }

function GetWallpaperInfo : TWallpaperInfo;




{---------------------------------------------------

 以下是關于獲取顯示器視頻模式的信息的類型聲明和函數

 ----------------------------------------------------}

type

  TVideoModeInfo = array of record

    Width: Cardinal;              //寬

    Height: Cardinal;             //高

    Frequency: Cardinal;          //頻率

    BitsPerPixel: Cardinal;       //每像素顏色數

    Monochrome: Boolean;          //單色

    Interlaced: Boolean;          //交錯

    Colors: Cardinal;             //顏色數

  end;


{ GetVideoModeInfo 返回顯示器所有視頻模式的信息 }

function GetVideoModeInfo: TVideoModeInfo;




{---------------------------------------------------

 以下是關于獲取計算機網絡的信息的類型聲明和函數

 ----------------------------------------------------}

type

  TNetTreatises = (IPX, TCPIP, NetBEUI);

  TNetTreatisesSet = set of TNetTreatises;

  TNetRec = record

    Description: string;

    ServiceName: string;

    Treatises : TNetTreatisesSet;

    IPAddress: string;

    IPSubnetMask: string;

    DefaultGateway: string;

    NetworkNumber: string;

  end;

  TNetInfo = array of TNetRec;

  TNetworkInfo = record

    Nets : TNetInfo;

    ConnectedResources: TStrings;

    SharedResources: TStrings;

    UserName: string;

    ComputerName: string;

  end;


{ GetNetworkInfo 返回計算機網絡的信息 }

function GetNetworkInfo: TNetworkInfo;




{---------------------------------------------------

 以下是關于獲取系統字體的信息的類型聲明和函數

 ----------------------------------------------------}

type

  TFontType = (ftDEVICE, ftRASTER, ftTRUETYPE);

  TFontTypes = set of TFontType;

  TtmFlag = (

    TM_ITALIC, TM_BOLD, TM_REGULAR,

    TM_NONNEGATIVE_AC, TM_PS_OPENTYPE,

    TM_TT_OPENTYPE, TM_MULTIPLEMASTER,

    TM_TYPE1, TM_DSIG);

  TtmFlags = set of TtmFlag;

  TFontInfo = array of record

    LogItalic: Boolean;

    LogStikeOut: Boolean;

    LogUnderline: Boolean;

    LogFamily: Byte;

    LogClipPrecision: Byte;

    LogQuality: Byte;

    LogOutPrecision: Byte;

    LogHeight: LongInt;

    LogOrientation: LongInt;

    LogEscapement: LongInt;

    LogWidth: LongInt;

    LogWeight: LongInt;

    Style: string;

    FullName: string;

    LogFaceName: string;

    Script: string;

    LogCharSet: TFontCharset;

    LogPitch: TFontPitch;

    FontType: TFontTypes;

    tmItalic: Boolean;

    tmUnderline: Boolean;

    tmStikeOut: Boolean;

    tmFamily: Byte;

    tmSizeEM: LongInt;

    tmExternalLeading: LongInt;

    tmMaxCharWidth: LongInt;

    tmCellHeight: LongInt;

    tmHeight: LongInt;

    tmAscent: LongInt;

    tmInternalLeading: LongInt;

    tmWeight: LongInt;

    tmDigitizedAspectY: LongInt;

    tmDigitizedAspectX: LongInt;

    tmDescent: LongInt;

    tmAveCharWidth: LongInt;

    tmFirstChar: string;

    tmCharSet: TFontCharset;

    tmPitch: TFontPitch;

    tmFlags: TtmFlags;

    tmDefaultChar: string;

    tmLastChar: string;

    tmBreakChar: string;

    tmOverhang: LongInt;

    tmAvgWidth: LongInt;

  end;


{ GetFontInfo 返回系統所有字體的信息 }

function GetFontInfo: TFontInfo;




{---------------------------------------------------

 以下是關于獲取系統國家的信息的類型聲明和函數

 ----------------------------------------------------}

type

  TLocaleInfo = record

    LanguageCode : string;              (* 語言代號 *)

    LanguageName : string;              (* 本地語言名稱 *)

    LanguageEngName : string;           (* 語言的英語名 *)

    LanguageShortName : string;         (* 語言名稱縮寫 *)


    CountryName : string;               (* 國家名 *)

    CountryCode : string;               (* 國家代號 *)

    CountryEngName : string;            (* 國家的英語名稱 *)

    CountryShortName : string;          (* 國家名縮寫 *)


    DefaultLanguage : string;           (* 缺省語言代號 *)

    DefaultCountryCode : string;        (* 缺省國家代碼 *)

    DefaultOemCodePage : string;        (* 缺省oem代碼頁 *)

    DefaultAnsiCodePage : string;       (* 缺省ansi代碼頁 *)

    DefaultMacCodePage : string;        (* 缺省mac頁 *)


    ListSeparator : string;             (* 列表項分割符 *)

    Measurement : string;               (* 測量單位 米制, 英制 *)


    DecimalSeparator : string;          (* 小數點符號 *)

    ThousandSeparator : string;         (* 千位分割符 *)

    Grouping : string;                  (* digit grouping *)

    Digits : string;                    (* number of fractional digits *)


    CurrencySymbol : string;            (* 本地貨幣符號 *)

    IntCurrencySymbol : string;         (* 國際貨幣符號 *)

    CurrencyDecimalSeparator : string;  (* 貨幣小數點分割符 *)

    CurrencyThousandSeparator : string; (* 貨幣千位分割符 *)

    CurrencyGrouping : string;          (* monetary grouping *)

    CurrencyDigits : string;            (* # local monetary digits *)

    PositiveCurrencyFormat : string;    (* positive currency mode *)


    DateSeparator : string;             (* 日期分割符 *)

    TimeSeparator : string;             (* 時間分割符 *)

    ShortDateFormat : string;           (* 短日期字符串 *)

    LongDateFormat : string;            (* 長日期字符串 *)

    TimeFormat : string;                (* 時間格式 *)

    ShortDateOrder : string;            (*  short date format ordering *)

    LongDateOrder  : string;            (* long date format ordering *)

    ClockMode : string;                 (* 時間格式 *)

    YearDigits : string;                (* 世紀格式 (短日期) *)

    MorningSymbol : string;             (* AM designator *)

    AfternoonSymbol : string;           (* PM designator *)

    CalendarType : string;              (* 日歷類型 *)

    FirstDayOfWeek : string;

    FirstWeekOfYear : string;

    ISOLangShortName : string;          (* ISO 縮寫語言名稱 *)

    ISOCtryShortName : string;          (* ISO 縮寫國家名稱 *)

  end;


{ GetLocaleInfo 返回系統默認的國家的信息 }

function GetLocaleInfo: TLocaleInfo;




{---------------------------------------------------

 以下是關于獲取Modem的信息的類型聲明和函數

 ----------------------------------------------------}

type

  TModemInfo = array of record

    SubKeyName: string;

    PortSpeed: LongInt;

    AttachedTo: string;

    Name: string;

    UserInit: string;

  end;


{ GetModemInfo 返回modem的信息 }

function GetModemInfo: TModemInfo;




{---------------------------------------------------

 以下是關于獲取USB設備的信息的類型聲明和函數

 ----------------------------------------------------}

type

  TUSBControlInfo = array of record

    DriverName : string;

    DriverVersion : string;

    ProviderName : string;

    DriverDate : string;

  end;


{ GetUSBControlInfo 返回所有USB設備的信息 }

function GetUSBControlInfo : TUSBControlInfo;


implementation


function GetDriveRec(Drive: Char): TDriveRec;

var

  Path : PChar;

  DByte : Byte;

  Serial, D1, D2 : DWORD;

  VolumeLabel, FileSystem: array[0..$FF] of Char;

begin

  Result.Drive := Drive;

  Path := PChar(Drive + ':\');

  DByte := Byte(Drive) - $40;

  Result.DriveType:= TSysDriveType(GetDriveType(Path));

  case Result.DriveType Of

    dtUnknown   : Result.DriveTypeString := SysUNKNOWN;

    dtNoRootDir : Result.DriveTypeString := SysNOROOTDIR;

    dtRemovable : Result.DriveTypeString := SysREMOVABLE;

    dtFixed     : Result.DriveTypeString := SysFIXEDDRIVE;

    dtNetwork   : Result.DriveTypeString := SysREMOTE;

    dtCDROM     : Result.DriveTypeString := SysCDROM;

    dtRAM       : Result.DriveTypeString := SysRAMDISK;

  end;

  Result.DiskSize := DiskSize(DByte);

  Result.DiskFree:= DiskFree(DByte);

  If (Result.DiskSize = -1) and (Result.DriveType <> dtNetwork) then

  begin

    Result.VolumeLabel       := '';

    Result.FileSystem        := '';

    Result.SerialNumber      := '';

    Result.SectorsPerCluster := 0;

    Result.BytesPerSector    := 0;

    Result.MaximumLength     := 0;

    Result.Options           := [];

  end

  else begin

    GetDiskFreeSpace(Path, Result.SectorsPerCluster, Result.BytesPerSector, D1, D2);

    GetVolumeInformation(Path, VolumeLabel, SizeOf(VolumeLabel),

      @Serial, Result.MaximumLength, D2, FileSystem, SizeOf(FileSystem));

    Result.SerialNumber:= IntToHex(Serial, 8);

    Insert('-', Result.SerialNumber, 5);

    Result.VolumeLabel:= VolumeLabel;

    Result.FileSystem:= FileSystem;

    If FS_CASE_IS_PRESERVED and d2 = FS_CASE_IS_PRESERVED then

      Result.Options:= [fsCaseIsPreserved];

    If FS_CASE_SENSITIVE and d2 = FS_CASE_SENSITIVE then

      Include(Result.Options, fsCaseIsPreserved);

    If FS_UNICODE_STORED_ON_DISK and d2 = FS_UNICODE_STORED_ON_DISK then

      Include(Result.Options, fsSupportsUnicode);

    If FS_PERSISTENT_ACLS and d2 = FS_PERSISTENT_ACLS then

      Include(Result.Options, fsPersistentACLs);

    If FS_FILE_COMPRESSION and d2 = FS_FILE_COMPRESSION then

      Include(Result.Options, fsSupportsCompression);

    If FS_VOL_IS_COMPRESSED and d2 = FS_VOL_IS_COMPRESSED then

      Include(Result.Options, fsIsCompressed);

    If Result.FileSystem = 'NTFS' then

      If FILE_ATTRIBUTE_COMPRESSED and GetFileAttributes(Path) = FILE_ATTRIBUTE_COMPRESSED then

        Include(Result.Options, fsIsCompressed);

    If $00000010 and d2 = $00000010 then

      Include(Result.Options, fsSupportsQuotas);

  end;

end;

function GetDriveInfo: TDriveInfo;

var

  Path : string;

  I, J : Integer;

begin

  SetLength(Result, 26);

  J := 0;

  for I := 0 to 25 do

  begin

    Path := Char(65+I)+':\';

    If (GetDriveType(PChar(Path)) In [2..6]) Then

    begin

      Result[J] := GetDriveRec(Char(65+I));

      Inc(J);

    end;

  end;

  SetLength(Result, J);

end;

function GetMemoryInfo : TMemoryInfo;

var

  Memory: MEMORYSTATUS;

  SysInfo : TSystemInfo;

begin

  memory.dwLength := sizeof(memory); //初始化

  GlobalMemoryStatus(memory);

  Result.UsePercent  := memory.dwMemoryLoad;

  Result.MemoryTotal := memory.dwTotalPhys;

  Result.MemoryUsable := memory.dwAvailPhys;

  Result.PageTotal := memory.dwTotalPageFile;

  Result.PageUsable := memory.dwAvailPageFile;

  Result.VirtualTotal := memory.dwTotalVirtual;

  Result.VirtualUsable := memory.dwAvailVirtual;

  GetSystemInfo(SysInfo);

  Result.PageSize := SysInfo.dwPageSize;

  Result.MinAppAddress := Cardinal(SysInfo.lpMinimumApplicationAddress);

  Result.MaxAppAddress := Cardinal(SysInfo.lpMaximumApplicationAddress);

  Result.AllocGranularity:= SysInfo.dwAllocationGranularity;

end;


type

  TCPUFeatureStr = array [TCPUFeature] of string;

const

  CPUVendorName: array[TCPUVendor] of pchar = (

    'Unknown',

    'Intel',

    'AMD',

    'IBM/VIA Cyrix',

    'Centaur/IDT',

    'NexGen',

    'UMC',

    'Rise');

  CPUVendorSigns: array[TCPUVendor] of pchar = (

    'Unidentified',

    'GenuineIntel',

    'AuthenticAMD',

    'CyrixInstead',

    'CentaurHauls',

    'NexGenDriven',

    'UMC UMC UMC ',

    'RiseRiseRise');

  CPUFeaturesAbbreviation: TCPUFeatureStr = (

    'FPU', 'VME', 'DE', 'PSE', 'TSC', 'MSR', 'PAE', 'MCE',

    'CX8', 'APIC', '---', 'SEP', 'MTRR', 'PGE', 'MCA', 'CMOV',

    'PAT', 'PSE-36', 'PSN', 'CLFlush', '---', 'DTES', 'ACPI', 'MMX',

    'FXSR', 'XMM', 'ISSE2', 'SNOOP', '---', 'ACC', 'JMPE', '---'
  );

  CPUFeaturesDescription: TCPUFeatureStr = (

    '內建浮點運算協處理器',

    '虛擬模式擴展',

    '調試模式擴展',

    '頁面大小擴展',

    '時間標記記數器',

    '特殊信號寄存器',

    '物理地址擴展',

    '計算機異常檢查',

    '比較并調換指令',

    '內建本地APIC',

    '保留',

    '快速系統訪問',

    '支持內存范圍寄存器',

    '整體頁面啟用',

    '處理器檢查結構',

    '條件指令傳送',

    '頁面屬性運算表',

    '36位虛擬內存擴展',

    '處理器序列號',

    'Cache Line Flush',

    '保留',

    'Debug Trace and EMON Store',

    'Processor Duty Cycle Control',

    'MMX',

    '快速浮點保存與恢復',

    '英特爾單指令多數據流擴展',

    '英特爾單指令多數據流擴展2',

    '自我檢測',

    '保留',

    'Automatic Clock Control',

    'JMPE 64-bit Architecture',

    '保留'

  );

  SystemBasicInformation = 0;

  SystemPerformanceInformation = 2;

  SystemTimeInformation = 3;


type

  TSYSTEM_BASIC_INFORMATION = record

    dwUnknown1: DWORD;

    uKeMaximumIncrement: ULONG;

    uPageSize: ULONG;

    uMmNumberOfPhysicalPages: ULONG;

    uMmLowestPhysicalPage: ULONG;