Ok, first off, let me say that I'm sorry for the lack of quality in this script. It's been awhile since I've scripted and I wanted to get back into it. I saw this thread and figured I'd give it a shot, and that also it would be easier/quicker than making a RS script.
I know there are parts of the script that would have to be re-written or optimized if it's used, and that's fine. I also would like to thank Coh3n with help with the form, I never knew they were that easy.
I wrote it as a new script so you can just plug it into Simba and run it. Let me know what you think, honestly :P
program new;
{$i srl\srl.scar}
{$i SRL\SRL\Misc\Stats.simba}
Const
SRLStats_Username = ''; // Your SRL Stats Username
SRLStats_Password = ''; // Your SRL Stats Password
stats_ShowStatsDialog = 'stats_ShowStatsDialog'; // Name for the Setting that will be set
var
stats_form: TForm;
stats_txtUser, stats_txtPass, stats_txtEmail: TEdit;
stats_btnRegister, stats_btnCancel: TButton;
stats_lblUser, stats_lblPass, stats_lblEmail: TLabel;
procedure stats_btnRegisterClick(Sender: TObject);
var
stats_Client: integer;
stats_PostData, stats_strError, stats_strSuccess: string;
stats_Success: boolean;
begin
// Check to make sure the user has filled in the Username and Password fields
if (Length(stats_txtUser.TEXT) = 0) OR (Length(stats_txtPass.TEXT) = 0) then
begin
MessageDlg('Error While Registering!', 'Please make sure you have entered a Username and Password into the appropriate fields.', mtError, [mbOk]);
end else
begin
try
stats_Client := InitializeHTTPClient(false, false);
// Set Post Data
stats_PostData := 'user=' + stats_txtUser.TEXT + '&pass=' + stats_txtPass.TEXT;
if Length(stats_txtEmail.TEXT) > 0 then
stats_PostData := stats_PostData + '&mail=' + stats_txtEmail.TEXT;
// Post data to STATS URL and receive response
stats_PostData := PostHTTPPage(stats_Client, 'http://stats.villavu.com/register', stats_PostData);
// Trim down the response to a bite size chunk
stats_PostData := Between('<div class="content">', '</form>', stats_PostData);
// If there is an error, strip out just the error message(s)
// (I know the replacement of <li> with <ERROR> is silly, but I'm tired
// and this fits at the time)
stats_strError := Replace(Between('<ul>', '</ul>', stats_PostData), 'li', 'ERROR');
// If successful, get the success response
stats_strSuccess := Between('<p>', '</p>', stats_PostData);
// This next part is weird, I know, but it's the only way I could figure
// out how to show right message(s)
if Length(stats_strError) > 0 then
MessageDlg('Error While Registering!', stats_strError + '!', mtError, [mbOk])
else if Length(stats_strSuccess) > 0 then
begin
MessageDlg('Registration Successful!', stats_strSuccess + ' You may find your account at: http://stats.villavu.com' + Between('href="', '">', stats_PostData) + '. Please fill in the SRL Stats information in your script and run again, this script is now ending.', mtConfirmation, [mbOk]);
stats_Success := true;
end;
finally
FreeHTTPClient(stats_Client);
if stats_Success then
stats_form.CLOSE;
end;
end;
end;
procedure stats_btnCancelClick(Sender: TObject);
begin
stats_form.CLOSE;
end;
procedure stats_formInit;
begin
stats_form := TForm.create(nil);
with stats_form do
begin
caption := 'Register for SRL Stats';
setBounds(100, 100, 280, 130);
end;
stats_lblUser := TLabel.Create(stats_form);
with stats_lblUser do
begin
parent := stats_form;
caption := 'Username: ';
top := 10;
left := 10;
end;
stats_lblPass := TLabel.Create(stats_form);
with stats_lblPass do
begin
parent := stats_form;
caption := 'Password: ';
top := 40;
left := 10;
end;
stats_lblEmail := TLabel.Create(stats_form);
with stats_lblEmail do
begin
parent := stats_form;
caption := 'Email (Opt): ';
top := 70;
left := 10;
end;
stats_txtUser := TEdit.Create(stats_form);
with stats_txtUser do
begin
parent := stats_form;
setBounds(75, 7, 200, 25);
Hint := 'Limit of 20 characters.';
ShowHint := true;
MaxLength := 20;
end;
stats_txtPass := TEdit.Create(stats_form);
with stats_txtPass do
begin
parent := stats_form;
setBounds(75, 37, 200, 25);
Hint := 'Limit of 20 characters.';
ShowHint := true;
MaxLength := 20;
PASSWORDCHAR := '*';
end;
stats_txtEmail := TEdit.Create(stats_form);
with stats_txtEmail do
begin
parent := stats_form;
setBounds(75, 67, 200, 25);
Hint := 'Limit of 40 characters, and also allows the characters email addresses can contain.';
ShowHint := true;
MaxLength := 40;
end;
stats_btnRegister := TButton.Create(stats_form);
with stats_btnRegister do
begin
parent := stats_form;
width := 100;
height := 25;
top := 100;
left := 10;
caption := 'Register';
onClick := @stats_btnRegisterClick;
end;
stats_btnCancel := TButton.Create(stats_form);
with stats_btnCancel do
begin
parent := stats_form;
width := 100;
height := 25;
top := 100;
left := 175;
caption := 'Cancel';
onClick := @stats_btnCancelClick;
end;
stats_form.showModal;
end;
procedure stats_formSafeCall(proc: string);
var
stats_v: TVariantArray;
begin
setLength(stats_v, 0);
threadSafeCall(proc, stats_v);
end;
procedure stats_formFree();
begin
stats_form.free();
end;
procedure SetupSRLStats_New(ScriptID: integer; UserName, UserPass: string);
begin
stats_Timer := GetSystemTime;
stats_ScriptID := IntToStr(ScriptID);
stats_Username := LowerCase(UserName);
stats_UserPass := UserPass;
stats_RandNames := ['leo the gravedigger', 'freaky forester', 'maze',
'prison pete', 'evil bob''s island', 'drill demon',
'quiz', 'surprise exam', 'mollys evil twin', 'pinball',
'sandwich lady', 'bee keeper', 'pillory', 'capn arnav',
'abyssal teleport', 'certer', 'mime', 'frog', 'trade',
'mod', 'fight', 'lamp', 'bird nest', 'death'];
SetArrayLength(stats_RandSolved, Length(stats_RandNames));
if ((stats_Username = '') AND (stats_UserPass = '')) AND (StrToBoolDef(GetSettingValue(stats_ShowStatsDialo g), True)) then
begin
case MessageBox('No Stats account entered, would you like to set one up?', 'SRL Stats', mbYesNoCancel) of
mrYes:
begin
try
stats_formSafeCall('stats_formInit');
except
writeln(exceptionToString(exceptionType, exceptionParam));
finally
stats_formSafeCall('stats_formFree');
end;
end;
mrNo:
begin
case MessageBox('Would you want to disable this dialog from showing again in the future? (Not Recommended)', 'Disable this dialog?', mbYesNoCancel) of
mrYes: SetSettingValue(stats_ShowStatsDialog, 'FALSE');
mrNo, mrCancel: Exit;
end;
stats_Username := 'Anonymous';
stats_UserPass := 'anon1337';
end;
mrCancel: TerminateScript;
end;
end;
end;
begin
ClearDebug;
SetupSRLStats_New(0, SRLStats_UserName, SRLStats_Password);
//WriteLn(GetSettingValue(stats_ShowStatsDialog)); // Used for testing
//DeleteSetting(stats_ShowStatsDialog); // Used for testing
end.
Here is the updated stats.simba file to include the changes that I made, and after testing it, it works. Here is the updated version.
(*
Stats
=====
The Stats include contains wrapper functions provided by the SRL Stats API.
The functions contained are meant for ease of use for implementation into
scripts.
*)
// behaves as entries in a dict.
type
TStats_Vars = record
Name: string;
Value: integer;
end;
const
stats_ShowStatsDialog = 'stats_ShowStatsDialog'; // Name for the Setting that will be set
var
stats_Vars: Array of TStats_Vars;
stats_UserName, stats_UserPass, stats_ScriptID: String;
stats_Timer: integer;
stats_RandNames: Array of String;
stats_RandSolved: Array of Integer;
stats_RandFailed: Array of Integer;
stats_form: TForm;
stats_txtUser, stats_txtPass, stats_txtEmail: TEdit;
stats_btnRegister, stats_btnCancel: TButton;
stats_lblUser, stats_lblPass, stats_lblEmail: TLabel;
procedure stats_btnRegisterClick(Sender: TObject);
var
stats_Client: integer;
stats_PostData, stats_strError, stats_strSuccess: string;
stats_Success: boolean;
begin
// Check to make sure the user has filled in the Username and Password fields
if (Length(stats_txtUser.TEXT) = 0) OR (Length(stats_txtPass.TEXT) = 0) then
begin
MessageDlg('Error While Registering!', 'Please make sure you have entered a Username and Password into the appropriate fields.', mtError, [mbOk]);
end else
begin
try
stats_Client := InitializeHTTPClient(false, false);
// Set Post Data
stats_PostData := 'user=' + stats_txtUser.TEXT + '&pass=' + stats_txtPass.TEXT;
if Length(stats_txtEmail.TEXT) > 0 then
stats_PostData := stats_PostData + '&mail=' + stats_txtEmail.TEXT;
// Post data to STATS URL and receive response
stats_PostData := PostHTTPPage(stats_Client, 'http://stats.villavu.com/register', stats_PostData);
// Trim down the response to a bite size chunk
stats_PostData := Between('<div class="content">', '</form>', stats_PostData);
// If there is an error, strip out just the error message(s)
// (I know the replacement of <li> with <ERROR> is silly, but I'm tired
// and this fits at the time)
stats_strError := Replace(Between('<ul>', '</ul>', stats_PostData), 'li', 'ERROR');
// If successful, get the success response
stats_strSuccess := Between('<p>', '</p>', stats_PostData);
// This next part is weird, I know, but it's the only way I could figure
// out how to show right message(s)
if Length(stats_strError) > 0 then
MessageDlg('Error While Registering!', stats_strError + '!', mtError, [mbOk])
else if Length(stats_strSuccess) > 0 then
begin
MessageDlg('Registration Successful!', stats_strSuccess + ' You may find your account at: http://stats.villavu.com' + Between('href="', '">', stats_PostData) + '. Please fill in the SRL Stats information in your script and run again, this script is now ending.', mtConfirmation, [mbOk]);
stats_Success := true;
end;
finally
FreeHTTPClient(stats_Client);
if stats_Success then
stats_form.CLOSE;
end;
end;
end;
procedure stats_btnCancelClick(Sender: TObject);
begin
stats_form.CLOSE;
end;
procedure stats_formInit;
begin
stats_form := TForm.create(nil);
with stats_form do
begin
caption := 'Register for SRL Stats';
setBounds(100, 100, 280, 130);
end;
stats_lblUser := TLabel.Create(stats_form);
with stats_lblUser do
begin
parent := stats_form;
caption := 'Username: ';
top := 10;
left := 10;
end;
stats_lblPass := TLabel.Create(stats_form);
with stats_lblPass do
begin
parent := stats_form;
caption := 'Password: ';
top := 40;
left := 10;
end;
stats_lblEmail := TLabel.Create(stats_form);
with stats_lblEmail do
begin
parent := stats_form;
caption := 'Email (Opt): ';
top := 70;
left := 10;
end;
stats_txtUser := TEdit.Create(stats_form);
with stats_txtUser do
begin
parent := stats_form;
setBounds(75, 7, 200, 25);
Hint := 'Limit of 20 characters.';
ShowHint := true;
MaxLength := 20;
end;
stats_txtPass := TEdit.Create(stats_form);
with stats_txtPass do
begin
parent := stats_form;
setBounds(75, 37, 200, 25);
Hint := 'Limit of 20 characters.';
ShowHint := true;
MaxLength := 20;
PASSWORDCHAR := '*';
end;
stats_txtEmail := TEdit.Create(stats_form);
with stats_txtEmail do
begin
parent := stats_form;
setBounds(75, 67, 200, 25);
Hint := 'Limit of 40 characters, and also allows the characters email addresses can contain.';
ShowHint := true;
MaxLength := 40;
end;
stats_btnRegister := TButton.Create(stats_form);
with stats_btnRegister do
begin
parent := stats_form;
width := 100;
height := 25;
top := 100;
left := 10;
caption := 'Register';
onClick := @stats_btnRegisterClick;
end;
stats_btnCancel := TButton.Create(stats_form);
with stats_btnCancel do
begin
parent := stats_form;
width := 100;
height := 25;
top := 100;
left := 175;
caption := 'Cancel';
onClick := @stats_btnCancelClick;
end;
stats_form.showModal;
end;
procedure stats_formSafeCall(proc: string);
var
stats_v: TVariantArray;
begin
setLength(stats_v, 0);
threadSafeCall(proc, stats_v);
end;
procedure stats_formFree();
begin
stats_form.free();
end;
(*
SetupSRLStats
~~~~~~~~~~~~~
.. code-block:: pascal
procedure SetupSRLStats(ScriptID: integer; UserName, UserPass: string);
Initializes all variables necessary for SRL stats to function. Username and
password are *not* case sensitive.
Example:
.. code-block:: pascal
SetupSRLStats(64, 'SRL-Developers', 'SRLSRLSRL');
*)
procedure SetupSRLStats(ScriptID: integer; UserName, UserPass: string);
begin
stats_Timer := GetSystemTime;
stats_ScriptID := IntToStr(ScriptID);
stats_Username := LowerCase(UserName);
stats_UserPass := UserPass;
stats_RandNames := ['Leo', 'Forester', 'Maze', 'P. Pete', 'Evil Bob',
'Demon', 'Quiz', 'Mordaut', 'Molly', 'Pinball',
'Sandwich', 'Beekeeper', 'Pillory', 'Arnav', 'Abyss',
'Certer', 'Mime', 'Frog'];
SetArrayLength(stats_RandSolved, Length(stats_RandNames));
SetArrayLength(stats_RandFailed, Length(stats_RandNames));
if ((stats_Username = '') AND (stats_UserPass = '')) AND (StrToBoolDef(GetSettingValue(stats_ShowStatsDialo g), True)) then
begin
case MessageBox('No Stats account entered, would you like to set one up?', 'SRL Stats', mbYesNoCancel) of
mrYes:
begin
try
stats_formSafeCall('stats_formInit');
except
writeln(exceptionToString(exceptionType, exceptionParam));
finally
stats_formSafeCall('stats_formFree');
end;
end;
mrNo:
begin
case MessageBox('Would you want to disable this dialog from showing again in the future? (Not Recommended)', 'Disable this dialog?', mbYesNoCancel) of
mrYes: SetSettingValue(stats_ShowStatsDialog, 'FALSE');
mrNo, mrCancel: Exit;
end;
stats_Username := 'Anonymous';
stats_UserPass := 'anon1337';
end;
mrCancel: TerminateScript;
end;
end;
end;
(*
stats_InitVariable
~~~~~~~~~~~~~~~~~~
.. code-block:: pascal
stats_InitVariable(VarName: String; InitValue: Integer);
Helper method to clean up code in the include. Removes some repeating code
internally.
.. WARNING::
Use of this method outside of this include *may* lead to multiple variables
of the same name. It does **not** check to see if the variable is already
present.
.. code-block:: pascal
stats_InitVariable('coal', 0);
*)
procedure stats_InitVariable(VarName: String; InitValue: Integer);
var
len: Integer;
begin
len := Length(stats_Vars);
SetArrayLength(stats_Vars, len + 1);
stats_Vars[len].Name := LowerCase(VarName);
stats_Vars[len].Value := InitValue;
end;
(*
stats_SetVariable
~~~~~~~~~~~~~~~~~
.. code-block:: pascal
stats_SetVariable(VarName: string; NewValue: Integer);
Sets the passed variable to the new value regardless of old value. This method
behaves much like stats_InitVariable but checks for the variable present first.
Example:
.. code-block:: pascal
stats_SetVariable('runite', 10)
*)
procedure stats_SetVariable(VarName: string; NewValue: Integer);
var
i, h: Integer;
begin
h := High(stats_Vars);
VarName := LowerCase(VarName); // set it to lowercase since not case sensitive
if (h >= 0) then
for i := h downto 0 do
if (VarName = stats_Vars[i].Name) then
begin
stats_Vars[i].Value := NewValue;
Exit;
end;
// the variable is not present already, thus make a new entry into the dict.
stats_InitVariable(VarName, NewValue);
end;
(*
stats_IncVariable
~~~~~~~~~~~~~~~~~
.. code-block:: pascal
procedure stats_IncVariable(VarName: string; Value: integer);
Increments a variable by the value passed.
Example:
.. code-block:: pascal
stats_IncVariable('cod', 69);
*)
procedure stats_IncVariable(VarName: string; Value: integer);
var
i, h: Integer;
begin
h := High(stats_Vars);
VarName := LowerCase(VarName); // set it to lowercase since not case sensitive
if (h >= 0) then
for i := h downto 0 do
if (VarName = stats_Vars[i].Name) then
begin
stats_Vars[i].Value := stats_Vars[i].Value + Value;
Exit;
end;
// the variable is not present already, thus make a new entry into the dict.
stats_InitVariable(VarName, Value);
end;
(*
stats_Commit
~~~~~~~~~~~~
.. code-block:: pascal
function stats_Commit: Boolean;
Sends all the information currently stored in the system to the server. Returns
true if commit was successful, displays error messages. One should note that the
stats variables are set to 0 on commit.
Example:
.. code-block:: pascal
if (stats_Commit) then
WriteLn('We are success.');
*)
function stats_Commit: Boolean;
var
SRLClient, Worked, i, ExtraTime, Increment: integer;
S: String;
begin
ExtraTime := GetSystemTime - stats_Timer;
Worked := ExtraTime div 60000;
// Exit if 5 minutes of time has not passed since last commit.
if Worked < 5 then Exit;
ExtraTime := ExtraTime - (Worked*60000);
stats_Timer := GetSystemTime - ExtraTime;
{$IFDEF Simba}
SRLClient := InitializeHTTPClientWrap(False);
{$ELSE}
SRLClient := InitializeHTTPClient(False, False);
{$ENDIF}
ClearPostData(SRLClient);
AddPostVariable(SRLClient, 'user', stats_UserName);
AddPostVariable(SRLClient, 'password', stats_UserPass);
AddPostVariable(SRLClient, 'script', stats_ScriptID);
AddPostVariable(SRLClient, 'time', IntToStr(Worked));
for i := rand_Leo to rand_Frog do
begin
// Update solved stats.
Increment := RandSolved[i] - stats_RandSolved[i];
if (Increment > 0) then
begin
stats_IncVariable(stats_RandNames[i] + ' (Solved)', Increment);
stats_RandSolved[i] := RandSolved[i];
end;
// Update unsolved stats.
Increment := RandFailed[i] - stats_RandFailed[i];
if (Increment > 0) then
begin
stats_IncVariable(stats_RandNames[i] + ' (Unsolved)', Increment);
stats_RandFailed[i] := RandFailed[i];
end;
end;
if (Length(stats_Vars) > 0) then
for i := High(stats_Vars) downto 0 do
with stats_Vars[i] do
begin
if (Value <= 0) then
Continue;
AddPostVariable(SRLClient, Name, IntToStr(Value));
Value := 0;//Clear for next commit
end;
S := PostHTTPPageEx(SRLClient, 'http://stats.villavu.com/api/commit');
FreeHTTPClient(SRLClient);
Result := False;
{$IFDEF Simba}
case StrToIntDef(ExtractFromStr(S, Numbers), -1) of
{$ELSE}
case StrToIntDef(GetNumbers(S), -1) of
{$ENDIF}
100: Result := True; // successful commit.
110: Writeln('SRL_Stats: Incorrect user and/or password');
120: Writeln('SRL_Stats: Incorrect script ID');
130: Writeln('SRL_Stats: Invalid time');
140: Writeln('SRL_Stats: Variable does not exist');
150: Writeln('SRL_Stats: Wrong info for variable');
160: Writeln('SRL_Stats: Internal server error');
else
Writeln('SRL_Stats: No POST return');
end;
end;
Here is the test script I was using to test the updated stats.simba
program new;
{$i srl\srl.scar}
{$i SRL\SRL\Misc\Stats.simba}
Const
SRLStats_Username = ''; // Your SRL Stats Username
SRLStats_Password = ''; // Your SRL Stats Password
begin
ClearDebug;
SetupSRLStats(0, SRLStats_UserName, SRLStats_Password);
//DeleteSetting(stats_ShowStatsDialog);
end.
Oh, and I created a new test user in the stats system. The Stats ID of the user is 559. If there's anything else I need to do, let me know.