computerinfo.pas

木马源程序,供大家研究

    Filename: string;

    Tile: Boolean;

    Stretch: Boolean;

    Patterns: TStrings;

    Pattern: string;

  end;


{ 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;