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

Нужна Помощь в написании процедуры в в рабочем скрипте!

тут можно задать вопрос по скриптингу
Post Reply
[EU]
Posts: 2
Joined: 20.02.2020 9:54

Нужна Помощь в написании процедуры в в рабочем скрипте!

Post by [EU] »

скрипт рабочий отсутствует процедура лута с трупов тех или иных предметов

// скрипт на добычу перьев. Чар стоит на респе, при появлении птиц в зоне
// поиска подходит, убивает и режет перья, всякий хлам выкидывает на пол.
// Хавает время от времени фишстейки, пока ждёт уходит в хайд.

Code: Select all

Program birds_killer;
{$Include 'all.inc'}

Const
Weapon = $13FE;     // тип оружия которым расчленять
Corpse = $2006;      // тип трупа
Feather = $1BD1;    // тип перьев

//=============================================//
var 
//=============================================//
Bird: array [1..2] of Cardinal;
CorpseID, Victim: Cardinal;
m, x: Integer;

procedure Inittypes;
begin
  Bird[1] := $0006;
  Bird[2] := $00D0;
end;

procedure Raschlenenie;
begin
  FindDistance := 2;
  FindType(Corpse,Ground);
  if (FindCount > 0) then
  begin
    if TargetPresent then CancelTarget;
    CorpseID := FindType(Corpse,Ground);
    UseObject(ObjAtLayerEx(RhandLayer,Self));
    WaitForTarget(1000);
    if TargetPresent then TargetToObject(CorpseID);
    Wait(1000);
    AddToSystemJournal(IntToStr(GetQuantity(FindType(Feather,backpack))) + ' Перьев')
    Ignore(CorpseID);
{
    // Выкидываем потроха
    FindType($1BD1,backpack);
    if (FindCount > 0) then Drop(FindItem,0,0,0,0);
    Wait(100);
    FindType($1607,backpack);
    if (FindCount > 0) then Drop(FindItem,0,0,0,0);
    Wait(100);
    FindType($1E8A,backpack);
    if (FindCount > 0) then Drop(FindItem,0,0,0,0);
    Wait(100);
}
  end;
end;

procedure Ynichtozhenie;
begin
  While GetHP(Victim) > 0 Do
  begin
    NewMoveXY(GetX(Victim),GetY(Victim),True,1,True);
    FindDistance := 1;
    Attack(Victim);
    Wait(1000);
  end;
  SetWarMode(False);
end;
procedure AttackChecking;
begin
  if (WarMode = false) then SetWarMode(True);
  if (ObjAtLayer(RhandLayer) = 0) then
  begin
    Equip(RhandLayer,FindType(Weapon,backpack));
    Wait(1000);
  end;
end;

procedure BirdSearching;
begin
  for m := 1 to 2 do
  begin
    Victim := 0;
    repeat
      FindDistance := 20;
      Victim := FindType(Bird[m],Ground);
      if Victim = 0 then break;
      AddToSystemJournal('Найдено '+inttostr(FindCount)+' '+GetName(Victim));
      AttackChecking;
      Ynichtozhenie;
      Raschlenenie;
      CheckSave;
    until Victim = 0;
  end;
end;

procedure GoHide;
begin
  UseSkill('Hiding');
  Wait(10000);
end;

BEGIN
  Inittypes;
  SetARStatus(true);
  repeat
    Hungry(1, Backpack);
    Wait(1000);
    for x := 0 to 1000 do
    begin
      BirdSearching;
      if (not hidden) then GoHide;
      Wait(1000);
    end;
  until Dead or (not Connected);
END.
Last edited by [EU] on 20.02.2020 14:08, edited 1 time in total.
[EU]
Posts: 2
Joined: 20.02.2020 9:54

Re: Помощь в написании процедуры в рабочем скрипте!

Post by [EU] »

Нашел вот такой Loot как их обьеденить ??? ПОМОГИТЕ

Code: Select all

Program Loot; 
const MaxWeightDif = 30;

procedure Loot;
var e : integer;
CorpseID : Cardinal; 
Loottype: array of Cardinal; 
begin
  FindDistance:= 2; 
  Loottype := [$0EED, $0C7C, $0E40, $0E41, $14EC, $0F3F, $0F84, $0F88, $0F8D, $0F85, $0F7B, $0F8C, $0F86, $0F7A, $0F13, $0F25, $0F13, $0F19, $0F2D, $0F15, $0F26, $0F21, $0F16, $0F10]; 
   while not dead do
   begin
    if ( Weight < ( MaxWeight - MaxWeightDif ) ) then
    begin
    If FindType($2006,Ground)>0 Then
      begin
        CorpseID:=FindItem;  
        If FindType($2D2F,backpack)>0 Then 
        begin
          UseObject(Finditem);
          WaitForTarget(5000);
          TargetToObject(CorpseID); 
          wait(500);
        end;
        UseObject(CorpseID); 
        wait(500);
        for e := 0 to Length(Loottype) -1 do 
         begin 
          while (FindType(Loottype[e],corpseID) > 0) and (GetDistance(CorpseID)<= FindDistance) do  
          begin
            MoveItem(finditem,0,BackPack,0,0,0);
            wait(500);
          end;
         end;
         Ignore(CorpseID);
      end;
    end; 
    end; 
    wait(50);
end;

begin
  loot;
end.
Tomers
Novice
Novice
Posts: 99
Joined: 06.08.2009 11:51

Re: Нужна Помощь в написании процедуры в в рабочем скрипте!

Post by Tomers »

[EU] wrote: 20.02.2020 10:02 скрипт рабочий отсутствует процедура лута с трупов тех или иных предметов

// скрипт на добычу перьев. Чар стоит на респе, при появлении птиц в зоне
// поиска подходит, убивает и режет перья, всякий хлам выкидывает на пол.
// Хавает время от времени фишстейки, пока ждёт уходит в хайд.

Code: Select all

Program birds_killer;
{$Include 'all.inc'}

Const
Weapon = $13FE;     // тип оружия которым расчленять
Corpse = $2006;      // тип трупа
Feather = $1BD1;    // тип перьев

//=============================================//
var 
//=============================================//
Bird: array [1..2] of Cardinal;
CorpseID, Victim: Cardinal;
m, x: Integer;

procedure Inittypes;
begin
  Bird[1] := $0006;
  Bird[2] := $00D0;
end;

procedure Raschlenenie;
begin
  FindDistance := 2;
  FindType(Corpse,Ground);
  if (FindCount > 0) then
  begin
    if TargetPresent then CancelTarget;
    CorpseID := FindType(Corpse,Ground);
    UseObject(ObjAtLayerEx(RhandLayer,Self));
    WaitForTarget(1000);
    if TargetPresent then TargetToObject(CorpseID);
    Wait(1000);
    AddToSystemJournal(IntToStr(GetQuantity(FindType(Feather,backpack))) + ' Перьев')
    Ignore(CorpseID);
{
    // Выкидываем потроха
    FindType($1BD1,backpack);
    if (FindCount > 0) then Drop(FindItem,0,0,0,0);
    Wait(100);
    FindType($1607,backpack);
    if (FindCount > 0) then Drop(FindItem,0,0,0,0);
    Wait(100);
    FindType($1E8A,backpack);
    if (FindCount > 0) then Drop(FindItem,0,0,0,0);
    Wait(100);
}
  end;
end;
procedure Loot;
var e : integer;
CorpseID : Cardinal;
Loottype: array of Cardinal;
begin
FindDistance:= 2;
Loottype := [$0EED, $0C7C, $0E40, $0E41, $14EC, $0F3F, $0F84, $0F88, $0F8D, $0F85, $0F7B, $0F8C, $0F86, $0F7A, $0F13, $0F25, $0F13, $0F19, $0F2D, $0F15, $0F26, $0F21, $0F16, $0F10];
while not dead do
begin
if ( Weight < ( MaxWeight - MaxWeightDif ) ) then
begin
If FindType($2006,Ground)>0 Then
begin
CorpseID:=FindItem;
If FindType($2D2F,backpack)>0 Then
begin
UseObject(Finditem);
WaitForTarget(5000);
TargetToObject(CorpseID);
wait(500);
end;
UseObject(CorpseID);
wait(500);
for e := 0 to Length(Loottype) -1 do
begin
while (FindType(Loottype[e],corpseID) > 0) and (GetDistance(CorpseID)<= FindDistance) do
begin
MoveItem(finditem,0,BackPack,0,0,0);
wait(500);
end;
end;
Ignore(CorpseID);
end;
end;
end;
wait(50);
end;

Code: Select all

procedure Ynichtozhenie;
begin
  While GetHP(Victim) > 0 Do
  begin
    NewMoveXY(GetX(Victim),GetY(Victim),True,1,True);
    FindDistance := 1;
    Attack(Victim);
    Wait(1000);
  end;
  SetWarMode(False);
end;
procedure AttackChecking;
begin
  if (WarMode = false) then SetWarMode(True);
  if (ObjAtLayer(RhandLayer) = 0) then
  begin
    Equip(RhandLayer,FindType(Weapon,backpack));
    Wait(1000);
  end;
end;

procedure BirdSearching;
begin
  for m := 1 to 2 do
  begin
    Victim := 0;
    repeat
      FindDistance := 20;
      Victim := FindType(Bird[m],Ground);
      if Victim = 0 then break;
      AddToSystemJournal('Найдено '+inttostr(FindCount)+' '+GetName(Victim));
      AttackChecking;
      Ynichtozhenie;
      Raschlenenie;
loot;

Code: Select all

 CheckSave;
    until Victim = 0;
  end;
end;

procedure GoHide;
begin
  UseSkill('Hiding');
  Wait(10000);
end;

BEGIN
  Inittypes;
  SetARStatus(true);
  repeat
    Hungry(1, Backpack);
    Wait(1000);
    for x := 0 to 1000 do
    begin
      BirdSearching;
      if (not hidden) then GoHide;
      Wait(1000);
    end;
  until Dead or (not Connected);
END.
Если тупо объединить то вот так.
Но здается мне что тебе не подойдет. Много всего он лутает из трупа, и, наверное, ты тип нужных тебе вещей в Loottype не вписывал, да и цикл в том луте мне не нравится, есть шанс наглухо зависнуть, я бы так не писал. Если еще актуально, напиши мне в дискорд Tomers#5134 напишу тебе процедурку
Post Reply