procedure SetDecimalSeparator(Ch: Char);
var
  DefLCID: LCID;
  Buffer: LPSTR;
begin
   Application.UpdateFormatSettings := True;
   StrPCopy(Buffer, Ch);
   DefLCID := GetThreadLocale;
   if SetLocaleInfo(DefLCID, LOCALE_SDECIMAL, Buffer) then
      DecimalSeparator := StrPas(Buffer)[1];
   Application.UpdateFormatSettings := False;
end;

// Или немного иначе
// procedure SetDecimalSeparator(Ch: TDecimalSeparator);
// var
//   DefLCID: LCID;
//   Buffer: LPTSTR;
//   OldUFS: Boolean;
// begin
//    OldUFS := Application.UpdateFormatSettings;
//    if not OldUFS then
//       Application.UpdateFormatSettings := True;
//  
//    GetMem(Buffer, 1);
//    StrPCopy(Buffer, Ch[1]);
//    DefLCID := GetThreadLocale;
//    if SetLocaleInfo(DefLCID, LOCALE_SDECIMAL, Buffer) then
//       FormatSettings.DecimalSeparator := StrPas(Buffer)[1];
//    FreeMem(Buffer);
//  
//    if not OldUFS then
//       Application.UpdateFormatSettings := False;
// end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   SetDecimalSeparator('.');
   SendNotifyMessage(HWND_BROADCAST, WM_WININICHANGE, SPI_SETNONCLIENTMETRICS, 0);
end;

// Способ первый
procedure GetWindowsScreen( PathToSave: string );
begin
   with TBitmap.Create do
   begin
      Width := Screen.Width;
      Height := Screen.Height;
      BitBlt( Canvas.Handle, 0, 0, Width, Height, GetDC( GetDesktopWindow ), 0, 0, SRCCOPY );
      SaveToFile( PathToSave );
      Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   GetWindowsScreen( 'C:\Screen.bmp' );
end;

// Способ второй
procedure GetScreenShot;
var
  DC: HDC;
  Bmp: TBitmap;
  C: TCanvas;
begin
   DC := GetDC( 0 );
   if DC <= 0 then
   begin
      ShowMessage( 'Invalid DC!!!' );
      Exit;
   end;
   Bmp := TBitmap.Create;
   C := TCanvas.Create;
   try
      C.Handle := DC;
      Bmp.Width := Screen.Width;
      Bmp.Height := Screen.Height;
      Bmp.Canvas.CopyRect( Screen.DesktopRect, C, Screen.DesktopRect );
      Bmp.SaveToFile( 'c:\shot.bmp' );
   finally
      Bmp.Free;
      C.Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   GetScreenShot;
end;

// Способ третий
// Константа CAPTUREBLT позволяет включить полупрозрачные окна в скриншот.
// Эта константа не определена в модулях Delphi. Использовать ее можно
// только в системах Windows 98/Me, Windows 2000/XP и более новых.
procedure CaptureScreen( ABitmap: TBitmap );
const
  CAPTUREBLT = $40000000;
var
  hdcScreen: HDC;
  hdcCompatible: HDC;
  hbmScreen: HBITMAP;
begin
   // Create a normal DC and a memory DC for the entire screen. The
   // normal DC provides a "snapshot" of the screen contents. The
   // memory DC keeps a copy of this "snapshot" in the associated
   // bitmap.

   hdcScreen := CreateDC( 'DISPLAY', nil, nil, nil );
   hdcCompatible := CreateCompatibleDC( hdcScreen );
   // Create a compatible bitmap for hdcScreen.

   hbmScreen := CreateCompatibleBitmap( hdcScreen,
                                        GetDeviceCaps( hdcScreen, HORZRES ),
                                        GetDeviceCaps( hdcScreen, VERTRES ) );

   // Select the bitmaps into the compatible DC.
   SelectObject( hdcCompatible, hbmScreen );
   ABitmap.Handle := hbmScreen;
   BitBlt( hdcCompatible, 0, 0, ABitmap.Width, ABitmap.Height,
           hdcScreen, 0, 0, SRCCOPY or CAPTUREBLT );

   DeleteDC( hdcScreen );
   DeleteDC( hdcCompatible );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
   Bmp := TBitmap.Create;
   CaptureScreen( Bmp );
   Bmp.SaveToFile( 'c:\shot.bmp' );
   Bmp.Free;
end;

const
   WM_THEMECHANGED = $031A;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMTHEMECHANGED( var Msg: TMessage ); message WM_THEMECHANGED;
  end;

{...}

implementation

{...}

procedure TForm1.WMTHEMECHANGED(var Msg: TMessage);
begin
   Caption := 'Theme changed';
   Msg.Result := 0;
end;

uses
   {...,} ComObj, SyncObjs;

var
  GetCurrentThemeName: function( pszThemeFileName: LPWSTR; cchMaxNameChars: Integer;
                                 pszColorBuff: LPWSTR; cchMaxColorChars: Integer;
                                 pszSizeBuff: LPWSTR; cchMaxSizeChars: Integer ): HRESULT; stdcall;

{...}

implementation

{...}

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName, ColorScheme, SizeName: WideString;
  hThemeLib: THandle;
begin
   try
      hThemeLib := LoadLibrary( 'uxtheme.dll' );
      if hThemeLib > 0 then
         GetCurrentThemeName := GetProcAddress( hThemeLib, 'GetCurrentThemeName' );
      if Assigned( GetCurrentThemeName ) then
      begin
         SetLength( FileName, 255 );
         SetLength( ColorScheme, 255 );
         SetLength( SizeName, 255 );
         OleCheck( GetCurrentThemeName( PWideChar( FileName), 255,
                                        PWideChar( ColorScheme ), 255,
                                        PWideChar( SizeName ), 255 ) );
         ShowMessage( PWideChar( FileName ) );
         ShowMessage( PWideChar( ColorScheme ) );
         ShowMessage( PWideChar( SizeName ) );
      end;
   finally
      FreeLibrary( hThemeLib );
   end;
end;

// Способ первый
// Windows Aero должен быть включен
procedure TForm1.Button1Click(Sender: TObject);
const
  APPCOMMAND_DWM_FLIP3D = $360000;
begin
   SendMessage( Handle, WM_APPCOMMAND, Handle, APPCOMMAND_DWM_FLIP3D );
end;

// Способ второй
// Windows Aero должен быть включен
{...,} ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShellExecute( Handle, 'open', 'shell:::{3080F90E-D7AD-11D9-BD98-0000947B0257}', nil, nil, SW_SHOW );
end;

// Или немного иначе
{...,} shellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var
  lpExecInfo: PShellExecuteInfoW;
begin
   New( lpExecInfo );
   lpExecInfo^.cbSize := SizeOf( TShellExecuteInfoW );
   lpExecInfo^.lpFile := 'shell:::{3080F90E-D7AD-11D9-BD98-0000947B0257}';
   lpExecInfo^.nShow := SW_NORMAL;
   ShellExecuteEx( lpExecInfo );
   Dispose( lpExecInfo );
end;

// Способ первый
type
  PTokenUser = ^TTokenUser;
  TTokenUser = packed record
    User: TSidAndAttributes;
  end;

const
  HEAP_ZERO_MEMORY = $00000008;
  SID_REVISION = 1; // Current revision level

{...}

implementation

{...}

function ConvertSid( Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD ): BOOL;
var
  psia: PSIDIdentifierAuthority;
  dwSubAuthorities: DWORD;
  dwSidRev: DWORD;
  dwCounter: DWORD;
  dwSidSize: DWORD;
begin
   Result := false;
   dwSidRev := SID_REVISION;
   if not IsValidSid( Sid ) then Exit;
   psia := GetSidIdentifierAuthority( Sid );
   dwSubAuthorities := GetSidSubAuthorityCount( Sid )^;
   dwSidSize := ( 15 + 12 + ( 12 * dwSubAuthorities ) + 1 ) * SizeOf( Char );

   if ( dwBufferLen < dwSidSize ) then
   begin
      dwBufferLen := dwSidSize;
      SetLastError( ERROR_INSUFFICIENT_BUFFER );
      Exit;
   end;

   StrFmt( pszSidText, 'S-%u-', [dwSidRev] );

   if ( psia.Value[0] <> 0 ) or ( psia.Value[1] <> 0 ) then
      StrFmt( pszSidText + StrLen( pszSidText ),
              '0x%.2x%.2x%.2x%.2x%.2x%.2x',
              [psia.Value[0], psia.Value[1], psia.Value[2],
              psia.Value[3], psia.Value[4], psia.Value[5]] )
   else
      StrFmt( pszSidText + StrLen( pszSidText ), '%u', [DWORD( psia.Value[5] ) +
              DWORD( psia.Value[4] shl 8 ) + DWORD( psia.Value[3] shl 16 ) +
              DWORD(psia.Value[2] shl 24)] );

   dwSidSize := StrLen(pszSidText);

   for dwCounter := 0 to dwSubAuthorities-1 do
   begin
      StrFmt( pszSidText + dwSidSize, '-%u', [GetSidSubAuthority( Sid, dwCounter )^] );
      dwSidSize := StrLen( pszSidText );
   end;

   Result := true;
end;

function ObtainTextSid( hToken: THandle; pszSid: PChar;
  var dwBufferLen: DWORD ): BOOL;
var
  dwReturnLength: DWORD;
  dwTokenUserLength: DWORD;
  tic: TTokenInformationClass;
  ptu: Pointer;
begin
   Result := false;
   dwReturnLength := 0;
   dwTokenUserLength := 0;
   tic := TokenUser;
   ptu := nil;

   if not GetTokenInformation( hToken, tic, ptu, dwTokenUserLength, dwReturnLength ) then
   begin
      if GetLastError = ERROR_INSUFFICIENT_BUFFER then
      begin
         ptu := HeapAlloc( GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength );
         if ptu = nil then Exit;
         dwTokenUserLength := dwReturnLength;
         dwReturnLength    := 0;

         if not GetTokenInformation( hToken, tic, ptu, dwTokenUserLength, dwReturnLength ) then Exit;
      end
      else
         Exit;
   end;

   if not ConvertSid( ( PTokenUser( ptu ).User ).Sid, pszSid, dwBufferLen ) then Exit;
   if not HeapFree( GetProcessHeap, 0, ptu ) then Exit;
   Result := true;
end;

function GetCurrentUserSid: string;
var
  hAccessToken: THandle;
  bSuccess: BOOL;
  dwBufferLen: DWORD;
  szSid: array[0..260] of Char;
begin
   Result := '';

   bSuccess := OpenThreadToken( GetCurrentThread, TOKEN_QUERY, true, hAccessToken );
   if not bSuccess then
   begin
      if GetLastError = ERROR_NO_TOKEN then
         bSuccess := OpenProcessToken( GetCurrentProcess, TOKEN_QUERY, hAccessToken );
   end;
   if bSuccess then
   begin
      ZeroMemory( @szSid, SizeOf( szSid ) );
      dwBufferLen := SizeOf( szSid );

      if ObtainTextSid( hAccessToken, szSid, dwBufferLen ) then
         Result := szSid;
      CloseHandle( hAccessToken );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetCurrentUserSid );
end;

// Способ второй
// Получение имени пользователя
function GettingUserName: string;
var
  Size: cardinal;
  pStr: PChar;
  Res: boolean;
begin
   pStr := nil;
   Size := MAX_COMPUTERNAME_LENGTH + 1;
   try
      pStr := StrAlloc( Size );
      Res := GetUserName( pStr, Size );
      if Res then
         Result := StrPas( pStr )
      else
         Result := '';
   finally
      if pStr <> nil then StrDispose( pStr );
   end;
end;

// Получение имени компьютера
function GettingComputerName: string;
var
  Size: cardinal;
  pStr: PChar;
  Res: boolean;
begin
   pStr := nil;
   Size := MAX_COMPUTERNAME_LENGTH + 1;
   try
      pStr := StrAlloc( Size );
      Res := GetComputerName( pStr, Size );
      if Res then
         Result := StrPas( pStr )
      else
         Result := '';
   finally
      if pStr <> nil then StrDispose( pStr );
   end;
end;

function ConvertSIDToString( ASID: Pointer ): string;
var
  i: integer;
  SIDAuth: PSIDIdentifierAuthority;
  SIDSubAuth: Cardinal;
  SIDSubAuthCount: Byte;
begin
   Result := 'S-1-';
   SIDAuth := GetSidIdentifierAuthority( ASID );
   for i := 0 to 5 do
      if SIDAuth.Value[i] <> 0 then
         Result := Result+IntToStr( SIDAuth.Value[i] );
   SIDSubAuthCount := GetSidSubAuthorityCount( ASID )^;
   for i := 0 to SIDSubAuthCount-1 do
   begin
      SIDSubAuth := GetSidSubAuthority( ASID, i )^;
      Result := Result + '-' + IntToStr( SIDSubAuth );
   end;
end;

function GetSIDFromAccount( AMachine, AName: string ): string;
var
  SID: Pointer;
  szDomain: PChar;
  cbDomain, cbSID: Cardinal;
  SidLen, SubAuthCount, NameUse: Cardinal;
  Domain: string;
begin
   Result := '';
   cbDomain := 0;
   cbSID := 0;
   LookupAccountName( PChar( AMachine ), PChar( AName ), SID, cbSID,
                      szDomain, cbDomain, NameUse );
   szDomain := StrAlloc( cbDomain );
   SID := AllocMem( cbSID );
   if LookupAccountName( PChar( AMachine ), PChar( AName ), SID, cbSID,
                         szDomain, cbDomain, NameUse ) then
   begin
      Result := ConvertSIDToString( SID );
      SubAuthCount := GetSidSubAuthorityCount(SID)^;
      SidLen := GetLengthSid( SID );
      Domain := StrPas( szDomain );
   end;
   StrDispose( szDomain );
   Freemem( SID );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetSIDFromAccount( GettingComputerName, GettingUserName ) );
end;

// Способ третий
function ConvertSidToStringSid( Sid: PSID; var StringSid: PChar ): BOOL;
  stdcall; external advapi32 name 'ConvertSidToStringSidW';

function GetUserSIDStr( SystemName, AccountName: string ): string;
var
  PSID, PRef: Pointer;
  SIDSize, RefSize, peUse: Cardinal;
  sSID: PChar;
begin
   Result := '';
   SIDSize := 0;
   RefSize := 0;
   // Первый вызов функции позволяет получить необходимые размеры буферов
   // для SID и имени домена
   LookupAccountName( PChar( SystemName ), PChar( AccountName ), nil,
                      SIDSize, nil, RefSize, peUse );
   GetMem( PSID, SIDSize );
   GetMem( PRef, RefSize );
   try
      // Получаем SID учетной записи
      if not LookupAccountName( PChar( SystemName ), PChar( AccountName ), PSID,
                                SIDSize, PRef,RefSize,peUse ) then 
         RaiseLastOSError;
      // Конвертируем SID в строковое представление
      if ConvertSidToStringSid( PSID, sSID ) then
      begin
         SetLength( Result, StrLen( sSID ) );
         StrCopy(PChar(Result),sSID);
         LocalFree( Cardinal( sSID ) );
      end;
   finally
      FreeMem( PRef );
      FreeMem( PSID );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetUserSIDStr( '', 'system' ) );
end;

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( FindWindow( 'Progman', 'Program Manager' ) ) );
end;

// Способ второй
function GetShellWindow: HWND; stdcall; external 'user32.dll' name 'GetShellWindow';

implementation

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetShellWindow ) );
end;

uses
  {...,} AccCtrl, AclAPI;

function GetOSVersion: Cardinal;
var
  OSVersionInfo: TOSVersionInfo;
begin
   Result := 0;
   FillChar( OSVersionInfo, SizeOf( OSVersionInfo ), 0 );
   OSVersionInfo.dwOSVersionInfoSize := SizeOf( OSVersionInfo );
   if GetVersionEx( OSVersionInfo ) then
   begin
      if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
      begin
         if OSVersionInfo.dwMajorVersion = 5 then
         begin
            if OSVersionInfo.dwMinorVersion = 0 then
               Result := 50
            else if OSVersionInfo.dwMinorVersion = 2 then
               Result := 52
            else if OSVersionInfo.dwMinorVersion = 1 then
               Result := 51
         end;
         if OSVersionInfo.dwMajorVersion = 6 then
         begin
            if OSVersionInfo.dwMinorVersion = 0 then
               Result := 60
            else if OSVersionInfo.dwMinorVersion = 1 then
              Result := 61;
         end;
      end;
   end;
end;

function RunAsSystem( ApplicationName: String ): Boolean;
var
  lpStartupInfo: TStartupInfo;
  lpProcessInformation: TProcessInformation;
  ppSecurityDescriptor: PPSecurity_Descriptor;
  ppDacl: PACL;
  hProcess, hToken: Cardinal;
begin
   Result := false;
   if ( GetOSVersion > 50 ) and ( GetOSVersion < 60 ) then
      hProcess:= OpenProcess( PROCESS_QUERY_INFORMATION, false, 4 )
   else
      hProcess:= OpenProcess( PROCESS_QUERY_INFORMATION, false, 8 );
   if hProcess <> 0 then
   begin
      try
         OpenProcessToken( hProcess, MAXIMUM_ALLOWED, hToken );
         if hToken <> 0 then
         begin
            if GetSecurityInfo( hToken, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil, @ppDacl, nil, ppSecurityDescriptor ) = ERROR_SUCCESS then
            begin
               if SetSecurityInfo( hToken, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil, nil, nil ) = ERROR_SUCCESS then
               begin
                  CloseHandle( hToken );
                  OpenProcessToken( hProcess, MAXIMUM_ALLOWED, hToken );
                  if hToken <> 0 then
                  begin
                     try
                        if ImpersonateLoggedOnUser( hToken ) then
                        begin
                           ZeroMemory( @lpStartupInfo, SizeOf( lpStartupInfo ) );
                           lpStartupInfo.cb:= SizeOf( lpStartupInfo );
                           if CreateProcessAsUser( hToken, PChar( ApplicationName ), '', nil, nil, false, CREATE_DEFAULT_ERROR_MODE, nil, nil, lpStartupInfo, lpProcessInformation ) then
                              Result := true;
                           RevertToSelf;
                        end;
                        SetSecurityInfo( hToken, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil, ppDacl, nil );
                     finally
                        CloseHandle( hToken );
                     end;
                  end;
               end;
            end;
         end;
      finally
         CloseHandle( hProcess );
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   RunAsSystem( Edit1.Text );
end;

// Способ первый
uses
  Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
  ZoneName, tmp: string;
  UTC: Integer;
  InstallDate: DWORD;
  _date, _time: DWORD;
  t: TDateTime;
begin
   Reg := TRegistry.Create(KEY_READ or KEY_QUERY_VALUE or KEY_WOW64_64KEY);
   Reg.RootKey := HKEY_LOCAL_MACHINE;

   // Получение часового пояса
   if Reg.OpenKeyReadOnly( 'SYSTEM\CurrentControlSet\Control\TimeZoneInformation' ) then
   begin
      ZoneName := Reg.ReadString( 'TimeZoneKeyName' );
      Reg.CloseKey;
      if Reg.OpenKeyReadOnly( 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\' + ZoneName ) then
      begin
         tmp := Reg.ReadString( 'Display' );
         UTC := StrToInt( Copy( tmp, 5, 3 ) ); // Тут лучше использовать регулярное выражение
         Reg.CloseKey;
      end;
   end;

   // Определение даты установки Windows
   if Reg.OpenKeyReadOnly( 'SOFTWARE\Microsoft\Windows NT\CurrentVersion' ) then
   begin
      InstallDate := Reg.ReadInteger( 'InstallDate' );
      _date := InstallDate div 86400;
      _time := InstallDate mod 86400;
      t := {дата} EncodeDate( 1970, 1, 1 ) + _date +
          {время} EncodeTime( _time div 3600 + UTC, ( _time div 60 ) mod 60, _time mod 60, 0 );
      ShowMessage( DateTimeToStr( t ) );
   end;

   Reg.CloseKey;
   Reg.Free;
end;

// Способ второй
uses
  DateUtils;

function GetWindowsSetupDate: string;
const
  regpath = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion';
  ValueName = 'InstallDate';
var
  hSubKey: HKEY;
  BufSize: DWORD;
  Buf: DWORD;
  MyValType: DWORD;
begin
   if RegOpenKey(HKEY_LOCAL_MACHINE, regpath, hSubKey) = ERROR_SUCCESS then
      if RegQueryValueEx(hSubKey, ValueName, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
      begin
         if RegQueryValueEx(hSubKey, ValueName, nil, @MyValType, @Buf, @BufSize) = ERROR_SUCCESS then
            Result := DateTimeToStr(UnixToDateTime(Buf));
         // Еще нужно добавить смещение (UTC) от часового пояся (см. первый способ)
      end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(GetWindowsSetupDate);
end;

// Пример демонстрирует использование DDE, чтобы запустить диалоговое окно Проводника Windows для поиска файлов.
// Пример открывает поиск файлов в каталоге C:\Temp:

uses
  {...,} DdeMan;

procedure TForm1.Button1Click(Sender: TObject);
begin
   with TDDEClientConv.Create( Self ) do
   begin
      ConnectMode := ddeManual;
      ServiceApplication := 'explorer.exe';
      SetLink( 'Folders', 'AppProperties' ) ;
      OpenLink;
      ExecuteMacro( '[FindFolder(, C:\Temp)]', false );
      CloseLink;
      Free;
   end;
end;