function CapsMode(const S: AnsiString): AnsiString;
 var
   Keys: TKeyboardState;
   Vk: Word;
   i: Integer;
   Ch: DWORD;
 begin
   FillChar(Keys, SizeOf(Keys), 0);
   Keys[VK_SHIFT] := $80;
   SetLength(Result, Length(S));

   for i := 1 to Length(Result) do
     begin
     Vk := VkKeyScanA(S[i]);
     if Vk = $FFFF then RaiseLastOsError(ERROR_NO_UNICODE_TRANSLATION);

     if ToAscii(LoByte(Vk), 0, Keys, @Ch, 0) <> 1 then RaiseLastOsError(ERROR_NO_UNICODE_TRANSLATION);

     Result[i] := AnsiChar(Ch)
     end;
 end;