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;
  try
    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
      C.Free;
    end;
  finally
    Bmp.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);
  try
    hdcCompatible := CreateCompatibleDC(hdcScreen);
    // Create a compatible bitmap for hdcScreen.

    try
      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);
    finally
      DeleteDC(hdcCompatible);
    end;
  finally
    DeleteDC(hdcScreen);
  end;
end;

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

const
  WM_THEMECHANGED = $031A;

type
  TForm1 = class(TForm)
  public
    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 должен быть включен
uses
  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);
  try
    lpExecInfo^.cbSize := SizeOf(TShellExecuteInfoW);
    lpExecInfo^.lpFile := 'shell:::{3080F90E-D7AD-11D9-BD98-0000947B0257}';
    lpExecInfo^.nShow := SW_NORMAL;
    ShellExecuteEx(lpExecInfo);
  finally
    Dispose(lpExecInfo);
  end;
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);
  try
    SID := AllocMem(cbSID);
    try
      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;
    finally
      FreeMem(SID);
    end;
  finally
    StrDispose(szDomain);
  end;
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);
  try
    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);
    end;
  finally
    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
      else 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
            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;
    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);
  try
    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;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
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;