Есть скрипт нашел тут
delphi Код:
Crystal: boolean;
//----------------------------------------------------------------
procedure Init; //Вызывается при включении скрипта
begin
Crystal:=false;
SendMsg('Начало инициализации скрипта, откройте инвентарь');
end;
//-----------------------------------------------------------------
procedure Free; //Вызывается при выключении скрипта
begin
ItemBase:=nil;
end;
//------------------------------------------------------------------
procedure SendMsg(msg:string);
begin
buf:=#$4A;
WriteD(0);
WriteD(10);
WriteS('');
WriteS(msg);
SendToClient;
end;
//----------------------------------------------------------------
procedure CreateItemBase; //Создает базу ObjectID и ItemID, опять же не проверяет пакет на правильность для экономия ресурсов
var
i,j: integer;
begin
j:=8;
SetLength(ItemBase,int((length(pck)-5)/14)); //1ый байт - идентификатор пакета, следующие 4 байта хз, далее для каждого итема отводится 28 байт, размер массива должен быть в 2 раза больше, чем итемов.
for i:=0 to int(Length(ItemBase)/2-1) do begin
ItemBase[i*2]:=ReadD(j);
ItemBase[i*2+1]:=ReadD(j);
j:=j+20;
end;
end;
//---------------------------------------------------------
procedure UpdateItemBase; //Удаляет без проверки, использовать аккуратно
var
i: integer;
begin
for i:=0 to int(Length(ItemBase)/2-1) do
if (ItemBase[i*2]=ReadD(8)) or (ItemBase[i*2+1]=ReadD(12)) then begin
ItemBase[i*2]:=0;
ItemBase[i*2+1]:=0;
Exit;
end
end;
//---------------------------------------------------------
function GetObjID(ItemID:integer): integer; //Выдает ObjectID по его ItemID, если ItemID не найден в базе, выдает -1
var
i: integer;
begin
for i:=0 to int(Length(ItemBase)/2-1) do
if (ItemBase[i*2+1]=ItemID) then begin
Result:=ItemBase[i*2];
Exit;
end;
Result:=-1;
end;
//-----------------------------------------------------------
procedure Crystallize(ObjectID: integer);
begin
buf:=#$72;
WriteD(ObjectID);
WriteD(1);
SendToServer;
end;
//---------------------------------------------------------
procedure KristallPodasa;
begin
//Продажа криспалов или других предметов в магазин
buf:=HStr('1E 00 00 00 00 01 00 00 00 32 BB 0C 10 B3 05 00 00 B8 D2 00 00 ');
SendToServer;
SendMsg('Продажа кристалов в магазин');
end;
//-----------------------------------------------------------
procedure PokukaOserelii;
begin
//покупка 250 S ожирелий
buf:=HStr('A7 96 02 00 00 A0 BB 0D 00 01 00 00 00 00 00 00 00 00 00 00 00');
SendToServer;
SendMsg('Покупка 5 Berserker Blade');
end;
//------------------------------------------------------------
//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if FromServer and (pck[1]=#$1B) then CreateItemBase; //создание базы предметов
if (length(ItemBase)=0) then exit; // если нет базы итемов, скрипт дальше не пустит
if FromServer and (pck[1]=#$27) and (pck[4]=#$03) then begin
UpdateItemBase; //Обновление базы, если принят пакет на удаление предмета
if Crystal and (GetObjID(5286)>0) then Crystallize(GetObjID(5286))
else begin
Crystal:=false;
SetLength(ItemBase,0);
SendMsg('Весь шмот кристаллизован');
//KristallPodasa;
//PokukaOserelii;
end;
end;
//if FromClient and (pck=HStr('1B 06 00 00 00')) then begin
// SendMsg('Панеслася!!!');
if (GetObjID(5286)>0) then begin
Crystal:=true;
Crystallize(GetObjID(5286));
end else SendMsg('Нужная шмотка не найдена');
end.
Помогите пожалуйста переделать его так что бы он кристализовал допустим тарбары автоматически. ID тарбаров 158. Я пытался убрать лишнее но скрипт не работет((( Или выкиньте сюда скрипт кристаллизации итемов. Буду очень благодарен
P.S. Без этого скрипта помру...