Stealth Client Forum

Альтернативный клиент Ultima Online
Текущее время: 16.10.2018 7:36

Часовой пояс: UTC + 2 часа




Начать новую тему Ответить на тему  [ Сообщений: 8 ] 
Автор Сообщение
 Заголовок сообщения: heartWoodQuest
СообщениеДобавлено: 22.09.2017 12:48 
Не в сети

Зарегистрирован: 22.09.2017 12:43
Сообщения: 4
Хотел бы заиметь самый простенький скрипт на капрендри под изи стелс или стим под что угодно чтоб работало,за вечную большую благодарность), странно почему на все квесты есть а именно на карпендри нету,спасибо тому кто откликнется на мою просьбу!


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 23.09.2017 9:06 
Не в сети Novice
Novice

Зарегистрирован: 28.01.2012 19:48
Сообщения: 193
$20

_________________
Stealth 8.8.3 | Клиент: 7.0.13.4


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 24.09.2017 0:22 
Не в сети

Зарегистрирован: 22.09.2017 12:43
Сообщения: 4
 
//
// Исходник для ОСИ. Работает и на ран Уо
// gloomia@gmail.com
//
// Автоквесты В Хертвуде. Карпа с отменой килл-квестов.
// Добываем руники.
//

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[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.

люди подскажите пишет ошибку allinc at 10:6): Unknown identifier
рабочий ли это скрипт? и хотелось бы узнать что он делает.


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 24.09.2017 3:22 
Не в сети Developer
Developer

Зарегистрирован: 24.03.2005 17:05
Сообщения: 3747
[quote="Whrikk"]люди подскажите пишет ошибку allinc at 10:6): Unknown identifier /quote]
открываешь файл all.inc из папки include и смотришь, что там в 10 строке.
Если там инклюд еще одного файла - давай его сюда.

_________________
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 24.09.2017 10:51 
Не в сети

Зарегистрирован: 22.09.2017 12:43
Сообщения: 4
Цитата:
Если там инклюд еще одного файла - давай его сюда.

сторонних файлов кроме самого скрипта который запускаю через стелс ничего нету.. я невкурсе что к чему можно нужно гдето создать этот allinc


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 24.09.2017 18:14 
Не в сети Developer
Developer

Зарегистрирован: 24.03.2005 17:05
Сообщения: 3747
Whrikk писал(а):
Цитата:
Если там инклюд еще одного файла - давай его сюда.

сторонних файлов кроме самого скрипта который запускаю через стелс ничего нету.. я невкурсе что к чему можно нужно гдето создать этот allinc

я тебе написал, ГДЕ его найти.

Не хочешь читать - увы тебе.

_________________
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 27.09.2017 22:03 
Не в сети Novice
Novice

Зарегистрирован: 28.01.2012 19:48
Сообщения: 193
ладно, $15 = супер бот

_________________
Stealth 8.8.3 | Клиент: 7.0.13.4


Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: heartWoodQuest
СообщениеДобавлено: 20.01.2018 16:18 
Не в сети

Зарегистрирован: 22.09.2017 12:43
Сообщения: 4
Код:
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.

Вот сам модуль
Код:
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.

хотелось вы узнать в чем проблемма скрипта, тестировал на Инцептуме


Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 8 ] 

Часовой пояс: UTC + 2 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  


Тюнинг и аксессуары. Тюнинг внедорожников: магазин 4х4 в Одессе. Интернет магазин "AMAX".
Также, на правах рекламы: школьный сайт: school-work.net и еще один: https://www.youtube.com/channel/UCFSPHKHjP22tEl8Rjcst9Fw.


Рейтинг@Mail.ru
Powered by phpBB® Forum Software © phpBB Group