home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d56 / CMDXCAP.ZIP / DXCommon.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-11-26  |  3.6 KB  |  136 lines
  1. unit DXCommon;
  2.  
  3. interface
  4.  
  5. //{$DEFINE ERRORFUNCS}
  6.  
  7.  
  8. uses
  9.   Windows;
  10.  
  11. const
  12.   UnrecognizedError = 'Unrecognized Error';
  13.  
  14. type
  15. {$IFDEF UNICODE}
  16.   PCharAW = PWideChar;
  17. {$ELSE}
  18.   PCharAW = PAnsiChar;
  19. {$ENDIF}
  20.  
  21. function IsNTandDelphiRunning : boolean;
  22. function RegGetStringValue(Hive: HKEY; const KeyName, ValueName: string): string;
  23. function ExistFile(const FileName: string): Boolean;
  24.  
  25. {$IFDEF ERRORFUNCS}
  26. function DXErrorString(Error: HResult): string;
  27. function DXErrorMessage(Error: HResult): boolean;
  28. {$ENDIF}
  29.  
  30. implementation
  31.  
  32. {$IFDEF ERRORFUNCS}
  33. uses DirectInput8, DirectInput, DirectSound, DirectMusic, DirectPlay, DirectPlay8,
  34.      Direct3D, Direct3DRM, DirectDraw, DirectShow, DirectXGraphics,
  35.      Dialogs, SysUtils;
  36.  
  37. function DXErrorMessage(Error: HResult): boolean;
  38. begin
  39.   Result := FAILED(Error);
  40.   if Result then
  41.     MessageDlg(DXErrorString(Error), mtError, [mbAbort], 0);
  42. end;
  43.  
  44. function DXErrorString(Error: HResult): string;
  45. var Facility: DWORD;
  46. begin
  47.   Facility := (Error shr 16) and $7FFF;
  48.  
  49.   case Facility of
  50.     // Direct3D, DirectDraw
  51.     _FACD3D : if (Error and $FFFF) > D3DERR_WRONGTEXTUREFORMAT
  52.       then Result := DirectXGraphics.DXGErrorString(Error)
  53.       else Result := DirectDraw.DDErrorString(Error);
  54.  
  55.     // DirectMusic, DirectSound
  56.     _FACDS : if (Error and $FFFF) > DMUS_ERRBASE
  57.       then Result := DirectMusic.DMErrorString(Error)
  58.       else Result := DirectSound.DSErrorString(Error);
  59.  
  60.     // DirectPlay
  61.     _FACDPV : Result := DirectPlay8.DPErrorString(Error);
  62.     _FACDPV7: Result := DirectPlay.DPErrorString(Error);
  63.  
  64. //Definitions still to come
  65.     else case Error of
  66.       S_OK : Result := '';
  67.       S_FALSE : Result := '';
  68.       E_INVALIDARG : Result := '';
  69.       E_NOINTERFACE : Result := '';
  70.       E_FAIL : Result := '';
  71.       E_OUTOFMEMORY : Result := '';
  72.       E_NOTIMPL : Result := '';
  73.       E_ACCESSDENIED : Result := '';
  74.  
  75.       else Result := DirectInput.DIErrorString(Error);
  76.     end;
  77.   end;
  78. end;
  79. {$ENDIF}
  80.  
  81. function RegGetStringValue(Hive: HKEY; const KeyName, ValueName: string): string;
  82. var EnvKey  : HKEY;
  83.     Buf     : array[0..255] of char;
  84.     BufSize : DWord;
  85.     RegType : DWord;
  86.     rc      : DWord;
  87. begin
  88.   Result := '';
  89.   BufSize := Sizeof(Buf);
  90.   ZeroMemory(@Buf, BufSize);
  91.   RegType := REG_SZ;
  92.   try
  93.     if (RegOpenKeyEx(Hive, PChar(KeyName), 0, KEY_READ, EnvKey) = ERROR_SUCCESS) then
  94.     begin
  95.       try
  96.         if (ValueName = '') then rc := RegQueryValueEx(EnvKey, nil, nil, @RegType, @Buf, @BufSize)
  97.           else rc := RegQueryValueEx(EnvKey, PChar(ValueName), nil, @RegType, @Buf, @BufSize);
  98.         if rc = ERROR_SUCCESS then Result := string(Buf);
  99.       finally
  100.         RegCloseKey(EnvKey);
  101.       end;
  102.     end;
  103.   finally
  104.     RegCloseKey(Hive);
  105.   end;
  106. end;
  107.  
  108.  
  109. function ExistFile(const FileName: string): Boolean;
  110. var hFile: THandle;
  111. begin
  112.   hFile := CreateFile(PChar(FileName), 0, 0, nil, OPEN_EXISTING, 0, 0);
  113.   Result := hFile <> INVALID_HANDLE_VALUE;
  114.   if Result = true then CloseHandle(hFile);
  115. end;
  116.  
  117.  
  118. function IsNTandDelphiRunning : boolean;
  119. var
  120.   OSVersion  : TOSVersionInfo;
  121.   AppName    : array[0..255] of char;
  122. begin
  123.   OSVersion.dwOsVersionInfoSize := sizeof(OSVersion);
  124.   GetVersionEx(OSVersion);
  125.   // Not running in NT or program is not Delphi itself ?
  126.   AppName[0] := #0;
  127.   lstrcat(AppName, PChar(ParamStr(0)));  // ParamStr(0) = Application.ExeName
  128.   CharUpperBuff(AppName, SizeOf(AppName));
  129.   result := ( (OSVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) and
  130.               (Pos('DELPHI32.EXE', AppName) = Length(AppName) - Length('DELPHI32.EXE') + 1) );
  131. end;
  132.  
  133.  
  134. end.
  135.  
  136.