nepret 0 Жалоба Опубликовано 5 октября, 2012 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. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
nepret 0 Жалоба Опубликовано 12 октября, 2012 Version + отредактировал 1 пост Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
tdceramica 0 Жалоба Опубликовано 17 ноября, 2012 не работает, выдает ошибку. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
nepret 0 Жалоба Опубликовано 18 ноября, 2012 какую? Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты