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

heartWoodQuest

Only working scripts
Post Reply
Whrikk
Posts: 4
Joined: 22.09.2017 12:43

heartWoodQuest

Post by Whrikk »

Хотел бы заиметь самый простенький скрипт на капрендри под изи стелс или стим под что угодно чтоб работало,за вечную большую благодарность), странно почему на все квесты есть а именно на карпендри нету,спасибо тому кто откликнется на мою просьбу!
GeeZeR
Apprentice
Apprentice
Posts: 226
Joined: 28.01.2012 19:48

Re: heartWoodQuest

Post by GeeZeR »

$20
Stealth 8.10.2 | Клиент: 7.0.13.4
Whrikk
Posts: 4
Joined: 22.09.2017 12:43

Re: heartWoodQuest

Post by Whrikk »

//
// Исходник для ОСИ. Работает и на ран Уо
// [email protected]
//
// Автоквесты В Хертвуде. Карпа с отменой килл-квестов.
// Добываем руники.
//

program HertwoodCarpRenicTools;
uses baru2;


const

// Кнопки Квест гампа

refuseQuest = '2';

acceptQuest = '4';
continueReward = '8';
acceptReward = '5';




// Тип сумок с ревардами

rewardBagType = $0E75;

// Задержки на гамп, добавление в квест-айтемы и прочее.

gumpDelay = 1250;
itemDelay = 1250;

// Треш


RewardBox = $0005CD00; //
questGiverID = $00000697; //


LogType = $1BD7; //Тип логов (дерево)
IronType = $1BF2; // Тип инготов купера (Цвет $0000)

CraftType = $0B5E; // Тип Вещи на квест.
CraftGump = '2'; // Ид кнопки гампа - квестовая вешь

SawType = $1028 ; // Тип пилы
SawGump = '58'; // Ид кнопки гампа - пила

TinkType = $1EB8; // Тип тинка
TinkGump = '23'; // Ид кнопки гампа - тулса




MaxW = 500; // Максимальныи вес. Идет на переплавку и сброс домои.

actionDelay = 800;

var x,y,i,k,p,r,rc:integer;
ctime:TDateTime;


procedure CheckSaw;
Begin
CheckSave;
AddToSystemJournal('Tinker tools: '+ intToStr( Count( TinkType ) ) );
AddToSystemJournal('Saw: '+intToStr(Count(SawType) ) );
FindType(IronType,backpack);
Wait(actionDelay);
AddToSystemJournal('Ingots: '+intToStr(FindFullQuantity) );
FindType(LogType,Ground);
Wait(actionDelay);
AddToSystemJournal('Board: '+intToStr(FindFullQuantity) );
while ( Count(SawType) < 5) do
begin
CheckSave;
FindType(TinkType,backpack);
Wait(actionDelay);
if FindCount < 2 then

begin
CheckSave;
UseObject(FindType(TinkType,backpack));
Wait(gumpDelay);
WaitGump(TinkGump)
Wait(itemDelay);
end

else

begin

repeat
CheckSave;
UseObject(FindType(TinkType,backpack));
Wait(gumpDelay);
WaitGump(SawGump);
Wait(itemDelay);

until Count(SawType) >= 5

end;

end;
End;

procedure QuestItem;
var i : integer;
Begin
RequestContextMenu( Self );
SetContextMenuHook( Self , 5);
CheckLag(30000);
Wait(actionDelay);
while (FindTypeEx(CraftType,$0000,Backpack,False) <> 0) do
begin
FindTypeEx(CraftType,$0000,Backpack,False);
If TargetPresent then TargetToObject(finditem);
CheckLag(30000);
Wait(actionDelay);
end;
If TargetPresent then CancelTarget;
End;

procedure GetReward;
Begin
//CloseSimpleGump();
UseObject(questGiverID);
CheckLag(30000);
Wait(gumpDelay);
WaitGump(continueReward);
CheckLag(30000);
Wait(actionDelay);
WaitGump(acceptReward);
CheckLag(30000);
Wait(itemDelay);
//CheckRewards; // Скинуть в лошадь.
CheckLag(30000);
Wait(actionDelay);
End;


procedure CreateItem;
Begin
GetResFromGround(LogType, $ffff, 90, 'досок');
while ( Count(CraftType) < 10) do
begin
CheckSave;
UseObject(FindType(SawType,backpack));
Wait(gumpDelay);
CheckLag(30000);
WaitGump(CraftGump);
Wait(itemDelay);
end;
CheckLag(30000);
WaitGump('0');
Wait(itemDelay);
End;

procedure checkRewards;
Begin
FindType(rewardBagType, Backpack);
CheckLag(30000);
Wait(actionDelay);

while ( FindType(rewardBagType, Backpack) <> 0 ) do
begin
MoveItem(finditem, 1, RewardBox, 0, 0, 0);
CheckLag(30000);
Wait(actionDelay);
end;
End;


procedure QuestOn;
var accept :Boolean;
a: integer;
b : TStringList;
i : Word;

Begin
accept := True;
while ( accept ) do
Begin
UseObject(questGiverID);
CheckLag(30000);
Wait(gumpDelay);
AddToSystemJournal('Ищем квест!!!');
b := TStringList.Create;
setsilentmode(true);
for a := 0 to GetGumpsCount - 1 do
GetGumpFullLines(a,b);
//GetGumpTextLines(a,b);
{'1 XmfHTMLGumpColor: 160 108 250 16 1073882 0 0 10000 22 Arch Support'}

for i := 0 to b.Count - 1 do
if b.Strings = '1 XmfHTMLGumpColor: 160 108 250 16 1073882 0 0 10000 22 Arch Support' then
begin
accept := false;
AddToSystemJournal('Квест найден!');
WaitGump(acceptQuest);
Wait(gumpDelay);
break;
end;
wait(actionDelay);
end;
b.free;
End;






BEGIN
finddistance := 20;
SetARStatus(true); // Поставь задержку на реконект 10 сек

while true do
begin
CheckSaw;
CreateItem;
QuestOn;
QuestItem;
GetReward;
CheckRewards;
Wait(1000);
end;
END.

люди подскажите пишет ошибку allinc at 10:6): Unknown identifier
рабочий ли это скрипт? и хотелось бы узнать что он делает.
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Re: heartWoodQuest

Post by Vizit0r »

[quote="Whrikk"]люди подскажите пишет ошибку allinc at 10:6): Unknown identifier /quote]
открываешь файл all.inc из папки include и смотришь, что там в 10 строке.
Если там инклюд еще одного файла - давай его сюда.
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Whrikk
Posts: 4
Joined: 22.09.2017 12:43

Re: heartWoodQuest

Post by Whrikk »

Если там инклюд еще одного файла - давай его сюда.
сторонних файлов кроме самого скрипта который запускаю через стелс ничего нету.. я невкурсе что к чему можно нужно гдето создать этот allinc
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Re: heartWoodQuest

Post by Vizit0r »

Whrikk wrote:
Если там инклюд еще одного файла - давай его сюда.
сторонних файлов кроме самого скрипта который запускаю через стелс ничего нету.. я невкурсе что к чему можно нужно гдето создать этот allinc
я тебе написал, ГДЕ его найти.

Не хочешь читать - увы тебе.
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
GeeZeR
Apprentice
Apprentice
Posts: 226
Joined: 28.01.2012 19:48

Re: heartWoodQuest

Post by GeeZeR »

ладно, $15 = супер бот
Stealth 8.10.2 | Клиент: 7.0.13.4
Whrikk
Posts: 4
Joined: 22.09.2017 12:43

Re: heartWoodQuest

Post by Whrikk »

Code: Select all

program HertwoodCarpRenicTools;
uses allinc;


const

// Кнопки Квест гампа 

refuseQuest = '2';

acceptQuest = '4';
continueReward = '8';
acceptReward = '5';




// Тип сумок с ревардами

rewardBagType = $0E75;

// Задержки на гамп, добавление в квест-айтемы и прочее.

gumpDelay = 1250;
itemDelay = 1250;

// Треш


RewardBox = $0005CD00; // 
questGiverID = $00000697; // 


LogType = $1BD7; //Тип логов (дерево)
IronType = $1BF2; // Тип инготов купера (Цвет $0000)

CraftType = $0B5E; // Тип Вещи на квест.
CraftGump = '2';  // Ид кнопки гампа - квестовая вешь

SawType = $1028 ; // Тип пилы 
SawGump = '58'; // Ид кнопки гампа - пила

TinkType = $1EB8; // Тип тинка
TinkGump = '23'; // Ид кнопки гампа - тулса




MaxW = 500; // Максимальныи вес. Идет на переплавку и сброс домои.

actionDelay = 800; 

var x,y,i,k,p,r,rc:integer;
ctime:TDateTime;


procedure CheckSaw;
Begin
CheckSave;
AddToSystemJournal('Tinker tools: '+ intToStr( Count( TinkType ) ) );
AddToSystemJournal('Saw: '+intToStr(Count(SawType) ) );
FindType(IronType,backpack);
Wait(actionDelay);
AddToSystemJournal('Ingots: '+intToStr(FindFullQuantity) );
FindType(LogType,Ground);
Wait(actionDelay);
AddToSystemJournal('Board: '+intToStr(FindFullQuantity) );
while ( Count(SawType) < 5) do
  begin
    CheckSave;
    FindType(TinkType,backpack);
    Wait(actionDelay);
    if FindCount < 2 then
    
      begin
        CheckSave;
        UseObject(FindType(TinkType,backpack));
        Wait(gumpDelay);
        WaitGump(TinkGump)
        Wait(itemDelay);
      end
    
    else
    
      begin
    
         repeat
          CheckSave;
          UseObject(FindType(TinkType,backpack));
          Wait(gumpDelay);
          WaitGump(SawGump);
          Wait(itemDelay);
    
         until Count(SawType) >= 5
    
      end;
    
  end;
End;

procedure QuestItem;
var i : integer;
Begin
  RequestContextMenu( Self );
  SetContextMenuHook( Self , 5);
  CheckLag(30000);
  Wait(actionDelay);
  while (FindTypeEx(CraftType,$0000,Backpack,False) <> 0) do
    begin
      FindTypeEx(CraftType,$0000,Backpack,False);
      If TargetPresent then TargetToObject(finditem);
      CheckLag(30000);
      Wait(actionDelay);
    end;
  If TargetPresent then CancelTarget;    
End;

procedure GetReward;
Begin
  //CloseSimpleGump();
  UseObject(questGiverID);
  CheckLag(30000);
  Wait(gumpDelay);
  WaitGump(continueReward);
  CheckLag(30000);
  Wait(actionDelay);
  WaitGump(acceptReward);
  CheckLag(30000);
  Wait(itemDelay);
  //CheckRewards; // Скинуть в лошадь.
  CheckLag(30000);
  Wait(actionDelay);
End;


procedure CreateItem;
Begin
GetResFromGround(LogType, $ffff, 90, 'досок');
while ( Count(CraftType) < 10) do
  begin
          CheckSave;
          UseObject(FindType(SawType,backpack));
          Wait(gumpDelay);
          CheckLag(30000);
          WaitGump(CraftGump);
          Wait(itemDelay);
  end;
  CheckLag(30000);
  WaitGump('0');
  Wait(itemDelay);
End;

procedure checkRewards;
Begin
   FindType(rewardBagType, Backpack);
   CheckLag(30000);
   Wait(actionDelay);
   
   while ( FindType(rewardBagType, Backpack) <> 0 ) do
     begin  
       MoveItem(finditem, 1, RewardBox, 0, 0, 0);
       CheckLag(30000);
       Wait(actionDelay);
     end;
End;


procedure QuestOn;
var accept :Boolean; 
a: integer; 
b : TStringList;
i : Word;

Begin
accept := True;
while ( accept ) do
   Begin         
      UseObject(questGiverID);
      CheckLag(30000);
      Wait(gumpDelay);
      AddToSystemJournal('Ищем квест!!!');
      b := TStringList.Create;
      setsilentmode(true);
      for  a := 0 to GetGumpsCount - 1 do 
      GetGumpFullLines(a,b);
      //GetGumpTextLines(a,b); 
      {'1   XmfHTMLGumpColor: 160  108  250  16  1073882  0  0  10000  22  Arch Support'}
      
      for i := 0 to b.Count - 1 do
      if b.Strings[i] = '1   XmfHTMLGumpColor: 160  108  250  16  1073882  0  0  10000  22  Arch Support' then
        begin
          accept := false;
          AddToSystemJournal('Квест найден!'); 
          WaitGump(acceptQuest); 
          Wait(gumpDelay);
          break;  
        end;
      wait(actionDelay);
    end;
b.free;    
End;






BEGIN
finddistance := 20;
SetARStatus(true); // Поставь задержку на реконект 10 сек

while true do
  begin
    CheckSaw;
    CreateItem;
    QuestOn;
    QuestItem;
    GetReward;
    CheckRewards;
    Wait(1000);
  end;
END. 
Вот сам модуль

Code: Select all

unit allinc; 


// For stealth client 6.xx.xx
//
//


interface 
            
procedure WaitConnection(WaitTime : Integer); 
procedure CheckSave;  
procedure CheckTargetError(lines, checktime : integer);
procedure FullDisconnect;
procedure GetResFromGround(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string); 
procedure stack(ObjType, Color : word); 
procedure StackInBox(ObjType, Color : word; container : cardinal);
procedure StackInBox50(ObjType, Color : word; container : cardinal);
procedure GetResFromBox(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string; box : cardinal); 
procedure CheckDoubleStack(tmptypCDS : cardinal; tmpcolCDS : cardinal);

implementation 


procedure WaitConnection(WaitTime : Integer);
begin
if Connected then Exit;
while not Connected do Wait(1000);
{WaitTime - Waiting After Connected}
wait(WaitTime);
end;
 
procedure CheckSave; 
var Time : TDateTime; 
begin 
Time:= Now - (0.5 / 1440); 
if InJournalBetweenTimes('Saving World State',Time,Now) >= 0 then Wait(30000) 
end;

procedure CheckTargetError(lines, checktime : integer);
var D : TDateTime;
begin
{5 minutes in DateTime = (1.0 * checktime) / 1440 = 0.00347}
D := Now - ((1.0 * checktime) / 1440.0);
InJournalBetweenTimes('I am already performing another action|doing something',D,Now);

if LineCount > lines then
  begin
  AddToSystemJournal('Error with target. Disconnected');
ClearJournal;
  Disconnect;
  end;

end;

procedure FullDisconnect;
begin
SetARStatus(false);
Disconnect;
end; 

procedure GetResFromGround(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string); 
// tmptyp   - тип ресурса
// tmpcol   - цвет ресурса 
// tmpcnt   - количество (которое необходимо взять) 
// tmpstr   - название ресурса (для сообщений) 
// Функция ищет на полу указанный ресурс по типу и берет указанное количество. 
// Взятие гарантированное, с проверкой коннекта. Ресурс берется только в том 
// случае, если его количество в паке меньше требуемого. Если ресурс на полу отсутствует, 
// процедура пишет об этом сообщение в журнал и входит в цикл ожидания появления 
// этого ресурса под ногами. 
// v.1.03 (c) Edred 
Var m, p : integer; 
begin 
   p := Count(tmptyp); 
   if p >= tmpcnt then exit; 
   waitconnection(3000); 
   FindTypeEx(tmptyp,tmpcol,Ground,False); 
   if GetQuantity(Finditem) < tmpcnt then 
   begin 
      repeat 
         addtosystemjournal('Warning: Мало ' + tmpstr + ' на полу, добавьте'); 
         wait(10000); 
         FindTypeEx(tmptyp,tmpcol,Ground,False); 
      until GetQuantity(Finditem) >= tmpcnt; 
   end; 
   m := GetQuantity(finditem); 
   if (tmpcnt - p) = 1 then p := p - 1; 
   while not Grab(FindItem,tmpcnt - p) do 
   begin 
      waitconnection(3000); 
      wait(500); 
      checksave; 
   end; 
   wait(500); 
   addtosystemjournal('Взял ' + inttostr(tmpcnt - p) + ' ' + tmpstr + ' из ' + inttostr(m) + ' штук'); 
end;

procedure stack(ObjType, Color : word); 
var PackItem, GroundItem : Cardinal; 
CountIt : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   CountIt := FindFullQuantity;
   Findtype(ObjType,ground);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat 
      FindtypeEx(ObjType,Color,ground,false); 
      IF FindCount > 0 then 
      if FindQuantity > 55000 then Ignore(finditem) 
      else GroundItem := finditem; 
      FindtypeEx(ObjType,Color,ground,false); 
   until (FindCount = 0) or (GroundItem <> 0); 
   if (PackItem <> 0) and (GroundItem <> 0) then MoveItems(backpack,ObjType,Color,GroundItem,0,0,0,1000) 
   else DropHere(PackItem); 
end;



procedure StackInBox(ObjType, Color : word; container : cardinal); 
var PackItem, GroundItem : Cardinal; 
CountIt : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   CountIt := FindFullQuantity;
   Findtype(ObjType, container);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat 
      FindtypeEx(ObjType,Color,container,false); 
      IF FindCount > 0 then 
      if FindQuantity > 55000 then Ignore(finditem) 
      else GroundItem := finditem; 
      FindtypeEx(ObjType,Color,container,false); 
   until (FindCount = 0) or (GroundItem <> 0); 
   if (PackItem <> 0) and (GroundItem <> 0) then MoveItems(backpack,ObjType,Color,GroundItem,0,0,0,1000) 
   else MoveItem(PackItem,0,container,0,0,0);
end;

procedure StackInBox50(ObjType, Color : word; container : cardinal); 
var PackItem, GroundItem : Cardinal; 
CountIt : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   CountIt := FindFullQuantity;
   Findtype(ObjType, container);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat 
      FindtypeEx(ObjType,Color,container,false); 
      IF FindCount > 0 then 
      if FindQuantity > 50000 then Ignore(finditem) 
      else GroundItem := finditem; 
      FindtypeEx(ObjType,Color,container,false); 
   until (FindCount = 0) or (GroundItem <> 0); 
   if (PackItem <> 0) and (GroundItem <> 0) then MoveItems(backpack,ObjType,Color,GroundItem,0,0,0,1000) 
   else MoveItem(PackItem,0,container,0,0,0);
end;

procedure GetResFromBox(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string; box : cardinal); 
// tmptyp   - тип ресурса
// tmpcol   - цвет ресурса 
// tmpcnt   - количество (которое необходимо взять) 
// tmpstr   - название ресурса (для сообщений) 
// Функция ищет на полу указанный ресурс по типу и берет указанное количество. 
// Взятие гарантированное, с проверкой коннекта. Ресурс берется только в том 
// случае, если его количество в паке меньше требуемого. Если ресурс на полу отсутствует, 
// процедура пишет об этом сообщение в журнал и входит в цикл ожидания появления 
// этого ресурса под ногами. 
// v.1.04 (c) FreeZzy
Var m, p : integer; 
begin 
   p := Count(tmptyp); 
   if p >= tmpcnt then exit; 
   waitconnection(3000); 
   FindTypeEx(tmptyp,tmpcol,box,False); 
   if GetQuantity(Finditem) < tmpcnt then 
   begin 
         addtosystemjournal('Warning: Мало ' + tmpstr + ' в контейнере, добавьте'); 
         wait(600);
            if GetQuantity(Finditem) > 0 then Grab(FindItem, GetQuantity(Finditem));
         exit; 
   end; 
   m := GetQuantity(finditem); 
   if (tmpcnt - p) = 1 then p := p - 1; 
   while not Grab(FindItem,tmpcnt - p) do 
   begin 
      waitconnection(3000); 
      wait(500); 
      checksave; 
   end; 
   wait(500); 
   addtosystemjournal('Взял ' + inttostr(tmpcnt - p) + ' ' + tmpstr + ' из ' + inttostr(m) + ' штук'); 
end;

procedure CheckDoubleStack(tmptypCDS : cardinal; tmpcolCDS : cardinal);
  begin
    FindtypeEx(tmptypCDS,tmpcolCDS,BackPack,false);
    IF FindCount > 1 then stack(tmptypCDS, tmpcolCDS);
  end;
end.
хотелось вы узнать в чем проблемма скрипта, тестировал на Инцептуме
Post Reply