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

quest HeartWood Bowcraft

Only working scripts
Post Reply
shinma
Expert
Expert
Posts: 505
Joined: 28.04.2011 12:05

quest HeartWood Bowcraft

Post by shinma »

Написал и выложил на зло всем жадным скриптерам. Для лентяев самое оно. одно но - сортировку халявно-полученного добра придумывайте сами, или ручками сидите и сортируйте что вам надо из того что нафармил бот. Сортировку не включал специально. чтобы не убрать интерес к игре.

Code: Select all

Program questHeartWoodBowcraft;
//Autor: Shinma
//Clear all quest!!!!
//Skill BC mast be 100
//Char mast have GiantBeetle with clear pack
//Char mast have 2-5 tinkertools,2-5 fletching
//Char mast have 0-ZERO boards and ingot, All material must be in bank in BugInBank
//Char autocraft fletching, tinkertools. He mast Have skill Tinkering for that. 
//this scipt not sort item.
const
QuestNPC1=$00016062 ;   //Enter ID
GiantBeetle=$0006B91A ; //Enter ID
BankX=7035;             //Bank in Heartwood
BankY=409;              //Bank in Heartwood
BugInBank =$400F2468 ;  //Enter ID Bag In Bank with board
QuestX= 7050;           //coord where do it quest(1 tail with trash barrel)
QuestY= 378;            //coord where do it quest
TrashBarrel=$0E77 ;
fletching=$1022 ;
TinkerTool=$1EB8 ;
ingot=$1BF2 ;
boards=$1BD7 ;
Bows=$13B2;         
Crossbows=$0F50;   
HeavyCrossbows=$13FD ; 
RepeatingCrossbows=$26C3;  
GumpAc=$E5DC;
GumpOk=$0320;


var
agump,i,j,n:integer;
QuestNPC : array of Cardinal;
QuestName : array of string;

procedure Init;
begin
AddToSystemJournal('Init') ;
QuestNPC:=[QuestNPC1];
SetPauseScriptOnDisconnectStatus(True);
SetARStatus(True);
FindDistance:=20;
if not Connected then 
    begin
    Connect;
    wait(5000);
    end;
end;

procedure CloseGamp;
var
g:integer;
begin
AddToSystemJournal('CloseGamp') ;
    for g:=0 to  GetGumpsCount-1 do 
        begin       
        if (GetGumpID(g) = $0326)  then 
            begin  
                NumGumpButton(g,5); 
                wait(500);  
                 NumGumpButton(g,0);
              //  AddToSystemJournal('ok') ;
            end;
        if (GetGumpID(g) = $FF3D ) or (GetGumpID(g) = $0320 )  then   
            begin
                NumGumpButton(g,7);  
                NumGumpButton(g,5); 
                 //AddToSystemJournal('Брать квест') ;
                 wait(500);
            end
            else
           //  AddToSystemJournal('не дали квест') ; 
        if (GetGumpID(g) = $E5DC) or (GetGumpID(g) =  $FF93) then   
            begin 
            NumGumpButton(g,7); 
            NumGumpButton(g,5);                  
          //  AddToSystemJournal('Check') ;
            end;
        //else  
          //  AddToSystemJournal('No Check') ;
        end; 
        wait(500);  
        for g:=0 to  GetGumpsCount-1 do 
        CloseSimpleGump(g); 
end;

Procedure CheckTinkerTools;
begin
checklag(50000);
AddToSystemJournal('CheckTinkerTools') ;
while (count(TinkerTool) <2) and (count(ingot) >2) do
  begin  
  for i:=0 to  GetGumpsCount do 
  begin      
  wait(500);
  CloseSimpleGump(i); 
  end;
  agump := GetGumpsCount;
  checklag(50000);
  UseObject(FindType(TinkerTool,Backpack)); 
    wait(1000);
    while agump = GetGumpsCount do
    Wait(60);     
    NumGumpButton(GetGumpsCount-1,9002);
    wait(600);
    NumGumpButton(GetGumpsCount-1,11); 
    AddToSystemJournal('Craft TinkerTool');
    wait(5000); 
  end;
end;

Procedure Checkfletching;
begin
checklag(50000);
AddToSystemJournal('Checkfletching') ;
while (count(fletching) <5) and (count(ingot) >3) do
  begin  
  for i:=0 to  GetGumpsCount do 
  begin      
  wait(500);
  CloseSimpleGump(i); 
  end;
  agump := GetGumpsCount;
  checklag(50000); 
  CheckTinkerTools;
  UseObject(FindType(TinkerTool,Backpack)); 
    wait(1000);
    while agump = GetGumpsCount do
    Wait(60);     
    NumGumpButton(GetGumpsCount-1,9002);
    wait(600);
    NumGumpButton(GetGumpsCount-1,28); 
    AddToSystemJournal('craft fletching');
    wait(5000); 
  end;
end;

procedure checkboards;
var
ZukBugBoard: Cardinal;
begin
AddToSystemJournal('checkboards') ;
if (Count(boards) < 100) then
  begin 
  if ObjAtLayer(HorseLayer) > 0 then 
    begin
    UseObject(Self);
    checklag(50000); 
    wait(500);
    RequestContextMenu(GiantBeetle);
    SetContextMenuHook(GiantBeetle, 10);
    wait(500);
    checklag(50000);
    ZukBugBoard := FindType(boards, LastContainer);
    if GetQuantity(ZukBugBoard) >= 100 then 
        begin 
        MoveItem(ZukBugBoard, count(boards), Backpack(), 0, 0, 0);  
        wait(2000); 
        checklag(50000); 
        if ObjAtLayer(HorseLayer) = 0 then
                begin
               // newmovexy(getX(GiantBeetle),gety(GiantBeetle),true,1,true);
                checklag(50000);
                UseObject(GiantBeetle);
                wait(2000);
                end;    
        end
    else
        begin  
        while ObjAtLayer(HorseLayer) = 0 do
            begin
            newmovexy(getX(GiantBeetle),gety(GiantBeetle),true,1,true);
            checklag(50000);
            UseObject(GiantBeetle);
            wait(500);
            end;
        newmovexy(BankX,BankY,true,1,true);   
       // while not dead and (ObjAtLayer(BankLayer) = 0) do
       //     begin 
            checklag(60000);
            uosay('bank');  
            wait(2000);
       //     end;  
        UseObject(BugInBank); 
        checklag(60000); 
        wait(2000);
        FindType(boards, BugInBank);
        checklag(60000); 
        MoveItem(FindItem,2500,backpack,0,0,0);
        wait(2000); 
        if count(ingot) < 50 then
          begin      
          UseObject(BugInBank); 
          checklag(60000); 
          wait(2000);
          FindType(ingot, BugInBank);
          checklag(60000); 
          MoveItem(FindItem,80,backpack,0,0,0);
          wait(2000);
          end;
          if ObjAtLayer(HorseLayer) > 0 then
            begin
            checklag(50000);
            UseObject(Self);
            checklag(50000); 
            wait(2000);
            RequestContextMenu(GiantBeetle);
            SetContextMenuHook(GiantBeetle, 10);
            wait(2000);
            checklag(50000);
            MoveItem(FindType(boards, backpack), count(boards), LastContainer, 0, 0, 0);  
            wait(2000); 
            checklag(50000);                  
            end;  
            if ObjAtLayer(HorseLayer) = 0 then
                begin
               // newmovexy(getX(GiantBeetle),gety(GiantBeetle),true,1,true);
                checklag(50000);
                UseObject(GiantBeetle);
                wait(2000);
                end;
        newmovexy(QuestX,QuestY,true,1,true); 
        end;
    end;
  end;  
end;

procedure create(BtRz,BtIt,kolvoboards,kolvoItem:integer;TpItem:word);
var
aa : TClilocRec;  
bb : TClilocItemRec;
OldSkill : Double;
checkW,ddd:integer;
begin
AddToSystemJournal('create') ;
IgnoreReset;
aa := GetToolTipRec(backpack);
bb := aa.Items[1];

while  (count(fletching)>0) and (strtoint(bb.Params[0])<124)  and not dead and (count(boards)>=kolvoboards) and (count(TpItem) < kolvoItem) do
  begin
  for i:=0 to  GetGumpsCount do 
    begin      
    wait(500);
    CloseSimpleGump(i); 
    end;
    agump := GetGumpsCount;
    checklag(50000);  
    CheckTinkerTools;
    Checkfletching;
    UseObject(FindType(fletching,Backpack)); 
    wait(1000);
    while agump = GetGumpsCount do
    Wait(60);     
    NumGumpButton(GetGumpsCount-1,BtRz);
    wait(600);
    NumGumpButton(GetGumpsCount-1,BtIt); 
    AddToSystemJournal('Create Item');
    wait(1000);     
    checkW:=0;   
    //AddToSystemJournal('111 count(TpItem)='+inttostr(count(TpItem)));
    while not dead and connected and (strtoint(bb.Params[0])<124) and IsObjectExists(FindItem) and (count(boards)>=kolvoboards) and (count(fletching) > 0) and (count(TpItem) < kolvoItem) and (checkW < 11)do  
    begin   
      checklag(50000); 
      WaitGump('1999');
      Wait(1500);
      aa := GetToolTipRec(backpack);
      bb := aa.Items[1]; 
      checkW:=checkW+1; 
      //AddToSystemJournal('222 count(TpItem)='+inttostr(count(TpItem)));        
    end;  
    CloseGamp;
    aa := GetToolTipRec(backpack);
    bb := aa.Items[1];
  end  ;
end; 


function CheckName ( ItemName, CheckString : String) : Boolean;
begin
result:=BMSearch(1,LowerCase(ItemName),LowerCase(CheckString)) >0;
end;

Procedure QuestReq;
var gi : TGumpInfo;
    i : Integer;
begin
AddToSystemJournal('QuestReq') ;
SetLength(QuestName,0);
checklag(60000);
QuestRequest;
wait(1000);
GetGumpInfo(GetGumpsCount-1, gi);
AddToSystemJournal('Gump has ' + IntToStr(Length(gi.XmfHTMLGumpColor)) + ' XmfHTMLGumpColors');
if Length(gi.XmfHTMLGumpColor) > 0 then
for i := 1 to (Length(gi.XmfHTMLGumpColor)-1) do
    begin
     
    SetLength(QuestName,Length(QuestName) +1 );
	QuestName[Length(QuestName)-1]:=GetClilocByID(gi.XmfHTMLGumpColor[i].Cliloc_id);
    end; 
    for i:=0 to (Length(QuestName)-1) do
  AddToSystemJournal('QuestName=' + QuestName[i]);
  NumGumpButton(GetGumpsCount-1,0);
end;

procedure MarkItem(ItType:word;kolvoItem:integer);
var
p:integer;
begin
AddToSystemJournal('MarkItem') ;
p:=0;
n:=0;
CloseGamp;
//findtype(ItType,backpack);
AddToSystemJournal('(count(ItType)='+inttostr(count(ItType))+' Name='+GetName(findtype(ItType,backpack))+' Hex='+inttohex(ItType,4));

if (count(ItType) >= kolvoItem) then
 while not dead and (p < kolvoItem)   do    
    begin 
    findtype(ItType,backpack);
    if  GetColor(finditem)=$0000 then
        begin       
        WaitTargetObject (finditem);    
        checklag(60000);
        RequestContextMenu(Self);
        SetContextMenuHook(Self, 5) ;
        wait(500);         
        end;
    Ignore (finditem);
    p:=p+1;  
    AddToSystemJournal('p='+inttostr(p));
    n:=1;
    wait(100);    
    end;  
    IgnoreReset;  
    if  TargetPresent then CancelTarget;
end;

procedure QuestEnd;
var
a:integer;
//gi : TGumpInfo;
begin
AddToSystemJournal('QuestEnd') ;
   // for i:= 0 to (Length(QuestNPC)-1) do
   if n = 1 then
    begin 
    //WaitGump('5');  
CloseGamp;
    a:=GetGumpsCount;
    checklag(60000);
    UseObject(QuestNPC[j]);
    while a =  GetGumpsCount do wait(50); 
   // GetGumpInfo(GetGumpsCount-1, gi);
    if GetGumpID(GetGumpsCount-1) = GumpOk  then   
    begin
    NumGumpButton(GetGumpsCount-1,5);        
   // AddToSystemJournal('Check');  
    SetLength(QuestName,0);
    end;
CloseGamp;
    end;  
    wait(500);
end;

Procedure QuestCheck;
begin
AddToSystemJournal('QuestCheck') ;

for j:=0 to (Length(QuestName)-1) do
    begin        
    AddToSystemJournal('QuestName[i] = ' +QuestName[j]); 
    if CheckName(QuestName[j],'Ingenious')then  
    if length(QuestName[j])=27 then
        begin 
        //RepeatingCrossbows=$26C3; 10 шт  
        AddToSystemJournal('Ingenious Archery, Part III');   
        AddToSystemJournal('create RepeatingCrossbows');
        create(9003,10,10,10,RepeatingCrossbows); 
        MarkItem(RepeatingCrossbows,10);
        QuestEnd;
        end;   
        if CheckName(QuestName[j],'Ingenious') then 
        if length(QuestName[j])=26 then
        begin 
        //HeavyCrossbows=$13FD ;  8 шт   
        AddToSystemJournal('Ingenious Archery, Part II'); 
        AddToSystemJournal('create HeavyCrossbows');
        create(9003,8,10,8,HeavyCrossbows);  
        MarkItem(HeavyCrossbows,8); 
        QuestEnd; 
        end;            
    if CheckName(QuestName[j],'Ingenious') then
    if length(QuestName[j])=25 then
    //if BMSearch(24,'Part I',QuestName[i]) >0 
        begin 
        //Crossbows=$0F50; 10 шт 
        AddToSystemJournal('Ingenious Archery, Part I');   
        AddToSystemJournal('create Crossbows');
        create(9003,7,7,10,Crossbows); 
        MarkItem(Crossbows,10); 
        QuestEnd;                      
        end;
    if CheckName(QuestName[j],'A Simple Bow')    then
        begin 
        //???     Bows    7шт 
        AddToSystemJournal('A Simple Bow');   
        AddToSystemJournal('create Bows');
        create(9003,6,7,10,Bows); 
        MarkItem(Bows,10);
        QuestEnd;
        end;
    end;
end;

procedure GimeMeQuest;
var
kk,a:integer;
begin
AddToSystemJournal('GimeMeQuest') ; 
  AddToSystemJournal('Length(QuestNPC)='+inttostr(Length(QuestNPC)));
    for kk:=0 to (Length(QuestNPC)-1) do 
        begin
        checklag(60000); 
        AddToSystemJournal('i='+inttostr(kk));
        AddToSystemJournal('name='+GetName(QuestNPC[kk]));
        UseObject(QuestNPC[kk]);
        a:=GetGumpsCount;
        checklag(60000);
        UseObject(QuestNPC[kk]);
        wait(500); 
        checklag(60000); 
        CloseGamp;  
        end;    
        AddToSystemJournal('name end');
end;
begin
checklag(60000);
Init;
checklag(60000);
CloseGamp;
checklag(60000);
while not dead do
    begin   
    checkboards;
    CheckTinkerTools;
    Checkfletching;
    checklag(60000);
    GimeMeQuest;
    QuestReq;
    QuestCheck;
    end;
end.
П.С. Жадным скриптерам: от добра (стелс) добра не ищут. И желаю чтоб на каждый ваш заныканный скрипт, на этом форуме появилось по два в гораздо лучшем исполнении.
--->>>ПОИСК ПО ФОРУМУ, НАЧНИ С НЕГО!!!<<<---
--->>>Search the forum, start with him!!!<<<---
95% Ваших вопросов уже кем-то написаны и решены.
Хреник
Novice
Novice
Posts: 70
Joined: 11.06.2008 20:33

Re: quest HeartWood Bowcraft

Post by Хреник »

молодец, почерпнул пару идей.

спасибо
Tune
Neophyte
Neophyte
Posts: 25
Joined: 09.01.2014 6:08

Re: quest HeartWood Bowcraft

Post by Tune »

Вроде все работало, запускаю на днях:
13:43:31:778 name=Jusae
13:43:33:292 CloseGamp
13:43:33:795 name end
13:43:33:798 QuestReq
13:43:35:322 Gump has 1 XmfHTMLGumpColors
13:43:35:325 QuestCheck
13:43:35:329 checkboards
13:43:35:732 CheckTinkerTools
13:43:36:075 Checkfletching
13:43:36:538 GimeMeQuest
13:43:36:542 Length(QuestNPC)=1
13:43:36:886 i=0
13:43:36:888 name=Jusae
13:43:38:321 CloseGamp
13:43:38:824 name end
13:43:38:827 QuestReq
13:43:40:091 Gump has 1 XmfHTMLGumpColors
13:43:40:094 QuestCheck
13:43:40:098 checkboards
13:43:40:590 CheckTinkerTools
13:43:40:833 Checkfletching
13:43:41:096 GimeMeQuest
13:43:41:099 Length(QuestNPC)=1
И оно повторяется, повторяется, повторяется...
В паке как обычно 3 тинкертулса, штук 8 флетчертулс, ресы в банке в мешке, жук постой, стартую у квестера, серв абисс...
SirJas
Posts: 2
Joined: 07.03.2015 12:40
Location: Ставрополь

Re: quest HeartWood Bowcraft

Post by SirJas »

а что значит сортировка не включена??? он не будет тоскать руники в дом????
shinma
Expert
Expert
Posts: 505
Joined: 28.04.2011 12:05

Re: quest HeartWood Bowcraft

Post by shinma »

Это значит что он просто собирает в сумку и не выкидывает какахи.
Всем привет.
--->>>ПОИСК ПО ФОРУМУ, НАЧНИ С НЕГО!!!<<<---
--->>>Search the forum, start with him!!!<<<---
95% Ваших вопросов уже кем-то написаны и решены.
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Re: quest HeartWood Bowcraft

Post by Vizit0r »

привет)
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Sonick071
Neophyte
Neophyte
Posts: 41
Joined: 21.04.2015 22:27

Re: quest HeartWood Bowcraft

Post by Sonick071 »

shinma wrote:Написал и выложил на зло всем жадным скриптерам.
Если у всех будет скрипт на Heartwood runic, то он ничего не будет стоить. Видел бы что творится на шарде где я играю. Не прекращающийся поток ботов в Heartwood city.
ПС. Если руник не инсурится - он автоматически становится подарком для воришек!
Если б не было stealth, то его следовало б придумать!
Bubonic Pestilence
Neophyte
Neophyte
Posts: 28
Joined: 14.12.2011 4:54
Contact:

Re: quest HeartWood Bowcraft

Post by Bubonic Pestilence »

Оффтоп конечно же...

> BugInBank
Зачем писать коммент на английском, если у тебя жуки в банке?! )
Лучше уж попросил кого-нибудь перевести, чтобы не позориться :D
Эх, вот был бы "RubyScript" =) так я такой бы харвестер написал...
shinma
Expert
Expert
Posts: 505
Joined: 28.04.2011 12:05

Re: quest HeartWood Bowcraft

Post by shinma »

Bubonic Pestilence wrote:Оффтоп конечно же...

> BugInBank
Зачем писать коммент на английском, если у тебя жуки в банке?! )
Лучше уж попросил кого-нибудь перевести, чтобы не позориться :D
Конечно лучше, а еще лучше заходя на форум за чужими скриптами и идеями не выё****я. Как минимум пока не сделаете хотя бы столько же. Кто-то строит забор/дома/парки, а кто-то на них пишет слово х*й, вот автор поста выше сейчас из вторых.
--->>>ПОИСК ПО ФОРУМУ, НАЧНИ С НЕГО!!!<<<---
--->>>Search the forum, start with him!!!<<<---
95% Ваших вопросов уже кем-то написаны и решены.
Hornet2015
Neophyte
Neophyte
Posts: 10
Joined: 16.11.2015 20:22

Re: quest HeartWood Bowcraft

Post by Hornet2015 »

Tune wrote:Вроде все работало, запускаю на днях:
13:43:31:778 name=Jusae
13:43:33:292 CloseGamp
13:43:33:795 name end
13:43:33:798 QuestReq
13:43:35:322 Gump has 1 XmfHTMLGumpColors
13:43:35:325 QuestCheck
13:43:35:329 checkboards
13:43:35:732 CheckTinkerTools
13:43:36:075 Checkfletching
13:43:36:538 GimeMeQuest
13:43:36:542 Length(QuestNPC)=1
13:43:36:886 i=0
13:43:36:888 name=Jusae
13:43:38:321 CloseGamp
13:43:38:824 name end
13:43:38:827 QuestReq
13:43:40:091 Gump has 1 XmfHTMLGumpColors
13:43:40:094 QuestCheck
13:43:40:098 checkboards
13:43:40:590 CheckTinkerTools
13:43:40:833 Checkfletching
13:43:41:096 GimeMeQuest
13:43:41:099 Length(QuestNPC)=1
И оно повторяется, повторяется, повторяется...
В паке как обычно 3 тинкертулса, штук 8 флетчертулс, ресы в банке в мешке, жук постой, стартую у квестера, серв абисс...
Тоже самое ... не работает скрипт :((
Post Reply