Как переключить CapsLock ?

program Project2;
 
{$APPTYPE CONSOLE}
{$R *.res}
 
uses
  System.SysUtils, windows, PSApi;
 
function MemoryUsage: DWORD;
var
  pmc: PROCESS_MEMORY_COUNTERS;
begin
  pmc.cb := sizeof(pmc);
  if GetProcessMemoryInfo(GetCurrentProcess, @pmc, sizeof(pmc)) then
    Result := pmc.WorkingSetSize + pmc.PagefileUsage
  else
    Result := $FFFFFFFF;
end;
 
const
  SizeArr = 1000000;
 
var
  Arr: Array of string;
 
  Usage, Usage2: DWORD;
 
function GetKB(Current: Byte): string;
begin
  case Current of
    0:
      Result := FloatToStr(Usage / 1024) + ' KB';
    1:
      Result := FloatToStr(Usage2 / 1024) + ' KB';
  else
    Result := FloatToStr((Usage2 - Usage) / 1024) + ' KB';
  end;
end;
 
procedure InitArr;
begin
  WriteLn('InitArr');
 
  Usage := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(0));
 
  SetLength(Arr, SizeArr);
 
  WriteLn('Successful selection');
 
  Usage2 := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(1));
 
  WriteLn('Difference in consumption: ' + GetKB(2));
 
  WriteLn('-----------------------------------');
end;
 
procedure FillingLines();
var
  i: Integer;
begin
  WriteLn('FillingLines');
 
  Usage := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(0));
 
  for i := Low(Arr) to High(Arr) do
  begin
    Arr[i] := '123456789012345678901234567890qwertyui' + IntToStr(i);
  end;
 
  WriteLn('Successful filling of lines');
 
  Usage2 := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(1));
 
  WriteLn('Difference in consumption: ' + GetKB(2));
 
  WriteLn('-----------------------------------');
end;
 
procedure FreeLines();
begin
  WriteLn('FreeLines');
 
  Usage := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(0));
 
  SetLength(Arr, 0);
 
  WriteLn('Successful free of lines');
 
  Usage2 := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(1));
 
  WriteLn('Received back : ' + GetKB(2));
 
  WriteLn('-----------------------------------');
 
  Usage := MemoryUsage;
 
  WriteLn('Current consumption: ' + GetKB(0));
end;
 
begin
  try
 
    InitArr;
    FillingLines();
    FreeLines();
  except
    on E: Exception do
      WriteLn(E.ClassName, ': ', E.Message);
  end;
  Readln;
 
end.