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

Mining SA

Only working scripts
Fenix
Developer
Developer
Posts: 275
Joined: 24.08.2010 7:20
Location: Ставрополь
Contact:

Mining SA

Post by Fenix »

Скрипт для майнинга. Проверялся на High Seas.
Необходимые скилы:
- Tinkering (чтобы мог делать Tinker Tools и лопаты).
- Magery или Chivalry для каста Recal/Sacred Journey.
Необходимые предметы в бекпаке:
- Немного инготов.
- Тинкер тузлы.
- Рунбука к дому/базе, где есть плавильня и ящик куда будут перекладываться инготы.
- Рунбуки к местам добычи.

Особенности: нет проверки на реги (я используют сет на 100% ЛРК), нет проверки на голод (нет особых последствий голодания). Скрипт автоматически делает лопаты, если таковые закончились. Автоматически делает тинкер тузлы, если их меньше двух.

Собственно скрипт:

Code: Select all

program Mining;

const
  Forge = $4006F085;
  IngotsStorage = $402181C2;
  IngotsType = $1BF2;
  
  HomeRuneBook = $4004FFCA;
  HomeRuneIndex = 0;
  RuneBookShift = 50; //50 for Recal, 75 for Sacred Journey, 100 for Gate Travel
  
  MiningType = $0F39;
  
  TinkerType = $1EB8;
  TKNumFirst = 9003;
  TKNumSecond = 11;
  
  TKMinerNumFirst = 9003;
  TKMinerNumSecond = 18;
  
  IronColor = $0000;
  IronCount = $20;
  
  WaitTime = 1000;
  RecalTime = 5000;
  WaitCycles = 7;
  LagWait = 15000;
  
var
  Terminated: Boolean;
  CurrentRune: Byte;
  CurrentBook: Integer;
  OreTypes: array of Word;
  GemTypes: array of Word;
  RuneBooks: array of Cardinal;
  MiningTool: Cardinal;
  TinkerTool: Cardinal;

procedure EventMinerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(0, TKMinerNumSecond) then Exit;
  if NumGumpButton(0, TKMinerNumFirst) then Exit;
  while IsGump do CloseSimpleGump(0);
end;


procedure EventTinkerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(0, TKNumSecond) then Exit;
  if NumGumpButton(0, TKNumFirst) then Exit;
  while IsGump do CloseSimpleGump(0);
end;

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


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

procedure CreateTKTools;//New
var
  Counter: Cardinal;
begin
  AddToSystemJournal('Делаем тинкер тузлы');
  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;
  while IsGump do CloseSimpleGump(0);
  AddToSystemJournal('Сделали тинкер тузлы');
end;

function CreateMiningTools: Boolean;//New
var
  Counter: Cardinal;
begin
//  AddToSystemJournal('Делаем минер тузлы');
  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, '');
  while IsGump do CloseSimpleGump(0);
  Result := CheckMiningTool;
//  AddToSystemJournal('Сделали минер тузлы');
end;

procedure SmellOre; //New
var
  CurOre, CurIndex: Integer;
  CurItem: Cardinal;
  List: TStringList;
begin
  try
    List := TStringList.Create;
    for CurOre := 0 to Length(OreTypes) - 1 do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      FindType(OreTypes[CurOre], Backpack);
      List.Clear;
      if GetFindedList(List) then begin
        CurIndex := 0;
        while CurIndex < List.Count do begin
          if Dead or not Connected then Exit;
          CurItem := StrToInt('$' + List.Strings[CurIndex]);
          CheckLag(LagWait);
          if (GetType(CurItem) <> OreTypes[CurOre])
            or (GetQuantity(CurItem) < 2) then begin
            Inc(CurIndex);
          end else begin
            if TargetPresent then CancelTarget;
            UseObject(CurItem);
            CheckLag(LagWait);
            WaitForTarget(WaitTime * 5);
            if TargetPresent then begin
              TargetToObject(Forge);
              CheckLag(LagWait);
              Wait(WaitTime);
            end;
            CheckLag(LagWait);
          end;
        end;
      end;
    end;
  finally
    List.Free;
  end;
end;

procedure MoveIngots; //New
var
  List: TStringList;
  CurIndex: Integer;
  CurIngot: Cardinal;
  CurIron: Cardinal;
  StartCount, ToMove: Integer;
begin
  CheckLag(LagWait);
  FindType(IngotsType, BackPack);
  CurIron := 0;
  try
    List := TStringList.Create;
    if GetFindedList(List) then begin
      CurIndex := 0;
      while CurIndex < FindCount do begin
        if Dead or not Connected then Exit;
        CurIngot := StrToInt('$' + List.Strings[CurIndex]);
        CheckLag(LagWait);
        StartCount := GetQuantity(CurIngot);
        if (GetColor(CurIngot) = IronColor)
          and (CurIron < IronCount) then begin
          ToMove := StartCount - (IronCount - CurIron);
        end else begin
          ToMove := StartCount;
        end;
        if ToMove > 0 then begin
          if MoveItem(CurIngot, ToMove, IngotsStorage, $FFFF, $FFFF, 0) then begin
            Inc(CurIndex);
            CurIron := CurIron + (StartCount - ToMove);
            CheckLag(LagWait);
            Wait(WaitTime);
          end;
        end else begin
          Inc(CurIndex);
          CurIron := CurIron + StartCount;
        end;
      end;
    end;
  finally
    List.Free;
  end;
end;

procedure MoveGems; //New
var
  List: TStringList;
  CurGem, CurIndex: Integer;
  CurItem: Cardinal;
begin
  CheckLag(LagWait);
  try
    List := TStringList.Create;
    for CurGem := 0 to Length(GemTypes) - 1 do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      FindType(GemTypes[CurGem], Backpack);
      List.Clear;
      if GetFindedList(List) then begin
        CurIndex := 0;
        while CurIndex < List.Count do begin
          if Dead or not Connected then Exit;
          CurItem := StrToInt('$' + List.Strings[CurIndex]);
          CheckLag(LagWait);
          if GetType(CurItem) <> GemTypes[CurGem] then begin
            Inc(CurIndex);
          end else begin
            Wait(WaitTime);
            MoveItem(CurItem, GetQuantity(CurItem), IngotsStorage, 0, 0, 0);
          end;
        end;
      end;
    end;
  finally
    List.Free;
  end;
end;


function RecallRune(RuneBook: Cardinal; Rune: Byte):Boolean; //New
var
  Counter: Byte;
  X, Y: Word;
begin
  Result := False;
  X := GetX(Self);
  Y := GetY(Self);
  CheckLag(LagWait);
  Wait(WaitTime);
  while Isgump do CloseSimpleGump(0);
  if Dead or not Connected then Exit;
  UseObject(RuneBook);
  CheckLag(LagWait);
  Counter := WaitCycles;
  while Counter > 0 do begin
    if IsGump then Break;
    Wait(WaitTime);
    CheckLag(LagWait);
    Inc(Counter);
  end;
  if IsGump then begin
    if NumGumpButton(0, RuneBookShift + 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; //New
begin
  Result := RecallRune(HomeRuneBook, HomeRuneIndex);
end;


function NextRune: Boolean; //New
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
    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 GoBase() then Break;
      if not RecallRune(RuneBooks[CurrentBook], CurrentRune) then Wait(10000);
    end;
    
    SmellOre;
    MoveIngots;
    MoveGems;
    
    while True do begin
      if Dead or not Connected then Exit;
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
      if GoBase() then Continue;
      if not NextRune then Wait(10000);
    end;
  end;
  while not CheckMiningTool do begin
    if Dead or not Connected then Exit;
    CreateMiningTools;
  end;
end;


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|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;
        if Not Finded then Wait(200);
        Dec(Counter);
      end;
      CheckState();
    end;
  end;    
end;

procedure MinePoint; //New
var
  X, Y: Word;
begin
  X := GetX(Self);
  Y := GetY(Self);
  Mine(X, Y);
  Mine(X + 1, Y);
  Mine(X + 1, Y + 1);
  Mine(X, Y + 1);
  Mine(X - 1, Y + 1);
  Mine(X - 1, Y);
  Mine(X - 1, Y - 1);
  Mine(X, Y - 1);
  Mine(X + 1, Y - 1);
  Mine(X + 2, Y + 2);
  Mine(X - 2, Y + 2);
  Mine(X - 2, Y - 2);
  Mine(X + 2, Y - 2);
end;

begin

  RuneBooks := [$40050CAF, $40053D22, $4004E5A6];
  OreTypes := [$19B7, $19B8, $19B9, $19BA];
  GemTypes := [$3192, $3193, $3194, $3195, $3197, $3198];

  CurrentBook := 0;
  CurrentRune := 0;
  
  SetEventProc(evIncomingGump, '');
  
  while not Terminated do begin
    if Dead then begin
      Terminated := True;
      Continue;
    end;
    if not Connected() then begin
      Connect();
      Wait(10000);
      Continue;
    end;
    NextRune;
    MinePoint;
  end;
end.
Описание настроек:
Anvile - идентификатор плавильни.
IngotsStorage - идентификатор ящика для инготов.
IngotsType - тип инготов.

HomeRuneBook - идентификатор рунбуки к дому/базе.
HomeRuneIndex - индекс руны к дому (нумерация начинается с 0).
RuneBookShift - сдвиг кодов кнопок в рунбуке (50 for Recal, 75 for Sacred Journey, 100 for Gate Travel).
MiningType - тип тузлов для майнинга.
TinkerType - тип тинкер тузлов
TKNumFirst - номер кнопки "Tools" в гампе тинкера (для создания тинкер тузлов).
TKNumSecond - номер кнопки для изготовления тинкер тузлов;

TKMinerNumFirst - номер кнопки "Tools" в гампе тинкера (для создания лопат).
TKMinerNumSecond - номер кнопки для изготовления лопат (если используете кирки - не забудьте поменять ещё и MiningType).
IronColor - цвет инготов айрона.
IronCount - количество инготов айрона, которое чар оставляет у себя после переплавки (для изготовления лопат и тинкер тузлов).

WaitTime - стандартное время ожидания.
RecalTime - время ожидания рекола.
WaitCycles - количество циклов ожидания.
LagWait - время ожидания лага.

OreTypes - массив с типами кучек руды (их ведь может быть несколько). Инициализируется в основной процедуре скрипта.
GemTypes - массив с типами добываемых камней (их тоже может быть несколько). Инициализируется в основной процедуре скрипта.
RuneBooks - массив с идентификаторами рунбук к местам добычи (тоже может быть несколько). Инициализируется в основной процедуре скрипта.

P.S.: В зависимости от шарда могут различаться коды кнопок как крафтерских меню, так и гампа рун-буки. Так что к этим вещам Ваше отдельное внимание.
Last edited by Fenix on 06.01.2011 22:01, edited 2 times in total.
Помните – ничто так не защищает ваши зубы 12 часов днем и 12 часов ночью как уважительное отношение к окружающим.
"Многие из вас знакомы с достоинствами программиста. Их всего три, и разумеется это: лень, нетерпеливость и гордыня"© Larry Wall
Xopxe
Posts: 8
Joined: 12.10.2010 12:40
Location: Odessa

Post by Xopxe »

Отличная работа! Респект!
На днях попробую запустить, а то на изиуо как-то напряжно контролировать процесс добычи.
porcojones
Neophyte
Neophyte
Posts: 10
Joined: 29.10.2010 15:27

Post by porcojones »

Como altero esse macro?
PReciso de um macro de recala e guarda..
Macks
Apprentice
Apprentice
Posts: 250
Joined: 27.02.2006 22:23
Location: АоП - Age Of Power

Post by Macks »

porcojones wrote:Como altero esse macro?
PReciso de um macro de recala e guarda..
Ele faz o minério antes de salvar recala de casa.
Ooops
Neophyte
Neophyte
Posts: 11
Joined: 26.10.2010 14:27

Post by Ooops »

ребята все сделал но после того как чар среколился на 1 руну анкопал металла он стоит и всё, в журнале пишется вечно какой-то один клилок и так вечно, подскажите пожалуйсто в чём проблема. И еще подскажите как запустить окно уо параллельно со стелс клиентом ! Заранее благодарен.
Fenix
Developer
Developer
Posts: 275
Joined: 24.08.2010 7:20
Location: Ставрополь
Contact:

Post by Fenix »

Добавил возможность выкладывать различные выкапываемые камни, их-то переплавлять нет необходимости. Подробности в первом посте с кодом.
Помните – ничто так не защищает ваши зубы 12 часов днем и 12 часов ночью как уважительное отношение к окружающим.
"Многие из вас знакомы с достоинствами программиста. Их всего три, и разумеется это: лень, нетерпеливость и гордыня"© Larry Wall
Zampi
Neophyte
Neophyte
Posts: 14
Joined: 07.01.2011 8:13
Location: RU

Post by Zampi »

Code: Select all

if (GetTileFlags(2, StaticData.Statics[i].Tile) and $200) = $200 then begin 
можете объяснить мне конструкцию, что делает?
Fenix
Developer
Developer
Posts: 275
Joined: 24.08.2010 7:20
Location: Ставрополь
Contact:

Post by Fenix »

С трудом. Проверяет есть ли в флагах тайла данной статики карты битовый флаг $200 (если не ошибаюсь, то это Surface или что-то подобное). Грубо говоря проверяет есть ли смысл кликать таргетом в данный тайл (может это какое-нить дерево или хлам на полу, а не скала).
Помните – ничто так не защищает ваши зубы 12 часов днем и 12 часов ночью как уважительное отношение к окружающим.
"Многие из вас знакомы с достоинствами программиста. Их всего три, и разумеется это: лень, нетерпеливость и гордыня"© Larry Wall
Zampi
Neophyte
Neophyte
Posts: 14
Joined: 07.01.2011 8:13
Location: RU

Post by Zampi »

Спасибо, я так примерно и думал… не очень понимаю «and $200)»
Zampi
Neophyte
Neophyte
Posts: 14
Joined: 07.01.2011 8:13
Location: RU

Post by Zampi »

с точки зрения именно синтаксиса :oops:
Miralex
Developer
Developer
Posts: 656
Joined: 11.03.2005 19:12
Contact:

Post by Miralex »

http://www.snkey.net/books/delphi/ch1-3.html
см. Побитовые операции
Zampi
Neophyte
Neophyte
Posts: 14
Joined: 07.01.2011 8:13
Location: RU

Post by Zampi »

Разобрался! Спасибо
myownstyle
Neophyte
Neophyte
Posts: 31
Joined: 28.12.2009 9:56

Post by myownstyle »

Работает как надо, класс, огромное спосибо!
Half-Life
Novice
Novice
Posts: 86
Joined: 30.10.2012 12:06
Location: Одесса
Contact:

Re: Mining SA

Post by Half-Life »

Добрый День, подскажите пожалуйста как правильно настроить рекол по руна буке. RuneBookShift идёт под номером 7. (Sacred Journey). На второй руне эта кнопка идёт под номером 13, третей 19.

Догадываюсь что надо что то изменить в строчке
if NumGumpButton(0, RuneBookShift + Rune) then begin
но не знаю что именно

сам разорбрался =\
Sumrak
Posts: 5
Joined: 02.11.2012 14:33

Re: Mining SA

Post by Sumrak »

Кто-нибудь может мне помочь? Нужен скрипт похожий, только чуть другой=) Просто в языках не шарю, а разбираться нет времени, сессия подходит=) надо свое учить...
Так вот.
Вместо того, чтоб складывать дома, надо плавить и продавать неписю, а деньги и гемы в банк=)
И желательно объясните как настроить рунбуки, да и вообще все под шард, а то, ну не шарю я ничего в этом=)! Спасибо.
Пс. Играю на Абисс, стелс запустить могу, чар заходит на сервак, а вот клиент через стелс не могу.
Я чайник со свистком!
Post Reply