{-----------------------------------------------------------------------------
                          ---> Project DelphiWorks <---
                                   Version 1.4.1
 -----------------------------------------------------------------------------
 Unit:        dwInternal.pas
 Description: DelphiWorks internal used functions
 Author:      Codehunter Works
 Release:     1.4.1
 State:       Unstable
 Created:     14.12.2002
 History:     20.06.2005, 13:34:51 - added dwiBrowseCallbackProc: callback routine for dwDialogs.dwShowFolderBrowserDialog
 				  20.06.2005, 13:42:16 - added dwiFolderBrowserInitialPath global init variable for dwiBrowseCallbackProc
              11.01.2006, 20:18:53 - added dwiGetImageFileHeaderShnapshot
-----------------------------------------------------------------------------}


unit dwInternal;                   

interface

uses dwFiles, dwTypes,
	  ActiveX, ShellAPI, ShlObj, SysUtils, Windows, Dialogs;
{-----------------------------------------------------------------------------
 Description: Functions for dwApplication
-----------------------------------------------------------------------------}
function dwiFlashApplicationGeneric(hWndOwner: HWND): Boolean;
function dwiFlashApplicationSpecific(hWndOwner: HWND; const Flags, FlashCount, TimeOut: DWord): Boolean;
function FlashWindowEx(var pfwi: FLASHWINFO): BOOL; stdcall;

{-----------------------------------------------------------------------------
 Description: Functions for dwDateTime
-----------------------------------------------------------------------------}
function dwiGetEasterDate(const Year: Word): TDateTime;
function dwiSundayBeforeDate(ADate: TDateTime): TDateTime;

{-----------------------------------------------------------------------------
 Description: Functions for dwDialogs
-----------------------------------------------------------------------------}
function dwiFormatDriveDlg(h: HWnd; lw, df, op: Word):
          longint stdcall; external 'Shell32.dll' name 'SHFormatDrive';

function SystemFocusDialog(hwndOwner: HWND; dwSelectionFlag: UINT;
  wszName: PWideChar; dwBufSize: DWORD; var bOKPressed: Boolean;
  wszHelpFile: PWideChar; dwContextHelpId: DWORD): DWORD; stdcall;
  external 'ntlanman.dll' Name 'I_SystemFocusDialog';

procedure RunFileDlgW(OwnerWnd: HWND; Icon: HICON; lpstrDirectory: PWideChar;
  lpstrTitle: PWideChar; lpstrDescription: PWideChar; Flags: Longint); stdcall;
  external 'Shell32.dll' Index 61;

procedure RunFileDlg(OwnerWnd: HWND; Icon: HICON; lpstrDirectory: PChar;
  lpstrTitle: PChar; lpstrDescription: PChar; Flags: Longint); stdcall;
  external 'Shell32.dll' Index 61;

function dwiShowRunFileDialog(OwnerWnd: HWND; InitialDir, Title, Description: PChar;
  flags: Integer; StandardCaptions: Boolean): Boolean;

function dwiOpenRecycleBin: Boolean;  

procedure dwiOpenCPL(const cpl: string);

procedure dwiFreePidl(pidl: Pointer);

function dwiSHAbout(hwndOwner: HWND; pszApp: PAnsiChar; lpszOther: PAnsiChar;
 hIcon: HICON): DWORD; stdcall; external 'Shell32.dll' name 'ShellAboutA';

var dwiFolderBrowserInitialPath: String;

function dwiBrowseCallbackProc(hWnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): lresult; stdcall;

{-----------------------------------------------------------------------------
 Description: Functions for dwFiles
-----------------------------------------------------------------------------}
function dwQueryCopyrightString(const EntryName, Translation: String; pInfoBuffer: Pointer): String;
function dwiReadCreateDateTime(const AFileName:TFilename; var AFileTime: TDateTime): Boolean;
procedure dwiReadDateTime(const AFilename:TFilename; var AFileDate: TDateTime);
function dwiWriteCreateDateTime(const AFileName:TFilename; AValue:TDateTime):Boolean;
function dwiWriteAge(const AFilename:TFilename; Age:TDateTime):Integer;

{-----------------------------------------------------------------------------
 Description: Functions for dwGraphics
-----------------------------------------------------------------------------}

function dwiGetImageFileHeaderShnapshot(AImageFile: TFilename; JPEG: Boolean = FALSE): String;

{-----------------------------------------------------------------------------
 Description: Functions for dwMedia
-----------------------------------------------------------------------------}
function dwInPort(PortAddr:word): byte; assembler; stdcall;

procedure dwNoSound;
procedure dwOutPort(PortAddr: word; Databyte: byte); assembler; stdcall;
procedure dwSound(Hz : Word);

{-----------------------------------------------------------------------------
 Description: Functions for dwMemory
-----------------------------------------------------------------------------}
function dwGetMemData: TMemoryStatus;

{-----------------------------------------------------------------------------
 Description: Functions for dwNetwork
-----------------------------------------------------------------------------}
function dwiNetUserChangePassword(Domain: PWideChar; UserName: PWideChar; OldPassword: PWideChar;
            NewPassword: PWideChar): Longint; stdcall; external 'netapi32.dll'
            Name 'NetUserChangePassword';

function NetUserEnum(ServerName: PWideChar;
   Level,
   Filter: DWORD;
   var Buffer: Pointer;
   PrefMaxLen: DWORD;
   var EntriesRead,
   TotalEntries,
   ResumeHandle: DWORD): Longword; stdcall; external 'netapi32.dll';

function NetApiBufferFree(pBuffer: PByte): Longint; stdcall; external
   'netapi32.dll';

function GetAdaptersInfo(const pAdapterInfo : PIP_ADAPTER_INFO;const pOutBufLen : PULONG) : DWORD; stdcall; external 'IPHLPAPI.DLL' name 'GetAdaptersInfo';    

{-----------------------------------------------------------------------------
 Description: Functions for dwRegistry
-----------------------------------------------------------------------------}
function dwiAutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                                  const AutorunOption:  TDWAutorunOption;
                                  const ValueName,
                                        CommandString:  String;
                                  const ProofCmdStr:    Boolean): Boolean;

function dwiLinkAPI(const Module, FunctionName: String): Pointer; forward;

{-----------------------------------------------------------------------------
 Description: Functions for dwScreens
-----------------------------------------------------------------------------}
//function EnumDisplaySettingsExA(lpszDeviceName: PChar; iModeNum: DWORD; var lpDevMode: _devicemodeA_0500; dwFlags: DWORD): LongBool; stdcall; external 'user32.dll';
function EnumDisplaySettingsExA(lpszDeviceName: LPCSTR; iModeNum: DWORD;
  var lpDevMode: TDWDevMode; dwFlags: DWORD): BOOL; //stdcall; external 'user32.dll';

function ChangeDisplaySettingsEx(lpszDeviceName: LPCSTR; lpDevMode: PDWDevMode;
  hwnd: HWND; dwflags: DWORD; lParam: Pointer): LongWord; stdcall;

function EnumDisplayDevices(lpDevice: LPCTSTR; iDevNum: DWord; var lpDisplayDevice: _DISPLAY_DEVICEA; dwFlags: DWord): BOOL;

procedure dwiMergeScreenModeToDevMode(var DevMode: TDWDevMode; const ScreenMode: TDWScreenMode);
procedure dwiScreenModeFromDevMode(var ScreenMode: TDWScreenMode; var DevMode: TDWDevMode);


{-----------------------------------------------------------------------------
 Description: Functions for dwWinSystem
-----------------------------------------------------------------------------}
function GetVersionEx(lpOs: pointer): BOOL; stdcall;
   external 'kernel32.dll' name 'GetVersionExA';

function dwiGetIEVersionString: String;

function dwiChangeWallpaperGeneric(const ImageFile: String; const WallpaperOpt: TDWWallpaperOpt): Boolean;
function dwiChangeWallpaperActiveDesktop(const ImageFile: String; const WallpaperOpt: TDWWallpaperOpt): Boolean;

procedure dwiGetIESuiteName(var VersionBlockEx: TDWVersionBlockEx);
procedure dwiVersionBlockExSetString(var VersionBlockEx: TDWVersionBlockEx);

implementation

uses dwConsts, dwLanguage, dwWinSystem,
     Classes, ComObj, Registry;

{-----------------------------------------------------------------------------
 Description: Functions for dwApplication
-----------------------------------------------------------------------------}
function FlashWindowEx; external user32 Name 'FlashWindowEx';

function dwiFlashApplicationGeneric(hWndOwner: HWND): Boolean;
begin
	result:= FlashWindow(hWndOwner, TRUE);
end;

function dwiFlashApplicationSpecific(hWndOwner: HWND; const Flags, FlashCount, TimeOut: DWord): Boolean;
var
	FWInfo: TFlashWInfo;
begin
	if not Assigned(@FlashWindowEx) then begin
   	result:= dwiFlashApplicationGeneric(hWndOwner);
    	exit;
  	end else begin
      with FWInfo do begin
         cbSize    := SizeOf(FWInfo);
         hWnd      := hWndOwner;
         dwFlags   := Flags;
         uCount    := FlashCount;
         dwTimeOut := TimeOut;
      end;
      result:= FlashWindowEx(FWInfo);
   end;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwDateTime
-----------------------------------------------------------------------------}
function dwiSundayBeforeDate(ADate: TDateTime): TDateTime;
//A: Toms | tom@swissdelphicenter.de
begin
   result:= ADate - 1;
   while DayOfWeek(result) <> 1 do result:= result - 1;
end;

function dwiGetEasterDate(const Year: Word): TDateTime;
//A: Benny Baumann | BenBE@firemail.de | http://www.swissdelphicenter.com/de/showcode.php?id=1278
var
   A, B, C, D, E, F, G, H, I, K, L, M, N, P: Word;
   DD, MM: Word;
begin
   a := Year mod 19;
   b := Year div 100;
   c := Year mod 100;
   d := b div 4;
   e := b mod 4;
   f := (b + 8) div 25;
   g := (b - f + 1) div 3;
   h := (19 * a + b - d - g + 15) mod 30;
   i := c div 4;
   k := c mod 4;
   l := (32 + 2 * e + 2 * i - h - k) mod 7;
   m := (a + 11 * h + 22 * l) div 451;
   n := (h + l - 7 * m + 114) div 31;
   p := (h + l - 7 * m + 114) mod 31 + 1;
   DD := p;
   MM := n;
   Result := EncodeDate(Year, MM, DD);
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwDialogs
-----------------------------------------------------------------------------}
procedure dwiOpenCPL(const cpl: string);
begin
   shellexecute(GetCurrentProcess,'open','rundll32.exe',
      pchar('shell32.dll,Control_RunDLL'+#32+cpl),nil,sw_shownormal);
end;

function dwiShowRunFileDialog(OwnerWnd: HWND; InitialDir, Title, Description: PChar;
  flags: Integer; StandardCaptions: Boolean): Boolean;
var
  TitleWideChar, InitialDirWideChar, DescriptionWideChar: PWideChar;
  Size: Integer;
begin
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and not StandardCaptions then
  begin
    Size := SizeOf(WideChar) * MAX_PATH;
{    InitialDirWideChar := nil;
    TitleWideChar := nil;
    DescriptionWideChar := nil;  }
    GetMem(InitialDirWideChar, Size);
    GetMem(TitleWideChar, Size);
    GetMem(DescriptionWideChar, Size);
    StringToWideChar(InitialDir, InitialDirWideChar, MAX_PATH);
    StringToWideChar(Title, TitleWideChar, MAX_PATH);
    StringToWideChar(Description, DescriptionWideChar, MAX_PATH);
    try
      RunFileDlgW(OwnerWnd, 0, InitialDirWideChar, TitleWideChar, DescriptionWideChar, Flags);
    finally
      FreeMem(InitialDirWideChar);
      FreeMem(TitleWideChar);
      FreeMem(DescriptionWideChar);
      result:= TRUE;
    end;
  end else
    try
    	RunFileDlg(OwnerWnd, 0, PChar(InitialDir), PChar(Title), PChar(Description), Flags);
    	result:= TRUE;
    finally
    end;
end;

function dwiOpenRecycleBin: Boolean;
var
  exInfo: TShellExecuteInfo;
begin
  FillChar(exInfo, SizeOf(exInfo), 0);
  with exInfo do
  begin
    cbSize := SizeOf(exInfo);
    fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_IDLIST;
    Wnd := 0;
    nShow := SW_SHOWNORMAL;
    lpVerb := 'open';
    ShGetSpecialFolderLocation(0, CSIDL_BITBUCKET, PItemIDLIst(lpIDList));
  end;
  result:= ShellExecuteEx(@exInfo);
  dwiFreePIDL(exinfo.lpIDList);
end;

procedure dwiFreePidl(pidl: Pointer);
var 
  allocator: IMalloc;
begin
  if Succeeded(shlobj.SHGetMalloc(allocator)) then 
  begin
    allocator.Free(pidl);
    {$IFDEF VER90}
    allocator.Release;
    {$ENDIF}
  end;
end;

function dwiBrowseCallbackProc(hWnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): lresult; stdcall;
begin
  if uMsg = BFFM_INITIALIZED then begin
    SendMessage(hWnd, BFFM_SETSELECTION, Ord(TRUE), lpData);
  end;
  result:= 0;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwFiles
-----------------------------------------------------------------------------}
function dwQueryCopyrightString(const EntryName, Translation: String; pInfoBuffer: Pointer): String;
var
  Buffer: Array[0..255] of Char;
  FuncSize: UINT;
  Ptr: Pointer;
begin
   result:= '';
   StrPCopy(Buffer, '\StringFileInfo\' + Translation + '\' + EntryName);
   if VerQueryValue(pInfoBuffer, Buffer, Ptr, FuncSize) then
     Result := StrPas(PChar(Ptr));
end;

function dwiReadCreateDateTime(const AFileName:TFilename; var AFileTime: TDateTime): Boolean;
var
  myHandle        : THandle;
  FindData      : TWin32FindData;
  LocalFileTime : TFileTime;
  DosFileTime   : Integer;
  R             : Boolean;
begin
  result:= FALSE;
  myHandle:=FindFirstFile(PChar(AFileName),FindData);
  if myHandle<>INVALID_HANDLE_VALUE then
  begin
    windows.FindClose(myHandle);
    R:=((FindData.dwFileAttributes and
          FILE_ATTRIBUTE_DIRECTORY)=0) and
          FileTimeToLocalFileTime(FindData.ftCreationTime,LocalFileTime) and
          FileTimeToDosDateTime(LocalFileTime,LongRec(DosFileTime).Hi,
                                LongRec(DosFileTime).Lo);
          AFileTime:= FileDateToDateTime(DosFileTime);
    result:= R;
  end;
end;

procedure dwiReadDateTime(const AFilename:TFilename; var AFileDate: TDateTime);
var
  i : Integer;
begin
  i:=FileAge(AFilename);
  AFileDate:= FileDateToDateTime(i);
end;

function dwiWriteCreateDateTime(const AFileName:TFilename; AValue:TDateTime):Boolean;
var
  myHandle        : THandle;
  LocalFileTime : TFileTime;
  FileTime      : TFileTime;
  DosFileTime   : Integer;
begin
  Result:=False;
  DosFileTime:=DateTimeToFileDate(AValue);
  if DosDateTimeToFileTime(LongRec(DosFileTime).Hi,
                           LongRec(DosFileTime).Lo,
                           LocalFileTime) and
     LocalFileTimeToFileTime(LocalFileTime,FileTime) then begin
     myHandle:=FileOpen(AFilename,fmOpenWrite);
     if (myHandle<>0) then begin
        Result:=SetFileTime(myHandle,@FileTime,Nil,Nil);
        FileClose(myHandle);
     end;
  end;
end;

function dwiWriteAge(const AFilename:TFilename; Age:TDateTime):Integer;
var
	R: Integer;
begin
  Result:=-1;
  R:=FileOpen(AFilename,fmOpenWrite);
  if R=-1 then Exit;
  try
    Result:=FileSetDate(R,DateTimeToFileDate(Age));
  finally
  FileClose(R);
  end;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwGraphics
-----------------------------------------------------------------------------}

function dwiGetImageFileHeaderShnapshot(AImageFile: TFilename; JPEG: Boolean = FALSE): String;
var
	FS: TFileStream;
   SS: TStringStream;
   Buffer: Array of Byte;
begin
	result:= '';
   if FileExists(AImageFile) and not dwFileIsOpen(AImageFile) then begin
	   FS:= TFileStream.Create(AImageFile, fmOpenRead);
      try
         if JPEG then FS.Seek(6, soFromBeginning);
         SS:= TStringStream.Create('');
         try
         	SS.CopyFrom(FS, 5);
            result:= SS.DataString;
         finally
         	SS.Free;
         end;
      finally
      	FS.Free;
      end;
   end;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwMedia
-----------------------------------------------------------------------------}
function dwInPort(PortAddr:word): byte; assembler; stdcall;
asm
   mov dx,PortAddr
   in al,dx
end;

procedure dwNoSound;
var
   TmpW : Word;
begin
   dwOutPort($43,182);
   TmpW := dwInPort($61);
   dwOutPort($61,TmpW and 3);
end;

procedure dwOutPort(PortAddr: word; Databyte: byte); assembler; stdcall;
asm
   mov al,Databyte
   mov dx,PortAddr
   out dx,al
end;

procedure dwSound(Hz : Word);
var TmpW : Word;
begin
   dwOutPort($43,182);
   TmpW:= dwInPort($61);
   dwOutPort($61,TmpW or 3);
   dwOutPort($42,lo(1193180 div hz));
   dwOutPort($42, hi(1193180 div hz));
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwMemory
-----------------------------------------------------------------------------}
function dwGetMemData: TMemoryStatus;
var
   MemStat: TMemoryStatus;
begin
   MemStat.dwLength:= SizeOf(MemStat);
   GlobalMemoryStatus(MemStat);
   result:= MemStat;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwRegistry
-----------------------------------------------------------------------------}
function dwiAutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
                                  const AutorunOption:  TDWAutorunOption;
                                  const ValueName,
                                        CommandString:  String;
                                  const ProofCmdStr:    Boolean): Boolean;
var
   bCanOpenKey,
   bValueExists,
   bCmdSame: Boolean;
   sOpenKey,
   sValue: String;
begin
   bCmdSame:= TRUE;
   bValueExists:= FALSE;
   with TRegistry.Create do begin
      case AutorunRootKey of
      dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
      dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
      end;
      case AutorunOption of
      dwaoRun:             sOpenKey:= sBaseKey + sRun;
      dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
      dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
      dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
      dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
      end;
      bCanOpenKey:= OpenKey(sOpenKey, FALSE);
      if bCanOpenKey then begin
         bValueExists:= ValueExists(ValueName);
         if bValueExists then begin
            sValue:= ReadString(ValueName);
            if ProofCmdStr then bCmdSame:= (sValue = CommandString);
         end;
      end;
      Free;
   end;
   result:= (bCanOpenKey and bValueExists and bCmdSame);
end;

function dwiLinkAPI(const Module, FunctionName: String): Pointer;
var
  hLib: HMODULE;
begin
  hLib := GetModulehandle(PChar(module));
  if hLib = 0 then
    hLib := LoadLibrary(PChar(module));
  if hLib <> 0 then
    Result := getProcAddress(hLib, PChar(functionname))
  else
    Result := nil;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwScreens
-----------------------------------------------------------------------------}
function EnumDisplaySettingsExA(lpszDeviceName: LPCSTR; iModeNum: DWORD;
  var lpDevMode: TDWDevMode; dwFlags: DWORD): BOOL;
type
	TdwiEnumDispaySettingsExA = function(lpszDeviceName: LPCSTR; iModeNum: DWORD;
  		var lpDevMode: TDWDevMode; dwFlags: DWORD): BOOL; stdcall;
var
	vEnumDisplaySettingsExA: TdwiEnumDispaySettingsExA;
   hEnumDisplaySettingsExA: THandle;
begin
	result:= FALSE;
	hEnumDisplaySettingsExA:= LoadLibrary('user32.dll');
   if hEnumDisplaySettingsExA <> 0 then begin
   	@vEnumDisplaySettingsExA:= GetProcAddress(hEnumDisplaySettingsExA,
                                                'EnumDisplaySettingsExA');
		if @vEnumDisplaySettingsExA <> NIL then begin
         result:= vEnumDisplaySettingsExA(lpszDeviceName,
                                          iModeNum,
                                          lpDevMode,
                                          dwFlags);
      end;
   end;
   FreeLibrary(hEnumDisplaySettingsExA);
end;

function EnumDisplayDevices(lpDevice: LPCTSTR; iDevNum: DWord;
			   var lpDisplayDevice: _DISPLAY_DEVICEA; dwFlags: DWord): BOOL;
type
	TdwiEnumDisplayDevicesA = function(lpDevice: LPCTSTR; iDevNum: DWord;
   	var lpDisplayDevice: _DISPLAY_DEVICEA; dwFlags: DWord): BOOL; stdcall;
var
	vEnumDisplayDevicesA: TdwiEnumDisplayDevicesA;
   hEnumDisplayDevicesA: THandle;
begin
	result:= FALSE;
   hEnumDisplayDevicesA:= LoadLibrary('user32.dll');
   if hEnumDisplayDevicesA <> 0 then begin
   	@vEnumDisplayDevicesA:= GetProcAddress(hEnumDisplayDevicesA,
      													'EnumDisplayDevicesA');
      if @vEnumDisplayDevicesA <> NIL then begin
      	result:= vEnumDisplayDevicesA(lpDevice,
         										iDevNum,
                                       lpDisplayDevice,
                                       dwFlags);
      end;
   end;
   FreeLibrary(hEnumDisplayDevicesA);
end;


function ChangeDisplaySettingsEx; external user32 name 'ChangeDisplaySettingsExA';

procedure dwiMergeScreenModeToDevMode(var DevMode: TDWDevMode; const ScreenMode: TDWScreenMode);
begin
	with DevMode, ScreenMode do begin
   	dmPelsWidth:= XResolution;
      dmPelsHeight:= YResolution;
      dmBitsPerPel:= BitDepth;
      dmDisplayFrequency:= Frequency;
      if Grayscale then
      	dmDisplayFlagsUnion.dmDisplayFlags:=
         	dmDisplayFlagsUnion.dmDisplayFlags and DM_GRAYSCALE;
      if Interlaced then
      	dmDisplayFlagsUnion.dmDisplayFlags:=
         	dmDisplayFlagsUnion.dmDisplayFlags and DM_INTERLACED;
      if dwIsWinXP then begin
         case Orientation of
            dwdo90Degrees: 	dmPaperUnion.dmDisplayOrientation:= DMDO_90;
            dwdo180Degrees: 	dmPaperUnion.dmDisplayOrientation:= DMDO_180;
            dwdo270Degrees: 	dmPaperUnion.dmDisplayOrientation:= DMDO_270;
            else				 	dmPaperUnion.dmDisplayOrientation:= DMDO_DEFAULT;
         end;
      end else dmPaperUnion.dmDisplayOrientation:= DMDO_DEFAULT;
   end;
end;

procedure dwiScreenModeFromDevMode(var ScreenMode: TDWScreenMode; var DevMode: TDWDevMode);
begin
      with ScreenMode do begin
         XResolution:= 	DevMode.dmPelsWidth;
         YResolution:= 	DevMode.dmPelsHeight;
         BitDepth:= 		DevMode.dmBitsPerPel;
         Frequency:= 	DevMode.dmDisplayFrequency;
         Grayscale:= 	((DevMode.dmDisplayFlagsUnion.dmDisplayFlags and
                       	  DM_GRAYSCALE) = DM_GRAYSCALE);
         Interlaced:= 	((DevMode.dmDisplayFlagsUnion.dmDisplayFlags and
                          DM_INTERLACED) = DM_INTERLACED);
         if not dwIsWinXP then begin
            if XResolution > YResolution then
             	Orientation:= dwdoPortrait else Orientation:= dwdoLandscape;
         end else begin
            case DevMode.dmPaperUnion.dmDisplayOrientation of
            DMDO_DEFAULT: Orientation:= dwdoDefault;
            DMDO_90:		  Orientation:= dwdo90Degrees;
            DMDO_180:	  Orientation:= dwdo180Degrees;
            DMDO_270:	  Orientation:= dwdo270Degrees;
            else			  Orientation:= dwdoDefault;
            end;
         end;

      end;
end;

{-----------------------------------------------------------------------------
 Description: Functions for dwWinSystem
-----------------------------------------------------------------------------}
function dwiGetIEVersionString: String;
const
   Keyn = '\Software\Microsoft\Internet Explorer\';
begin
   result:= '';
   with TRegistry.Create(KEY_READ) do begin
      RootKey:= HKEY_LOCAL_MACHINE;
      if OpenKey(Keyn, FALSE) then begin
         result:= ReadString('Version');
      end;
      Free;
   end;
end;

function dwiDWWPOptToWallPaperOpt(DWWPOpt: TDWWallpaperOpt): TWallPaperOpt;
begin
	with result do begin
   	dwSize:= SizeOf(TWallPaperOpt);
      case DWWPOpt of
      dwwpoCenter: 	dwStyle:= WPSTYLE_CENTER;
      dwwpoTile: 		dwStyle:= WPSTYLE_TILE;
      dwwpoStretch: 	dwStyle:= WPSTYLE_STRETCH;
      dwwpoMax: 		dwStyle:= WPSTYLE_MAX;
      else				dwStyle:= WPSTYLE_CENTER;
      end;
   end;
end;

function dwiDWWPOptToInt(DWWPOpt: TDWWallpaperOpt): Integer;
begin
	case DWWPOpt of
   dwwpoCenter: 	result:= 0;
   dwwpoTile:		result:= 1;
   dwwpoStretch:	result:= 2;
   else 				result:= 0;
   end;
end;
                               
function dwiChangeWallpaperGeneric(const ImageFile: String; const WallpaperOpt: TDWWallpaperOpt): Boolean;
var
  reg: TRegIniFile;
begin
  reg := TRegIniFile.Create('Control Panel\Desktop');
  try
    with reg do
    begin
//      WriteString('', 'Wallpaper', ImageFile);
      WriteInteger('', 'WallpaperStyle', dwiDWWPOptToInt(WallpaperOpt));
    end;
  finally
    reg.Free;
  end;
  result:= SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(ImageFile),
    									  SPIF_SENDWININICHANGE);
end;

function dwiChangeWallpaperActiveDesktop(const ImageFile: String; const WallpaperOpt: TDWWallpaperOpt): Boolean;
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  hObj: IUnknown;
  ADesktop: IActiveDesktop;
  wstr: PWideChar;
  pwpo: TWallPaperOpt;
begin
  result:= TRUE;
  hObj:= CreateComObject(CLSID_ActiveDesktop);
  ADesktop:= hObj as IActiveDesktop;
  wstr:= AllocMem(MAX_PATH);
  pwpo:= dwiDWWPOptToWallPaperOpt(WallpaperOpt);
  try
    StringToWideChar(ImageFile, wstr, MAX_PATH);
    result:= result and (ADesktop.SetWallpaperOptions(pwpo, 0) = S_OK);
    result:= result and (ADesktop.SetWallpaper(wstr, 0) = S_OK);
    result:= result and (ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE) = S_OK);
  finally
    FreeMem(wstr);
  end;
end;

procedure dwiGetIESuiteName(var VersionBlockEx: TDWVersionBlockEx);
begin
	with VersionBlockEx do begin
   	if AsString = '4.40.0308.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME1 else
   	if AsString = '4.40.0520.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME2 else
   	if AsString = '4.70.1155.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME3 else
   	if AsString = '4.70.1158.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME4 else
   	if AsString = '4.70.1215.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME5 else
   	if AsString = '4.70.1300.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME6 else
   	if AsString = '4.71.1008.0003' then VersionBlockEx.SuiteName:= DWLNG_IENAME7 else
   	if AsString = '4.71.1712.0005' then VersionBlockEx.SuiteName:= DWLNG_IENAME8 else
   	if AsString = '4.72.2106.0007' then VersionBlockEx.SuiteName:= DWLNG_IENAME9 else
   	if AsString = '4.72.3110.0003' then VersionBlockEx.SuiteName:= DWLNG_IENAME10 else
   	if AsString = '4.72.3612.1707' then VersionBlockEx.SuiteName:= DWLNG_IENAME11 else
   	if AsString = '4.72.3711.2900' then VersionBlockEx.SuiteName:= DWLNG_IENAME12 else
   	if AsString = '5.00.0518.0005' then VersionBlockEx.SuiteName:= DWLNG_IENAME13 else
   	if AsString = '5.00.0910.1308' then VersionBlockEx.SuiteName:= DWLNG_IENAME14 else
   	if AsString = '5.00.2014.0213' then VersionBlockEx.SuiteName:= DWLNG_IENAME15 else
   	if AsString = '5.00.2314.1000' then VersionBlockEx.SuiteName:= DWLNG_IENAME16 else
   	if AsString = '5.00.2516.1900' then VersionBlockEx.SuiteName:= DWLNG_IENAME17 else
   	if AsString = '5.00.2614.3500' then VersionBlockEx.SuiteName:= DWLNG_IENAME18 else
   	if AsString = '5.00.2717.2000' then VersionBlockEx.SuiteName:= DWLNG_IENAME19 else
   	if AsString = '5.00.2721.1400' then VersionBlockEx.SuiteName:= DWLNG_IENAME20 else
   	if AsString = '5.00.2723.2900' then VersionBlockEx.SuiteName:= DWLNG_IENAME21 else
   	if AsString = '5.00.2919.0800' then VersionBlockEx.SuiteName:= DWLNG_IENAME22 else
   	if AsString = '5.00.2919.3800' then VersionBlockEx.SuiteName:= DWLNG_IENAME23 else
   	if AsString = '5.00.2919.6307' then VersionBlockEx.SuiteName:= DWLNG_IENAME24 else
   	if AsString = '5.00.2919.6400' then VersionBlockEx.SuiteName:= DWLNG_IENAME25 else
   	if AsString = '5.00.2920.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME26 else
   	if AsString = '5.00.3103.1000' then VersionBlockEx.SuiteName:= DWLNG_IENAME27 else
   	if AsString = '5.00.3105.0106' then VersionBlockEx.SuiteName:= DWLNG_IENAME28 else
   	if AsString = '5.50.3825.1300' then VersionBlockEx.SuiteName:= DWLNG_IENAME29 else
   	if AsString = '5.50.4030.2400' then VersionBlockEx.SuiteName:= DWLNG_IENAME30 else
   	if AsString = '5.50.4134.0100' then VersionBlockEx.SuiteName:= DWLNG_IENAME31 else
   	if AsString = '5.50.4134.0600' then VersionBlockEx.SuiteName:= DWLNG_IENAME32 else
   	if AsString = '5.50.4308.2900' then VersionBlockEx.SuiteName:= DWLNG_IENAME33 else
   	if AsString = '5.50.4522.1800' then VersionBlockEx.SuiteName:= DWLNG_IENAME34 else
   	if AsString = '5.50.4807.2300' then VersionBlockEx.SuiteName:= DWLNG_IENAME35 else
   	if AsString = '6.00.2462.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME36 else
   	if AsString = '6.00.2479.0006' then VersionBlockEx.SuiteName:= DWLNG_IENAME37 else
   	if AsString = '6.00.2600.0000' then VersionBlockEx.SuiteName:= DWLNG_IENAME38 else
   	if AsString = '6.00.2800.1106' then VersionBlockEx.SuiteName:= DWLNG_IENAME39;
   end;
end;

procedure dwiVersionBlockExSetString(var VersionBlockEx: TDWVersionBlockEx);

	function MinZeroes(NumStr: String; MinLength: Integer): String;
   var
   	TempStr: String;
      I: Integer;
   begin
   	if Length(NumStr) < MinLength then begin
      	for I:= 1 to (MinLength - Length(NumStr)) do begin
         	TempStr:= TempStr + '0';
         end;
         result:= TempStr + NumStr;
      end else
      	result:= NumStr;
   end;

begin
	with VersionBlockEx do begin
		AsString:= IntToStr(dwVersionMajor) + '.' +
      			  MinZeroes(IntToStr(dwVersionMinor), 2) + '.' +
                 MinZeroes(IntToStr(dwBuildMajor), 4) + '.' +
                 MinZeroes(IntToStr(dwBuildMinor), 4);
   end;
end;

end.