SRL Archive - OSR Advanced Scripting Tutorials

Multithreading with Timer


caused

2009-10-06 19:26:18

Introduction:
In this tutorial I'll be showing you how to use the TTimer object to run multiple functions or procedures at once. This is called Multithreading.

It's very usefull when you want to create your progress report all the time the script is running, or when you just want to scan for a certain event, while a script is running.

It's not "real" multithreading though. Because real MT typically enables you to safe Critical Sections, synchronize threads or vary the priority of a thread…

Example Script (no timers):
We are wanting to use an extra thread for our proggy in this script. We also want another thread, to do stuff, like "painting" a progress report or such.

All of that will happen while our actuall script is looping the woodcutting procedures.

program Timers;
var
loadcount : integer;

procedure proggy;
begin
ClearReport;
AddToReport('Scriptname');
AddToReport('Time Running: '+IntToStr(GetTimeRunning));
AddToReport('Loads: '+IntToStr(loadcount));
end;

procedure Woodcutting;
begin
WriteLn('Woodcutting');
wait(5000);
end;

procedure Dropping;
begin
WriteLn('Dropping');
wait(5000);
end;

procedure mainloop;
begin
Woodcutting;
Dropping;
inc(loadcount);
end;

begin

repeat
mainloop;

proggy;
until(loadcount=10);

end.

Generating a Timer and calling it:
We will generate a new form(not visible) and Create a new timer on that form. We may also apply our timer to the undetermined nil pointer, which would spare us the form, but may result in exceptions when not freed correctly.

I hope i commented everything suffieciently. If you still got any question don't bother to ask ;).

Code with timers/Multithreading:

program Timers;

var
//Timer and Form Vars
frmDesign: TForm;
thread1, thread2: TTimer;
//proggy var
loadcount : integer;

procedure proggy;
begin
ClearReport;
AddToReport('Scriptname');
AddToReport('Time Running: '+IntToStr(GetTimeRunning));
AddToReport('Loads: '+IntToStr(loadcount));
end;

//The procedure of our first thread/timer
procedure t1(sender: TObject);
begin
proggy;
end;

//The procedure of our second thread/timer
procedure t2(sender: TObject);
begin
writeln('Timer 2 Looping, painting the progress report and such');
end;

//Creating the Form
procedure InitForm;
begin
frmDesign := CreateForm;
end;

//Creating the Timer
procedure InitTimer;
begin
thread1 := TTimer.Create(frmDesign);
thread2 := TTimer.Create(frmDesign);
end;

procedure SafeInitFormandTimer;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('InitForm',v);
ThreadSafeCall('InitTimer',v);

//Function which is run everytime the timer loops
thread1.OnTimer := @t1;
//timer interval in ms
thread1.Interval := 300;
//enabled
thread1.enabled := TRUE;

//Same as above for the second timer/thread
thread2.OnTimer := @t2;
thread2.Interval := 200;
thread2.enabled := TRUE;
end;

procedure Woodcutting;
begin
WriteLn('Woodcutting');
wait(5000);
end;

procedure Dropping;
begin
WriteLn('Dropping');
wait(5000);
end;

procedure mainloop;
begin
Woodcutting;
Dropping;
inc(loadcount);
end;

begin
//Generating and setting up the timer
SafeInitFormandTimer;

repeat
mainloop;

// proggy;
until(loadcount = 10);

// And Freeing the memory
FreeForm(frmDesign);
end.

Conclusion:
So, this technique can be used whenever you need multiple tasks done at the "same time". Watch out that you do not write in the same var or use a function multiple times at the same time, that may cause access violations and stops the script.

Another good thing, where a thread/timer comes in handy is, when you want your script to download a website, but you do not want the whole script to stop and wait till it's done. Or when you want to download multiple websites at once ;).

If anything is unclear, feel free to ask :).

~caused

Zerghunter3000

2009-10-30 23:17:00

Can you give me an example of how i put an autoresponder in my script at all times plz.

caused

2009-10-31 13:08:23

From: Zerghunter3000
Can you give me an example of how i put an autoresponder in my script at all times plz.


Well, you gotta read that tutorial ;). THan you will know what to do.

~caused

Sex

2009-10-31 17:22:18

You can also use SetTimeOut.

caused

2009-11-01 08:22:12

Hmn that is true : D… Maybe that's even a better solution. I wasn't aware that scar had such function : O

Here's an example with SetTimeout.

program New;

procedure checksomething;
begin
writeLn('test');
SetTimeout(1000,'checksomething');
end;

begin
SetTimeout(1000,'checksomething');
wait(5000);
end.

Floor66

2009-11-01 09:27:26

I only got the TTimers xD
Explain the SetTimeouts to me tho.

This is something I'm going to use if I ever write a script, though.

edit;
SCAR seems to crash fatally when you pause a script while the threads are running…

Sex

2009-11-01 12:46:08

Maybe a Try Except will fix it? Probably not though.

Floor66

2009-11-01 13:07:20


Program New;

Var
MyNumber, MyNumber2, StartTime, PauseTime : Integer;
Stop : Boolean;
frmDesign : TForm;
Threads : Array Of TTimer;

Procedure DoNumber(Sender : TObject);
Var
i : Integer;
Begin
Inc(MyNumber);
i := MyNumber;
WriteLn('Thread[1] :: Inc :: '+ IntToStr(i));
If MyNumber = 10 Then
Stop := True;
End;

Procedure DoNumber2(Sender : TObject);
Var
i : Integer;
Begin
Dec(MyNumber2);
i := MyNumber2;
WriteLn('Thread[2] :: Dec :: '+ IntToStr(i));
If MyNumber2 = 0 Then
Stop := True;
End;

Procedure ShowTimeRunning(Sender : TObject);
Var
i : Integer;
Begin
i := (GetSystemTime - StartTime - PauseTime);
Disguise('Thread[0] :: Time Running :: '+ IntToStr(i) +' ms');
End;

Procedure ScriptPause;
Var
i : Integer;
Begin
For i := 0 To High(Threads) Do
Threads[i].Enabled := False;
Disguise('Thread[3] :: SCRIPT PAUSED!');
PauseTime := GetSystemTime;
End;

Procedure ScriptResume;
Var
i : Integer;
Begin
For i := 0 To High(Threads) Do
Threads[i].Enabled := True;
Disguise('Thread[3] :: SCRIPT RESUMED!');
PauseTime := (GetSystemTime - PauseTime);
End;

Procedure InitForm;
Begin
frmDesign := CreateForm;
End;

Procedure InitTimer;
Var
i : Integer;
Begin
For i := 0 To High(Threads) Do
Threads[i] := TTimer.Create(frmDesign);
End;

Procedure SafeInitAll;
Var
v : TVariantArray;
Begin
SetArrayLength(v, 0);
ThreadSafeCall('InitForm', v);
ThreadSafeCall('InitTimer', v);

Threads[0].OnTimer := @ShowTimeRunning;
Threads[0].Interval := 1;
Threads[0].Enabled := True;

Threads[1].OnTimer := @DoNumber;
Threads[1].Interval := 1000;
Threads[1].Enabled := True;

Threads[2].OnTimer := @DoNumber2;
Threads[2].Interval := 1001;
Threads[2].Enabled := True;
End;

Begin
SetArrayLength(Threads, 3);
MyNumber2 := 10;
StartTime := GetSystemTime;
SafeInitAll;
Repeat
MoveMouse(Random(500), Random(500));
Wait(100);
Until(Stop);
WriteLn('We stopped!');
End.

Try running that a few times repeatedly. It seems to get all glitchy and stop somewhere in the middle without saying 'We stopped!'

The script is supposed to;
1)
Count up from 0-10
2)
Count down from 10-0
3)
Keep track of the time in MS

at the same time, while the mouse is moving in a random 500x500 box, using TTimers.

EDIT:
Updated the script with ScriptPause/Resume.

nielsie95

2009-11-01 13:09:38

From: Floor66
I only got the TTimers xD
Explain the SetTimeouts to me tho.

This is something I'm going to use if I ever write a script, though.

edit;
SCAR seems to crash fatally when you pause a script while the threads are running…


Use ScriptPause and ScriptResume to pause/resume the timer.

Floor66

2009-11-01 13:20:45

Wth I can't use ScriptPause? Gives me an Unknown Identifier…

EDIT:
Oh shit, I forgot… That's not how it works :p

EDIT2:
Got it ;)

Procedure ScriptPause;
Var
i : Integer;
Begin
For i := 0 To High(Threads) Do
Threads[i].Enabled := False;
Disguise('Thread[3] :: SCRIPT PAUSED!');
PauseTime := GetSystemTime;
End;

Procedure ScriptResume;
Var
i : Integer;
Begin
For i := 0 To High(Threads) Do
Threads[i].Enabled := True;
Disguise('Thread[3] :: SCRIPT RESUMED!');
PauseTime := (GetSystemTime - PauseTime);
End;

EDIT2:
Added 'PauseTime' so it can be subtracted from the total, so you'd get a genuine RUNtime count.
But still, if you play it a few times after eachother it glitches sometimes and quits somewhere randomly :(

Drax

2012-01-29 02:05:29

Can we still use this in scripts? Iv tryed but cant seem to get it working :(

Main

2012-01-29 02:35:03

am sure you can still do this pesudo multithreading, just have a function, but write it as a boolean or integer, and make while running the first function, run the second function.

bg5

2012-02-12 22:32:40

Just created this:



program Timers;

{$i SRL/SRL.simba}

var

frmDesign: TForm;
RandomCheck: TTimer;

a: integer;



procedure t1(sender: TObject);
begin
//FindNormalRandoms;
writeln('checking for randoms');
end;


//Creating the Form
procedure InitForm;
begin
frmDesign := CreateForm;

RandomCheck := TTimer.Create(frmDesign);

With RandomCheck do
begin
//Function which is run everytime the timer loops
RandomCheck.OnTimer := @t1;
//timer interval in ms
RandomCheck.Interval := 2000;
//enabled
RandomCheck.enabled := TRUE;
end;
end;


procedure SafeInitFormandTimer;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('InitForm',v);
end;


begin

SafeInitFormandTimer;
for a:= 1 to 20 do
begin
writeln('Do something');

wait (500);
end;
writeln(timerunning);
FreeForm(frmDesign);
end.


I didn't test it in real script yet . I'm a bit afraid it can crash something.

What happens if Timer call his procedure (t1) in the middle of other function ,like FindColors. For example FindColors have already scanned half of screen ,then Timer is called and interupts it. After Timer's procedure ends FindColors will continue it's work ( scans remaining half od screen) or will crash?

Mat

2012-03-20 13:29:07

From: beginner5
Just created this:



program Timers;

{$i SRL/SRL.simba}

var

frmDesign: TForm;
RandomCheck: TTimer;

a: integer;



procedure t1(sender: TObject);
begin
//FindNormalRandoms;
writeln('checking for randoms');
end;


//Creating the Form
procedure InitForm;
begin
frmDesign := CreateForm;

RandomCheck := TTimer.Create(frmDesign);

With RandomCheck do
begin
//Function which is run everytime the timer loops
RandomCheck.OnTimer := @t1;
//timer interval in ms
RandomCheck.Interval := 2000;
//enabled
RandomCheck.enabled := TRUE;
end;
end;


procedure SafeInitFormandTimer;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('InitForm',v);
end;


begin

SafeInitFormandTimer;
for a:= 1 to 20 do
begin
writeln('Do something');

wait (500);
end;
writeln(timerunning);
FreeForm(frmDesign);
end.


I didn't test it in real script yet . I'm a bit afraid it can crash something.

What happens if Timer call his procedure (t1) in the middle of other function ,like FindColors. For example FindColors have already scanned half of screen ,then Timer is called and interupts it. After Timer's procedure ends FindColors will continue it's work ( scans remaining half od screen) or will crash?

With this if you try any function say FindNormalRandoms it ends the script.

Home

2012-03-20 13:30:26

Timers doesn't work currently on Simba.

~Home