Log in

View Full Version : DTM Freeing Help Please



John
04-09-2012, 07:50 AM
Now my problem is with freeing the dtms, when ever i stop the dtm it says 'Dtm 1, 2 Not freed' ? but i am freeing them all near the end of the script..


Script:
program EvlinsGildedAltarReMade;//V3.30By Evlin
{$i srl/srl/misc/smart.simba}
{$i SRL\SRL.simba}
{$i sps/sps.simba}



{______________ONLY HAVE ONE KIND OF BONES IN THE TAB YOU ARE USING____________}
const
{______________________________Script Setup____________________________________}

//Player Setup
UserLogin = 'fakeman@hotmail.com'; //RuneScape Username
UserPassword = 'fake'; //Runescape Password
Pin = ''; //Bank Pin, Leave blank if none.

//Summoning
UseSummoning = 'No'; //Leave at No Please(still in dev)

//BoneType
TypeOfBones = '3'; { Type in one of the Following:
* 0 = Dragon Bones
* 1 = BabyDragonBones
* 2 = FrostDragon Bones
* 3 = Big Bones

____________________________END OF SCRIPT SETUP________________________________}
var
Herb, BoneDTM, BonesForRun, XpForRun, BoneSacraficed, ExpGained, TripNumber: integer;
BoneName : String;

procedure DeclarePlayers;
begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
CurrentPlayer := 0;
Players[0].Name := UserLogin;
Players[0].Pass := UserPassword;
Players[0].Active := True;
Players[0].Pin := Pin;
end;


Procedure BoneValues;
begin
Case Lowercase(TypeOfBones) of
'0' :
begin
BoneDTM := DTMFromString('mlwAAAHicY2dgYOBjYmAQAGJhIBYBYikglg ViSSDeD5Q/AsTHgfg0EJ8C4mNAfAiI61tagSQTViwCJHFhRjwYCgBFZAg5') ;
BoneName:= 'DragonBones';
XpForRun:= 6300;
BonesForRun:= 25;
end;
'1':
begin
BoneDTM := DTMFromString('mlwAAAHicY2dgYLBmYmBwA2JHILYBYgcgdg ZiFyCeDJSfCcQzoHgeEM8B4mlAvHDWLCDJhBWLAElcmBEPhgIA fc4Iew==');
BoneName:='BabyDragonBones';
XpForRun:= 2625;
BonesForRun:= 25;
end;
'2':
begin
BoneDTM := DTMFromString('mlwAAAHicY2dgYOBjYmAQAGJhIBYBYikglg ViSSDeD5Q/AsTHgfg0EJ8C4mNAfAiI61tagSQTViwCJHFhRjwYCgBFZAg5') ;
BoneName:='FrostDragonBones';
XpForRun:= 15750;
BonesForRun:= 25;
end;
'3':
begin
BoneDTM := DTMFromString('mlwAAAHicY2dgYLBmYmBwA2JHILYBYgcgdg ZiFyCeDJSfCcQzoHgeEM8B4mlAvHDWLCDJhBWLAElcmBEPhgIA fc4Iew==');
BoneName:='BigBones';
XpForRun:= 1300;
BonesForRun:= 25;
end;
end;
end;


Procedure ProgressReport;
begin
WriteLn('_______Evlins Gilded Altar______');
WriteLn('Time Ran For ' + TimeRunning + '');
WriteLn('You Have Gained ' + IntToStr(ExpGained) + ' Prayer xp');
WriteLn('You Have Sacraficed ' + IntToStr(BoneSacraficed) + ' ' + (BoneName));
WriteLn('You Have Done ' + IntToStr(TripNumber) + ' Trips');
WriteLn('________________________________');
end;


procedure WalkToBankBackUp;
var
x, y: integer;
begin
SymbolAccuracy := 0.5;
if FindSymbol(x, y, 'bank') then
MMouse(x, y, 2, 2);
ClickMouse2(True);
SymbolAccuracy := 0.8;
FFlag(1);
Wait(500+random(500));
end;


procedure WalkToBank;
begin
SPS_Setup(RUNESCAPE_SURFACE, ['10_6'])
SPS_Continue := true;
if SPS_WalkPath([Point(4181, 2649), Point(4182, 2655), Point(4182, 2662),
Point(4183, 2670), Point(4184, 2676), Point(4192, 2678), Point(4199, 2680),
Point(4207, 2681), Point(4211, 2684)]) then
begin
FFlag(2);
Wait(1000 + Random(200));
end else
begin
WalkToBankBackUp;
end;
end;


function UseBankNPC: Boolean;
var
bx, by, Speed, ColFace, ColGrey, ColBlue, ColHair, t: Integer;
begin
Result := (LoggedIn) and (BankScreen or PinScreen);
if (Result) then exit;
Speed := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
ColFace := 7842002;
ColGrey := 8883597;
ColBlue := 5322302;
ColHair := 1714479;
if (FindObjThroughMM(bx, by, 'npc', [ColFace, ColBlue, ColGrey, ColHair], [5, 5, 5, 5],
['ounter', 'se Co', 'anke', 'to B', 'Banker', 'nker'], 2, 2)) then
begin
Mouse(bx, by, 0, 0, False);
if (WaitOptionMulti(['kly Co', 'se-qu', 'ank B', 'Bank Banker', 'ank', 'nker'], 750)) then
begin
t := (GetSystemTime + 5000);
repeat
if (BankScreen) or (PinScreen) then
begin
Result := true;
Break;
end;
Wait(50);
until(GetSystemTime > t);
if (Length(Players) > 0) then
if ((PinScreen) and (Players[CurrentPlayer].Pin <> '')) then
InPin(Players[CurrentPlayer].Pin);
Result := (BankScreen) or (PinScreen);
end;
end;
ColorToleranceSpeed(Speed);
end;


procedure Bank;
var
x, y: integer;
aFound: extended;
begin
Herb := DTMFromString('mggAAAHicY2NgYNgJxPuAeD8QbwPiw0B8HI inAfFUIJ4HxHOBeA4QTwZibl8eIMmEgSWBJDbMiANDAACM8Akc ');
repeat
UseBankNPC;
until(BankScreen) or (PinScreen);
if (PinScreen) then
begin
InPin(Pin);
end;
If (BankScreen) then
Wait(1300+random(50));
begin
if FindDTM(Herb, x, y, 26, 84, 480, 292) then
begin
Writeln('Found The Marrentill');
MMouse(x, y, 7, 7);
ClickMouse2(True);
Wait(375+random(50));
ClickMouse2(true);
Wait(375+random(50));
end else
begin
Writeln('You Have No Marrentill!');
TerminateScript;
end;
if FindDTMRotated(BoneDTM, x, y, 26, 84, 480, 292, -Pi/4, Pi/4, Pi/60, aFound) then
begin
Writeln('Found the ' + BoneName);
MMouse(x, y, 7, 7);
ClickMouse2(False);
Wait(450+random(25));
ChooseOption('All');
Wait(450+random(25));
end else
begin
WriteLn('You Have No ' + BoneName + '!');
TerminateScript;
end;
end;
CloseBank;
FreeDTM(Herb);
end;


procedure TeleToHouse;
begin
if (BankScreen) then
begin
CloseBank;
Wait(500+random(100));
end;
begin
InvMouse(1, 1);
Wait(6750+random(1000));
end;
end;


function DoorColour: Integer;
var
arP: TPointArray;
arC: TIntegerArray;
tmpCTS, i, arL: Integer;
X, Y, Z: Extended;
begin
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.27, 0.95);

FindColorsSpiralTolerance(MSCX, MSCY, arP, 5333874, MSX1, MSY1, MSX2, MSY2, 4);
if (Length(arP) = 0) then
begin
Writeln('Failed to find the color, no result.');
ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);
Exit;
end;

arC := GetColors(arP);
ClearSameIntegers(arC);
arL := High(arC);

for i := 0 to arL do
begin
ColorToXYZ(arC[i], X, Y, Z);

if (X >= 10.09) and (X <= 16.08) and (Y >= 10.47) and (Y <= 16.07) and (Z >= 7.71) and (Z <= 10.86) then
begin
Result := arC[i];
Writeln('AutoColor = ' + IntToStr(arC[i]));
Break;
end;
end;

ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);

if (i = arL + 1) then
Writeln('AutoColor failed in finding the color.');
end;


procedure OpenDoor;
var
x, y: integer;
Begin
ClickNorth(SRL_ANGLE_HIGH);
begin
if FindObjTPA(x, y, DoorColour , 3, 1, 70, 80, 200, ['oor']) then
begin
MMouse(x, y, 0, 0);
ClickMouse2(True);
Flag;
Wait(700+random(75));
MouseBox(250, 40, 268, 73, 1);
Flag;
Wait(2000+random(75));
end;
end;
end;


procedure TeleToBank;
var
x, y: integer;
begin
if FindColorTolerance(x, y, 7114144, 49, 23, 92, 50, 10) then
begin
MMouse(x, y, 0, 0);
Wait(280+random(250));
ClickMouse2(true);
Flag;
Wait(2300+random(200));
MouseBox(223, 381, 301, 387, 1);
Wait(7000+random(250));
end else
begin
WriteLn('Did not Find Amulet, Are You Sure You Have One?');
TerminateScript;
end;
end;


procedure RightBurner;
var
x, y: integer;
begin
if FindColorTolerance(x, y, 2409718, 313, 48, 413, 180, 10) then
begin
WriteLn('Found Right Burner, Lighting.');
MMouse(x, y, 0, 0);
Wait(200+random(50));
ClickMouse2(True);
Flag;
Wait(3000+random(120));
if FindBlackChatMessage('ncense') then
begin
WriteLn('The Right Burner Is Lit');
end else
begin
WriteLn('I dont Think the Burner Is Lit, Just Incase, starting over.');
TeleToBank;
end;
end;
end;


procedure LeftBurner;
var
x, y: integer;
begin
if FindColorTolerance(x, y, 2409718, 33, 89, 104, 158, 10) then
begin
WriteLn('Found Left Burner, Lighting.');
MMouse(x, y, 0, 0);
Wait(200+random(50));
ClickMouse2(True);
Flag;
Wait(3000+random(120));
if FindBlackChatMessage('ncense') then
begin
WriteLn('The Left Burner Is Lit');
end else
begin
WriteLn('I dont Think the Burner Is Lit, Just Incase, starting over.');
TeleToBank;
end;
end;
end;


function Book: Integer;
var
arP: TPointArray;
arC: TIntegerArray;
tmpCTS, i, arL: Integer;
X, Y, Z: Extended;
begin
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.35, 0.25);

FindColorsSpiralTolerance(MSCX, MSCY, arP, 10985631, MSX1, MSY1, MSX2, MSY2, 6);
if (Length(arP) = 0) then
begin
Writeln('Failed to find the color, no result.');
ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);
Exit;
end;

arC := GetColors(arP);
ClearSameIntegers(arC);
arL := High(arC);

for i := 0 to arL do
begin
ColorToXYZ(arC[i], X, Y, Z);

if (X >= 28.19) and (X <= 40.02) and (Y >= 29.35) and (Y <= 41.59) and (Z >= 34.29) and (Z <= 49.10) then
begin
Result := arC[i];
Writeln('AutoColor = ' + IntToStr(arC[i]));
Break;
end;
end;

ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);

if (i = arL + 1) then
Writeln('AutoColor failed in finding the color.');
end;


procedure Altar;
var
x, y: integer;
begin
if FindObjTPA(x, y, Book , 6, 1, 5, 10, 20, ['tar']) then
begin
WriteLn('Found Altar, Sacraficing.');
MMouse(x, y, 7, 7);
ClickMouse2(true);
end else
begin
WriteLn('Did not Find The Altar, Terminating Script.');
TerminateScript;
end;
end;


Procedure Sacrafice;
begin
InvMouse(9, MOUSE_RIGHT);
Wait(300+random(120));
ChooseOption('Use');
Altar;
Flag;
Wait(1700+random(200));
MouseBox(234, 404, 284, 453, MOUSE_LEFT);
end;


procedure Using;
begin
WriteLn('Sacraficing...');
repeat
Wait(500);
until(InvCount = 1);
WriteLn('Finished Sacraficing, Banking.');
BoneSacraficed := BoneSacraficed + BonesForRun;
ExpGained := ExpGained + XpForRun;
TripNumber := TripNumber + 1;
end;


Procedure SetUpScript;
begin
ClearDebug;
Smart_Server := 77;
Smart_Members := True;
Smart_Signed := True;
Smart_SuperDetail := False;
SetUpSRL;
DeclarePlayers;
WriteLn('Evlins Gilded Altar ReBuffed V3.30');
WriteLn('Please Be Sure To Post Any Bugs You Run Into On My Thread');
LogInPlayer;
BoneValues;
end;

begin
SetUpScript;
repeat
Bank;
TeleToHouse;
OpenDoor;
RightBurner;
LeftBurner;
Sacrafice;
Using;
ProgressReport;
TeleToBank;
WalkToBank;
until(not LoggedIn);
FreeDTM(BoneDTM);
end.

m34tcode
04-09-2012, 07:54 AM
I havent looked thoroughly, But it looks like you are writing over the dtm with a new dtm before freeing the old one. You must free the old one first, else it will be lost inside your computer forever;]

EDIT: I misinterpreted your case statement. Are you ending the script prematurely? That could cause leaked DTMs.
Other than that, all your DTMs seem to be freed up.

Sin
04-09-2012, 08:11 AM
Are you stopping it? You need to AddOnTerminate if so.

John
04-09-2012, 08:45 AM
I don't get what you mean.. Where would i add the AddOnTerminate?

Sex
04-09-2012, 09:01 AM
I havent looked thoroughly, But it looks like you are writing over the dtm with a new dtm before freeing the old one. You must free the old one first, else it will be lost inside your computer forever;]


Eh, it isn't lost forever :).

var
DTM : integer;
begin
DTM := DTMFromString('sdfsgsfdhdf');
Writeln(DTM);
DTM := DTMFromString('sdfgshghf');
Writeln(DTM);
FreeDTM(DTM - 1);
FreeDTM(DTM);
end.

@OP: You terminate the script via TerminateScript in multiple places in your script. This is likely the cause of your issue. As suggested, you can use AddOnTerminate and free the DTMs in that procedure so that they will be freed if the script terminates. Bear in mind that this will only run if you don't force-stop the script (i.e pressing stop twice). However, it is better to rewrite your procedure so that there is no need to do this. If an error occurs, just skip the rest of the procedure and go to the end to free all resources.

AddOnTerminate Example:

{$I SRL/SRL.simba} // needed because AddOnTerminate is in SRL
procedure Blah;
begin
Writeln('foo'); // free all your DTMs here.
end;

var
b : boolean;
begin
AddOnTerminate('Blah');
if not b then
TerminateScript
else
Writeln('b is true!');
end.

m34tcode
04-09-2012, 09:35 AM
Sex, Because dtms are created in order, that is inaccurate. You dont know that it is the previous DTM that was not freed, and if it wasn't, and you attempt to free it. Simba will raise an error

John
04-09-2012, 11:18 AM
Thank's guys, What would you guys say to me if i was going to apply for members with this script?

Frement
04-09-2012, 11:58 AM
Could something like this be used?

{ GLOBAL VAR }
var SafeDTMs: TIntegerArray;

function SafeDTMFromString(DTMString: String): LongInt;
begin
SetArrayLength(SafeDTMs, High(SafeDTMs) + 1);
SafeDTMs[High(SafeDTMs) - 1] := DTMFromString(DTMString);
Result := SafeDTMs[High(SafeDTMs) - 1];
end;

procedure SafeFreeDTMs;
var I: Integer;
begin
for I := 0 to High(SafeDTMs) do begin
FreeDTM(SafeDTMs[I]);
end;
end;

m34tcode
04-09-2012, 09:54 PM
Good idea. Could use add a free dtm fumction that frees the dtm and removes it from the array.

That way if you dynamically load dtms in your script, you can free them just as quickly

Home
04-09-2012, 10:06 PM
function FreeDTMs(DTMs :TIntegerArray) :Boolean;
var
I :Integer;
begin
for I := 0 to Length(DTMs) - 1 do
try FreeDTM(I); except end;
end;


I would do it that way : ) Just throwing ideas.

~Home

Sex
04-09-2012, 10:36 PM
Sex, Because dtms are created in order, that is inaccurate. You dont know that it is the previous DTM that was not freed, and if it wasn't, and you attempt to free it. Simba will raise an error

No, that script runs fine, there is no error. I added a DTMExists function to Simba a while ago, and you can use that if you want.

DTM1 := DTMFromString => 0
DTM2 := DTMFromString => 1
FreeDTM(DTM2)
DTM3 := DTMFromString => 1
etc..

For example, you can run this and it would still find the first DTM.

var
DTM, x, y, w, h : integer;
begin
DTM := DTMFromString('sdfsgsfdhdf');
Writeln(DTM);
DTM := DTMFromString('sdfgshghf');
Writeln(DTM);
GetClientDimensions(w, h);
if FindDTM(x, y, DTM - 1, 0, 0, w, h) then
MoveMouse(x, y);
if DTMExists(DTM - 1) then FreeDTM(DTM - 1);
if DTMExists(DTM) then FreeDTM(DTM);
end.

m34tcode
04-10-2012, 04:07 AM
An idea expanding upons frements.

With his function, we can add safefreedtms to freesrl;

This would mean no memory leaks, if you forget to free a dtm.