Forum in READ ONLY mode! All questions and discussions on Discord official server, invite link: https://discord.gg/VxsGzJ7

Mining SA

Only working scripts
afibur
Neophyte
Neophyte
Posts: 16
Joined: 17.02.2014 17:29

Re: Mining SA

Post by afibur »

Народ, помогите...
Настраивают меседжи для копки, все верно поставил, все равно тупо вокруг обкапывается. Не хочет полностью выкапывать кочку.
код

Code: Select all

 procedure Mine(X, Y: Integer);
var
  StaticData: TStaticCell;
  Tile: Word;
  Z: ShortInt;
  Finded: Boolean;
  Counter: Byte;
  StartTime: TDateTime;
  i: Integer;
begin
  Finded := False;
  StaticData := ReadStaticsXY(X, Y, WorldNum);
  for i := 0 to StaticData.StaticCount - 1 do begin
    if i >= StaticData.StaticCount then Break;
    if (GetTileFlags(2, StaticData.Statics[i].Tile) and $200) = $200 then begin
      Tile := StaticData.Statics[i].Tile;
      Z := StaticData.Statics[i].Z;
      Finded := True;
      Break;
    end; 
  end;
  
  CheckState(); 
  while Finded do begin
    if Dead or not Connected then Exit;
    if TargetPresent then CancelTarget;
    while not CheckMiningTool do begin
      if Dead or not Connected then Exit;
      CreateMiningTools;
    end;
    CheckLag(LagWait);
    Wait(WaitTime)
    UseObject(MiningTool);
    CheckLag(LagWait);
    WaitForTarget(WaitTime);
    if TargetPresent then begin
      StartTime := Now;
      TargetToTile(Tile, X, Y, Z);
      Counter := WaitCycles;
      Finded := False;
      while (not Finded) and (Counter > 0) do begin
        CheckLag(LagWait);
        if InJournalBetweenTimes('t mine there|is too far away|cannot be seen|no metal here to mine', StartTime, Now) <> 0 then Exit;
        if InJournalBetweenTimes('put it in your backpack|loosen some rocks|have worn out your tool', StartTime, Now) <> 0 then Finded := True;
        Dec(Counter);
      end;
      CheckState();
    end;
  end;    
end;
Код под катом.
UPDATE: скрипт реагирует на сообщения. Но при сообщении успешной копке, всеравно переходит к следующей точке...
UPDATE2: все работает, поменял количество вейтсайклов в начале скрипта.
Last edited by afibur on 26.02.2014 4:19, edited 1 time in total.
Half-Life
Novice
Novice
Posts: 86
Joined: 30.10.2012 12:06
Location: Одесса
Contact:

Re: Mining SA

Post by Half-Life »

Немного модифицированный скрипт копает по кочкам. Проверяет есть ли поблизости ПК. НЕ переплавляет руду!
Mining

Code: Select all

program Mining;

const
IngotsStorage=$409B2029;
IngotsType=$1BF2;

HomeRuneBook=$4032DFC3;
HomeRuneIndex=0;
RuneBookShift=7;

MiningType=$0F39;
TinkerType=$1EB8;
TKNumFirst=8;
TKNumSecond=23;
TKMinerNumFirst=8;
TKMinerNumSecond=72;

IronColor=$0000;
IronCount=40;

WaitTime=500;
RecalTime=2000;
WaitCycles=7;
LagWait=10000;

var
CurrentRune:Byte;
CurrentBook,MiningTool,TinkerTool:Integer;
GemTypes,OreTypes,Killers:array of Word;
RuneBooks:array of Cardinal;
cTime,cTime2:TDateTime;

procedure EventMinerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKMinerNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKMinerNumFirst) then Exit;
  CloseSimpleGump(GetGumpsCount-1);
end;

procedure EventTinkerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKNumFirst) then Exit;
  CloseSimpleGump(GetGumpsCount-1);
end;

function CheckMiningTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(MiningType, Backpack);
  if GetType(MiningTool) <> MiningType then MiningTool := FindItem;
  Result := FindCount > 0;
end;

function CheckTinkerTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(TinkerType, Backpack);
  if GetType(TinkerTool) <> TinkerType then TinkerTool := FindItem;
  Result := FindCount > 1;
end;

procedure CreateTKTools;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventTinkerGump');
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckTinkerTool) then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end
    else Wait(1000);
    Inc(Counter);
    if Counter > WaitCycles then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end;
  end;
end;

function CreateMiningTools: Boolean;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventMinerGump');
  if not CheckTinkerTool then begin
    CreateTKTools;
  end;
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckMiningTool) then Break;
    Inc(Counter);
    if Counter > WaitCycles then Break;
    Wait(1000);
  end;
  SetEventProc(evIncomingGump, '');
  CloseSimpleGump(GetGumpsCount-1);
  Result := CheckMiningTool;
end;

procedure Move(Item:Array of Word);
var
j:Byte;
begin
  CheckLag(LagWait);
  CheckLag(LagWait);
  for j := 0 to Length(Item)-1 do begin
    if Dead or not Connected then Exit;
    CheckLag(LagWait);
    While (FindType(Item[j], Backpack)>1) do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      Wait(WaitTime);
      MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
    end;
  end;
end;

procedure TakeIngots;
var
Count,CountBox:Word;
begin
  FindTypeEx(IngotsType,IronColor,Backpack,false);
  Count:=FindQuantity;
  if Count<IronCount then begin
    CheckLag(LagWait);
    Wait(WaitTime);
    UseObject(IngotsStorage);
    Wait(WaitTime*4);
    CheckLag(LagWait);
    CountBox:=GetQuantity(FindTypeEx(IngotsType,IronColor,IngotsStorage,false));
    if CountBox < IronCount then begin
      Disconnect;
      Halt;
    end;
    Grab(finditem,(IronCount-Count));
  end;
end;

function RecallRune(RuneBook: Cardinal; Rune: Byte):Boolean;
var
X,Y:Word;
begin
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  Result:=False;
  X:=GetX(Self);
  Y:=GetY(Self);
  CheckLag(LagWait);
  Wait(WaitTime);
  if Dead or not Connected then Exit;
  cTime2:=Now;
  while (cTime2 < cTime)do begin
    cTime2:=Now;
    wait(100);
  end;
  UseObject(RuneBook);
  CheckLag(LagWait);
  cTime:=Now+0.00008;
  if IsGump then begin
    if NumGumpButton(GetGumpsCount-1, RuneBookShift + 6*Rune) then begin
      CheckLag(LagWait);
      Wait(RecalTime);
      CheckLag(LagWait);
      Result := (X <> GetX(Self)) or (Y <> GetY(Self));
    end else Result := False;
  end else Result := False;
end;

function GoBase: Boolean;
begin
  Result:=RecallRune(HomeRuneBook, HomeRuneIndex);
end;

function NextRune: Boolean;
var
Counter:Cardinal;
begin
  if CurrentRune > 15 then begin
    CurrentRune := 0
    Inc(CurrentBook);
    if CurrentBook >= Length(RuneBooks) then CurrentBook := 0;
  end;
  for Counter := 0 to WaitCycles do begin
    if Dead or not Connected then Exit;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    GoBase;
    Wait(10000);
  end;
end;

procedure CheckState;
begin
  if MaxWeight < Weight + 60 then begin
    while True do begin
      if Dead or not Connected then Exit;
      if GoBase() then Break;
      if not RecallRune(RuneBooks[CurrentBook], CurrentRune) then Wait(10000);
    end;
    Move(OreTypes);
    Move(GemTypes);
    TakeIngots;
    while True do begin
      if Dead or not Connected then Exit;
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
      if GoBase() then Continue;
      if not NextRune then Wait(10000);
    end;
  end;
end;

function CheckPK: boolean;
var
i,q:integer;
begin
  FindDistance:=25;
  for q:=0 to high(Killers) do
  for i:=3 to 6 do
  if FindNotoriety(Killers[q],i)>0 then begin
    Result:=True;
    AddToSystemJournal('Пришел плохой дядя - ' + GetName(FindItem));
    AddToSystemJournal('Runebook # '+IntToStr(CurrentBook+1));
    AddToSystemJournal('Rune # '+IntToStr(CurrentRune+1));
    FindDistance:=2;
    Exit;
  end;
  FindDistance:=2;
end;

procedure Mine(X, Y: Integer);
var
Tile:Word;
Z:ShortInt;
Counter:Byte;
StartTime:TDateTime;
begin
  CheckState;
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  while True do begin
    if Dead or not Connected then Exit;
    if TargetPresent then CancelTarget;
    CheckLag(LagWait);
    Wait(WaitTime);
    while not CheckMiningTool do begin
      if Dead or not Connected then Exit;
      CreateMiningTools;
      While IsGump do CloseSimpleGump(GetGumpsCount-1);
    end;
    UseObject(MiningTool);
    CheckLag(LagWait);
    WaitForTarget(LagWait);
    if TargetPresent then begin
      StartTime := Now;
      TargetToTile(Tile, X, Y, Z);
      Counter:=WaitCycles;
      CheckLag(LagWait);
      if InJournalBetweenTimes('t mine there|is too far away|cannot be seen|is no metal here to mine', StartTime, Now) > 0 then
      Exit;
      Wait(200);
      Dec(Counter);
      CheckState;
      if CheckPK then begin
        cTime:=Now-0.00008;
        GoBase;
        Inc(CurrentRune);
        Wait(WaitTime*100);
        RecallRune(RuneBooks[CurrentBook], CurrentRune);
        CheckLag(LagWait);
        Wait(WaitTime);
      end;
    end;
  end;
end;

procedure MinePoint;
var
X, Y: Word;
begin
  X:=GetX(Self);
  Y:=GetY(Self);
  Mine(X,Y);
  Inc(CurrentRune);
end;

begin
 // AddGumpIgnoreByID(4063159494);
  SetEventProc(evIncomingGump, '');
  if not Connected() then begin
    Connect();
    Wait(10000);
  end;
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  cTime:=Now;
  RuneBooks:=[$4032DFFA,$402641B0];
  OreTypes:=[$19B7,$19B8,$19B9,$19BA];
  GemTypes:=[$3192,$3193,$3194,$3195,$3197,$3198];
  Killers:=[$0190,$0191,$025E,$025D];
  CurrentBook:=0;
  CurrentRune:=0;
  while True do begin
    if Dead then begin
      AddToSystemJournal('You Dead.');
      AddToSystemJournal('Runebook # '+IntToStr(CurrentBook+1));
      AddToSystemJournal('Rune # '+IntToStr(CurrentRune+1));
      Halt;
    end;
    if not Connected then begin
      Connect;
      Wait(10000);
      Continue;
    end;
    NextRune;
    MinePoint;
  end;
end.
tyca7
Posts: 6
Joined: 21.02.2014 12:34

Re: Mining SA

Post by tyca7 »

Half-Life wrote:Немного модифицированный скрипт копает по кочкам. Проверяет есть ли поблизости ПК. НЕ переплавляет руду!
Mining

Code: Select all

program Mining;

const
IngotsStorage=$409B2029;
IngotsType=$1BF2;

HomeRuneBook=$4032DFC3;
HomeRuneIndex=0;
RuneBookShift=7;

MiningType=$0F39;
TinkerType=$1EB8;
TKNumFirst=8;
TKNumSecond=23;
TKMinerNumFirst=8;
TKMinerNumSecond=72;

IronColor=$0000;
IronCount=40;

WaitTime=500;
RecalTime=2000;
WaitCycles=7;
LagWait=10000;

var
CurrentRune:Byte;
CurrentBook,MiningTool,TinkerTool:Integer;
GemTypes,OreTypes,Killers:array of Word;
RuneBooks:array of Cardinal;
cTime,cTime2:TDateTime;

procedure EventMinerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKMinerNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKMinerNumFirst) then Exit;
  CloseSimpleGump(GetGumpsCount-1);
end;

procedure EventTinkerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKNumFirst) then Exit;
  CloseSimpleGump(GetGumpsCount-1);
end;

function CheckMiningTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(MiningType, Backpack);
  if GetType(MiningTool) <> MiningType then MiningTool := FindItem;
  Result := FindCount > 0;
end;

function CheckTinkerTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(TinkerType, Backpack);
  if GetType(TinkerTool) <> TinkerType then TinkerTool := FindItem;
  Result := FindCount > 1;
end;

procedure CreateTKTools;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventTinkerGump');
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckTinkerTool) then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end
    else Wait(1000);
    Inc(Counter);
    if Counter > WaitCycles then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end;
  end;
end;

function CreateMiningTools: Boolean;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventMinerGump');
  if not CheckTinkerTool then begin
    CreateTKTools;
  end;
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckMiningTool) then Break;
    Inc(Counter);
    if Counter > WaitCycles then Break;
    Wait(1000);
  end;
  SetEventProc(evIncomingGump, '');
  CloseSimpleGump(GetGumpsCount-1);
  Result := CheckMiningTool;
end;

procedure Move(Item:Array of Word);
var
j:Byte;
begin
  CheckLag(LagWait);
  CheckLag(LagWait);
  for j := 0 to Length(Item)-1 do begin
    if Dead or not Connected then Exit;
    CheckLag(LagWait);
    While (FindType(Item[j], Backpack)>1) do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      Wait(WaitTime);
      MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
    end;
  end;
end;

procedure TakeIngots;
var
Count,CountBox:Word;
begin
  FindTypeEx(IngotsType,IronColor,Backpack,false);
  Count:=FindQuantity;
  if Count<IronCount then begin
    CheckLag(LagWait);
    Wait(WaitTime);
    UseObject(IngotsStorage);
    Wait(WaitTime*4);
    CheckLag(LagWait);
    CountBox:=GetQuantity(FindTypeEx(IngotsType,IronColor,IngotsStorage,false));
    if CountBox < IronCount then begin
      Disconnect;
      Halt;
    end;
    Grab(finditem,(IronCount-Count));
  end;
end;

function RecallRune(RuneBook: Cardinal; Rune: Byte):Boolean;
var
X,Y:Word;
begin
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  Result:=False;
  X:=GetX(Self);
  Y:=GetY(Self);
  CheckLag(LagWait);
  Wait(WaitTime);
  if Dead or not Connected then Exit;
  cTime2:=Now;
  while (cTime2 < cTime)do begin
    cTime2:=Now;
    wait(100);
  end;
  UseObject(RuneBook);
  CheckLag(LagWait);
  cTime:=Now+0.00008;
  if IsGump then begin
    if NumGumpButton(GetGumpsCount-1, RuneBookShift + 6*Rune) then begin
      CheckLag(LagWait);
      Wait(RecalTime);
      CheckLag(LagWait);
      Result := (X <> GetX(Self)) or (Y <> GetY(Self));
    end else Result := False;
  end else Result := False;
end;

function GoBase: Boolean;
begin
  Result:=RecallRune(HomeRuneBook, HomeRuneIndex);
end;

function NextRune: Boolean;
var
Counter:Cardinal;
begin
  if CurrentRune > 15 then begin
    CurrentRune := 0
    Inc(CurrentBook);
    if CurrentBook >= Length(RuneBooks) then CurrentBook := 0;
  end;
  for Counter := 0 to WaitCycles do begin
    if Dead or not Connected then Exit;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    GoBase;
    Wait(10000);
  end;
end;

procedure CheckState;
begin
  if MaxWeight < Weight + 60 then begin
    while True do begin
      if Dead or not Connected then Exit;
      if GoBase() then Break;
      if not RecallRune(RuneBooks[CurrentBook], CurrentRune) then Wait(10000);
    end;
    Move(OreTypes);
    Move(GemTypes);
    TakeIngots;
    while True do begin
      if Dead or not Connected then Exit;
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
      if GoBase() then Continue;
      if not NextRune then Wait(10000);
    end;
  end;
end;

function CheckPK: boolean;
var
i,q:integer;
begin
  FindDistance:=25;
  for q:=0 to high(Killers) do
  for i:=3 to 6 do
  if FindNotoriety(Killers[q],i)>0 then begin
    Result:=True;
    AddToSystemJournal('Пришел плохой дядя - ' + GetName(FindItem));
    AddToSystemJournal('Runebook # '+IntToStr(CurrentBook+1));
    AddToSystemJournal('Rune # '+IntToStr(CurrentRune+1));
    FindDistance:=2;
    Exit;
  end;
  FindDistance:=2;
end;

procedure Mine(X, Y: Integer);
var
Tile:Word;
Z:ShortInt;
Counter:Byte;
StartTime:TDateTime;
begin
  CheckState;
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  while True do begin
    if Dead or not Connected then Exit;
    if TargetPresent then CancelTarget;
    CheckLag(LagWait);
    Wait(WaitTime);
    while not CheckMiningTool do begin
      if Dead or not Connected then Exit;
      CreateMiningTools;
      While IsGump do CloseSimpleGump(GetGumpsCount-1);
    end;
    UseObject(MiningTool);
    CheckLag(LagWait);
    WaitForTarget(LagWait);
    if TargetPresent then begin
      StartTime := Now;
      TargetToTile(Tile, X, Y, Z);
      Counter:=WaitCycles;
      CheckLag(LagWait);
      if InJournalBetweenTimes('t mine there|is too far away|cannot be seen|is no metal here to mine', StartTime, Now) > 0 then
      Exit;
      Wait(200);
      Dec(Counter);
      CheckState;
      if CheckPK then begin
        cTime:=Now-0.00008;
        GoBase;
        Inc(CurrentRune);
        Wait(WaitTime*100);
        RecallRune(RuneBooks[CurrentBook], CurrentRune);
        CheckLag(LagWait);
        Wait(WaitTime);
      end;
    end;
  end;
end;

procedure MinePoint;
var
X, Y: Word;
begin
  X:=GetX(Self);
  Y:=GetY(Self);
  Mine(X,Y);
  Inc(CurrentRune);
end;

begin
 // AddGumpIgnoreByID(4063159494);
  SetEventProc(evIncomingGump, '');
  if not Connected() then begin
    Connect();
    Wait(10000);
  end;
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  cTime:=Now;
  RuneBooks:=[$4032DFFA,$402641B0];
  OreTypes:=[$19B7,$19B8,$19B9,$19BA];
  GemTypes:=[$3192,$3193,$3194,$3195,$3197,$3198];
  Killers:=[$0190,$0191,$025E,$025D];
  CurrentBook:=0;
  CurrentRune:=0;
  while True do begin
    if Dead then begin
      AddToSystemJournal('You Dead.');
      AddToSystemJournal('Runebook # '+IntToStr(CurrentBook+1));
      AddToSystemJournal('Rune # '+IntToStr(CurrentRune+1));
      Halt;
    end;
    if not Connected then begin
      Connect;
      Wait(10000);
      Continue;
    end;
    NextRune;
    MinePoint;
  end;
end.
не повезло мне не заводиться у меня на шарде((
Half-Life
Novice
Novice
Posts: 86
Joined: 30.10.2012 12:06
Location: Одесса
Contact:

Re: Mining SA

Post by Half-Life »

Почему? что пишет?
tyca7
Posts: 6
Joined: 21.02.2014 12:34

Re: Mining SA

Post by tyca7 »

Half-Life wrote:Почему? что пишет?
я уже не помню не стал заморачиваться переделал автоламбер EDREDа на кочки и все)
SirJas
Posts: 2
Joined: 07.03.2015 12:40
Location: Ставрополь

Re: Mining SA

Post by SirJas »

Здраствуйте,сразу скажу ,что не соображаю абсолютно ничего в скриптах на стелсе и вообще в скриптах , кроме как понять айдишники ... копаю вашим скриптом,которые переделан категорически на кочки ... хотелось бы что бы копал по скалам .. что нужно в нем изменить ?? вот собссно сам скрипт

Code: Select all

program Mining;

const
IngotsStorage=$411891B6;
IngotsType=$1BF2;

HomeRuneBook=$400AE09A;
HomeRuneIndex=0;
RuneBookShift=5;

MiningType=$0F39;
TinkerType=$1EB8;
TKNumFirst=8;
TKNumSecond=23;
TKMinerNumFirst=8;
TKMinerNumSecond=72;

IronColor=$0000;
IronCount=40;

WaitTime=500;
RecalTime=2000;
WaitCycles=7;
LagWait=10000;

var
CurrentRune:Byte;
CurrentBook,MiningTool,TinkerTool:Integer;
GemTypes,OreTypes,Killers:array of Word;
RuneBooks:array of Cardinal;
cTime,cTime2:TDateTime;

procedure EventMinerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKMinerNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKMinerNumFirst) then Exit;
  CloseSimpleGump(GetGumpsCount-1);
end;

procedure EventTinkerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKNumFirst) then Exit;
  CloseSimpleGump(GetGumpsCount-1);
end;

function CheckMiningTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(MiningType, Backpack);
  if GetType(MiningTool) <> MiningType then MiningTool := FindItem;
  Result := FindCount > 0;
end;

function CheckTinkerTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(TinkerType, Backpack);
  if GetType(TinkerTool) <> TinkerType then TinkerTool := FindItem;
  Result := FindCount > 1;
end;

procedure CreateTKTools;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventTinkerGump');
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckTinkerTool) then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end
    else Wait(1000);
    Inc(Counter);
    if Counter > WaitCycles then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end;
  end;
end;

function CreateMiningTools: Boolean;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventMinerGump');
  if not CheckTinkerTool then begin
    CreateTKTools;
  end;
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckMiningTool) then Break;
    Inc(Counter);
    if Counter > WaitCycles then Break;
    Wait(1000);
  end;
  SetEventProc(evIncomingGump, '');
  CloseSimpleGump(GetGumpsCount-1);
  Result := CheckMiningTool;
end;

procedure Move(Item:Array of Word);
var
j:Byte;
begin
  CheckLag(LagWait);
  CheckLag(LagWait);
  for j := 0 to Length(Item)-1 do begin
    if Dead or not Connected then Exit;
    CheckLag(LagWait);
    While (FindType(Item[j], Backpack)>1) do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      Wait(WaitTime);
      MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
    end;
  end;
end;

procedure TakeIngots;
var
Count,CountBox:Word;
begin
  FindTypeEx(IngotsType,IronColor,Backpack,false);
  Count:=FindQuantity;
  if Count<IronCount then begin
    CheckLag(LagWait);
    Wait(WaitTime);
    UseObject(IngotsStorage);
    Wait(WaitTime*4);
    CheckLag(LagWait);
    CountBox:=GetQuantity(FindTypeEx(IngotsType,IronColor,IngotsStorage,false));
    if CountBox < IronCount then begin
      Disconnect;
      Halt;
    end;
    Grab(finditem,(IronCount-Count));
  end;
end;

function RecallRune(RuneBook: Cardinal; Rune: Byte):Boolean;
var
X,Y:Word;
begin
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  Result:=False;
  X:=GetX(Self);
  Y:=GetY(Self);
  CheckLag(LagWait);
  Wait(WaitTime);
  if Dead or not Connected then Exit;
  cTime2:=Now;
  while (cTime2 < cTime)do begin
    cTime2:=Now;
    wait(100);
  end;
  UseObject(RuneBook);
  CheckLag(LagWait);
  cTime:=Now+0.00008;
  if IsGump then begin
    if NumGumpButton(GetGumpsCount-1, RuneBookShift + 6*Rune) then begin
      CheckLag(LagWait);
      Wait(RecalTime);
      CheckLag(LagWait);
      Result := (X <> GetX(Self)) or (Y <> GetY(Self));
    end else Result := False;
  end else Result := False;
end;

function GoBase: Boolean;
begin
  Result:=RecallRune(HomeRuneBook, HomeRuneIndex);
end;

function NextRune: Boolean;
var
Counter:Cardinal;
begin
  if CurrentRune > 15 then begin
    CurrentRune := 0
    Inc(CurrentBook);
    if CurrentBook >= Length(RuneBooks) then CurrentBook := 0;
  end;
  for Counter := 0 to WaitCycles do begin
    if Dead or not Connected then Exit;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    GoBase;
    Wait(10000);
  end;
end;

procedure CheckState;
begin
  if MaxWeight < Weight + 60 then begin
      while True do begin
      if Dead or not Connected then Exit;
      if GoBase() then Break;
      if not RecallRune(RuneBooks[CurrentBook], CurrentRune) then Wait(10000);
    end;
    Move(OreTypes);
    Move(GemTypes);
    TakeIngots;
    while True do begin
      if Dead or not Connected then Exit;
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
      if GoBase() then Continue;
      if not NextRune then Wait(10000);
    end;
  end;
end;

function CheckPK: boolean;
var
i,q:integer;
begin
  FindDistance:=25;
  for q:=0 to high(Killers) do
  for i:=3 to 6 do
  if FindNotoriety(Killers[q],i)>0 then begin
    Result:=True;
    AddToSystemJournal('Пришел плохой дядя - ' + GetName(FindItem));
    AddToSystemJournal('Runebook # '+IntToStr(CurrentBook+1));
    AddToSystemJournal('Rune # '+IntToStr(CurrentRune+1));
    FindDistance:=2;
    Exit;
  end;
  FindDistance:=2;
end;

procedure Heal();
begin
 if Poisoned then
  begin
   WaitTargetSelf;
   Cast('Cure');
   Wait(2500);
  end; 
 if GetHP(Self) < GetMaxHP(self) then
  begin
   Waittargetself();
   Cast('Greater Heal');
   Wait(2500);
  end;
end;

function GetFoundItems(var Items: Array Of Cardinal): Integer;
var List: TStringList; i: Integer;
begin
  List := TStringList.Create;
  if GetFindedList(List) = False then Result := 0
  else begin
    SetLength(Items, List.Count);
    for i := 0 to Length(Items)-1 do Items[i] := StrToInt('$'+List.Strings[i]);
    Result := Length(Items);
  end;
  List.Free;
end;

procedure CombineOre;
var
 CombineTypes : Array of Word;
 i,k : Integer;
 fItems : Array of Cardinal;
 //fItem : Cardinal;
begin
 CombineTypes := [$19B9, $19BA, $19B8];
 for i := 0 to Length(CombineTypes)-1 do
  begin
   FindType(CombineTypes[i], Backpack);
   if GetFoundItems(fItems) > 0 then
    for k := 0 to Length(fItems)-1 do
     begin      
      UseObject(fItems[k]);
      if WaitForTarget(60000) then
       TargetToObject(FindTypeEx($19B7, GetColor(fItems[k]), Backpack, True));
      Wait(500);
     end;
  end; 
end;

procedure Mine(X, Y: Integer);
var
//Tile:Word;
Z:ShortInt;
Counter:Byte;
StartTime:TDateTime;
begin
  CheckState;
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  while True do begin
    if Dead or not Connected then Exit;
    if TargetPresent then CancelTarget;
    CheckLag(LagWait);
    Wait(WaitTime);
    while not CheckMiningTool do begin
      if Dead or not Connected then Exit;
      CreateMiningTools;
      While IsGump do CloseSimpleGump(GetGumpsCount-1);
    end;
	//Heal;
    if Weight > (MaxWeight - 100) then CombineOre; 
    UseObject(MiningTool);
    CheckLag(LagWait);
    WaitForTarget(LagWait);
    if TargetPresent then begin
      StartTime := Now; 

      Z:=GetZ(self);
      TargetToXYZ(X, Y, Z);
      Counter:=WaitCycles;
      CheckLag(LagWait);
      if InJournalBetweenTimes('t mine there|is too far away|cannot be seen|is no metal here to mine|attacking', StartTime, Now) > 0 then
      Exit;
      Wait(200);
      Dec(Counter);
      CheckState;
      if (CheckPK) or (Hp < (MaxHp-10)) then begin
        cTime:=Now-0.00008;
        GoBase;
        Inc(CurrentRune);
        Wait(WaitTime*100);
        RecallRune(RuneBooks[CurrentBook], CurrentRune);
        CheckLag(LagWait);
		Heal();
        Wait(WaitTime);		
      end;      
    end;
  end;
end;

procedure MinePoint;
var
X, Y: Word;
begin
  X:=GetX(Self);
  Y:=GetY(Self);
  Mine(X,Y);
  Inc(CurrentRune);
end;

procedure OnSpeech(Text, SenderName : String; SenderID : Cardinal);
begin
 if Text = 'attacking you' then
  begin
   GoBase;
   Inc(CurrentRune);
   Wait(WaitTime*100);
   RecallRune(RuneBooks[CurrentBook], CurrentRune);
   CheckLag(LagWait);
   Wait(WaitTime);
  end;
end;

begin
  AddGumpIgnoreByID($F22EE4C6);
  SetEventProc(evUnicodeSpeech, 'OnSpeech');
  SetEventProc(evIncomingGump, '');
  if not Connected() then begin
    Connect();
    Wait(10000);
  end;
  While IsGump do CloseSimpleGump(GetGumpsCount-1);
  cTime:=Now;
  RuneBooks:=[$40A43658,$4017DD46];   //,$40746136
  OreTypes:=[$19B7,$19B8,$19B9,$19BA];
  GemTypes:=[$3192,$3193,$3194,$3195,$3197,$3198,
  $0F26,$0F13,$0F10,$0F19,$0F21,$0F16,$0F15,$0F25,$0F2D];
  Killers:=[$0190,$0191,$025E,$025D,$0011];
  CurrentBook:=0;
  CurrentRune:=0;
  while True do begin
    if Dead then begin
      AddToSystemJournal('You Dead.');
      AddToSystemJournal('Runebook # '+IntToStr(CurrentBook+1));
      AddToSystemJournal('Rune # '+IntToStr(CurrentRune+1));
      Halt;
    end;
    if not Connected then begin
      Connect;
      Wait(10000);
      Continue;
    end;
    NextRune;
    MinePoint;
  end;
end.
ledo
Posts: 1
Joined: 01.04.2015 18:30

Re: Mining SA

Post by ledo »

Доброго времени суток. Скрипт из самого первого поста при запуске, не делает ничего. Хотя все кнопочки там проставил под свой сервак. он не вылетает но сильно загружает и греет проц. С этого же стелса запущены 3 скрипта на лумбер и с ними нету никаких проблем. Помогите разобраться пожалуйста.
okloki21
Posts: 1
Joined: 21.08.2015 21:52

Re: Mining SA

Post by okloki21 »

Ребя прошу помощи разобраться в скрипте. Дело в том что скрипт при выгрузке руды иногда в хаотичном порятдке просто застывает после того как выгрузит все из пака. Чар может копать летать выгружать 10 раз нормально потом в какой то момент берет и застывает около сундука на минуту ато и 10 или меньше по разному. но потом летит дальше копать. В System Journal пишет бывает Drag error; Object not found Я попробывал исправить так
СКПИПТ
program Mining;

const
IngotsStorage=$41939597;
IngotsType=$1BF2;

HomeRuneBook=$40f2910d;
HomeRuneIndex=0;
RuneBookShift=7;

MiningType=$0F39;

TinkerType=$1EB8;
TKNumFirst=8;
TKNumSecond=23;

TKMinerNumFirst=8;
TKMinerNumSecond=72;

IronColor=$0000;
IronCount=$40;

WaitTime=500;
RecalTime=2000;
WaitCycles=7;
LagWait=5000; // CheckLag(LagWait); genera 'you see: backpack' en el journal del client , supongo como sistema de deteccion del lag



var
Terminated: Boolean;
CurrentRune: Byte;
CurrentBook,i: Integer;
GemTypes,OreTypes,Killers: array of Word;
RuneBooks: array of Cardinal;
MiningTool,TinkerTool: Cardinal;
cTime,cTime2: TDateTime;
direction,dist: Integer;


procedure EventMinerGump(Serial, GumpID, X, Y: Cardinal);
begin
if NumGumpButton(GetGumpsCount-1, TKMinerNumSecond) then Exit;
if NumGumpButton(GetGumpsCount-1, TKMinerNumFirst) then Exit;
CloseSimpleGump(GetGumpsCount-1);
end;


procedure EventTinkerGump(Serial, GumpID, X, Y: Cardinal);
begin
if NumGumpButton(GetGumpsCount-1, TKNumSecond) then Exit;
if NumGumpButton(GetGumpsCount-1, TKNumFirst) then Exit;
CloseSimpleGump(GetGumpsCount-1);
end;


function CheckMiningTool: Boolean;
begin
CheckLag(LagWait);
FindType(MiningType, Backpack);
if GetType(MiningTool) <> MiningType then MiningTool := FindItem;
Result := FindCount > 0;
end;


function CheckTinkerTool: Boolean;
begin
CheckLag(LagWait);
FindType(TinkerType, Backpack);
if GetType(TinkerTool) <> TinkerType then TinkerTool := FindItem;
Result := FindCount > 1;
end;

function CheckPK: boolean;
var
ii,q:integer;
begin
FindDistance:=25;
for q:=0 to high(Killers) do
for ii:=3 to 6 do
if FindNotoriety(Killers[q],ii)>0 then begin
Result:=True;
AddToSystemJournal('PK' +GetName(FindItem)+' libro: '+IntToStr(CurrentBook+1)+' Rune: '+IntToStr(CurrentRune+1));
FindDistance:=2;
Exit;
end;
FindDistance:=2;
if (Poisoned) or (HP<>MaxHP) then Result:=True;
end;
procedure CreateTKTools;
var
Counter: Cardinal;
begin
SetEventProc(evIncomingGump, 'EventTinkerGump');
UseObject(TinkerTool);
Counter := 0;
while True do begin
if (Dead)
or (not Connected)
or (CheckTinkerTool) then begin
SetEventProc(evIncomingGump, '');
Break;
end
else Wait(1000);
Inc(Counter);
if Counter > WaitCycles then begin
SetEventProc(evIncomingGump, '');
Break;
end;
end;
end;

function CreateMiningTools: Boolean;
var
Counter: Cardinal;
begin
SetEventProc(evIncomingGump, 'EventMinerGump');
if not CheckTinkerTool then begin
CreateTKTools;
end;
UseObject(TinkerTool);
Counter := 0;
while True do begin
if (Dead)
or (not Connected)
or (CheckMiningTool) then Break;
Inc(Counter);
if Counter > WaitCycles then Break;
Wait(1000);
end;
SetEventProc(evIncomingGump, '');
CloseSimpleGump(GetGumpsCount-1);
Result := CheckMiningTool;
end;


procedure MoveOres;
var
CurOre: Integer;
begin
CheckLag(LagWait);
for CurOre := 0 to Length(OreTypes)-1 do begin
if Dead or not Connected then Exit;
CheckLag(LagWait);
FindType(OreTypes[CurOre], Backpack);
while FindCount > 0 do begin
if Dead or not Connected then Exit;
CheckLag(LagWait);
MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
Wait(WaitTime);
FindType(OreTypes[CurOre], Backpack);
end;
end;
end;

procedure MoveGems;
var
CurGem: Integer;
begin
CheckLag(LagWait);
for CurGem := 0 to Length(GemTypes)-1 do begin
if Dead or not Connected then Exit;
CheckLag(LagWait);
FindType(GemTypes[CurGem], Backpack);
while FindCount > 0 do begin
if Dead or not Connected then Exit;
CheckLag(LagWait);
MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
Wait(WaitTime);
FindType(GemTypes[CurGem], Backpack);
end;
end;
end;


procedure TakeIngots;
var
count: integer;
begin
FindTypeEx(IngotsType, IronColor, Backpack, false);
count:=FindQuantity;
if count < IronCount then begin
UseObject(IngotsStorage);
wait(1500);
FindTypeEx(IngotsType, IronColor, IngotsStorage, false);
Grab(finditem, IronCount-count);
end;
end;

function RecallRune(RuneBook: Cardinal; Rune: Byte):Boolean;
var
Counter: Byte;
X, Y: Word;
begin
Result := False;
X := GetX(Self);
Y := GetY(Self);
CheckLag(LagWait);
Wait(WaitTime);
if Dead or not Connected then Exit;
cTime2:=Now;
while (cTime2 < cTime)do begin
cTime2:=Now;
wait(100);
end;
UseObject(RuneBook);
CheckLag(LagWait);
cTime:=Now+0.00008;
Counter := WaitCycles;
while Counter > 0 do begin
if IsGump then Break;
Wait(WaitTime);
CheckLag(LagWait);
Inc(Counter);
end;
if IsGump then begin
if NumGumpButton(GetGumpsCount-1, RuneBookShift + 6*Rune) then begin
CheckLag(LagWait);
Wait(RecalTime);
CheckLag(LagWait);
Result := (X <> GetX(Self)) or (Y <> GetY(Self));
end else Result := False;
end else Result := False;
end;


function GoBase: Boolean;
begin
Result := RecallRune(HomeRuneBook, HomeRuneIndex);
end;


function NextRune: Boolean;
var
Counter: Cardinal;
begin
Inc(CurrentRune);
if CurrentRune > 15 then begin
CurrentRune := 0
Inc(CurrentBook);
if CurrentBook >= Length(RuneBooks) then CurrentBook := 0;
end;
for Counter := 0 to WaitCycles do begin //bucle de recall is blocked etc
if Dead or not Connected then Exit;
Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
if Result then Break;
Inc(CurrentRune);
Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
if Result then Break;
GoBase;
Wait(10000);
end;
end;


procedure CheckState; //check weight tools
begin
if MaxWeight < Weight + 60 then begin
while True do begin
if Dead or not Connected then Exit;
if GoBase() then Break;
if GoBase() then Break; //gobase return boolean
if not RecallRune(RuneBooks[CurrentBook], CurrentRune) then Wait(10000);
end;
MoveOres;
MoveGems;
TakeIngots;
while True do begin
if Dead or not Connected then Exit;
if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break; //recallrune return boolean
if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
if GoBase() then Continue;
if not NextRune then Wait(10000);
end;
end;
while not CheckMiningTool do begin //wtf all functions return boolean ?ї
if Dead or not Connected then Exit;
CreateMiningTools;
end;
end;


function TileX(): Integer;
var
x: Integer;
begin
dist := 1;

case direction of
1: x := GetX(Self())+dist;
2: x := GetX(Self())+dist;
3: x := GetX(Self())+0;
4: x := GetX(Self())-dist;
5: x := GetX(Self())-dist;
6: x := GetX(Self())-dist;
7: x := GetX(Self())+0;
8: x := GetX(Self())+dist;
end;
Result := x;
end;

function TileY(): Integer;
var
y: Integer;
begin
dist:=1;

case direction of
1: y := GetY(Self())+0;
2: y := GetY(Self())-dist;
3: y := GetY(Self())-dist;
4: y := GetY(Self())-dist;
5: y := GetY(Self())+0;
6: y := GetY(Self())+dist;
7: y := GetY(Self())+dist;
8: y := GetY(Self())+dist;
end;
Result := y;
end;

procedure checkhp();
begin
if MaxHP>hp then begin
if not(CheckPK) and (IsObjectExists(IngotsStorage)) then exit ;

unequip(ArmsLayer);
wait(600);
unequip(EggsLayer);
wait(600);
unequip(GlovesLayer);
wait(600);
unequip(HatLayer);
wait(600);
unequip(LegsLayer);
wait(600);
unequip(NeckLayer);
wait(600);
unequip(TorsoLayer);
wait(600);
unequip(CloakLayer);
wait(600);
unequip(PantsLayer);
wait(600);
end;
end;
procedure Mine(X, Y: Integer);
var
StaticData: TStaticCell;
Tile: Word;
Z: ShortInt;
Finded: Boolean;
Counter: Byte;
StartTime: TDateTime;
i: Integer;
begin
Finded := True;
StaticData := ReadStaticsXY(X, Y, WorldNum);
for i := 0 to StaticData.StaticCount - 1 do begin
if i >= StaticData.StaticCount then Break;
if (GetTileFlags(2, StaticData.Statics.Tile) and $200) = $200 then begin
Tile := StaticData.Statics.Tile;
Z := StaticData.Statics.Z;
Finded := True;
Break;
end;
end;

CheckState();

while Finded do begin
if Dead or not Connected then Exit;
if TargetPresent then CancelTarget;
if Dead or not Connected then Exit;
CheckLag(LagWait);
Wait(WaitTime);



if CheckPK then begin
cTime:=Now-0.00008;
GoBase;
Inc(CurrentRune);
Wait(WaitTime*1200);
RecallRune(RuneBooks[CurrentBook], CurrentRune);
CheckLag(LagWait);
Wait(WaitTime);
end;

checkhp();

UseObject(MiningTool);
CheckLag(LagWait);
WaitForTarget(LagWait);
if TargetPresent then begin
StartTime := Now;
TargetToTile(Tile, X, Y, Z);
Counter := WaitCycles;
Finded := False;
while (not Finded) and (Counter > 0) do begin
CheckLag(LagWait);
if InJournalBetweenTimes('t mine there|is too far away|cannot be seen|is no metal here to mine', StartTime, Now) > 0
then
Exit;
if InJournalBetweenTimes('put it in your backpack|loosen some rocks but fail to find any useable ore|have worn out your tool', StartTime, Now) > 0
then
Finded := True; // aja! finded es una variable!
if Not Finded then Wait(200);
Dec(Counter);
end;
CheckState();
end;
end;
end;

procedure MinePoint; //New

begin

for direction :=1 to 8 do begin
Mine( TileX ,TileY ); //mina x y
end;
end;
//main ini
begin

cTime:=Now;
for i:=0 to 5 do begin
CloseSimpleGump(0);
CloseSimpleGump(GetGumpsCount-1);
end;
RuneBooks := [$40f294d3, $40f28e11];
OreTypes := [$19B7, $19B8, $19B9, $19BA];
GemTypes := [$3192, $3193, $3194, $3195, $3197, $3198, $0F25, $0F26, $0F16, $0F19, $0F21, $0F15, $0F10, $0F2D, $0F13];
CurrentBook := 0;
CurrentRune := 0;
SetEventProc(evIncomingGump, '');
while not Terminated do begin //main loop
if Dead then begin
Terminated := True;
Continue;
end;
if not Connected() then begin
Connect();
Wait(10000);
Continue;
end;
NextRune; //nextrune
MinePoint; //ini mine
end;
end.


ПОСЛЕ
CheckLag(LagWait);
Вставил
Wait(WaitTime); но результат тот же(

procedure MoveOres;
var
CurOre: Integer;
begin
CheckLag(LagWait);
for CurOre := 0 to Length(OreTypes)-1 do begin
if Dead or not Connected then Exit;
CheckLag(LagWait);
FindType(OreTypes[CurOre], Backpack);
while FindCount > 0 do begin
if Dead or not Connected then Exit;
CheckLag(LagWait);
MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
Wait(WaitTime);
FindType(OreTypes[CurOre], Backpack);
end;
end;
end;

МОЖЕТ кто топоможет разобраться почему чар паузит после того как скинет все?
Post Reply