home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_DirectX.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-21  |  4.5 KB  |  167 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               DirectX 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_DirectX;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TDirectX = class(TPersistent)
  23.   private
  24.     FVersion: string;
  25.     FDirect3D: TStrings;
  26.     FDirectPlay: TStrings;
  27.     FDirectMusic: TStrings;
  28.   public
  29.     constructor Create;
  30.     destructor Destroy; override;
  31.     procedure GetInfo;
  32.     procedure Report(var sl :TStringList);
  33.   published
  34.     property Version :string read FVersion write FVersion stored false;
  35.     property Direct3D :TStrings read FDirect3D write FDirect3D stored false;
  36.     property DirectPlay :TStrings read FDirectPlay write FDirectPlay stored false;
  37.     property DirectMusic :TStrings read FDirectMusic write FDirectMusic stored false;
  38.   end;
  39.  
  40.  
  41. implementation
  42.  
  43. uses
  44.   Registry, MiTeC_Routines;
  45.  
  46. { TDirectX }
  47.  
  48. constructor TDirectX.Create;
  49. begin
  50.   inherited;
  51.   FDirect3D:=TStringlist.Create;
  52.   FDirectPlay:=TStringlist.Create;
  53.   FDirectMusic:=TStringlist.Create;
  54. end;
  55.  
  56. destructor TDirectX.Destroy;
  57. begin
  58.   FDirect3D.Free;
  59.   FDirectPlay.Free;
  60.   FDirectMusic.Free;
  61.   inherited;
  62. end;
  63.  
  64. procedure TDirectX.GetInfo;
  65. var
  66.   bdata :pchar;
  67.   sl :tstringlist;
  68.   i :integer;
  69. const
  70.   rkDirectX = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\DirectX';
  71.     rvDXVersionNT = 'InstalledVersion';
  72.     rvDXVersion95 = 'Version';
  73.   rkDirect3D = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Direct3D\Drivers';
  74.   rkDirectPlay = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\DirectPlay\Services';
  75.   rkDirectMusic = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\DirectMusic\SoftwareSynths';
  76.     rvDesc = 'Description';
  77. begin
  78.   try
  79.  
  80.   with TRegistry.Create do begin
  81.     rootkey:=HKEY_LOCAL_MACHINE;
  82.     if OpenKey(rkDirectX,false) then begin
  83.       bdata:=stralloc(255);
  84.       if ValueExists(rvDXVersion95) then
  85.         FVersion:=ReadString(rvDXVersion95);
  86.       if FVersion='' then
  87.         if ValueExists(rvDXVersionNT) then
  88.           try
  89.             readbinarydata(rvDXVersionNT,bdata^,4);
  90.             FVersion:=inttostr(lo(integer(bdata^)))+'.'+inttostr(hi(integer(bdata^)));
  91.           except
  92.             {$IFDEF D4PLUS}
  93.             try
  94.               readbinarydata(rvDXVersionNT,bdata^,8);
  95.               FVersion:=inttostr(lo(integer(bdata^)))+'.'+inttostr(hi(integer(bdata^)));
  96.             except
  97.             end;
  98.             {$ENDIF}
  99.           end;
  100.       closekey;
  101.       strdispose(bdata);
  102.     end;
  103.     FDirect3D.Clear;
  104.     FDirectPlay.Clear;
  105.     FDirectMusic.Clear;
  106.     sl:=tstringlist.create;
  107.     if OpenKey(rkDirect3D,false) then begin
  108.       getkeynames(sl);
  109.       closekey;
  110.       for i:=0 to sl.count-1 do
  111.         if OpenKey(rkDirect3D+'\'+sl[i],false) then begin
  112.           if ValueExists(rvDesc) then
  113.             FDirect3D.Add(ReadString(rvDesc));
  114.           closekey;
  115.         end;
  116.     end;
  117.     if OpenKey(rkDirectPlay,false) then begin
  118.       getkeynames(sl);
  119.       closekey;
  120.       for i:=0 to sl.count-1 do
  121.         if OpenKey(rkDirectPlay+'\'+sl[i],false) then begin
  122.           if ValueExists(rvDesc) then
  123.             FDirectPlay.Add(ReadString(rvDesc));
  124.           closekey;
  125.         end;
  126.     end;
  127.     if OpenKey(rkDirectMusic,false) then begin
  128.       getkeynames(sl);
  129.       closekey;
  130.       for i:=0 to sl.count-1 do
  131.         if OpenKey(rkDirectMusic+'\'+sl[i],false) then begin
  132.           if ValueExists(rvDesc) then
  133.             FDirectMusic.Add(ReadString(rvDesc));
  134.           closekey;
  135.         end;
  136.     end;
  137.     sl.free;
  138.     free;
  139.   end;
  140.  
  141.   except
  142.     on e:Exception do begin
  143.       MessageBox(0,PChar(e.message),'TDirectX.GetInfo',MB_OK or MB_ICONERROR);
  144.     end;
  145.   end;
  146. end;
  147.  
  148.  
  149. procedure TDirectX.Report(var sl: TStringList);
  150. begin
  151.   with sl do begin
  152.     Add('[DirectX]');
  153.     if Version<>'' then begin
  154.       Add(Format('Version=%s',[Version]));
  155.       Add('[Direct3D]');
  156.       StringsToRep(Direct3D,'Count','Device',sl);
  157.       Add('[DirectPlay]');
  158.       StringsToRep(DirectPlay,'Count','Device',sl);
  159.       Add('[DirectMusic]');
  160.       StringsToRep(DirectMusic,'Count','Device',sl);
  161.     end;
  162.   end;
  163. end;
  164.  
  165.  
  166. end.
  167.