SRL Archive - Other Scripts

I got this idea from "WhatPulse".. It dosn't do anything special, Just records the keys you type, the clicks you do, the function keys you press and the f keys you press. After a certain amount of specified seconds it refreshes the results in the debug box.

Const
  Every = 5; // Refresh Progress Report Every .. Seconds?

var KeysPressed, TotalClicks, FKeys, Functions: integer;
    wStatus, Before: string;
    Pressed: array [1..255] of Integer;
    Clicked: array [1..2] of Integer;
    FKey: array [1..12] of Integer;
    FunctionK: array [0..8] of Integer;

procedure RenewStatus;
begin
 Before:= WStatus;
 WStatus:= '';
end;

function CorrectSq(c: char): string;
begin
 case c of
  chr(13), 13: result:= 'Enter';
  chr(32), 32: result:= 'Space';
  chr(8), 8: result:= 'Backspace';
 end;
  if Result <> '' then
    exit
  else
    result:= c;
end;

procedure WaitForKey(c: char);
begin
  WStatus:= WStatus + 'Last Pressed Key '+CorrectSq(c);
 while isKeyDown(c) do
   wait(1);
end;

function KeyDownWait: boolean;
var i: integer;
begin
 for i:= 1 to 255 do
  begin
   if isKeyDown(chr(i)) then
     begin
       RenewStatus;
       WaitForKey(chr(i));
      Pressed[i]:= Pressed[i] + 1;
      result:= True;
       break;
     end;
  end;
end;

procedure WaitForClick(Left: boolean);
var Click: string;
begin
 if Left then
  Click:= 'Left'
 else
  Click:= 'Right';
  WStatus:= WStatus + 'Last '+Click+' Clicked';
 while IsMouseButtonDown(Left) do
   wait(1);
end;

function ClickDownWait: boolean;
var i: integer;
    down: boolean;
begin
 for i:= 1 to 2 do
   begin
     if (i = 1) then
       down:= false
     else
       down:= true;
    if IsMouseButtonDown(down) then
      begin
        RenewStatus;
        WaitForClick(down);
       if (Down) then
         Clicked[1]:= Clicked[1] + 1
       else
         Clicked[2]:= Clicked[2] + 1;
       result:= true;
        exit;
      end;
   end;
end;

procedure WaitForF(f: Integer);
begin
  WStatus:= WStatus + 'Last Pressed F'+inttostr(f);
 while IsFKeyDown(f) do
   wait(1);
end;

function FKeyDownWait: boolean;
var i: Integer;
begin
 for i:= 1 to 12 do
   begin
     if IsFKeyDown(i) then
       begin
         RenewStatus;
         WaitForF(i);
        FKey[i]:= FKey[i] + 1;
        result:= true;
         exit;
       end;
   end;
end;

function CorrectFunSq(i: integer): string;
begin
 case i of
  3, 6: result:= 'Shift';
  4, 7: result:= 'Control';
  5, 8: result:= 'Alt';
 end;
  if Result <> '' then
    exit
  else
    Result:= 'Function ('+Inttostr(i)+')';
end;

procedure WaitForFunction(i: integer);
begin
  WStatus:= WStatus + 'Last Pressed '+CorrectFunSq(i);
 while IsFunctionKeyDown(i) do
   wait(1);
end;

function FunctionKeyDownWait: boolean;
var i: Integer;
begin
 for i:= 1 to 8 do
   begin
     if IsFunctionKeyDown(i) then
       begin
         RenewStatus;
         WaitForFunction(i);
        result:= true;
        FunctionK[i]:= FunctionK[i] + 1;
         exit;
       end;
   end;
end;

procedure StatusCheck;
begin
 if not(WStatus = Before) then
   Status(WStatus);
end;

procedure Process;
begin
 if KeyDownWait then
  KeysPressed:= KeysPressed + 1;
 if ClickDownWait then
  TotalClicks:= TotalClicks + 1;
 if FKeyDownWait then
  FKeys:= FKeys + 1;
 if FunctionKeyDownWait then
  Functions:= Functions + 1;
  StatusCheck;
end;

procedure Progress;
var i: integer;
begin
 for i:= 1 to 255 do
   begin
    if Pressed[i] > 0 then
       Writeln('Pressed "'+CorrectSq(Chr(i))+'", '+inttostr(Pressed[i])+' times.');
   end;
 for i:= 0 to 8 do
   begin
     if FunctionK[i] > 0 then
       Writeln('Pressed "'+CorrectFunSq(i)+'", '+inttostr(FunctionK[i])+' times.');
   end;
 for i:= 1 to 2 do
   begin
     if Clicked[i] > 0 then
       begin
         if i = 1 then
           Writeln('Clicked "Left", '+inttostr(Clicked[1])+' times.')
         else
           Writeln('Clicked "Right", '+inttostr(Clicked[2])+' times.');
       end;
     end;
  for i:= 1 to 12 do
    begin
      if FKey[i] > 0 then
        Writeln('Pressed "F'+inttostr(i)+'", '+inttostr(FKey[i])+' times.');
    end;
end;

procedure Reset;
var i: Integer;
begin
  for i:= 1 to 255 do
   Pressed[i] := 0;
  for i:= 0 to 8 do
   FunctionK[i]:= 0;
  for i:= 1 to 2 do
   Clicked[i]:= 0;
  for i:= 1 to 12 do
   FKey[i]:= 0;
end;

var Start: integer;
begin
  wStatus:= 'Began Counting..';
  Before:= wStatus;
  Start:= GetSystemTime;
   ClearDebug;
   Reset;
  GetApplication.MessageBox('Clicked OK To Start..', 'Alert!', 0);
 repeat
   Process;
  if (((GetSystemTime-Start)/1000) >= Every) then
    begin
      ClearDebug;
      Progress;
     Start:= GetSystemTime;
    end;
 until(False);
end.

:)

nice it works good!

From: mr. pali
nice it works good!

Thanx.

I was going to add Arrow Keys aswell, but i got to annoyed by repeating the same steps. ;p
And if it's only a 5 minute try script, then theirs no real use to it.

could you make it so that it say how the key is named? like: VK_Shift ?

Woah we done do year and 2 month bumps around here. For your question just type

KeyDown(VK_Shift);
Wait(100+Random(30));
KeyUp(VK_Shift):

Its not accurate. Like i hit " This "

This is what i got -

Pressed "h", 1 times.
Pressed "i", 1 times.
Pressed "s", 1 times.
Pressed "t", 1 times.
Successfully executed