home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Source / MSI_DirectX.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-24  |  4.5 KB  |  159 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               DirectX Detection Part                  }
  6. {           version 6.0 for Delphi 5,6                  }
  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 {$IFNDEF D6PLUS} write FVersion {$ENDIF} stored false;
  35.     property Direct3D :TStrings read FDirect3D {$IFNDEF D6PLUS} write FDirect3D {$ENDIF} stored false;
  36.     property DirectPlay :TStrings read FDirectPlay {$IFNDEF D6PLUS} write FDirectPlay {$ENDIF} stored false;
  37.     property DirectMusic :TStrings read FDirectMusic {$IFNDEF D6PLUS} write FDirectMusic {$ENDIF} 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.   with TRegistry.Create do begin
  79.     rootkey:=HKEY_LOCAL_MACHINE;
  80.     if OpenKey(rkDirectX,false) then begin
  81.       bdata:=stralloc(255);
  82.       if ValueExists(rvDXVersion95) then
  83.         FVersion:=ReadString(rvDXVersion95);
  84.       if FVersion='' then
  85.         if ValueExists(rvDXVersionNT) then
  86.           try
  87.             readbinarydata(rvDXVersionNT,bdata^,4);
  88.             FVersion:=inttostr(lo(integer(bdata^)))+'.'+inttostr(hi(integer(bdata^)));
  89.           except
  90.             {$IFDEF D4PLUS}
  91.             try
  92.               readbinarydata(rvDXVersionNT,bdata^,8);
  93.               FVersion:=inttostr(lo(integer(bdata^)))+'.'+inttostr(hi(integer(bdata^)));
  94.             except
  95.             end;
  96.             {$ENDIF}
  97.           end;
  98.       closekey;
  99.       strdispose(bdata);
  100.     end;
  101.     FDirect3D.Clear;
  102.     FDirectPlay.Clear;
  103.     FDirectMusic.Clear;
  104.     sl:=tstringlist.create;
  105.     if OpenKey(rkDirect3D,false) then begin
  106.       getkeynames(sl);
  107.       closekey;
  108.       for i:=0 to sl.count-1 do
  109.         if OpenKey(rkDirect3D+'\'+sl[i],false) then begin
  110.           if ValueExists(rvDesc) then
  111.             FDirect3D.Add(ReadString(rvDesc));
  112.           closekey;
  113.         end;
  114.     end;
  115.     if OpenKey(rkDirectPlay,false) then begin
  116.       getkeynames(sl);
  117.       closekey;
  118.       for i:=0 to sl.count-1 do
  119.         if OpenKey(rkDirectPlay+'\'+sl[i],false) then begin
  120.           if ValueExists(rvDesc) then
  121.             FDirectPlay.Add(ReadString(rvDesc));
  122.           closekey;
  123.         end;
  124.     end;
  125.     if OpenKey(rkDirectMusic,false) then begin
  126.       getkeynames(sl);
  127.       closekey;
  128.       for i:=0 to sl.count-1 do
  129.         if OpenKey(rkDirectMusic+'\'+sl[i],false) then begin
  130.           if ValueExists(rvDesc) then
  131.             FDirectMusic.Add(ReadString(rvDesc));
  132.           closekey;
  133.         end;
  134.     end;
  135.     sl.free;
  136.     free;
  137.   end;
  138. end;
  139.  
  140.  
  141. procedure TDirectX.Report(var sl: TStringList);
  142. begin
  143.   with sl do begin
  144.     Add('[DirectX]');
  145.     if Version<>'' then begin
  146.       Add(Format('Version=%s',[Version]));
  147.       Add('[Direct3D]');
  148.       StringsToRep(Direct3D,'Count','Device',sl);
  149.       Add('[DirectPlay]');
  150.       StringsToRep(DirectPlay,'Count','Device',sl);
  151.       Add('[DirectMusic]');
  152.       StringsToRep(DirectMusic,'Count','Device',sl);
  153.     end;
  154.   end;
  155. end;
  156.  
  157.  
  158. end.
  159.