Nava2
2008-10-25 10:51:53
This was moved here, as it is not allowed to be placed into SRL. It can still be used as before. Place it into your SRL folder in Core. :)
Cheers.
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ยป AutoRespond Routines --//
//-----------------------------------------------------------------//
// * procedure DBDumpArray; // * by Nava2
// * procedure SetupSmartRespond(UseSmartRespond : Boolean; // * by Nava2
// RespPerPlayer, MinChatTime, MaxChatTime : Integer); // *
// * procedure RemoveArray(Index : Integer; Arr : Array) // * by MylesMadness
// * procedure SetupAutoResponder; // * by Nava2
// * function InStrArrExx(S: String; StrArr: TStringArray; // * by N3ss3s
// Var Where: Integer): Boolean; // *
// * procedure AddName(Name : String); // * by Nava2
// * procedure AssessNames(Name : String); // * by Nava2
// * function SmartRespond(Name : String); // * by Nava2
// * function InChatArr(Text:TStringArray): Boolean; // * by WT-Fakawi, Nava2 & EvilChicken!
// * function Respond: Boolean; // * by Nava2
// * procedure SetupSRLAutoResponder // * SRL -- Please note, UNUSED.
type // My type used for recording players.
ARPlayer = Record
Name : String;
Count, Time : Integer;
end;
var
OldMessage : string; // Stores the old message so it doesn't respond again.
QnR : Array of Array [0..1] of TStringArray; // Array of questions and answers.
UseRespond, UseSmartResponder : Boolean; // All booleans are answered in SetupAutoResponder.
RandomErrorChance, RespondTimer : Integer; // Used by Basic Auto Responder
RespondTime, MinR, MaxR, ResPlayer : Integer; // SmartResponder Variables
NameArray : Array of ARPlayer;
DebugResponder : Boolean;
{*******************************************************************************
procedure SetupAutoResponder;
By: Nava2
Description: Allows user to set up Array for auto responder. Add more lines to
create more questions and answers. As well, the more answers the
better anti-ban it is. Please note, this procedure must be copied
into your script, then called.
The description of the variables are posted in the procedure, take
note of them.
Example:
procedure SetupAutoResponder;
var
HowManyQuestions, RespPerPlayer, MinChatTime, MaxChatTime : integer;
UseSmartRespond : Boolean;
begin
UseRespond := True;
RespondTime := 3; // Time to wait before any response is made. (Minutes)
RandomErrorChance := 20; // Add Random Typos to text? 0 is NO Errors, the lower the number the more errors.
UseSmartRespond := True;
RespPerPlayer := 8; // Number of responders per individual player. 0 is infinite.
MinChatTime := 3; // Amount of time to wait between talking to individual players. (Minutes)
MaxChatTime := 15; // Amount of time to wait before dropping a player due to them not talking. (Minutes)
HowManyQuestions := 2;
SetArrayLength(QnR, HowManyQuestions);
QnR[0][0] := ['level', 'lvl'];
QnR[0][1] := ['my level is ' + Players[CurrentPlayer].Integers[0]', 'GTFO NOOB'];
QnR[1][0] := ['hi', 'hey'];
QnR[1][1] := ['hello', 'T I T S OR G T F O'];
SetupSmartRespond(UseSmartRespond, RespPerPlayer, MinChatTime, MaxChatTime);
end;
*******************************************************************************}
{
procedure SetupAutoResponder;
var
HowManyQuestions, RespPerPlayer, MinChatTime, MaxChatTime : integer;
UseSmartRespond : Boolean;
begin
UseRespond := True;
RespondTime := 3; // Time to wait before any response is made. (Minutes)
RandomErrorChance := 20; // Add Random Typos to text? 0 is NO Errors, the lower the number the more errors.
UseSmartRespond := True;
RespPerPlayer := 0; // Number of responders per individual player. 0 is infinite.
MinChatTime := 0; // Amount of time to wait between talking to individual players. (Minutes)
MaxChatTime := 0; // Amount of time to wait before dropping a player due to them not talking. (Minutes)
HowManyQuestions := 1;
SetArrayLength(QnR, HowManyQuestions);
QnR[0][0] := []; //Questions
QnR[0][1] := []; //Answers to Previous Questions
SetupSmartRespond(UseSmartRespond, RespPerPlayer, MinChatTime, MaxChatTime);
end;
}
{*******************************************************************************
procedure DBDumpArray;
By: Nava2
Description: Writelns all players in the player array.
*******************************************************************************}
procedure DBDumpArray;
var
I, H: integer;
begin
if not DebugResponder then Exit;
H := High(NameArray);
for i := 0 to h do
begin
Writeln('Player['+ IntToStr(I) + ']:');
Writeln(' Name : ' + NameArray[i].Name);
Writeln(' Timer : ' + IntToStr(TimeFromMark(NameArray[i].Time)));
Writeln(' Count : ' + IntToStr(TimeFromMark(NameArray[i].Count)));
end;
end;
{*******************************************************************************
procedure SetupSmartRespond(UseSmartRespond : Boolean; RespPerPlayer, MinChatTime, MaxChatTime : Integer);
By: Nava2
Description: Parameters Setup the Smart AutoResponder.
UseSmarRespond : As it seems, set to true to use the SmartResponder, set to false to not.
RespPerPlayer : How many times would you like to respond to a certain player?
0 is infinite.
MinChatTime : How long to wait between responding to individual players.
MaxChatTime : How long to wait before dropping a player due to inactivity.
0 is Infinite, but not recommended.
*******************************************************************************}
procedure SetupSmartRespond(UseSmartRespond : Boolean; RespPerPlayer, MinChatTime, MaxChatTime : Integer);
begin
UseSmartResponder := UseSmartRespond;
if not UseSmartResponder then Exit;
ResPlayer := RespPerPlayer;
MinR := MinChatTime * 60000;
MaxR := MaxChatTime * 60000;
end;
{*******************************************************************************
procedure RemoveElement(Index : Integer; var Arr : Array);
By: MylesMadness
Description: Removed Piece Index of an Array, the Array is defined by the user.
*******************************************************************************}
Procedure RemoveArray(Index : Integer; var Arr : Array of ARPlayer);
var
I, H : Integer;
begin
H := High(Arr);
SetArrayLength(Arr, Length(Arr) + 1)
for I := Index to H do
Arr[Index] := Arr[Index + 1];
SetArrayLength(Arr, High(Arr));
end;
{*******************************************************************************
Function InStrArrExx(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 InStrArrExx(S: String; StrArr: Array of ARPlayer; Var Where: Integer): Boolean;
Var
I: Integer;
Begin
For I := 0 To High(StrArr) Do
If LowerCase(StrArr[i].Name) = LowerCase(S) Then
Begin
Where := i;
Result := True;
Break;
End;
End;
{*******************************************************************************
procedure AssessNames(Name : String);
function SmartRespond(Name : String): Boolean;
By: Nava2
Description: Procedures Used for the Smart Responder.
1. Adds a name to the type array.
2. Checks if any names should be removed.
3. Checks that the inputted name is eligible to be responded to.
*******************************************************************************}
procedure AssessNames(Name : String);
var
I, H : Integer;
begin
if not InStrArrExx(Name, NameArray, H) and (LowerCase(Name) <> LowerCase(Players[CurrentPlayer].Name)) and
(Pos('@', LowerCase(name)) = 0) and (Name <> '') then
begin
H := GetArrayLength(NameArray);
SetLength(NameArray, H + 1);
NameArray[h].Name := Name;
MarkTime(NameArray[h].Time);
NameArray[h].Count := 0;
end;
H := High(NameArray);
for I := 0 to H do
if (TimeFromMark(NameArray[i].Time) >= MaxR) then
RemoveArray(I, NameArray);
end;
function SmartRespond(Name : String): boolean;
var
I : Integer;
begin
if not UseSmartResponder then
begin
Result := True;
Exit;
end;
AssessNames(Name);
if InStrArrExx(Name, NameArray, I) then
Result := ((TimeFromMark(NameArray[i].Time) >= MinR) or (MinR = 0)) and
((NameArray[i].Count <= ResPlayer) or (ResPlayer = 0));
DBDumpArray;
end;
{*******************************************************************************
function InChatArr(Text: TStringArray) : Boolean;
By: WT-Fakawi, Nava2, & EvilChicken!
Description: Grabs Last Chat Line and performs checks on occurence of text
*******************************************************************************}
function InChatArr(Text: TStringArray): Boolean;
var
I, H : integer;
s : string;
// This should probably be in Text.scar...
begin
H := High(Text);
if (not (GetLastChatText(s))) then Exit;
for I := 0 to H do
if Pos(Lowercase(Text[i]), Lowercase(s)) > 0 then
begin
Result := true;
Exit;
end;
end;
{*******************************************************************************
function Respond : boolean;
By: Nava2
Description: Responds to assorted text. Will NOT respond to itself. Returns a
boolean so people can record how many responds if they would like.
Also, will not respond every time.
*******************************************************************************}
function Respond : boolean;
var
CurrentMessage, Name, S : string;
I, II, H : integer;
begin
if not UseRespond then Exit;
GetLastChatText(CurrentMessage);
if (TimeFromMark(RespondTimer) < (RespondTime * 30000)) or (CurrentMessage = OldMessage) then Exit;
LastChatter(Name);
if not SmartRespond(Name) then Exit;
OldMessage := CurrentMessage;
if Lowercase(Name) = Lowercase(Players[CurrentPlayer].name) then exit;
case random(8) of
0..4: begin
H := High(QnR);
for I := 0 to H do
begin
Writeln(BoolToStr(InChatArr(QnR[i][0])));
if InChatArr(QnR[i][0]) then
begin
S := QnR[i][1][Random(Length(QnR[i][1]))];
if (RandomErrorChance > 0) then
S := AddMistakes(S, RandomErrorChance);
TypeSend(S);
Result := true;
InStrArrExx(Name, NameArray, II);
MarkTime(NameArray[II].Time);
Inc(NameArray[II].Count);
MarkTime(RespondTimer);
Break;
end;
end;
end;
end;
DBDumpArray;
end;
procedure SetupSRLAutoResponder;
begin
UseRespond := false;
end;Cheers.