куплю скрипт
Posted: 27.07.2016 11:46
собственно куплю скрипт на шард inceptum,на квест в хертвуде.
Code: Select all
Program Heartwood;
uses
Gumps;
var
Runebook : Cardinal;
BowCount, indx : Integer;
GTime, StartTime : TDateTime;
GWeight, PrevLogs{, TotalBows} : Integer;
RestartScript : Boolean;
Colors : Array of Word;
{config vars}
AtHomePoint : TPoint;
AtVendorsPoint : TPoint;
Recalls : Array of Byte;
const
Lag = 600;
PrizeBag = $4093494D;
LoadBag = $4093494E;
procedure SetConfig(CharName : String);
begin
case CharName of
'JippersCrippers' :
begin
AtVendorsPoint.X := 7040;
AtVendorsPoint.Y := 378;
AtHomePoint.X := 2169;
AtHomePoint.Y := 882;
Recalls := [11,23];
end;
'Bifur' :
begin
AtVendorsPoint.X := 7040;
AtVendorsPoint.Y := 378;
AtHomePoint.X := 2169;
AtHomePoint.Y := 882;
Recalls := [11,23];
end;
'Drabadanter' :
begin
AtVendorsPoint.X := 7040;
AtVendorsPoint.Y := 378;
AtHomePoint.X := 2169;
AtHomePoint.Y := 882;
Recalls := [7,13];
end;
'Driller' :
begin
AtVendorsPoint.X := 7040;
AtVendorsPoint.Y := 378;
AtHomePoint.X := 2169;
AtHomePoint.Y := 882;
Recalls := [7,13];
end;
'Melnik' :
begin
AtVendorsPoint.X := 7040;
AtVendorsPoint.Y := 378;
AtHomePoint.X := 2169;
AtHomePoint.Y := 882;
Recalls := [17,23];
end;
'Dwalin' :
begin
AtVendorsPoint.X := 7040;
AtVendorsPoint.Y := 378;
AtHomePoint.X := 2169;
AtHomePoint.Y := 882;
Recalls := [7,13];
end;
end;
end;
procedure WaitLag;
begin
Wait(Lag);
end;
function GetFoundItems(var Items: Array Of Cardinal): Integer;
var List: TStringList; i: Integer;
begin
List := TStringList.Create;
if GetFindedList(List) = False then Result := 0
else begin
SetLength(Items, List.Count);
for i := 0 to Length(Items)-1 do Items[i] := StrToInt('$'+List.Strings[i]);
Result := Length(Items);
end;
List.Free;
end;
procedure StartSystem;
begin
Runebook := FindType($22C5, Backpack);
end;
procedure CastRecall(Where : Integer);
var
currX : Integer;
i : Integer;
begin
currX := GetX(Self);
//while GetX(Self) = currX do
//begin
if RestartScript then Exit;
UseObject(Runebook);
WaitLag;
NumGumpButton(GetGumpsCount-1, Where);
for i := 0 to 70 do
begin
if GetX(Self) <> CurrX then
Break;
Wait(100);
end;
Wait(2000);
//end;
end;
procedure RecallTo(Where : String);
begin
case Where of
'Bank' : CastRecall(5);
'Yew' : CastRecall(Recalls[0]);
'Home' : CastRecall(Recalls[1]);
end;
end;
procedure MoveTo(Where : String);
begin
ClearBadLocationList;
case Where of
'Heartwood' :
begin
if Getx(Self) < 6000 then
begin
RecallTo('Yew');
NewMoveXY(535, 992, true, 0, true); //vhod v portal
end;
WaitLag;
Wait(2000);
NewMoveXY(AtVendorsPoint.X, AtVendorsPoint.y, true, 1, true); //kvesteru
WaitLag;
end;
'Home' :
begin
while GetX(Self) > 6000 do
begin
ClearBadLocationList;
if RestartScript then Exit;
NewMoveXY(6984, 339, true, 0, true); //vuhod iz heartwood
FindType($3967, Ground);
if FindItem > 0 then
NewMoveXY(Getx(FindItem), GetY(FindItem), true, 0, true);
end;
WaitLag;
Wait(2000);
UOSay('Guards');
if GetX(Self) < 5000 then
RecallTo('Home')
else
MoveTo(Where);
WaitLag;
Wait(1000);
end;
end;
end;
procedure GetQuest;
var
bool : Boolean;
gi : TGumpInfo;
begin
{if not hidden then
repeat
UseSkill('Hiding');
Wait(7000);
until Hidden;}
bool := False;
if RestartScript then Exit;
repeat
UseObject($00000677);
WaitLag;
if wait_for_gump($4C4C6DB0, 3000) then
begin
GetGumpInfo(GetGumpsCount-1, gi);
if Length(gi.XmfHTMLGumpColor) > 0 then
if (GetClilocById(gi.XmfHTMLGumpColor[1].Cliloc_Id) = 'A Simple Bow') then
bool := True;
end;
until bool;
PushGumpButton(GetGumpsCount-1, 'Quest Offer', 95, 395, 4);
end;
procedure LoadBows(Count : Integer);
begin
NewMoveXY(GetX(PrizeBag), GetY(PrizeBag), true, 1, true);
UseObject(LoadBag);
WaitLAg;
AddToSystemJournal('Loading bows: ' + TimeToStr(Now));
repeat
if FindType($13B2, LoadBag) > 0 then
begin
if MoveItem(FindType($13B2, LoadBag), 1, Backpack, 0,0,0) then
WaitLag
else
LoadBows(Count);
end
else
//AddToSystemJournal('No bows at load bag!');
Wait(1000);
//WaitLag;
FindType($13B2, Backpack);
until FindCount >= Count;
end;
procedure Unload;
//var
{LootTypes : Array of Word;
i,k : Integer;
Items : Array of Cardinal;}
begin
NewMoveXY(AtHomePoint.X, AtHomePoint.Y, true, 1, true);
if GetZ(Self) > 9 then
repeat
ClearBadLocationList;
NewMoveXY(2171, 893, true, 1, true);
NewMoveXY(GetX(PrizeBag), GetY(PrizeBag), true, 1, true);
until GetZ(Self) < 15;
{UseObject(PrizeBag);
WaitLag;}
{if RestartScript then Exit;
LootTypes := [$1022, $2F58, $2F5A, $2F59, $2F5B];
FindType($FFFF, Backpack);
if GetFoundItems(Items) > 0 then
for i := 0 to Length(Items)-1 do
for k := 0 to Length(LootTypes)-1 do
if GetType(Items[i]) = LootTypes[k] then
begin
if RestartScript then Exit;
if k = 0 then
if GetColor(Items[i]) = $0000 then Continue;
MoveItem(Items[i], 1, PrizeBag, 1,1,1);
WaitLag;
end;}
while FindType($1022, Backpack) > 0 do
if MoveItem(FindItem, 0, PrizeBag, 0,0,0) then
Wait(600);
end;
function CountTime(Time : TDateTime) : Double;
var
Hour, Min, Sec, MSec: Word;
begin
Result := 0;
DecodeTime(Time, Hour, Min, Sec, MSec);
if Hour > 0 then
Result := (Hour * 60)*60;
if Min > 0 then
Result := Result + (Min*60);
if Sec > 0 then
Result := Result + Sec;
AddToSystemJOurnal(FloatToStr(Result));
end;
procedure ToggleQuestItem;
var
gi : TGumpInfo;
i : Integer;
//tmpCont : Cardinal;
begin
if RestartScript then Exit;
//tmpCount := FindType($0E79, Backpack);
if Self = $000037FE then SetContextMenuHook(Self, 6) else SetContextMenuHook(Self, 5);
RequestContextMenu(Self);
i := 0;
WaitLag;
repeat
//RequestContextMenu(Self);
if WaitForTarget(1000) then
begin
TargetToObject(FindTypeEx($13B2, 0000, backpack, True));
//WaitLag;
Wait(50);
i := i + 1;
FindTypeEx($13B2, $04EA, Backpack, True);
end
else
RequestContextMenu(Self);
until FindFullQuantity >= 10;
CancelTarget;
if TargetPresent then TargetToObject(Self);
WaitLag;
UseObject($00000677);
if wait_for_gump($4C4C6DB0, 3000) then
begin
WaitLag;
GetGumpInfo(GetGumpsCount-1, gi);
if Length(gi.GumpButtons) >= 2 then
NumGumpButton(GetGumpsCount-1, gi.GumpButtons[1].return_value);
if wait_for_gump($4C4C6DB0, 3000) then
begin
GetGumpInfo(GetGumpsCount-1, gi);
if Length(gi.GumpButtons) > 0 then
NumGumpButton(GetGumpsCount-1, gi.GumpButtons[0].return_value);
end;
end
else
ToggleQuestItem;
IgnoreReset;
ClearContextMenu;
end;
function CheckItemProps(Item : Cardinal) : Boolean;
var
Props : Array of String;
i : Integer;
begin
Result:= False;
Props := ['recovery 3',
'casting 3',
'cost 10%',
'cost 11%',
'cost 12%',
'cost 13%',
'cost 14%',
'cost 15%',
'cost 16%',
'cost 17%',
'cost 18%',
'cost 19%',
'cost 20%',
'repond',
'regeneration',
'chance increase'
];
for i := 0 to Length(Props)-1 do
if (BmSearch(1,AnsiLowerCase(GetToolTip(Item)), Props[i]) > 0) then
Result := True;
end;
procedure NewLooter(Container : Cardinal);
var
i : Integer;
begin
UseObject(Container);
WaitLag;
for i := Low(Colors) to High(Colors) do
if FindTypeEx($1022, Colors[i], Container, False) > 0 then
if MoveItem(FindItem, 0, Backpack, 0,0,0) then
begin
Wait(600);
FillNewWindow('Got a ' + GetToolTip(FindItem) + ' at: ' + TimeToStr(Now));
end;
end;
procedure LootHandler(Container : Cardinal);
var
LootTypes : Array of Word;
Items : Array of Cardinal;
i, k : Integer;
begin
if RestartScript then Exit;
LootTypes := [$1022{, $2F58, $2F5A, $2F59, $2F5B}];
UseObject(Container);
WaitLag;
//Wait(1000);
FindType($FFFF, Container);
if GetFoundItems(Items) > 0 then
for i := 0 to Length(Items)-1 do
begin
//FillNewWindow('Got reward: ' + GetToolTip(Items[i]));
for k := 0 to Length(LootTypes)-1 do
if GetType(Items[i]) = LootTypes[k] then
begin
if CheckItemProps(Items[i]) then
begin
MoveItem(Items[i], 1, Backpack, 0,0,0);
WaitLag;
end;
if (GetType(Items[i]) = LootTypes[0]) then
if (GetColor(Items[i]) = $04A9) or (GetColor(Items[i]) = $04A8) then
begin
MoveItem(Items[i], 1, Backpack, 0,0,0);
FillNewWindow('Got reward! TOOL. ' + GetToolTip(Items[i]) + ' ' + TimeToStr(Now));
WaitLag;
end;
if (BMSearch(1, GetToolTip(Items[i]), 'Heartwood') > 0) then
AddToSystemJournal('Got runic!');
//if (k > 0) then
if (BMSearch(1, AnsiLowerCase(GetToolTip(Items[i])), 'bonus: 30') > 0){ or
(BMSearch(1, AnsiLowerCase(GetToolTip(Items[i])), 'bonus: 29') > 0) or
(BMSearch(1, AnsiLowerCase(GetToolTip(Items[i])), 'bonus: 28') > 0) }then
begin
MoveItem(Items[i], 1, Backpack, 0,0,0);
WaitLag;
//AddToSystemJournal('Got reward: ' + GetToolTip(Items[i]));
end;
end;
end;
end;
function BowsCheck : Boolean;
begin
Result := False;
FindType($13B2, Backpack);
if FindCount > 10 then
Result := True;
end;
procedure MainProc;
var
i : Integer;
begin
for i := 0 to GetGumpsCount-1 do
CloseSimpleGump(i);
GWeight := Weight;
GTime := Now;
while not RestartScript do
begin
//AddToSystemJournal(IntToStr(((MaxWeight-70)/6)))
WaitLag;
FindType($13B2, Backpack);
BowCount := FindCount;
if not BowsCheck then
begin
while (Getx(self) > 2200) or (GetX(Self) < 1500) do
MoveTo('Home');
Unload;
LoadBows((MaxWeight - Weight - 20)/6);
end;
while (GetX(Self) < 6000) or (Dist(7040, 378, GetX(Self), GetY(Self))>2) do
MoveTo('Heartwood');
for indx := 0 to (BowCount/10)-1 do
begin
GetQuest;
ToggleQuestItem;
WaitLag;
end;
while FindType(GetType(Backpack), Backpack)>0 do
begin
//WaitLag;
//LootHandler(FindItem);
NewLooter(FindItem);
WaitLag;
MoveItem(FindType(GetType(Backpack), Backpack), 1, $40CD9538, 0,0,0);
WaitLag;
end;
end;
end;
procedure OnSpeech(Text,SenderName : String; SenderId : Cardinal);
begin
if Text = 'The world is saving, please wait.' then
WaitJournalLine(Now, 'World save complete.', 20000);
end;
begin
SetEventProc(evUnicodeSpeech, 'OnSpeech');
IgnoreReset;
StartSystem;
//MoveTo('Bank');
AddGumpIgnoreBySerial($30AAC19);
RestartScript := False;
StartTime := Now;
PrevLogs := 0;
MoveOpenDoor := True;
MoveThroughNPC := 1;
MoveCheckStamina := Stam/2;
SetConfig(GetName(Self));
Colors := [$04A9, $04A8];
//LootHandler(FindType(GetType(Backpack), Backpack));
while True do
begin
RestartScript := False;
MainProc;
Wait(50);
end;
end.
нет, это же бесплатный скрипт.alexandr wrote:спс,попробую может что и получится!)а можешь пжлст принцип его описать !?
Code: Select all
unit Gumps;
interface
function PushGumpButton(GumpIndex : ShortInt; GumpText : String; X, Y, Return_Value : Integer) : Boolean;
function wait_for_gump(gump_id,wait_time_ms : integer) : boolean;
implementation
function PushGumpButton(GumpIndex : ShortInt; GumpText : String; X, Y, Return_Value : Integer) : Boolean;
var
GI : TGumpInfo;
TextFound, ButtonFound : Boolean;
ButtonIndex, i : Integer;
begin
GetGumpInfo(GumpIndex, GI);
Wait(50);
{if Length(GI.XmfHTMLGumpColor) > 0 then
for i := 0 to Length(GI.XmfHTMLGumpColor)-1 do
begin
//AddToSystemJournal(GetClilocById(GI.XmfHTMLGumpColor[i].Cliloc_Id));
if GumpText = GetClilocById(GI.XmfHTMLGumpColor[i].Cliloc_Id) then
begin
TextFound := True;
Break;
end;
end;}
TextFound := True;
if Length(GI.GumpButtons) > 0 then
for i := 0 to Length(GI.GumpButtons)-1 do
begin
//AddToSystemJournal(IntToStr(GI.GumpButtons[i].Return_Value));
if (X = GI.GumpButtons[i].X) and (Y = GI.GumpButtons[i].Y) and (Return_Value = GI.GumpButtons[i].Return_Value) then
begin
ButtonIndex := i;
ButtonFound := True;
Break;
end;
end;
if TextFound and ButtonFound then
begin
NumGumpButton(GumpIndex, GI.GumpButtons[ButtonIndex].return_value);
//AddToSystemJournal('Pushed the button!');
Result := True;
end;
{if not TextFound then
AddToSystemJournal('Text not found!');
if not ButtonFound then
AddToSystemJournal('Button not found!');}
end;
function wait_for_gump(gump_id,wait_time_ms : integer) : boolean;
var
wait_cycle : integer;
begin
if dead or not connected then exit;
repeat
if getgumpid(getgumpscount-1) = gump_id then
begin
result := true;
break;
end;
wait(50);
CheckLag(60000);
inc(wait_cycle);
until wait_cycle >= (wait_time_ms/50);
end;
end.
а хз, наверно руны в рунбуках. То-есть первая поидее домой, вторая в хартвуд.alexandr wrote:что означают цифры (Recalls := [11,23]) 11 и 23????
Powered by phpBB® Forum Software © phpBB Limited