systeminfo.pas

得到

 FPCMCIA.Free;
 FCDROM.Free;
 F3dAccel.Free;
 FMouse.Free;
 FKeyboard.Free;
 FModem.Free;
 FMonitor.Free;
 FSCSI.Free;
 FPrinter.Free;
 FMedia.Free;
 FAdapter.Free;
 FSystem.Free;
 FUSB.Free;
 FPorts.Free;
  inherited Destroy;
End;

procedure TDevice.RefreshInfo;
var Count:Integer;
Begin
 FHDC.Free;FHDC:=TstringList.Create;
 FFDC.Free;FFDC:=tStringList.create;
 FMultiFun.Free;
 FMultiFun:=TstringList.Create;
 FInfraRed.Free;
 FInfraRed:=tstringList.create;
 FPCMCIA.Free;
 FPCMCIA:=tStringList.Create;
 FCDROM.Free;
 FCDROM:=tStringList.Create;
 F3dAccel.Free;
 F3dAccel:=tStringList.Create;
 FMouse.Free;
 FMouse:=tStringList.Create;
 FKeyboard.Free;
 FKeyboard:=tStringList.Create;
 FModem.Free;
 FModem:=tstringList.Create;
 FMonitor.Free;
 FMonitor:=tstringList.Create;
 FSCSI.Free;
 FSCSI:=tstringList.Create;
 FPrinter.Free;
 FPrinter:=tstringList.Create;
 FMedia.Free;
 FMedia:=tstringList.Create;
 FAdapter.Free;
 FAdapter:=tStringList.Create;
 FSystem.Free;
 FSystem:=TStringList.Create;
 FUSB.Free;
 FUSB:=tStringList.Create;
 FPorts.Free;
 FPorts:=tStringList.Create;

 with TRegistry.Create do
 Try
  RootKey := HKEY_LOCAL_MACHINE;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\System\'+FormatFloat('0000',Count), False) do
  Begin
   FSystem.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\USB\'+FormatFloat('0000',Count), False) do
  Begin
   FUSB.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Ports\'+FormatFloat('0000',Count), False) do
  Begin
   FPorts.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Adapter\'+FormatFloat('0000',Count), False) do
  Begin
   FAdapter.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Media\'+FormatFloat('0000',Count), False) do
  Begin
   FMedia.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\SCSIAdapter\'+FormatFloat('0000',Count), False) do
  Begin
   FSCSI.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Printer\'+FormatFloat('0000',Count), False) do
  Begin
   FPrinter.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Mouse\'+FormatFloat('0000',Count), False) do
  Begin
   FMouse.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Monitor\'+FormatFloat('0000',Count), False) do
  Begin
   FMonitor.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Modem\'+FormatFloat('0000',Count), False) do
  Begin
   FModem.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Keyboard\'+FormatFloat('0000',Count), False) do
  Begin
   FKeyboard.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\3D Accelerators\'+FormatFloat('0000',Count), False) do
  Begin
   F3dAccel.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\CDROM\'+FormatFloat('0000',Count), False) do
  Begin
   FCDROM.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\PCMCIA\'+FormatFloat('0000',Count), False) do
  Begin
   FPCMCIA.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Infrared\'+FormatFloat('0000',Count), False) do
  Begin
   FInfraRed.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\MultiFunction\'+FormatFloat('0000',Count), False) do
  Begin
   FMultiFun.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\HDC\'+FormatFloat('0000',Count), False) do
  Begin
   FHDC.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;

  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\FDC\'+FormatFloat('0000',Count), False) do
  Begin
   FFDC.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  
 Finally
  Free;
 End;
End;

constructor TLocaleInfo.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;

destructor TLocaleInfo.Destroy;
Begin
  inherited Destroy;
End;

procedure TLocaleInfo.RefreshInfo(LocaleID:Cardinal);
var Buffer : PChar;
    BufLen : Integer;
Begin
 BufLen:=255;
 GetMem(Buffer,BufLen);
 Try
 GetLocaleInfo(LocaleID, LOCALE_SLANGUAGE, Buffer, BufLen);
 FLang   :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SENGLANGUAGE, Buffer, BufLen);
 FEngLang  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SABBREVLANGNAME, Buffer, BufLen);
 FAbbrLang :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_ICOUNTRY, Buffer, BufLen);
 FCountry  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SCOUNTRY, Buffer, BufLen);
 FFCountry :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SABBREVCTRYNAME, Buffer, BufLen);
 FAbbrCtry :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SLIST, Buffer, BufLen);
 FList   :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_IMEASURE, Buffer, BufLen);
 FMeasure  :=Buffer;
 case FMeasure[1] of
 '0' : FMeasure := 'Decimal';
 '1' : FMeasure := 'Usa';
 end;

 GetLocaleInfo(LocaleID, LOCALE_SDECIMAL, Buffer, BufLen);
 FDecimal  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_IDIGITS, Buffer, BufLen);
 FDigit  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SCURRENCY, Buffer, BufLen);
 FCurrency :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SINTLSYMBOL, Buffer, BufLen);
 FIntlSymbol:=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SMONDECIMALSEP, Buffer, BufLen);
 FMonDecSep :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SMONTHOUSANDSEP, Buffer, BufLen);
 FMonThoSep :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_ICURRDIGITS, Buffer, BufLen);
 FCurrdigit :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_ICURRENCY, Buffer, BufLen);
 FPCurrMode :=Buffer;
 case FPCurrMode[1] of
 '0': FPCurrMode := 'Prefix, no separation';
 '1': FPCurrMode := 'Suffix, no separation';
 '2': FPCurrMode := 'Prefix, 1-char. separation';
 '3': FPCurrMode := 'Suffix, 1-char. separation';
 end;

 GetLocaleInfo(LocaleID, LOCALE_INEGCURR, Buffer, BufLen);
 FNCurrMode :=Buffer;
 case FNCurrMode[1] of
 '0': FNCurrMode := '$1.1)';
 '1': FNCurrMode := '-$1.1';
 '2': FNCurrMode := '$-1.1';
 '3': FNCurrMode := '$1.1-';
 '4': FNCurrMode := '(1.1$)';
 '5': FNCurrMode := '-1.1$';
 '6': FNCurrMode := '1.1-$';
 '7': FNCurrMode := '1.1$-';
 '8': FNCurrMode := '-1.1 $ (space before $)';
 '9': FNCurrMode := '-$ 1.1 (space after $)';
 end;

 GetLocaleInfo(LocaleID, LOCALE_SDATE, Buffer, BufLen);
 FDate  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_STIME, Buffer, BufLen);
 FTime  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_STIMEFORMAT, Buffer, BufLen);
 FTimeFormat :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_SSHORTDATE, Buffer, BufLen);
 FShortDate  :=Buffer;

 GetLocaleInfo(LocaleID, LOCALE_IDATE, Buffer, BufLen);
 FShortDateOrdr :=Buffer;
 case FShortDateOrdr[1] of
 '0': FShortDateOrdr := 'Month-Day-Year';
 '1': FShortDateOrdr := 'Day-Month-Year';
 '2': FShortDateOrdr := 'Year-Month-Day';
 end;

 GetLocaleInfo(LocaleID, LOCALE_ILDATE, Buffer, BufLen);
 FLongDateOrdr  :=Buffer;
 case FLongDateOrdr[1] of
 '0': FLongDateOrdr := 'Month-Day-Year';
 '1': FLongDateOrdr := 'Day-Month-Year';
 '2': FLongDateOrdr := 'Year-Month-Day';
 end;

 GetLocaleInfo(LocaleID, LOCALE_ITIME, Buffer, BufLen);
 FTimeFormatSpec  :=Buffer;
 case FTimeFormatSpec[1] of
 '0': FTimeFormatSpec := 'AM / PM 12-hour format';
 '1': FTimeFormatSpec := '24-hour format';
 end;

 GetLocaleInfo(LocaleID, LOCALE_ICENTURY, Buffer, BufLen);
 FYearFormat  :=Buffer;
 case YearFormat[1] of
 '0': YearFormat := 'Abbreviated 2-digit century';
 '1': YearFormat := 'Full 4-digit century';
 end;
 Finally
 FreeMem(Buffer,BufLen);
 End;
End;

constructor TTimeZone.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;

destructor TTimeZone.Destroy;
Begin
  inherited Destroy;
End;

procedure TTimeZone.RefreshInfo;
var Information:_Time_Zone_Information;
Begin
 GetTimeZoneInformation(Information);
 with Information do
 Begin
  FBias:=Bias;
  FDayLightBias:=DaylightBias;
  FDaylightName:=DaylightName;
  FStandardName:=StandardName;
  FDaylightTime:=DaylightTime;
  FStandardTime:=StandardTime;
 End;
End;

constructor TDirectories.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;

destructor TDirectories.Destroy;
Begin
  inherited Destroy;
End;

{procedure TDirectories.RefreshInfo;
Begin

End;
}

constructor TDisk.Create;
Begin
  inherited Create;
  FDrive:='C:';
{  RefreshInfo;
}End;

destructor TDisk.Destroy;
Begin
  inherited Destroy;
End;

procedure TDisk.GetDiskInfo(Drive:String);
var DriveType                : Integer;
//  I                        : Int64;
    vSectorsPerCluster       : Cardinal;
    vBytesPerSector          : Cardinal;
    vNumberOfFreeCluster     : Cardinal;
    vTotalNumberOfCluster    : Cardinal;
    vTotalNumberOfBytes      : Int64;
    vTotalNumberOfFreeBytes  : Int64;    { Quotas for the calling thread }
    vClusterSize             : Cardinal;
    vFreeBytes               : Cardinal;
    MaxFilenameLength,
    FSFlags                  : DWord;