SRL Archive - Help

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('mlwAAAHicY2dgYOBjYmAQAGJhIBYBYikglgViSSDeD5Q/AsTHgfg0EJ8C4mNAfAiI61tagSQTViwCJHFhRjwYCgBFZAg5');
            BoneName:= 'DragonBones';
            XpForRun:= 6300;
            BonesForRun:= 25;
         end;
   '1':
         begin
            BoneDTM := DTMFromString('mlwAAAHicY2dgYLBmYmBwA2JHILYBYgcgdgZiFyCeDJSfCcQzoHgeEM8B4mlAvHDWLCDJhBWLAElcmBEPhgIAfc4Iew==');
            BoneName:='BabyDragonBones';
            XpForRun:= 2625;
            BonesForRun:= 25;
         end;
   '2':
         begin
            BoneDTM := DTMFromString('mlwAAAHicY2dgYOBjYmAQAGJhIBYBYikglgViSSDeD5Q/AsTHgfg0EJ8C4mNAfAiI61tagSQTViwCJHFhRjwYCgBFZAg5');
            BoneName:='FrostDragonBones';
            XpForRun:= 15750;
            BonesForRun:= 25;
         end;
   '3':
         begin
            BoneDTM := DTMFromString('mlwAAAHicY2dgYLBmYmBwA2JHILYBYgcgdgZiFyCeDJSfCcQzoHgeEM8B4mlAvHDWLCDJhBWLAElcmBEPhgIAfc4Iew==');
            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('mggAAAHicY2NgYNgJxPuAeD8QbwPiw0B8HIinAfFUIJ4HxHOBeA4QTwZibl8eIMmEgSWBJDbMiANDAACM8Akc');
  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.

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.

Are you stopping it? You need to AddOnTerminate if so.

I don't get what you mean.. Where would i add the AddOnTerminate?

From: m34tcode
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.

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

Thank's guys, What would you guys say to me if i was going to apply for members with this script?

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;

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

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

From: m34tcode
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.

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.