home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_Machine.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-25  |  5KB  |  165 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               Machine Detection Part                  }
  6. {           version 5.4 for Delphi 3,4,5                }
  7. {                                                       }
  8. {       Copyright ⌐ 1997,2001 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_Machine;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TMachine = class(TPersistent)
  23.   private
  24.     FName: string;
  25.     FLastBoot: TDatetime;
  26.     FUser: string;
  27.     FSystemUpTime: Extended;
  28.     FBIOSExtendedInfo: string;
  29.     FBIOSCopyright: string;
  30.     FBIOSName: string;
  31.     FBIOSDate: string;
  32.     FScrollLock: Boolean;
  33.     FNumLock: Boolean;
  34.     FCapsLock: Boolean;
  35.     FComp: string;
  36.     function GetSystemUpTime: Extended;
  37.   public
  38.     procedure GetInfo;
  39.     procedure Report(var sl :TStringList);
  40.   published
  41.     property Name :string read FName write FName stored false;
  42.     property User :string read FUser write FUser stored false;
  43.     property SystemUpTime :Extended read FSystemUpTime write FSystemUpTime stored false;
  44.     property LastBoot :TDatetime read FLastBoot write FLastBoot stored false;
  45.     property BIOSCopyright :string read FBIOSCopyright write FBIOSCopyright stored false;
  46.     property BIOSDate :string read FBIOSDate write FBIOSDate stored false;
  47.     property BIOSExtendedInfo :string read FBIOSExtendedInfo write FBIOSExtendedInfo stored false;
  48.     property BIOSName :string read FBIOSName write FBIOSName stored false;
  49.     property CapsLock: Boolean read FCapsLock write FCapsLock stored false;
  50.     property NumLock: Boolean read FNumLock write FNumLock stored false;
  51.     property ScrollLock: Boolean read FScrollLock write FScrollLock stored false;
  52.     property Computer: string read FComp Write FComp stored False;
  53.   end;
  54.  
  55. implementation
  56.  
  57. uses
  58.   Registry, MiTeC_Routines;
  59.  
  60. { TMachine }
  61.  
  62. function TMachine.GetSystemUpTime: Extended;
  63. begin
  64.   try
  65.     FSystemUpTime:=GetTickCount/1000;
  66.   except
  67.     FSystemUpTime:=0;
  68.   end;
  69.   result:=FSystemUpTime;
  70. end;
  71.  
  72. procedure TMachine.GetInfo;
  73. var
  74.   bdata :pchar;
  75.   KeyState : TKeyBoardState;
  76.   sl: TStrings;
  77. const
  78.   cBIOSName = $FE061;
  79.   cBIOSDate = $FFFF5;
  80.   cBIOSExtInfo = $FEC71;
  81.   cBIOSCopyright = $FE091;
  82.  
  83.   rkBIOS = {HKEY_LOCAL_MACHINE\}'HARDWARE\DESCRIPTION\System';
  84.     rvBiosDate = 'SystemBiosDate';
  85.     rvBiosID = 'Identifier';
  86.     rvBiosVersion = 'SystemBiosVersion';
  87.  
  88.   rvComputerClass = 'Computer';
  89.  
  90. begin
  91.   try
  92.  
  93.   sl:=TStringList.Create;
  94.   try
  95.     FLastBoot:=Now-(GetTickCount/1000)/(24*3600);
  96.   except
  97.     FLastBoot:=0;
  98.   end;
  99.   FSystemUpTime:=GetSystemUpTime;
  100.   FName:=GetMachine;
  101.   FUser:=GetUser;
  102.   if isNT then begin
  103.     with TRegistry.Create do begin
  104.       rootkey:=HKEY_LOCAL_MACHINE;
  105.       if OpenKey(rkBIOS,false) then begin
  106.         if ValueExists(rvBIOSID) then
  107.           FBiosName:=ReadString(rvBIOSID);
  108.         if ValueExists(rvBIOSVersion) then begin
  109.           bdata:=AllocMem(255);
  110.           try
  111.             readbinarydata(rvBIOSVersion,bdata^,255);
  112.             FBIOSCopyright:=strpas(pchar(bdata));
  113.           except
  114.           end;
  115.           FreeMem(bdata);
  116.         end;
  117.         if ValueExists(rvBIOSDate) then
  118.           FBIOSDate:=ReadString(rvBIOSDate);
  119.         closekey;
  120.       end;
  121.       free;
  122.     end;
  123.   end else begin
  124.     FBIOSName:=string(pchar(ptr(cBIOSName)));
  125.     FBIOSDate:=string(pchar(ptr(cBIOSDate)));
  126.     FBIOSCopyright:=string(pchar(ptr(cBIOSCopyright)));
  127.     FBIOSExtendedInfo:=string(pchar(ptr(cBIOSExtInfo)));
  128.   end;
  129.   GetKeyboardState(KeyState);
  130.   FCapsLock:=KeyState[VK_CAPITAL]=1;
  131.   FNumLock:=KeyState[VK_NUMLOCK]=1;
  132.   FScrollLock:=KeyState[VK_SCROLL]=1;
  133.   GetClassDevices(ClassKey,rvComputerClass,DescValue,sl);
  134.   if sl.Count>0 then
  135.     FComp:=sl[0]
  136.   else
  137.     FComp:='';
  138.   sl.Free;
  139.  
  140.   except
  141.     on e:Exception do begin
  142.       MessageBox(0,PChar(e.message),'TMachine.GetInfo',MB_OK or MB_ICONERROR);
  143.     end;
  144.   end;
  145. end;
  146.  
  147.  
  148. procedure TMachine.Report(var sl: TStringList);
  149. begin
  150.   with sl do begin
  151.     Add('[Machine]');
  152.     Add(Format('Name=%s',[Name]));
  153.     Add(Format('User=%s',[User]));
  154.     Add(Format('BIOS name=%s',[BIOSName]));
  155.     Add(Format('BIOS Copyright=%s',[BIOSCopyright]));
  156.     Add(Format('BIOS Date=%s',[BIOSDate]));
  157.     Add(Format('BIOS Extended info=%s',[BIOSExtendedInfo]));
  158.     Add(Format('Last Boot=%s',[DateTimeToStr(LastBoot)]));
  159.     Add(Format('System Up Time=%s',[FormatSeconds(SystemUpTime,true,false,false)]));
  160.     Add(Format('Computer=%s',[Computer]));
  161.   end;
  162. end;
  163.  
  164. end.
  165.