nepret 0 Жалоба Опубликовано 9 ноября, 2012 В бекпаке иметь: Бочку Trash Еду Удочки(много) инклюды: {$Include 'CheckSave.inc'}; {$Include 'Hungry.inc'}; {$Include 'waitconnection.inc'}; Скрипт автоматически ищет тайлы с водой Всю пойманную рыбу и обувь, скидывает под ноги Карты и сос-бутылки перекидывает в треш-бочонок АХТУНГ! Ловить только в море! Это связано с тем, что возле берега, другие типы тайлов. Искать и добавлять их в массив мне было откровенно влом (их около 20-30 штук) Program Fishing; type TileRecord = Record t,x,y : integer; end; var Tile : array [0..5000] of TileRecord; TileCount : integer; b : TMapCell; uh, dh, enter, tab : String; {$Include 'CheckSave.inc'}; {$Include 'Hungry.inc'}; {$Include 'waitconnection.inc'}; function CheckTarget(SecTime : integer) : Boolean; var t : integer; begin SecTime := SecTime * 10; t := 0; repeat if not Connected then exit; checksave; 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; procedure OpenBackpack; begin if (LastContainer <> Backpack) and (dead = false) then begin repeat if not Connected then exit; Checksave; UseObject(Backpack); wait(1000); until LastContainer = Backpack; end; end; procedure SetSayinfo; begin uh := #13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#9#9#9#9 ; dh := #13#10#13#10#13#10; enter := #13#10; tab := '#9'; end; procedure EndScript; begin if not GetPauseScriptOnDisconnectStatus then SetPauseScriptOnDisconnectStatus(true); SetARStatus(false); Disconnect; AddToSystemJournal(uh+'>>>>>> Перезапусти скрипт! <<<<<<'+dh); repeat wait(100); until false; end; procedure CheckDead; begin if Dead then begin AddToSystemJournal(dh+'Я мёртв!'); EndScript; end; end; procedure SearchPoint; var x, y, i, i0 : integer; ArrayTile : array [0..5] of integer; begin ArrayTile[0] := 168; ArrayTile[1] := 169; ArrayTile[2] := 170; ArrayTile[3] := 171; ArrayTile[4] := 310; ArrayTile[5] := 311; if not Connected then exit; CheckDead; AddToSystemJournal(uh); AddToSystemJournal('Ищем воду в радиусе 6 тайлов...'); for x := GetX(self)-6 to GetX(self)+6 do begin for y := GetY(self)-6 to GetY(self)+6 do begin b := GetMapCell(x, y, WorldNum); for i := 0 to High(ArrayTile) do begin if b.Tile = ArrayTile[i] then begin Tile[i0].t := b.Tile; Tile[i0].x := x; Tile[i0].y := y; break; end; end; if Tile[i0].t > 0 then begin TileCount := TileCount + 1; i0 := i0 + 1; end; end; end; AddToSystemJournal('Нашли тайлов: '+IntToStr(TileCount)+'.'); if TileCount = 0 then EndScript; AddToSystemJournal('Рыбачим...'+dh); end; procedure CheckItem; var i, Trash : integer; Item : array [0..13] of cardinal; begin Item[0] := $170A; //тапки Item[1] := $170B; Item[2] := $170C; Item[3] := $170D; Item[4] := $170E; Item[5] := $170F; Item[6] := $1710; Item[7] := $1711; Item[8] := $0DC8; //сети Item[9] := $14ED; //карты Item[10] := $099F; //бутылки Item[11] := $09CC; //рыба Item[12] := $09CD; Item[13] := $09CE; if not Connected then exit; CheckDead; OpenBackpack; FindTypeEx($0E77, $FFFF, Backpack, False); if FindCount < 1 then begin AddToSystemJournal('Нет бочки Trash.'); EndScript; end; Trash := finditem; for i := 0 to 13 do begin repeat FindTypeEx(Item[i], $FFFF, Backpack, False); if FindCount > 0 then begin if (i < 8) or (i > 10) then MoveItem(finditem, 0, Ground, 0,0,0); if (i >=8) and (i <= 10) then MoveItem(finditem, 0, Trash, 0,0,0); if not Connected then exit; CheckDead; CheckSave; CheckLag(10); end; until FindCount < 1; end; end; procedure UsePole; begin if not Connected then exit; CheckDead; if ObjAtLayer(LhandLayer) <= 0 then begin OpenBackpack; FindTypeEx($0DBF, $FFFF, Backpack, False); if FindCount < 1 then begin AddToSystemJournal('Нет удочек.'); EndScript; end; UseType($0DBF, $FFFF); end else begin UseObject(ObjAtLayer(LhandLayer)); end; end; procedure StartFishing; var i, t : integer; time : TDateTime; begin for i := 0 to TileCount-1 do begin if not Connected then exit; CheckDead; CheckSave; CancelTarget; Hungry(Backpack); t := 0; repeat CancelTarget; if t >= 5 then wait(5000); UsePole; if not Connected then exit; CheckDead; CheckTarget(5); if not Connected then exit; CheckDead; t := t + 1; until TargetPresent; time := Now; TargetToTile(0, Tile[i].x, Tile[i].y, -254); CheckLag(10); t := 0; repeat wait(100); t := t + 1; CheckSave; if not Connected then exit; CheckDead; until (InJournalBetweenTimes('That is too far away|There doesn|I am already doing|You find|You catch|They don', time, Now) <> -1) or (t >= 200); if FoundedParamID >= 3 then i := i - 1; end; end; begin SetARStatus(true); SetPauseScriptOnDisconnectStatus(false); if not Connected then waitconnection(5000); SetSayinfo; SearchPoint; repeat if not Connected then waitconnection(5000); CheckItem; StartFishing; until false; end. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
nepret 0 Жалоба Опубликовано 9 ноября, 2012 Ловля БП сетью. В бекпаке иметь: сеть, еда инклюды: {$Include 'CheckSave.inc'}; {$Include 'Hungry.inc'}; {$Include 'waitconnection.inc'}; Program Fishing_GetBP; type TileRecord = Record t,x,y : integer; end; var TileCount, FishingDistance : integer; Tile : array [0..5000] of TileRecord; uh, dh, enter, tab : String; {$Include 'CheckSave.inc'}; {$Include 'Hungry.inc'}; {$Include 'waitconnection.inc'}; function CheckTarget(SecTime : integer) : Boolean; var t : integer; begin SecTime := SecTime * 10; t := 0; repeat if not Connected then exit; checksave; 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; procedure OpenBackpack; begin if (LastContainer <> Backpack) and (dead = false) then begin repeat if not Connected then exit; Checksave; UseObject(Backpack); wait(1000); until LastContainer = Backpack; end; end; procedure SetSayinfo; begin uh := #13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#9#9#9#9 ; dh := #13#10#13#10#13#10; enter := #13#10; tab := '#9'; end; procedure EndScript; begin if not GetPauseScriptOnDisconnectStatus then SetPauseScriptOnDisconnectStatus(true); SetARStatus(false); Disconnect; AddToSystemJournal(uh+'>>>>>> Перезапусти скрипт! <<<<<<'+dh); repeat wait(100); until false; end; procedure CheckDead; begin if Dead then begin AddToSystemJournal('Я мёртв!'); EndScript; end; end; procedure CheckDuble; var i, i0 : integer; begin if not Connected then exit; CheckDead; AddToSystemJournal('Отсееваем дубликаты и пустые тайлы...'); for i := 0 to TileCount do begin for i0 := i+1 to TileCount do begin if (Tile[i].x = Tile[i0].x) and (Tile[i].y = Tile[i0].y) and (Tile[i].x > 0) and (Tile[i].y > 0) then begin Tile[i0].x := 0; Tile[i0].y := 0; end; end; end; for i := 0 to TileCount do begin if (Tile[i].x = 0) and (Tile[i].y = 0) then begin i0 := i; while i0 <= TileCount do begin Tile[i0].x := Tile[i0+1].x; Tile[i0].y := Tile[i0+1].y; i0 := i0 + 1; end; TileCount := TileCount - 1; end; end; AddToSystemJournal('После отсеевания осталось: '+IntToStr(TileCount)+'.'); end; function SearchPoint : Boolean; var a : TFoundTilesArray; TyleType : array [0..9] of cardinal; b, i, i0, StartX, StartY, check : integer; begin if not Connected then exit; CheckDead; TyleType[0] := 6039; TyleType[1] := 6040; TyleType[2] := 6041; TyleType[3] := 6042; TyleType[4] := 6043; TyleType[5] := 6044; TyleType[6] := 16368; TyleType[7] := 16369; TyleType[8] := 0; TyleType[9] := 16011; AddToSystemJournal(dh); AddToSystemJournal('Ищем тайлы с водой...'); StartX := GetX(Self); StartY := GetY(Self); for i := 0 to 9 do begin b:= GetStaticTilesArray(StartX-FishingDistance,StartY-FishingDistance,StartX+FishingDistance,StartY+FishingDistance, WorldNum, TyleType[i], a); if b > 0 then begin for i0 := 0 to b do begin Tile[TileCount].t := a[i0].Tile; Tile[TileCount].x := a[i0].X; Tile[TileCount].y := a[i0].Y; TileCount := TileCount + 1; end; end; end; if TileCount > 0 then check := TileCount + 1; AddToSystemJournal('Нашли тайлов: '+IntToStr(check)+'.'); if TileCount <= 0 then exit; CheckDuble; result := True; end; procedure CheckItem; begin FindTypeEx($0DC8, $FFFF, Backpack, False); if FindCount < 1 then EndScript; end; procedure StartFishing; var i, t : integer; time : TDateTime; begin for i := 0 to TileCount do begin if not Connected then exit; CheckDead; CheckSave; Hungry(Backpack); repeat CheckItem; CancelTarget; UseType($0DC8, $FFFF); CheckTarget(5); if not Connected then exit; CheckDead; until TargetPresent; time := Now; TargetToTile(Tile[i].t, Tile[i].x, Tile[i].y, -254); CheckLag(10); t := 0; repeat wait(100); t := t + 1; CheckSave; if not Connected then exit; CheckDead; until (InJournalBetweenTimes('just got|Nothing|Это слишком далеко|Здесь больше нет жемчуга', time, Now) <> -1) or (t >= 200); if FoundedParamID <= 1 then i := i - 1; end; end; begin SetARStatus(true); SetPauseScriptOnDisconnectStatus(false); if not Connected then waitconnection(10); FishingDistance := 4; SetSayinfo; SearchPoint; repeat if not Connected then waitconnection(10); StartFishing; until false; end. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
nepret 0 Жалоба Опубликовано 9 ноября, 2012 Подбираем все ботинки найденные в радиусе 2 тайла. В бекпаке иметь: Побольше сумок типа "Бекпак". Скрипт автоматически перебрасывает обувь в сумку, если та заполниться, начинает кидать шузы в другую сумку... и так далее пока не подберёт все тапки Program Get_Boots; var Bag : array [0..225] of cardinal; BagCount, BagNum : integer; time : TDateTime; function CheckAllBag : Boolean; var i, bc : integer; begin FindTypeEx($0E75, $FFFF, Backpack, false); if FindCount > 0 then begin bc := FindCount; for i := 0 to bc - 1 do begin FindTypeEx($0E75, $FFFF, Backpack, false); Bag[i] := finditem; Ignore(finditem); BagCount := BagCount + 1; end; if BagCount < 1 then begin AddToSystemJournal('В бекпаке не найдено сумок.'); exit; end; BagCount := BagCount - 1; end; result := true; end; function CheckBag : Boolean; begin checklag(10); if InJournalBetweenTimes('That item is too heavy for the container or the container is full.', time, Now) <> -1 then BagNum := BagNum + 1; if BagNum > BagCount then exit; result := true; end; procedure GetBoot; var i : integer; Item : array [0..7] of cardinal; begin Item[0] := $170A; //тапки Item[1] := $170B; Item[2] := $170C; Item[3] := $170D; Item[4] := $170E; Item[5] := $170F; Item[6] := $1710; Item[7] := $1711; for i := 0 to 7 do begin repeat FindTypeEx(Item[i], $FFFF, Ground, False); if FindCount > 0 then begin time := Now; MoveItem(finditem, 0, Bag[BagNum], 0,0,0); if not CheckBag then begin AddToSystemJournal('Все бекпаки переполнены!'); exit; end; end; until FindCount < 1; end; AddToSystemJournal('На полу больше нет обуви.'); end; begin if not CheckAllBag then exit; GetBoot; AddToSystemJournal('Конец скрипта.'); end. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
nepret 0 Жалоба Опубликовано 9 ноября, 2012 Переработка обуви. Ищет тапки в бекпаках на земле, берёт по 1 штуке, режет на кожу В бекпаках иметь: Много много ножниц еду Инклюды: {$Include 'hungry.inc'} Program Processing_Boots; var Bag : array [0..225] of cardinal; BagCount, BagNum : integer; {$Include 'hungry.inc'} function CheckAllBag : Boolean; var i, bc : integer; begin FindTypeEx($0E75, $FFFF, Ground, false); if FindCount > 0 then begin bc := FindCount; for i := 0 to bc - 1 do begin FindTypeEx($0E75, $FFFF, Ground, false); Bag[i] := finditem; Ignore(finditem); BagCount := BagCount + 1; end; if BagCount < 1 then begin AddToSystemJournal('На земле не найдено сумок.'); exit; end; BagCount := BagCount - 1; end; result := true; end; procedure OpenBag (IDBag : cardinal); begin if LastContainer <> IDBag then begin repeat UseObject(IDBag); wait(1000); until LastContainer = IDBag; end; end; function ProcBoot (TypeRes : integer) : Boolean; var time : TDateTime; begin FindTypeEx(TypeRes, $FFFF, backpack, false); if FindCount > 0 then begin repeat FindTypeEx($0F9E, $FFFF, backpack, false); if FindCount < 1 then exit; if FindCount > 0 then begin time := Now; if TargetPresent then CancelTarget; UseType($0F9E, $FFFF); WaitForTarget(30000); FindTypeEx(TypeRes, $FFFF, backpack, false); WaitTargetObject(finditem); repeat wait(100); until InJournalBetweenTimes('You could make|О нет, вы сломали', time, Now) <> -1; end; FindTypeEx(TypeRes, $FFFF, backpack, false); until FindCount < 1; end; result := true; end; procedure GetBoot; var i : integer; Item : array [0..7] of cardinal; begin Item[0] := $170A; //тапки Item[1] := $170B; Item[2] := $170C; Item[3] := $170D; Item[4] := $170E; Item[5] := $170F; Item[6] := $1710; Item[7] := $1711; for i := 0 to 7 do begin repeat if not ProcBoot(Item[i]) then begin AddToSystemJournal('В бекпаке нет ножниц!'); exit; end; OpenBag(Bag[BagNum]); FindTypeEx(Item[i], $FFFF, Bag[BagNum], False); if FindCount > 0 then begin MoveItem(finditem, 0, backpack, 0,0,0); CheckLag(1000); Hungry(backpack); end; until FindCount < 1; end; end; begin if not CheckAllBag then exit; repeat GetBoot; BagNum := BagNum + 1; until BagNum > BagCount; if BagNum > BagCount then AddToSystemJournal('В контейнерах больше нет обуви.'); end. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
Kamui 0 Жалоба Опубликовано 11 ноября, 2012 При запуске скрипта на рыбалку выдает: C:\games\Ultima Online\Scripts\Include\CheckSave.inc 00:32:19:692 Compiling 00:32:19:704 Compiler: [Error] (fishing.sc at 12:27): 'BEGIN' expected 00:32:19:706 : Compiling failed 00:32:19:708 Script fishing.sc stopped successfuly Подскажи как исправить плз. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
MeSSiR 0 Жалоба Опубликовано 12 ноября, 2012 Инклюды скачай Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
Kamui 0 Жалоба Опубликовано 12 ноября, 2012 Инклюды скачай Я не заметил что он их по другому пути ищет. Исправил все работает. Огромное спасибо автору. Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
Dvigan 0 Жалоба Опубликовано 11 июля, 2014 Ловля БП сетью. В бекпаке иметь: сеть, еда инклюды: {$Include 'CheckSave.inc'}; {$Include 'Hungry.inc'}; {$Include 'waitconnection.inc'}; Program Fishing_GetBP; type TileRecord = Record t,x,y : integer; end; var TileCount, FishingDistance : integer; Tile : array [0..5000] of TileRecord; uh, dh, enter, tab : String; {$Include 'CheckSave.inc'}; {$Include 'Hungry.inc'}; {$Include 'waitconnection.inc'}; function CheckTarget(SecTime : integer) : Boolean; var t : integer; begin SecTime := SecTime * 10; t := 0; repeat if not Connected then exit; checksave; 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; procedure OpenBackpack; begin if (LastContainer <> Backpack) and (dead = false) then begin repeat if not Connected then exit; Checksave; UseObject(Backpack); wait(1000); until LastContainer = Backpack; end; end; procedure SetSayinfo; begin uh := #13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#9#9#9#9 ; dh := #13#10#13#10#13#10; enter := #13#10; tab := '#9'; end; procedure EndScript; begin if not GetPauseScriptOnDisconnectStatus then SetPauseScriptOnDisconnectStatus(true); SetARStatus(false); Disconnect; AddToSystemJournal(uh+'>>>>>> Перезапусти скрипт! <<<<<<'+dh); repeat wait(100); until false; end; procedure CheckDead; begin if Dead then begin AddToSystemJournal('Я мёртв!'); EndScript; end; end; procedure CheckDuble; var i, i0 : integer; begin if not Connected then exit; CheckDead; AddToSystemJournal('Отсееваем дубликаты и пустые тайлы...'); for i := 0 to TileCount do begin for i0 := i+1 to TileCount do begin if (Tile[i].x = Tile[i0].x) and (Tile[i].y = Tile[i0].y) and (Tile[i].x > 0) and (Tile[i].y > 0) then begin Tile[i0].x := 0; Tile[i0].y := 0; end; end; end; for i := 0 to TileCount do begin if (Tile[i].x = 0) and (Tile[i].y = 0) then begin i0 := i; while i0 <= TileCount do begin Tile[i0].x := Tile[i0+1].x; Tile[i0].y := Tile[i0+1].y; i0 := i0 + 1; end; TileCount := TileCount - 1; end; end; AddToSystemJournal('После отсеевания осталось: '+IntToStr(TileCount)+'.'); end; function SearchPoint : Boolean; var a : TFoundTilesArray; TyleType : array [0..9] of cardinal; b, i, i0, StartX, StartY, check : integer; begin if not Connected then exit; CheckDead; TyleType[0] := 6039; TyleType[1] := 6040; TyleType[2] := 6041; TyleType[3] := 6042; TyleType[4] := 6043; TyleType[5] := 6044; TyleType[6] := 16368; TyleType[7] := 16369; TyleType[8] := 0; TyleType[9] := 16011; AddToSystemJournal(dh); AddToSystemJournal('Ищем тайлы с водой...'); StartX := GetX(Self); StartY := GetY(Self); for i := 0 to 9 do begin b:= GetStaticTilesArray(StartX-FishingDistance,StartY-FishingDistance,StartX+FishingDistance,StartY+FishingDistance, WorldNum, TyleType[i], a); if b > 0 then begin for i0 := 0 to b do begin Tile[TileCount].t := a[i0].Tile; Tile[TileCount].x := a[i0].X; Tile[TileCount].y := a[i0].Y; TileCount := TileCount + 1; end; end; end; if TileCount > 0 then check := TileCount + 1; AddToSystemJournal('Нашли тайлов: '+IntToStr(check)+'.'); if TileCount <= 0 then exit; CheckDuble; result := True; end; procedure CheckItem; begin FindTypeEx($0DC8, $FFFF, Backpack, False); if FindCount < 1 then EndScript; end; procedure StartFishing; var i, t : integer; time : TDateTime; begin for i := 0 to TileCount do begin if not Connected then exit; CheckDead; CheckSave; Hungry(Backpack); repeat CheckItem; CancelTarget; UseType($0DC8, $FFFF); CheckTarget(5); if not Connected then exit; CheckDead; until TargetPresent; time := Now; TargetToTile(Tile[i].t, Tile[i].x, Tile[i].y, -254); CheckLag(10); t := 0; repeat wait(100); t := t + 1; CheckSave; if not Connected then exit; CheckDead; until (InJournalBetweenTimes('just got|Nothing|Это слишком далеко|Здесь больше нет жемчуга', time, Now) <> -1) or (t >= 200); if FoundedParamID <= 1 then i := i - 1; end; end; begin SetARStatus(true); SetPauseScriptOnDisconnectStatus(false); if not Connected then waitconnection(10); FishingDistance := 4; SetSayinfo; SearchPoint; repeat if not Connected then waitconnection(10); StartFishing; until false; end. Пожалуйста помогите разобраться! Прикрепленный файл уже не работает, поэтому я скопировал этот код, открыл файл блокнот, вставил туда код, сохранил файл изменив расширение на .sc Получился файл BlackPearl.sc по адресу Ultima Online\Stealth\Scripts Далее из этой темы http://middle-earth.ru/forum/index.php?sho...%EA%EB%FE%E4%FB скопировал указанные инклюды и вставил каждую в свой файл блокнота по адресу Ultima Online\Stealth\Scripts\Include, изменив им расширение на .inc Все ли правильно проделал на данном этапе? Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты
nepret 0 Жалоба Опубликовано 15 июля, 2014 запускать скрипт можно из любого места в папке со стелсом, а вот инклюды должны лежать в папочке Include Поделиться сообщением Ссылка на сообщение Поделиться на другие сайты