Rich
2009-07-06 11:07:39
Someone suggested this. What it does is get your average time to type a character, then types at that speed with itself and a bit more as randomness.
Functions:
New Text.scar:
Test script below. Just run it and see what it does.
How it used:
Just like TypeSendEx, except the first time it is called, it will ask for your average, then it will be remembered. I've tested it, and it now works fine. All you have to call is TypeSendExWait('Hello!', True, 1); Just to let you know, every 1 for AvAmount counts for two texts; one small, and one big. After the first time it is called, it does not matter what AvAmount is.
So as long as you've called SetupSRL, you'll be fine.
Thanks,
Richard
Functions:
{*******************************************************************************
function SetupTSEW(Amount : Integer) : Integer;
By: R1ch
Description: Prepares TypeSendExWait for use ~ gets average keystroke time.
*******************************************************************************}
procedure SetupTSEW(Amount : Integer);
var
TextsL, TextsB : TStringArray;
I, R, T, G, TL, Re : Integer;
begin
if (Avg <> 0) then Exit;
ClearDebug;
TextsL:= ['Hello', 'Dude', 'Sure', 'Name', 'SRL M', 'SCAR', 'Mean', 'Gets', 'Secs', 'Memb', 'Wizz', 'Zeph', 'Hobb', 'Why?', 'Sets', 'Levs', 'Type', 'Help'];
TextsB:= ['1234567890', 'qwertyuiop', 'How are you', 'Hello there', 'Getting average', 'SRL is great!', 'Milliseconds', 'Moderator', 'Runescape', 'Average', 'Wizzup?', 'SetupTSEW'];
if (ReadLn('I already know my average. Y/N') = LowerCase('y')) then
begin
Re:= StrToInt(ReadLn('Your average in milliseconds?'));
Avg:= RandomRange(Re - 5, Re + 5);
Alert('Your average is: ' + IntToStr(Avg) + ' milliseconds...');
Wait(1500);
Exit;
end;
if (Amount <= 0) then
begin
SRL_Warn('TypeSendExWait/SetupTSEW', 'Incorrect Amount: ' + IntToStr(Amount), warn_AllVersions);
TerminateScript;
end;
WriteLn('Type the texts below in the box STRAIGHT AWAY!');
Wait(2500);
WriteLn('Do not worry about upper and lower case');
Wait(2000);
ClearDebug;
for I:= 1 to Amount do
begin
R:= Random(High(TextsL));
WriteLn(TextsL[R]);
Wait(2000);
T:= GetSystemTime;
TL:= TL + (Length(ReadLn(TextsL[R])));
R:= Random(High(TextsB));
WriteLn(TextsB[R]);
Wait(2000);
TL:= TL + (Length(ReadLn(TextsB[R])));
G:= G + (GetSystemTime - T - 2000 - RandomRange((TL * 130), (TL * 205)));
Avg:= Round(G / TL);
if not(InRange(Avg, 20, 70)) then
Avg:= RandomRange(30, 60);
end;
Alert('Your average is: ' + IntToStr(Avg) + ' milliseconds');
Wait(2500);
Alert('Remember it!');
Wait(2500);
end;{*******************************************************************************
procedure TypeSendExWait(Text : string; PressEnter: Boolean; AvAmount : Integer);
By: R1ch
Description: Like TypeSendEx, but you set your own average keystroke time by
running it once. The first time it is called, it will get your
average, then remember it. AvAmount it amount of pairs of texts to
type to get the average. More = better
*******************************************************************************}
procedure TypeSendExWait(Text : string; PressEnter: Boolean; AvAmount : Integer);
var
S : string;
I, L, Av : Integer;
C : Byte;
Shift : Boolean;
begin
if (Avg = 0) then
begin
SetupTSEW(AvAmount);
Av:= Avg;
end;
S:= 'ABCDEFGHIJKLMNOPQRSTUVWXZ' + '~!@#$%^&*()_+{}|:"<>?';
L := Length(Text);
for I:= 1 to L do
begin
Shift:= (Pos(Text[i], S) > 0);
if(Shift)then
begin
KeyDown(VK_SHIFT);
Wait(Av + Random(Av + 3));
while(Pos(Text[i], S) > 0)and(I <= Length(Text))do
begin
C := GetKeyCode(StrGet(Text, I));
TypeByte(c);
Wait(Av + Random(Av + 3));
I:= I + 1;
if(I > Length(Text))then Break;
end;
end;
if(Shift)then
KeyUp(VK_SHIFT);
Wait(Av + Random(Av + 3));
if(I <= Length(Text))then
begin
C:= GetKeyCode(StrGet(Text, I));
TypeByte(C);
Wait(Av + Random(Av + 3));
end;
end;
If Not PressEnter Then Exit;
C := GetKeyCode(Chr(13));
TypeByte(C);
end;New Text.scar:
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ยป Text Routines --//
//-----------------------------------------------------------------//
// * function srl_Explode(str, del: string): TStringArray; // * by Mixster
// * function srl_Implode(Pieces: TStringArray; Separator: string): string; // * by ZephyrsFury
// * procedure TypeByte(k: Byte); // * by Mutant Squirrle
// * procedure TypeSendEx(Text: string; PressEnter: Boolean); // * by SKy Scripter
// * procedure TypeSend(Text: String); // * by N1ke!
// * function AddMistakes(Orig: string; Chance: Integer): string; // * by ZephyrsFury
// * function GetUpText: String; // * by Freddy1990
// * function IsUpText(UpText: String): Boolean; // * by Masquerader / Nielsie95 / Freddy1990
// * function IsUpTextMultiCustom(Text: TStringArray): Boolean; // * by Starblaster100 / Nielsie95 / Freddy1990
// * function GetLevelAtPos(x, y: Integer): integer; // * by marpis and Nava2
// * function FindNPCChatText(txt: string; Action: (ClickLeft,ClickRight,Move,Nothing)): Boolean; // * by Kernel Klink and Nielsie95
// * function FindText(var cx, cy: Integer; txt: String; font, xs, ys, xe, ye: Integer): Boolean; // * by Stupid3ooo
// * function ClickText(txt: String; font, x1, y1, x2, y2: Integer; left: Boolean): Boolean; // * by Stupid3ooo and SKy Scripter
// * Function LoadTextTPA(Text : String; Chars : Integer;var height : integer) : TPointArray; // * by Raymond
// * Function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean; // * by Raymond
// * Function FindTextTpa(Color,Tol,xs,ys,xe,ye : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean; // * by Raymond
// * function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean; // * by Wizzup?, Nava2, and modified by N1ke!
// * function ChooseOptionMulti(Text: TStringArray): Boolean; // * by Wizzup? modified by N1ke!
// * function ChooseOptionEx(Txt, TextType: String): Boolean; // * by Wizzup?, Nava2, and modified by N1ke!
// * function ChooseOption(txt: String): Boolean; // * by Stupid3ooo, modded by Sumilion
// * Function OptionsExist(txt: TStringArray; MoveMouse: boolean): boolean; // * by Rasta Magician
// * procedure CloseWindow; // * by Solemn Wishes, Starblaster100 and ZephyrsFury
// * Function InStrArrEx(S: String; StrArr: TStringArray; Var W: Integer): Boolean; // * by n3ss3s
// * function StrInArr(str: string; arrS: TStringArray): Boolean; // * by Narcle & Nava2
// * function ArrInStr(arrS: TStringArray; str: string): Boolean; // * by Narcle & Nava2
// * procedure SetDebugColors(Text, Back: Integer); // * by Nava2
// * procedure WriteArrayCols(Lines: TStringArray; Text, Back: Integer); // * by Nava2
{ var OldLine,TheLine, TheName: String;
Description: ChatLog vars. }
var
OldLine, TheLine, TheName : string;
Avg : Integer;
{ const clMessage, clChat, clTrade, clFriend
Description: Text colour constants. }
const
clMessage = clBlack;
clChat = clBlue;
clTrade = clPurple;
clFriend = 128;
function CloseBank: Boolean; Forward;
{*******************************************************************************
function srl_Explode(str, del: string): TStringArray;
By: mixster
Description: Explodes a string into a TStringArray, seperated by del.
*******************************************************************************}
function srl_Explode(str, del: string): TStringArray;
var
i, l: Integer;
begin
i := 0;
l := -1;
SetLength(Result, 0);
if (str = '') then
Exit;
repeat
Inc(l);
SetLength(Result, l + 1);
i := Pos(del, str);
if i <= 0 then
Break;
Result[l] := Copy(str, 1, i - 1);
Delete(str, 1, i + Length(del) - 1);
until false
Result[l] := Copy(str, 1, Length(str));
end;
{*******************************************************************************
function srl_Implode(Pieces: TStringArray; Separator: string): string;
By: ZephyrsFury
Description: Combines Pieces in a single string separated by a Separator.
*******************************************************************************}
function srl_Implode(Pieces: TStringArray; Glue: string): string;
var
II, H: Integer;
begin
H := High(Pieces);
if (H < 0) then Exit;
Result := Pieces[0];
if H > 0 then
for II := 1 to H do
Result := Result + Glue + Pieces[II];
end;
{*******************************************************************************
procedure TypeByte(k: Byte);
By: Mutant Squirrle
Description: Types one char.
*******************************************************************************}
procedure TypeByte(k: Byte);
begin
KeyDown(k);
Wait(10 + Random(50));
KeyUp(k);
end;
{*******************************************************************************
procedure TypeSendEx(Text: string; PressEnter: Boolean);
By: SKy Scripter
Description: Sends human like text.
*******************************************************************************}
procedure TypeSendEx(Text: string; PressEnter: Boolean);
var
S: string;
I, L: Integer;
C: Byte;
Shift: Boolean;
begin
S:= 'ABCDEFGHIJKLMNOPQRSTUVWXZ' + '~!@#$%^&*()_+{}|:"<>?';
L := Length(Text);
for I:= 1 to L do
begin
Shift:= (Pos(Text[i], S) > 0);
if(Shift)then
begin
KeyDown(VK_SHIFT) Wait(40 + Random(40));
while(Pos(Text[i], S) > 0)and(I <= Length(Text))do
begin
C := GetKeyCode(StrGet(Text, I));
TypeByte(c);
Wait(40 + Random(40));
I:= I + 1;
if(I > Length(Text))then Break;
end;
end;
if(Shift)then
KeyUp(VK_SHIFT);
Wait(40 + Random(40));
if(I <= Length(Text))then
begin
C:= GetKeyCode(StrGet(Text, I));
TypeByte(C);
Wait(40 + Random(40));
end;
end;
If Not PressEnter Then Exit;
C := GetKeyCode(Chr(13));
TypeByte(C);
end;
{*******************************************************************************
procedure TypeSend(Text: string);
By: N1ke!
Description: Sends human like text.
*******************************************************************************}
procedure TypeSend(Text: string);
begin
TypeSendEx(Text, True);
end;
{*******************************************************************************
function AddMistakes(Orig: string; Chance: Integer): string;
By: ZephyrsFury
Description: Adds human mistakes to Orig such as mistypes, missing letters,
wrong cases. Probability that a character is typed wrong is 1 / Chance. ie.
Higher 'Chance' = less mistakes (I know thats stupid but oh well...).
Probability is the chance that an individual character is typed incorrectly.
That is if you have more characters in a string you will get more mistakes overall.
20 - 30 is usually good but it varies depending on your string so experiment!
Use: TypeSend(AddMistakes('Hello', 20));
*******************************************************************************}
function AddMistakes(Orig: string; Chance: Integer): string;
var
Line1, Line2, Line: array [0..3] of string;
i, j, TPos, Prob, Mist, L: Integer;
Norm, Caps, Excp, TLine, NewKey: string;
begin
Norm := '`1234567890-=qwertyuiop[]\asdfghjkl;''zxcvbnm,./';
Caps := '~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:"ZXCVBNM<>?';
Excp := '`1234567890-=[]\;'',./~!@#$%^&*()_+{}|:"<>?';
Line1[0] := '`1234567890-= '; Line2[0] := '~!@#$%^&*()_+ ';
Line1[1] := ' qwertyuiop[]\'; Line2[1] := ' QWERTYUIOP{}|';
Line1[2] := ' asdfghjkl;'' '; Line2[2] := ' ASDFGHJKL:" ';
Line1[3] := ' zxcvbnm,./ '; Line2[3] := ' ZXCVBNM<>? ';
L := Length(Orig);
for i := 1 to L do
begin
Prob := Chance;
Prob := Prob + Mist; //More mistakes = less chance of another mistake
if (Pos(Orig[i], Excp) <> 0) then Prob := Prob - 2; //If char is hard to type (numbers/symbols) - more chance
if (i = 1) then Prob := Prob + 5; //The first letter - less chance
if (Orig[i] <> ' ') and (Random(Max(Prob, 0)) = 0) then
begin
if (Pos(Orig[i], Norm) <> 0) then
Line := Line1
else
if (Pos(Orig[i], Caps) <> 0) then
Line := Line2;
for j := 0 to 3 do
begin
TPos := Pos(Orig[i], Line[j]);
if (TPos <> 0) then
case Random(19) of
0..5: //Same line
begin
TLine := Line[j];
try
NewKey := TLine[TPos - 1 + Random(3)];
except end;
if (NewKey = '') or (NewKey = ' ') then
NewKey := TLine[TPos];
end;
6..8: //Line above
begin
TLine := Line[Max(j - 1, 0)]
try
NewKey := Line[j - 1][TPos + Random(2)];
except end;
if (NewKey = '') or (NewKey = ' ') then
NewKey := TLine[TPos];
end;
9..11: //Line below
begin
TLine := Line[Min(j + 1, High(Line))]
try
NewKey := TLine[TPos - 1 + Random(2)]; //Wrong case
except end;
if (NewKey = '') or (NewKey = ' ') then
NewKey := TLine[TPos];
end;
12..16:
begin
if (i - 1 >= 1) then
begin
if (Pos(Orig[i - 1], Caps) <> 0) then
NewKey := Line2[j][TPos]
else
if (Pos(Orig[i - 1], Norm) <> 0) then
NewKey := Line1[j][TPos]
end else
if (i + 1 <= Length(Orig)) then
begin
if (Pos(Orig[i + 1], Caps) <> 0) then
NewKey := Line2[j][TPos]
else
if (Pos(Orig[i + 1], Norm) <> 0) then
NewKey := Line1[j][TPos];
end;
end;
17, 18: if (i <> 1) then NewKey := ''; //Missing letters
end;
end;
end else
NewKey := Orig[i];
if (NewKey <> Orig[i]) then Inc(Mist);
Result := Result + NewKey;
end;
end;
{*******************************************************************************
function GetUpText: String;
By: Freddy1990
Description: Returns text in upperleft corner.
*******************************************************************************}
function GetUpText: string;
begin
Result := rs_GetUpText;
end;
{*******************************************************************************
function IsUpText(UpText: String): Boolean;
By: Freddy1990
Description: Returns up text that might be to the right
*******************************************************************************}
function IsUpText(UpText: string): Boolean;
begin
Result := (Pos(UpText, rs_GetUpText) > 0);
end;
{*******************************************************************************
function IsUpTextMultiCustom(Text: TStringArray): Boolean;
By: Starblaster100 / Nielsie95 / Freddy1990
Description: Checks for the occurance of any of the strings in the array.
Use: IsUpTextMultiCustom(['Att', 'ttac', 'ack', 'monst', 'ster'])
*******************************************************************************}
function IsUpTextMultiCustom(Text: TStringArray): Boolean;
var
TheText: string;
i, n: Integer;
begin
TheText := rs_GetUpText;
n := High(Text);
for i := 0 to n do
if (Pos(Text[i], TheText) <> 0) then
begin
Result := True;
Exit;
end;
end;
{*******************************************************************************
function GetLevelAtPos(x, y: Integer): integer;
By: marpis and Nava2
Description: Returns the level of the character at (x, y), uses uptext. Returns
-1 if none are found.
*******************************************************************************}
function GetLevelAtPos(x, y: Integer): integer;
begin
MMouse(x, y, 0, 0);
Wait(RandomRange(80, 150));
Result := StrToIntDef(Between('l: ', ')', rs_GetUpText), -1);
end;
{*******************************************************************************
function FindNPCChatText(txt: string; Action: (ClickLeft,ClickRight,Move,Nothing)): Boolean;
By: Kernel Klink and Nielsie95
Description: Finds a text said by a NPC in chat. If found it'll perform action,
where action can be:
Nothing - Just return wether its found
Move - Just move the mouse to it
Clickleft - Movemouse & Clickmouse left
Clickright - MoveMouse & Clickmouse right
*******************************************************************************}
function FindNPCChatText(txt: string; Action: fnct_ActionOptions): Boolean;
var
tx, ty, S: Integer;
begin
Result := False;
if txt = '' then
begin
srl_Warn('FindNPCChatText', 'txt is empty', warn_AllVersions);
Exit;
end;
S := CreateBitmapMaskFromText(txt, NPCChars);
if FindBitmapMaskTolerance(S, tx, ty, 9, 348, 523, 471, 50, 10) then
begin
Result := True;
case Action of
Move: MMouse(tx, ty + 2, Random(Length(txt) * 5), 4);
ClickLeft: Mouse(tx, ty + 2, Random(Length(txt) * 5), 4, True);
ClickRight: Mouse(tx, ty + 2, Random(Length(txt) * 5), 4, False);
end;
end;
FreeBitmap(S);
end;
{*******************************************************************************
function FindText(var cx, cy: Integer; txt: String; font, xs, ys, xe, ye: Integer): Boolean;
By: Stupid3ooo
Description: Searches for text in specified box with specified font.
*******************************************************************************}
function FindText(var cx, cy: Integer; txt: string; font, xs, ys, xe, ye:
Integer): Boolean; //by Stupid3ooo
var
S: Integer;
begin
S := CreateBitmapMaskFromText(txt, font);
if (xs < 0) then xs := 0;
if (ys < 0) then ys := 0;
Result := FindBitmapMaskTolerance(S, cx, cy, xs, ys, xe, ye, 30, 30);
FreeBitmap(S);
end;
{*******************************************************************************
function ClickText(Text: string; Chars, x1, y1, x2, y2: Integer; Left: Boolean): Boolean;
By: SKy Scripter
Description: Clicks text if found in box.
*******************************************************************************}
function ClickText(Text: string; Chars, x1, y1, x2, y2: Integer; Left: Boolean): Boolean;
var
Mask, w, h, tx, ty: Integer;
begin
try
Mask:= CreateBitmapMaskFromText(Text, Chars);
except
srl_Warn('ClickText', 'Invalid Character Names', warn_AllVersions);
Exit;
end;
Result:= FindBitmapMaskTolerance(Mask, tx, ty, x1, y1, x2, 502, 10, 10);
GetBitmapSize(Mask, W, H);
FreeBitmap(Mask);
if(Result)then
Mouse(TX + (W/4), TY + (H/4), (W/2), (H/2), Left);
end;
{*******************************************************************************
Function Function LoadTextTPA(Text : String; Chars : Integer;var height : integer) : TPointArray;
By: Raymond
Description: Loads a TPA of the text.. It also returns the real height
of the Text.. Used in FindTextTPAinTPA
*******************************************************************************}
Function LoadTextTPA(Text : String; Chars : Integer;var height : integer) : TPointArray;
var
DC : HDC;
CTS,w,h : INteger;
BMP : Integer;
begin;
BMP := CreateBitmapMaskFromText(Text,Chars);
DC := GetClientCanvas.Handle;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(0);
GetBitmapSize(BMP,W,H);
SetTargetDc(GetBitmapDc(BMP));
FindColorsTolerance(Result,clwhite,0,0,w+1,h+1,0);
height := h - 1;
SetTargetDC(DC);
ColorToleranceSpeed(CTS);
FreeBitmap(BMP);
end;
{*******************************************************************************
Function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean;
By: Raymond
Description: Uses TPA's to find text..Returns the found pos in x and y (if not found both are 0)
In action you can put what you want to do after its found..
Nothing - Just return wether its found
Move - Just move the mouse to it
Clickleft - Movemouse & Clickmouse left
Clickright - MoveMouse & Clickmouse right
*******************************************************************************}
Function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt : string; Chars : Integer; Action :fnct_ActionOptions ) : Boolean;
var
TextTPA,SearchTPA, Matches: TPointArray;
Box : TBox;
xx,yy : integer;
begin
FindColorsTolerance(SearchTPA,Color,xs,ys,xe,ye,tol);
if Length(SearchTPA) < 1 then
Exit;
TextTPA:= LoadTextTPA(Txt,Chars,yy);
Result := FindTextTPAinTPA(yy,TextTPA,SearchTPA,Matches);
x := 0; y:=0;
if Result = False then
Exit;
Box := GetTPABounds(TextTPA);
SortTPAFrom(Matches, Point(Box.x1, Box.y1));
x := matches[0].x;
y := matches[0].y;
if Action = Nothing then
Exit;
GetMousePos(xx,yy);
if not IntInBox(xx,yy,IntToBox(matches[0].x,matches[0].y,matches[0].x + Box.x2,Matches[0].y + (Box.y2 shr 1))) then
MMouse(matches[0].x + Random(box.x2),Matches[0].y + Random(Box.y2 shr 1),0,0);
if Action = Move then
Exit;
GetMousePos(xx,yy);
Case Action of
ClickLeft : Mouse(xx,yy,0,0,true);
ClickRight: Mouse(xx,yy,0,0,false);
end;
end;
{*******************************************************************************
Function FindTextTpa(Color,Tol,xs,ys,xe,ye : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean;
By: Raymond
Description: Just like FindTextTPAEx, but without the x and y pos returning.
*******************************************************************************}
Function FindTextTpa(Color,Tol,xs,ys,xe,ye : integer; Txt : string; Chars : Integer; Action :fnct_ActionOptions ) : Boolean;
var
x,y : integer;
begin
Result := FindTextTPAEx(Color,Tol,xs,ys,xe,ye,x,y,Txt,chars,action);
end;
{*******************************************************************************
function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean;
By: Wizzup?, Nava2, and N1ke!
Description: Finds Popup menu, then clicks on it.
Will look for the first string first and so on.
It will search for the Text Type you input valid arguments are
'action', 'player': The white text
'npc': The yellow text
'object': The cyan text
'all': Searches for all colors of text.
Will default to 'all'.
*******************************************************************************}
function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean;
var
B, T: TBox;
TPA, TextTPA: TPointArray;
aTPA: T2DPointArray;
I, C, H, HH, ii, L: Integer;
P: TPoint;
Occurances: array [0..4] of TPointArray;
Colors: TIntegerArray;
begin
Result := False;
GetClientDimensions(B.X2, B.Y2);
B.X1 := 0;
B.Y1 := 0;
FindColorsTolerance(TPA, 4674653, B.X1, B.Y1, B.X2, B.Y2, 0);
If Length(TPA) < 10 Then
Exit;
B.X2 := 0;
B.Y2 := 0;
P := TPA[0];
H := High(TPA);
Dec(H);
For I := 0 To H Do
If TPA[i].X = TPA[I+1].X - 1 Then
Begin
If C > 5 Then
Begin
B.X1 := P.X;
B.Y1 := P.Y;
Break;
End Else
C := C + 1;
End
Else
Begin
P := TPA[I + 1];
C := 0;
End;
If I = Length(TPA) Then
Begin
WriteLn('Choose Option Menu Getting Failed');
Exit;
End;
InvertTPA(TPA);
C := 0;
P := TPA[0];
H := High(TPA);
Dec(H);
For I := 0 To H Do
If TPA[i].X = TPA[I+1].X + 1 Then
Begin
If C > 5 Then
Begin
B.X2 := P.X;
B.Y2 := P.Y;
Break;
End Else
C := C + 1;
End Else
Begin
P := TPA[I + 1];
C := 0;
End;
If I = Length(TPA) Then
Begin
WriteLn('Choose Option Menu Getting Failed');
Exit;
End;
TPA := [];
Colors := [16777215, 4231423, 2070783, 65535, 16776960];
case LowerCase(TextType) of
'action', 'player': FindColorsTolerance(Occurances[0], Colors[0], B.x1, B.y1, B.x2, B.y2, 3);
'item' : begin
FindColorsTolerance(Occurances[1], Colors[1], B.x1, B.y1, B.x2, B.y2, 3);
FindColorsTolerance(Occurances[2], Colors[2], B.x1, B.y1, B.x2, B.y2, 3);
end;
'npc' : FindColorsTolerance(Occurances[3], Colors[3], B.x1, B.y1, B.x2, B.y2, 3);
'object': FindColorsTolerance(Occurances[4], Colors[4], B.x1, B.y1, B.x2, B.y2, 3);
else
begin
FindColorsTolerance(Occurances[0], 4674653, B.X1, B.Y1, B.X2, B.Y2, 0);
FindColorsTolerance(Occurances[1], clBlack, B.X1, B.Y1, B.X2, B.Y2, 0);
TPA := MergeATPA(Occurances);
ClearDoubleTPA(TPA);
TPA := ReturnPointsNotInTPA(TPA, B);
end;
end;
if High(TPA) < 1 then TPA := MergeATPA(Occurances);
aTPA := SplitTPAEx(TPA, 7, 1);
SortATPAFromFirstPoint(aTPA, Point(B.x1, B.y1));
H := High(Texts);
L := High(aTPA);
For I :=0 To H do
begin
TextTPA := LoadTextTPA(Texts[i], UpChars, HH);
for ii := 0 to L do
If FindTextTPAInTPA(HH, TextTPA, aTPA[ii], TPA) Then
Begin
T := GetTPABounds(TPA);
Result := True;
Case Action of
ClickLeft: MouseBox(B.x1 + 5, T.y1 + 2, B.x2 - 5, T.y2 - 2, 1);
Move: MouseBox(B.x1 + 5, T.y1 + 2, B.x2 - 5, T.y2 - 2, 3);
Nothing: begin end;
else
srl_warn('ChooseOptionMultiEx', 'ClickRight not a valid click for RS menus!', warn_AllVersions);
end;
Exit;
End;
end;
MMouse(B.X1 - 50, B.Y1 - 50, 40, B.Y2 - B.Y1);
Wait(200 + Random(100));
end;
{*******************************************************************************
function ChooseOptionMulti(Text: TStringArray): Boolean;
By: Wizzup? modified by N1ke!
Description: Finds Popup menu, then clicks on it.
Will look for the first string first and so on.
*******************************************************************************}
function ChooseOptionMulti(Txt: TStringArray): Boolean;
begin
Result := ChooseOptionMultiEx(Txt, 'All', ClickLeft);
end;
{*******************************************************************************
function ChooseOptionEx(Txt, TextType: string): Boolean;
By: Wizzup?
Description: Finds an option in a popup menu, then clicks on it. Searches for
TextType. See ChooseOptionMultiEx for valid options.
Default is 'all'.
*******************************************************************************}
function ChooseOptionEx(Txt, TextType: string): Boolean;
begin
Result := ChooseOptionMultiEx([Txt], TextType, ClickLeft);
end;
{*******************************************************************************
function ChooseOption(txt: String): Boolean;
By: Wizzup?
Description: Finds an option in a popup menu, then clicks on it.
*******************************************************************************}
function ChooseOption(Txt: String): Boolean;
begin
Result := ChooseOptionMultiEx([Txt], 'All', ClickLeft);
end;
{*******************************************************************************
Function OptionsExist(txt: TStringArray; Move: boolean): boolean;
By: Rasta Magician
Description: Returns true if an Option in txt is found in the RS Option Menu
Will move or do nothing according to the boolean Move
*******************************************************************************}
Function OptionsExist(txt: TStringArray; MoveMouse: boolean): boolean;
begin
if MoveMouse then
Result := ChooseOptionMultiEx(Txt, 'All', Move)
else
Result := ChooseOptionMultiEx(Txt, 'All', Nothing);
end;
{*******************************************************************************
function CloseWindow: Boolean;
By: NaumanAkhlaQ, Narcle, and Nava2
Description: Closes any open windows.
*******************************************************************************}
function CloseWindow: Boolean;
var
Col: TIntegerArray;
b: T2DPointArray;
a: T2DPointArray;
Pa: TBox;
I, ii, h, l: Integer;
begin
Result := CloseBank;
Col := [1118997, 1449250, {Main typ 1}
8042720, 4160933, {Skill}
6854059, 2902100, {Quest}
4282212, 2503226, {Main typ 2}
39423, 13567, {Red X}
1514271, 1580837, {Deposit Box}
2106925, 1250584];
SetLength(b, 2);
for I := 0 to 6 do
begin
FindColors(b[0], Col[i*2], MSCX, MSY1, MSX2, MSCY);
FindColors(b[1], Col[i*2+1], MSCX, MSY1, MSX2, MSCY);
l := (High(b[0]) + High(b[1]));
//Writeln(IntToStr(i) + ' Col1: ' + IntToStr(High(b[0])) + ' Col2: ' + IntToStr(High(b[1])) + ' T: ' + IntToStr(l));
if InRange(l, 6, 53) or InRange(l, 94, 250) then
begin
a := SplitTPA(CombineTPA(b[0], b[1]), 5);
SortATPAFromFirstPoint(a, Point(385, 100));
//DebugATPA(a, '');
for ii := 0 to h do
begin
Pa := GetTPABounds(a[ii]);
if ((Pa.x2 - Pa.x1) > 50) or ((Pa.y2 - Pa.y1) > 50) then Continue;
MMouse(RandomRange(Pa.x1, Pa.x2), RandomRange(Pa.y1, Pa.y2), 0, 0);
Result := (Pos('lose', rs_GetUpText) > 0);
Pa.x2 := GetTimeRunning + 2000;
while (not Result) and (GetTimeRunning < Pa.x2) do
begin
Wait(10);
Result := (Pos('lose', rs_GetUpText) > 0);
end;
Wait(Random(300));
if Result then
begin
GetMousePos(Pa.x1, Pa.y1);
Mouse(Pa.x1, Pa.y1, 0, 0, True);
Result := True;
//Writeln('Close Window Type ' + IntToStr(i));
Exit;
end;
end;
end;
end;
end;
{*******************************************************************************
Function InStrArrEx(S: String; StrArr: TStringArray; Var Where: Integer): Boolean;
By: n3ss3s
Description: Returns true if the string S was found in the StrArr, and if so
stores the index into Where.
*******************************************************************************}
Function InStrArrEx(S: String; StrArr: TStringArray; Var Where: Integer): Boolean;
Var
I, H: Integer;
Begin
H := High(StrArr);
For I := 0 To H Do
If LowerCase(StrArr[i]) = LowerCase(S) Then
Begin
Where := i;
Result := True;
Break;
End;
End;
{*******************************************************************************
function StrInArr(str: string; arrS: TStringArray): Boolean;
By: Narcle & Nava2
Description: Returns True if str is found in the Array. Case sensitive. Uses Pos
*******************************************************************************}
function StrInArr(str: string; arrS: TStringArray): Boolean;
var
I, L, H: Integer;
begin
Result := True;
L := Low(arrS); H := High(arrS);
for I := L to H do
if Pos(Str, arrS[I]) > 0 then
Exit;
Result := False;
end;
{*******************************************************************************
function ArrInStr(arrS: TStringArray; str: string): Boolean;
By: Narcle & Nava2
Description: Returns True if the Array is found in the str. Case sensitive. Uses Pos
*******************************************************************************}
function ArrInStr(arrS: TStringArray; str: string): Boolean;
var
I, L, H: Integer;
begin
Result := True;
L := Low(arrS); H := High(arrS);
for I := L to H do
if Pos(arrS[I], Str) > 0 then
Exit;
Result := False;
end;
{*******************************************************************************
procedure SetDebugColors(Text, Back: Integer);
By: Nava2
Description: Sets the next WriteLn's colours to Text and Back respectively.
*******************************************************************************}
procedure SetDebugColors(Text, Back: Integer);
{$IFDEF SCAR320UP}
var
d: TDebugParams;
begin
d := GetDebugParams;
d.Color := Text;
d.BackColor := Back;
SetDebugParams(d);
end;
{$ELSE}
begin end;
{$ENDIF}
{*******************************************************************************
procedure WriteArrayCols(Lines: TStringArray; Text, Back: Integer);
By: Nava2
Description: Writes a TStringArray with Text and Back colours. If not using
3.20, it will just writeln the array.
*******************************************************************************}
procedure WriteArrayCols(Lines: TStringArray; Text, Back: Integer);
var
i, h: Integer;
begin
h := High(Lines);
for i := 0 to h do
begin
SetDebugColors(Text, Back);
Writeln(Lines[i]);
end;
end;
{*******************************************************************************
function SetupTSEW(Amount : Integer) : Integer;
By: R1ch
Description: Prepares TypeSendExWait for use ~ gets average keystroke time.
*******************************************************************************}
procedure SetupTSEW(Amount : Integer);
var
TextsL, TextsB : TStringArray;
I, R, T, G, TL, Re : Integer;
begin
if (Avg <> 0) then Exit;
ClearDebug;
TextsL:= ['Hello', 'Dude', 'Sure', 'Name', 'SRL M', 'SCAR', 'Mean', 'Gets', 'Secs', 'Memb', 'Wizz', 'Zeph', 'Hobb', 'Why?', 'Sets', 'Levs', 'Type', 'Help'];
TextsB:= ['1234567890', 'qwertyuiop', 'How are you', 'Hello there', 'Getting average', 'SRL is great!', 'Milliseconds', 'Moderator', 'Runescape', 'Average', 'Wizzup?', 'SetupTSEW'];
if (ReadLn('I already know my average. Y/N') = LowerCase('y')) then
begin
Re:= StrToInt(ReadLn('Your average in milliseconds?'));
Avg:= RandomRange(Re - 5, Re + 5);
Alert('Your average is: ' + IntToStr(Avg) + ' milliseconds...');
Wait(1500);
Exit;
end;
if (Amount <= 0) then
begin
SRL_Warn('TypeSendExWait/SetupTSEW', 'Incorrect Amount: ' + IntToStr(Amount), warn_AllVersions);
TerminateScript;
end;
WriteLn('Type the texts below in the box STRAIGHT AWAY!');
Wait(2500);
WriteLn('Do not worry about upper and lower case');
Wait(2000);
ClearDebug;
for I:= 1 to Amount do
begin
R:= Random(High(TextsL));
WriteLn(TextsL[R]);
Wait(2000);
T:= GetSystemTime;
TL:= TL + (Length(ReadLn(TextsL[R])));
R:= Random(High(TextsB));
WriteLn(TextsB[R]);
Wait(2000);
TL:= TL + (Length(ReadLn(TextsB[R])));
G:= G + (GetSystemTime - T - 2000 - RandomRange((TL * 130), (TL * 205)));
Avg:= Round(G / TL);
if not(InRange(Avg, 20, 70)) then
Avg:= RandomRange(30, 60);
end;
Alert('Your average is: ' + IntToStr(Avg) + ' milliseconds');
Wait(2500);
Alert('Remember it!');
Wait(2500);
end;
{*******************************************************************************
procedure TypeSendExWait(Text : string; PressEnter: Boolean; AvAmount : Integer);
By: R1ch
Description: Like TypeSendEx, but you set your own average keystroke time by
running it once. The first time it is called, it will get your
average, then remember it. AvAmount it amount of pairs of texts to
type to get the average. More = better
*******************************************************************************}
procedure TypeSendExWait(Text : string; PressEnter: Boolean; AvAmount : Integer);
var
S : string;
I, L, Av : Integer;
C : Byte;
Shift : Boolean;
begin
if (Avg = 0) then
begin
SetupTSEW(AvAmount);
Av:= Avg;
end;
S:= 'ABCDEFGHIJKLMNOPQRSTUVWXZ' + '~!@#$%^&*()_+{}|:"<>?';
L := Length(Text);
for I:= 1 to L do
begin
Shift:= (Pos(Text[i], S) > 0);
if(Shift)then
begin
KeyDown(VK_SHIFT);
Wait(Av + Random(Av + 3));
while(Pos(Text[i], S) > 0)and(I <= Length(Text))do
begin
C := GetKeyCode(StrGet(Text, I));
TypeByte(c);
Wait(Av + Random(Av + 3));
I:= I + 1;
if(I > Length(Text))then Break;
end;
end;
if(Shift)then
KeyUp(VK_SHIFT);
Wait(Av + Random(Av + 3));
if(I <= Length(Text))then
begin
C:= GetKeyCode(StrGet(Text, I));
TypeByte(C);
Wait(Av + Random(Av + 3));
end;
end;
If Not PressEnter Then Exit;
C := GetKeyCode(Chr(13));
TypeByte(C);
end;Test script below. Just run it and see what it does.
program TSEW;
{.include SRL/SRL.scar}
var
Avg : Integer;
procedure SetupTSEW(Amount : Integer);
var
TextsL, TextsB : TStringArray;
I, R, T, G, TL, Re : Integer;
begin
if (Avg <> 0) then Exit;
ClearDebug;
TextsL:= ['Hello', 'Dude', 'Sure', 'Name', 'SRL M', 'SCAR', 'Mean', 'Gets', 'Secs', 'Memb', 'Wizz', 'Zeph', 'Hobb', 'Why?', 'Sets', 'Levs', 'Type', 'Help'];
TextsB:= ['1234567890', 'qwertyuiop', 'How are you', 'Hello there', 'Getting average', 'SRL is great!', 'Milliseconds', 'Moderator', 'Runescape', 'Average', 'Wizzup?', 'SetupTSEW'];
if (ReadLn('I already know my average. Y/N') = LowerCase('y')) then
begin
Re:= StrToInt(ReadLn('Your average in milliseconds?'));
Avg:= RandomRange(Re - 5, Re + 5);
Alert('Your average is: ' + IntToStr(Avg) + ' milliseconds...');
Wait(1500);
Exit;
end;
if (Amount <= 0) then
begin
SRL_Warn('TypeSendExWait/SetupTSEW', 'Incorrect Amount: ' + IntToStr(Amount), warn_AllVersions);
TerminateScript;
end;
WriteLn('Type the texts below in the box STRAIGHT AWAY!');
Wait(2500);
WriteLn('Do not worry about upper and lower case');
Wait(2000);
ClearDebug;
for I:= 1 to Amount do
begin
R:= Random(High(TextsL));
WriteLn(TextsL[R]);
Wait(2000);
T:= GetSystemTime;
TL:= TL + (Length(ReadLn(TextsL[R])));
R:= Random(High(TextsB));
WriteLn(TextsB[R]);
Wait(2000);
TL:= TL + (Length(ReadLn(TextsB[R])));
G:= G + (GetSystemTime - T - 2000 - RandomRange((TL * 130), (TL * 205)));
Avg:= Round(G / TL);
if not(InRange(Avg, 20, 70)) then
Avg:= RandomRange(30, 60);
end;
Alert('Your average is: ' + IntToStr(Avg) + ' milliseconds');
Wait(2500);
Alert('Remember it!');
Wait(2500);
end;
procedure TypeSendExWait(Text : string; PressEnter: Boolean; AvAmount : Integer);
var
S : string;
I, L, Av : Integer;
C : Byte;
Shift : Boolean;
begin
if (Avg = 0) then
begin
SetupTSEW(AvAmount);
Av:= Avg;
end;
S:= 'ABCDEFGHIJKLMNOPQRSTUVWXZ' + '~!@#$%^&*()_+{}|:"<>?';
L := Length(Text);
for I:= 1 to L do
begin
Shift:= (Pos(Text[i], S) > 0);
if(Shift)then
begin
KeyDown(VK_SHIFT);
Wait(Av + Random(Av + 3));
while(Pos(Text[i], S) > 0)and(I <= Length(Text))do
begin
C := GetKeyCode(StrGet(Text, I));
TypeByte(c);
Wait(Av + Random(Av + 3));
I:= I + 1;
if(I > Length(Text))then Break;
end;
end;
if(Shift)then
KeyUp(VK_SHIFT);
Wait(Av + Random(Av + 3));
if(I <= Length(Text))then
begin
C:= GetKeyCode(StrGet(Text, I));
TypeByte(C);
Wait(Av + Random(Av + 3));
end;
end;
If Not PressEnter Then Exit;
C := GetKeyCode(Chr(13));
TypeByte(C);
end;
procedure TypeWhatYouWantInThisProc;
//Use two TSEWs to see it remember you average
begin
TypeSendExWait('Like my procedure?', True, 2); //Your message, press enter, amount of pairs of texts to get average
TypeSendExWait('Please tell me what you think of it', False, 0);
{Click cursor in here after deleting this text}
end;
begin
SetupSRL;
TypeWhatYouWantInThisProc;
end.How it used:
Just like TypeSendEx, except the first time it is called, it will ask for your average, then it will be remembered. I've tested it, and it now works fine. All you have to call is TypeSendExWait('Hello!', True, 1); Just to let you know, every 1 for AvAmount counts for two texts; one small, and one big. After the first time it is called, it does not matter what AvAmount is.
So as long as you've called SetupSRL, you'll be fine.
Thanks,
Richard