Перейти к содержанию
Форум шарда Middle-Earth
nepret

[Stealth] Ogorod

Рекомендуемые сообщения

UP 12.10.2012

  • Исправил некоторые баги с посадкой семян
  • Добавил авто-хил бинтами

 

// Create by nepret
////////////////////////////////////////////////////////////////////////////////////
//
//                                  Ogorod v 1.2
//
//                  Скрипт на вскопку огорода и посадку семян.
//
////////////////////////////////////////////////////////////////////////////////////
//
//                              !!!  АХТУНГ !!!
//
//  Скрипт не предназначен для вскопки территории домов типа Tower и Villa.
//  Это связано с тем, что обработка земли код крышей (tower) или 2 этажом (villa),
//  не возможна из-за бага...
//
////////////////////////////////////////////////////////////////////////////////////
//
//  Два режима работы:
//  1-й режим: Запись, сортировка, сохранение координат огорода
//             в файл вида "xxxx_yyyy.loc".
//             Файлы записываються в корневую папку Stealth.
//             Пример: D:\Ultima Online\Stealth
//    1*Прилетаем на огород
//    2*Ставим переменную SaveCoorMod = 1
//    3*Запускаем скрипт
//    4*Вызываем таргет(юзаем нож, скилл и др... главное, добиваемся появления таргета)
//    5*Бегаем по всем местам где можно выращивать реагенты(желательно 2-3 раза)
//    6*Как только пробежали по всем тайлам на огороде, сбрасываем таргет
//     (Можно нажать Esc или кинуть таргет на что либо, главное чтобы он пропал)
//    7*Ждём завершение скрипта
//
//  2-й режим: Определение места положения, загрузка нужного файла с координатами,
//             копка тайлов, засеивание тайлов.
//    1*Проверяем наличие в бекпке
//     ** Лопаты
//     ** Семена реагентов
//     ** Еда (Язык интерфейса должен быть русским .lang)
//     ** Так же надо помнить о возможном выкапывании элементалей и слизняков
//     *** Вар включается автоматически
//    2*Прилетаем на огород
//    3*Запускаем скрипт
//
////////////////////////////////////////////////////////////////////////////////////
Program ogorod;
type
  TileRecord = Record
  x,y : integer;
end;
type
  RdyTileRecord = Record
  x,y : integer;
end;
const
////////////////////////////////////////////////////////////////////////////////////
                            //   
DistanceCheckLoction = 50;  // Дистанция проверки локации.
                            //
//////////////////////////////
                            //
Food = $097B;               // Тип еды, которую будем кушать в процессе.
                            // $097B - жаренная рыба
                            // $09F2 - жаренное мясо
                            // $171F - бананы
                            //
//////////////////////////////
                            //                            
SaveCoorMod = 0;            // Вариант работы скрипта: 1-Запись координат 0-Копка                            
                            //
//////////////////////////////
                            //                            
DebugMode = 0;              // Не трогать!
                            //
////////////////////////////////////////////////////////////////////////////////////                            
var
es, ens, ulf, eie, ins, ol, wcif, fs, fh : String;
FileNameLoc : String;
HungryJournalTime, WaitMsgInJournalToEP : TDateTime;
CheckDebug, td : integer;
Tiles : array [1..5000] of array [1..2] of Integer;
Tile : array [0..5000] of TileRecord;
RdyTile : array [0..5000] of RdyTileRecord;
Count, locx, locy : integer;
htime : TDateTime;


procedure RunInfoMSG;
begin
  es := #13#10+'--------------------- Error! -------------------------';
  ins := #13#10+'----------------------- Info -------------------------';
  ens := #13#10+'------------------------------------------------------';
  ulf := #13#10+'>>> Нет файла с разметкой координат под эту локацию...';
  eie := #13#10+'>>> Скрипт завершился с ошибкой!';
  ol := #13#10+'Локация определенна.';
  wcif := #13#10+'Работаем по координатам из фала: ';
  fs := #13#10+'Нету семян.';
  fh := #13#10+'Нету лопаты.';
end;


//////////////////////////////////////////////////////////////////////////////////////////////////////
procedure WaitConnection(WaitTime : Integer);
begin
if Connected then Exit;
while not Connected do Wait(1000);
wait(WaitTime);
end;

function Debug(OperationTimeSec : integer; DelayInCycleMs : integer) : Boolean;
begin
if DebugMode = 1 then
begin
if td = 0 then CheckDebug := 1;
if CheckDebug = 1 then
begin
if DelayInCycleMs = 0 then
begin
AddToSystemJournal('>>> Debug <<< Минимально-допустимая задержка в цикле := 1ms. Debug инклюд завершился с ошибкой!');
CheckDebug := 0;
td := 1;
exit;
end;
OperationTimeSec := OperationTimeSec * 1000;
td := td + DelayInCycleMs;
if td >= OperationTimeSec then
begin
result := true;
CheckDebug := 0;
end;
end;  
end;
end;

function Hungry(Plase : cardinal) : Boolean;
var
VarFood : string;
begin
if dead then exit;
if Food = $097B then VarFood := 'жареной рыбы';
if Food = $09F2 then VarFood := 'жареного мяса';
if Food = $171F then VarFood := 'бананов';
if not (Food = $097B) or (Food = $09F2) or (Food = $171F) then VarFood := 'еды';
FindTypeEx(Food, $FFFF, Plase, True);
if FindCount < 1 then
begin
AddToSystemJournal('>>> Нет '+ VarFood +'!');
result := false;
exit;
end;
result := true;
if HungryJournalTime = 0 then
begin
HungryJournalTime := Now;
repeat
FindTypeEx(Food, $FFFF, Plase, False);
if FindCount > 0 then
begin
UseObject(finditem);
wait(1000);
end;
until InJournalBetweenTimes('Я объелс|You are full', HungryJournalTime, Now) <> -1;
end
else
begin
if Now < HungryJournalTime + (1.0/1440) then exit;
end;
if (InJournalBetweenTimes('голодны|Вы почти умираете от голода|Ваш желудок болит|Вы чувствуете слабость|You are absolutely stuffed|You are stuffed|hungry at all|You are a little hungry|You are somewhat hungry|You are REALLY hungry|Your stomash hurts|Your stomash hurts and you feel dizzy|You are starving|You are almost dying of hunger|You are DYING of hunger', HungryJournalTime, Now) <> -1) and (LineName = 'System') and (LineTextColor = 443) then
begin
FindTypeEx(Food, $FFFF, Plase, False);
if FindCount > 0 then  UseObject(finditem);
end;
HungryJournalTime := Now;
end;

procedure CheckSave; 
var Time : TDateTime; 
begin 
Time:= Now - (0.5 / 1440); 
if InJournalBetweenTimes('Saving World State',Time,Now) >= 0 then
repeat
wait(1000);
if not Connected then exit;
until InJournalBetweenTimes('Saving World State complete',Time,Now) >= 0;
end;

function CheckTarget(SecTime : integer) : Boolean;
var
t : integer;
begin
  SecTime := SecTime * 10;
  td := 0;
  t := 0;
  repeat
    if not Connected then exit;
    checksave;
    if Debug(SecTime/10,100) then AddToSystemJournal('>>> Debug <<< Блок инклюда CheckTarget ');
    wait(100);
    t := t + 1;
  until TargetPresent or (t >= SecTime);
  if t >= SecTime then result := false;
  if not Connected then exit;
  if TargetPresent then result := true;
end;
//////////////////////////////////////////////////////////////////////////////////////////////////////

function LoadTilesFromFile (FileName : String) : Boolean; 
var MyStringList : TStringList; 
    i : integer; 
    S : String;
    X,Y : Integer; 
begin 
  Result := true;
  try 
    MyStringList := TStringList.Create; 
    MyStringList.LoadFromFile(FileName);
    Count := MyStringList.Count; 
    if MyStringList.Count = 0 then Result := false
    else for i := 0 to MyStringList.Count - 1 do 
      begin 
        S := MyStringList.Strings[i]; 
        X := StrToInt(Copy(S,1,4));
        Y := StrToInt(Copy(S,5,5));
        Tiles[i+1][1] := X;
        Tiles[i+1][2] := Y;
      end; 
  finally 
    MyStringList.Free; 
  end; 
end;

procedure CheckWarMode;
begin
  if not IsWarMode(self) then SetWarMode(true);
end;

function CheckItems : Boolean;
begin
  repeat
    FindTypeEx($0F7F, $0000, Backpack, False);
    if FindCount > 0 then ignore(finditem);
  until FindCount < 1;
  FindTypeEx($0F7F, $FFFF, Backpack, False);
  if FindCount < 1 then
    begin
      result := false;
      AddToSystemJournal(+es+fs+ens);
      exit;
    end;
  FindTypeEx($0F39, $FFFF, Backpack, False);
  if FindCount < 1 then
    begin
      result := false;
      AddToSystemJournal(+es+fh+ens);
      exit;
    end;
  result := true;
end;

procedure Heal;
var
t : integer;
begin
  if not Connected then exit;
  while true do
    begin
      if HP >= Str then exit;
      if not Connected then exit; 
      FindTypeEx($0E21, $FFFF, backpack, False);
      if FindCount < 1 then exit;
      if FindCount > 0 then
        begin
          if targetpresent then canceltarget;
          htime := Now;
          if not Connected then exit;
          UseObject(finditem);
          t := 0;
          td := 0;
          repeat
            if Debug(10,100) then AddToSystemJournal('>>> Debug <<< Блок Heal > 1 цикл(400)');
            wait(100);
            if not Connected then exit;
            CheckSave;
            t := t + 1;
          until TargetPresent or (t >= 50);
          if not Connected then exit;
          WaitTargetObject(self);
        end;
      td := 0;
      t := 0;
      repeat
        if Debug(30,100) then AddToSystemJournal('>>> Debug <<< Блок Heal > 2 цикл(414)');
        wait(100);
        if not Connected then exit;
        CheckSave;
        t := t + 1;
      until (InJournalBetweenTimes('You were|You have healed|The patient|You must', htime, Now) <> -1) or (t >= 300) or dead;
      htime := Now;
      Hungry(ground);
    end;  
end;

procedure EarthProcessing;
var
i, t : integer;
begin
  LoadTilesFromFile(FileNameLoc);
  for i := 1 to Count do
    begin
      Heal;
      Hungry(backpack);
      if newMoveXY(Tiles[i][1], Tiles[i][2], True, 0, True) then
        begin
          CheckWarMode;
          if not CheckItems then exit;
          repeat
            if TargetPresent then CancelTarget;
            UseType($0F39, $FFFF);
            CheckTarget(5);
            TargetToXYZ(Tiles[i][1], Tiles[i][2], GetZ(self));
            WaitMsgInJournalToEP := Now;
            CheckSave;
            UseType($0F39, $FFFF);
            if (CheckTarget(1) = false) or ((InJournalBetweenTimes('Вы вскопали землю|Вы заново обработали землю|Здесь уже вскопано|There is nothing to dig here', WaitMsgInJournalToEP, Now) <> -1)) then break;
            if not newMoveXY(Tiles[i][1]+1, Tiles[i][2]+1, True, 0, True) then break;
          until false;
          t := 0;
          repeat
            wait(100);
            CheckSave;
            t := t + 1;
          until (InJournalBetweenTimes('Вы вскопали землю|Вы заново обработали землю|Здесь уже вскопано|There is nothing to dig here', WaitMsgInJournalToEP, Now) <> -1) and (LineName = 'System') or (t >= 100);
          if (GetX(self) <> Tiles[i][1]) or (GetY(self) <> Tiles[i][2]) then newMoveXY(Tiles[i][1], Tiles[i][2], True, 0, True);
          if TargetPresent then CancelTarget;
          UseType($0F7F, $FFFF);
          FindTypeEx($0ABD, $FFFF, Backpack, False);
          if FindCount > 0 then MoveItem(finditem, 0, ground, 0,0,0);
        end;  
    end;  
end;

function CheckLoction : Boolean;
var
x, y : integer;
begin
  x := GetX(self);
  for x := x - DistanceCheckLoction to GetX(self) + DistanceCheckLoction do
    begin
      y := GetY(self);
      for y := y - DistanceCheckLoction to GetY(self) + DistanceCheckLoction do
        begin
          if FileExists(IntToStr(x)+'_'+IntToStr(y)+'.loc') then
            begin
              result := true;
              FileNameLoc := IntToStr(x)+'_'+IntToStr(y)+'.loc';
              AddToSystemJournal(+ins+ol+wcif+FileNameLoc+ens);
              exit;
            end;
        end;
    end;
  AddToSystemJournal(+es+ulf+eie+ens);
  result := false;
end;

procedure WriteToFile(filepath: string; data: string);
var mode: Word;
begin
if FileExists(filepath) then mode := fmOpenReadWrite
else mode := fmCreate;
with TFileStream.Create(filepath,mode) do
  try
    Seek(0,soFromEnd);
    WriteBuffer(data,Length(data));
  finally
    Free;
  end;
end;

procedure GetCoorTile;
var
i, x, y : integer;
begin
  ClientPrintEx(self, 5, 1, 'Координаты локации сохранены.');
  ClientPrintEx(self, 5, 1, 'Для начала записи координат, вызовите таргет.');
  AddToSystemJournal(#13#10+'Координаты локации сохранены.');
  AddToSystemJournal(#13#10+'Для начала записи координат, вызовите таргет.');
  i := 0;
  CancelTarget;
  repeat
    wait(1000);
  until TargetPresent;
  ClientPrintEx(self, 5, 1, 'Начало разметки огорода.');
  AddToSystemJournal(#13#10+'Начало разметки огорода.');
  repeat
    if ((x <> GetX(self)) or (y <> GetY(self))) and (GetZ(self) <= 3) then
      begin
        if i > 5000 then break;
        Tile[i].x := GetX(self);
        Tile[i].y := GetY(self);
        x := GetX(self);
        y := GetY(self);
        i := i + 1;
        wait(100);
      end;
  until not TargetPresent;
  Count := i - 1;
  ClientPrintEx(self, 5, 1, 'Конец разметки огорода.');
  AddToSystemJournal(#13#10+'Конец разметки огорода.');    
end;

procedure CheckDubleCoor;
var
xi, yi, ii, i : integer;
begin
  ClientPrintEx(self, 5, 1, 'Обрабатываю данные...');
  AddToSystemJournal(#13#10+'Обрабатываю данные...');  
  repeat
    xi := Tile[ii].x;
    yi := Tile[ii].y;
    for i := 0 to Count do
      begin
        if ii <> i then
          begin
            if (xi = Tile[i].x) and (yi = Tile[i].y) then
              begin
                Tile[i].x := 0;
                Tile[i].y := 0;
              end;
          end;
      end;
    ii := ii + 1;
    if ii >= Count then break;
  until false;
  ii := 0; 
  for i := 0 to Count do
    begin
      if (Tile[i].x > 0) and (Tile[i].y > 0) then
        begin
          RdyTile[ii].x := Tile[i].x;
          RdyTile[ii].y := Tile[i].y;
          ii := ii + 1;
        end;
    end;
    Count := ii - 1;
    for i := 0 to Count do
      begin
        WriteToFile(IntToStr(locx)+'_'+IntToStr(locy)+'.loc', IntToStr(RdyTile[i].x)+' '+IntToStr(RdyTile[i].y)+#13#10);
      end;
      ClientPrintEx(self, 5, 1, 'Обработка данных закончена.');
      AddToSystemJournal(#13#10+'Обработка данных закончена.'); 
end;

begin
  if SaveCoorMod = 1 then
    begin
      CancelTarget;
      locx := GetX(self);
      locy := GetY(self);
      GetCoorTile;
      CheckDubleCoor;
      ClientPrintEx(self, 5, 1, 'Скрипт завершил работу.');
      AddToSystemJournal(#13#10+'Скрипт завершил работу.');
      CancelTarget;
      exit;
    end;
  RunInfoMSG;
  if not CheckItems then exit;
  if not CheckLoction then exit;
  EarthProcessing;
end.
 

 

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

×
×
  • Создать...