Полезные функции

[xkor]

Некоторые полезные куски кода и функции для использования в своих скриптах:

Отправка сообщений в объявления:

// отправка сообщений в объявления
// видишь только ты

procedure SendMsg(msg:string);
begin
buf:=#$4A;
WriteD(0);
WriteD(10);
WriteS('');
WriteS(msg);
SendToClient;
end;

для использования:
SendMsg('Панеслася!!!');

Таймер со сквозным проходом
Если ставить sleep() то скрипт останавливается на время, но и пакеты тоже не принимаются и не отправляются, так вот эта функция позваляет избежать этого
//(c)dmitry501
var
tick: Integer;

procedure Init;
begin
end;
function Pause(Timewait: Integer):Boolean;
// сквозная проверка без остановки скрипта (c)dmitry501
var
t : integer;
begin
result := false;
t := Round(Time*86400);
if t > (tick + Timewait) then
begin
tick := t;
result := true;
end;
end;
пример использования
if (NoEarned=1) and pause(2) then //+ 2 секунды ожидания
begin
...........
end;

StrToHex преобразование
//(c) xkor
function StrToHex(packet: string):string;
var
i:integer;
tmp:byte;

function ByteToHex(b: byte): Char;
begin
if b<10 then result:=chr(b+$30)
else result:=chr(b+$37);
end;

begin
result:='';
for i:=1 to length(packet) do begin
tmp:=ord(packet[i]) div 16;
result:=result+ByteToHex(tmp);
tmp:=ord(packet[i]) - tmp*16;
result:=result+ByteToHex(tmp)+' ';
end;
end;
пример использования

hextr2:=hextostr(pck);
SHOWMESSAGE(hextr2);

[mks]

кто тебе мешает 1 единственный скрипт перенести в топ про БООТА?
етот топ- мервый- поверь...
а то что там про инвентарь написано- то нужно переместить в топ- ДА БУДЕТ БОТ
леха ну реально.. то что можно уместить в приделах одной тему то нехуй плодить по разным топикам...
я думаю всетаки темка полезная, при написании скрипта не придется копаться в готовых и выдергивать из них нужные куски

[xkor]

я думаю всетаки темка полезная, при написании скрипта не придется копаться в готовых и выдергивать из них нужные куски
он имел в виду перенести эти заготовки в тему с описанием встроеных переменных и функций
может он и прав...

[Shura1oplot]

я думаю, встроенные переменные и функции это именно ВСТРОЕННЫЕ. в этой теме есть удачные решения некоторых задач программирования, а готовые миниботы - это все таки ГОТОВЫЕ миниботы. не имеет смысла соединять эти темы - неразбериха получится.

[Shura1oplot]

Работа с инвентарем
скрипт умеет добавлять и удалять вещи из инвентаря, модифицировать их свойства. знает все свойства вещей, которые знает клиент (количество, уровень заточки, надета ли вещь и пр.)
поддерживает только 80 слотов, так что под чаров, имеющих мультипрофу, надо корректировать скрипт.

var
Inventory: array[0..79,0..9] of integer; // инвентарь (itemType1, ObjectID, ItemID, count, itemType2, CustType1, isEquipped, BodyPart, EnchantLevel, CustType2)

procedure InventoryCreate;
var
i,k: integer;
begin
for i:=0 to 79 do
if (i<ReadH(4)) then begin
Inventory:=ReadH(i*28+6); // itemType1
Inventory[i,1]:=ReadD(i*28+8); // ObjectId
Inventory[i,2]:=ReadD(i*28+12); // ItemID
Inventory[i,3]:=ReadD(i*28+16); // count
Inventory[i,4]:=ReadH(i*28+20); // itemType2
Inventory[i,5]:=ReadH(i*28+22); // CustType1
Inventory[i,6]:=ReadH(i*28+24); // isEquipped
Inventory[i,7]:=ReadD(i*28+26); // BodyPart
Inventory[i,8]:=ReadH(i*28+30); // EnchantLevel
Inventory[i,9]:=ReadH(i*28+32); // CustType2
end else
for k:=0 to 9 do Inventory[i,k]:=0; // забиваем нулями
end;

procedure InventoryUpdate;
var
i,j,k: integer;
begin
for j:=0 to (ReadH(2)-1) do begin
case pck[j*30+4] of
#$01: k:=0; // add item, запишет на пустую ячейку
#$02: k:=ReadD(j*30+8); // mod item
#$03: begin // remove item, обнулит ячейки удаленного предмета
k:=ReadD(j*30+8);
for i:=0 to 79 do
if (Inventory[i,0]=k) then begin
for k:=0 to 9 do Inventory[i,k]:=0;
exit;
end;
end;
end;
for i:=0 to 79 do
if (Inventory[i,1]=k) then begin
Inventory[i,0]:=ReadH(j*30+6); // itemType1
Inventory[i,1]:=ReadD(j*30+8); // ObjectId
Inventory[i,2]:=ReadD(j*30+12); // ItemID
Inventory[i,3]:=ReadD(j*30+16); // count
Inventory[i,4]:=ReadH(j*30+20); // itemType2
Inventory[i,5]:=ReadH(j*30+22); // CustType1
Inventory[i,6]:=ReadH(j*30+24); // isEquipped
Inventory[i,7]:=ReadD(j*30+26); // BodyPart
Inventory[i,8]:=ReadH(j*30+30); // EnchantLevel
Inventory[i,9]:=ReadH(j*30+32); // CustType2
break;
end;
end;
end;

function GetInv(obj,up,down:integer): integer; // up и down не проверяются
var // 0-itemType1, 1-ObjectId, 2-ItemID, 3-count, 4-itemType2, 5-CustType1, 6-isEquipped, 7-BodyPart, 8-EnchantLevel, 9-CustType2
i: integer;
begin
for i:=0 to 79 do
if (Inventory[i,up]=obj) then begin
Result:=Inventory[i,down];
exit;
end;
Result:=-1;
end;

BEGIN
//--- INVENTORY BEGIN ---//
if FromServer then case pck[1] of
#$1B: InventoryCreate;
#$27: InventoryUpdate;
end;
//--- INVENTORY END ---//
END.

Использовать так:

// 0-itemType1, 1-ObjectId, 2-ItemID, 3-count, 4-itemType2, 5-CustType1, 6-isEquipped, 7-BodyPart, 8-EnchantLevel, 9-CustType2

GetInv(по чему будем искать, номер того по чему будем искать, номер того что надо найти);

ex: GetInv(6408,2,1) - вернет ObjectID свадебного платья, если онное лежит в инвентаре, иначе вернет -1
ex2: GetInv(6408,2,8) - вернет уровень заточки первого попавшегося в инвентаре свадебного платья, если свадебного платья нет, то вернет -1

=======================
процедура использования предмета

procedure UseItem(ItemObjID,shift:integer);
begin
buf:=#$14;
WriteD(ItemObjID);
WriteD(shift);
SendToServer;
end;


Добавлено спустя 3 часа 26 минут 2 секунды:
[i]Мониторинг статов чара (хп, мп, цп и координаты)

var
CharObjID,MyCorX,MyCorY,MyCorZ: integer;
MaxHP,CurHP,MaxMP,CurMP,MaxCP,CurCP: integer;
CharName: string;

procedure InitStats;
var
i: integer;
begin
CharObjID:=ReadD(18);
MyCorX:=ReadD(2);
MyCorY:=ReadD(6);
MyCorZ:=ReadD(10);
i:=22;
CharName:=ReadS(i);
i:=i+44;
MaxHP:=ReadD(i);
CurHP:=ReadD(i);
MaxMP:=ReadD(i);
CurMP:=ReadD(i);
i:=i+363;
MaxCP:=ReadD(i);
CurCP:=ReadD(i);
end;

procedure StatsUpdate;
var
i: integer;
begin
for i:=0 to ReadD(6)-1 do
case pck[i*8+10] of
#$09: CurHP:=ReadD(i*8+14);
#$0A: MaxHP:=ReadD(i*8+14);
#$0B: CurMP:=ReadD(i*8+14);
#$0C: MaxMP:=ReadD(i*8+14);
#$21: CurCP:=ReadD(i*8+14);
#$22: MaxCP:=ReadD(i*8+14);
end;
end;

procedure CorsUpdate;
begin
MyCorX:=ReadD(2);
MyCorY:=ReadD(6);
MyCorZ:=ReadD(10);
end;

BEGIN
//--- STATS BEGIN ---//
if FromServer and (pck[1]=#$04) then InitStats;
if FromServer and (pck[1]=#$0E) and (CharObjID=ReadD(2)) then StatsUpdate;
if FromClient and (pck[1]=#$48) then CorsUpdate;
//--- STATS END ---//
END.


соответственно

CharName - имя персонажа
MaxHP - максимальное кол-во хп
CurHP - текушее количество хп
по аналогии мп и цп
MyCorX (Y,Z) - текущие координаты (координаты берутся из пакетов ValidatePosition)


Добавлено спустя 47 минут 59 секунд:
Таймер со сквозным проходом (mod)
позволяет задавать переменную, по которой будет проверяться время

function Wait(var tick: integer;Timewait: Integer): Boolean;
// сквозная проверка без остановки скрипта (c)dmitry501
// modifed by Sh00rGo
var
t: integer;
begin
result:=false;
t:=Round(Time*86400);
if t>(tick+Timewait) then begin
if tick>0 then result:=true;
tick:=t;
end;
end;


пример использования:

var
time1,time2: integer;

procedure Init;
begin
time1:=0;
time2:=1;
end;

procedure SendMsg(msg:string);
begin
buf:=#$4A;
WriteD(0);
WriteD(10);
WriteS('');
WriteS(msg);
SendToClient;
end;

function Wait(var tick: integer;Timewait: Integer): Boolean;
// сквозная проверка без остановки скрипта (c)dmitry501
// modifed by Sh00rGo
var
t: integer;
begin
result:=false;
t:=Round(Time*86400);
if t>(tick+Timewait) then begin
if tick>0 then result:=true;
tick:=t;
end;
end;

begin
if Wait(time1,2) then SendMsg('бу');
if Wait(time2,10) then SendMsg('ы');
end.


в данном случае "бу" будет отсылаться раз в 2 секунды, а "ы" - раз в 10 секунд. переменные time1 и time2 вручную лучше не модифицировать.

если передаваемая переменная tick равна 0, то таймер сработает с заданной задержкой после первого вызова функции, если равна 1, то сразу.

в примере - "ы" отошлется сразу после первого вызова функции, а "бу" через 2 секунды после первого вызова функции.

[QaK]

Мой вариант "инвентаризации", описание атрибутов объектов и действий над ними взял у Shura1oplot'a

//Инвентаризация by QaK

var ItemCount:integer; //количество занятых слотов/количество вещей
Inventory: array[1..250,1..10]of integer; //массив инвентаря
//инвентарь
//1 - ItemType1
//2 - ObjectID
//3 - ItemID
//4 - ItemCount
//5 - ItemType2
//6 - CustType1
//7 - IsEquipped
//8 - BodyPart
//9 - EnchantLevel
//10 - CustType2
procedure Init; //Вызывается при включении скрипта
begin

end;

procedure Free; //Вызывается при выключении скрипта
begin

end;

//процедура считывания параметров одного предмета
procedure ItemAction(var Counter:integer;CurrentSlot:integer);
//Counter - Позиция считываемая из пакета, модифицируется функциями ReadC,ReadD
//CurrentSlot - Индекс в массиве Inventory (от 1 до 250)
var c1:integer;
begin
for c1:=1 to 10 do
begin //Если значение однобайтное
if (c1=1)or(c1=5)or(c1=6)or(c1=7)or(c1=9) then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
inc(Counter);
end;
//Если значение четырехбайтное
if (c1=2)or(c1=3)or(c1=4)or(c1=8) then
begin Inventory[CurrentSlot,c1]:=ReadD(Counter);
end;
//Если значение последнее
if c1=10 then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
Counter:=Counter+2;
end;
end;
end;

//Пакет от сервера 1В - создаем или модифицируем весь инвентарь
procedure CreateItemBase;
var
i,j: integer;
begin
ItemCount:=ReadC(4);//Считываем количество вещей в инвентаре
j:=6;
for i:=1 to ItemCount do ItemAction(j,i);
end;

//Пакет от сервера 27 - действия (доавить/изменить/удалить) над одним/несколькими предметами
procedure UpdateItemBase;
var
i,ij,ijk:integer; //простые счетчики для перебора значений
j:integer; //Текущая позиция, откуда считываем значения из пакета
count:integer; //Количество изменяемых предметов
Action: integer; //Действие над предметом
k:boolean; //Нашли ли мы удаляемый предмет?
begin
k:=false;
count:=ReadC(1);//Считываем количество изменяемых предметов
j:=4;
for i:=1 to count do
begin Action:=ReadC(j);//Считываем действие
inc(j);
{ADD} if Action=1 then
begin Inc(ItemCount);//Увеличиваем количество занятых слотов
ItemAction(j,ItemCount); //Добавляем предмет
end;
{Update}if Action=2 then for ij:=1 to ItemCount do //Ищем изменяемый предмет по ObjectID
If Inventory[ij,2]=ReadD((j-1)*30+8) then //Если нашли
begin ItemAction(j,ij); //Изменяем данные о нем
exit; //Больше проверять не надо - выходим из цикла
end;
{Delete}if Action=3 then begin for ij:=1 to ItemCount-1 do //Ищем удаляемый предмет
begin If Inventory[iji,2]=ReadD((j-1)*30+8) then k:=true; //Если нашли,фиксируем это
If k then //если найден удаляемы объект
for ijk:=1 to 10 do //то сдвигаем элементы массива-инвентаря
Inventory[ij,ijk]:=Inventory[ij+1,ijk];
end;
Dec(ItemCount);//Уменьшаем количество занятых слотов
end;
end;
end;

//Получить ObjectID предмета, зная его ItemID
function GetInfo(ItemID:integer):integer;
var c1:integer;
begin Result:=-1;
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin Result:=Inventory[c1,2];
exit;//Если нашли - выходим из цикла
end;
end;

//Использовать предмет с заданным ItemID
procedure UseItem(ItemID:integer);
var c1:integer;
begin
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin buf:=#$14;
WriteD(Inventory[c1,2]);
WriteD(0);
SendToServer;
exit; //Чтоб не использовать несколько предметов с одинаковым ItemID (например заточки)
end;
end;

//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
begin if (pck[1]=#$1B) then
begin CreateItemBase;
exit;
end;
if (pck[1]=#$27) then
begin UpdateItemBase;
exit;
end;
end;
end.

[Юля]

Помню этот небольшой скриптик принес мне просто бешеное богатсво на сервере где я играла, но поскольку я больше не играю, то выкладываю в массы :)

суть проста, программа ведет учет всех персов в округе, когда по вашему персу-торговцу кликают, она пишет в френдчат ему предложение купить стрелу и обешание за это рассказать анекдотик. за покупку программа конечно же как и обешала рассказывает анекдотик. как показывает практика, самая идеальная цена чтобы клиенты купили как можно больше ваших стрел, для х1 - это не более 3к, для х5 - 10к. а для привлечения внимания именно к вашему торговцу, в титуле (для этого вам надо быть в клане) постоянно мигает рожица и надпись "АНЕКДОТЫ". Все анекдоты грузяться с папки c:\l2jokes (в аттаче уже готовый архив с 237 анекдотами), каждый анекдот в отдельном файле, не более 255 символов.

Пользуйтесь на здоровье ;)

// copyright (c) 2006, 2007 Puella

var curpos: byte;
TITLE_DATA2: array [0..16] of string;

const
jokes_max = 237;

var
f: TStringList;
jokes: array [1..jokes_max] of string;
jokes_real: integer;
IDs: array [1..2000] of cardinal;
Names: array [1..2000] of String;
count: Integer;
MyID: Cardinal;
MyName: String;
m: TMemo;
t: TTimer;

InTimer: Boolean;

procedure OnTimerProc;
begin
InTimer := true;
buf := #$55;
WriteS(MyName);
WriteS(TITLE_DATA2[curpos]);
SendToServer;

curpos := curpos + 1;
if curpos > 16 then curpos := 0;

InTimer := false;
end;

procedure Init;
var i: byte;
begin
randomize;
count := 0;

f := TStringList.Create;
jokes_real := 0;
for i := 1 to jokes_max do
begin
try
f.LoadFromFile('C:\l2jokes\' + IntToStr(i) + '.txt');
jokes_real := jokes_real + 1;
except
end;
jokes[jokes_real] := f.Text;
end;
f.free;

TITLE_DATA2[0] := '@(o_O)@';
TITLE_DATA2[1] := '@(O_o)@';
TITLE_DATA2[2] := '@(o_O)@';
TITLE_DATA2[3] := '@(O_o)@';
TITLE_DATA2[4] := '';
TITLE_DATA2[5] := 'ANEKDOTI';
TITLE_DATA2[6] := '';
TITLE_DATA2[7] := 'ANEKDOTI';
TITLE_DATA2[8] := '';
TITLE_DATA2[9] := 'ANEKDOTI';
TITLE_DATA2[10] := '';
TITLE_DATA2[11] := '@(o_O)@';
TITLE_DATA2[12] := '@(O_o)@';
TITLE_DATA2[13] := '@(o_O)@';
TITLE_DATA2[14] := '@(O_o)@';
TITLE_DATA2[15] := '@(o_O)@';
TITLE_DATA2[16] := '@(O_o)@';

curpos := 0;

t := TTimer.Create(nil);
t.Enabled := false;
t.Interval := 2000;
t.OnTimer := @OnTimerProc;

ShowTab;

m:=TMemo.Create(UserTab);
m.parent:=UserTab;
m.align:=alClient;
m.ReadOnly:=true;
m.ScrollBars:=ssBoth;
m.lines.add('Анекдотов загружено: ' + inttostr(jokes_real));
end;

procedure Free;
begin
m.Free;
HideTab;

t.OnTimer := nil;
t.Enabled := false;
t.Interval := 0;
t.Free;
end;

function FindPlayer(ObjID: cardinal): integer;
var k: cardinal;
begin
result := -1;
if Count > 0 then
for k := 1 to Count do
if IDs[k] = ObjID then
begin
result := k;
break
end;
end;

var
i, k: integer;
objid: cardinal;
name: string;
begin
if FromServer then
case pck[1] of
#$64:
begin
i := 2;
if ReadD(i) = 380 then {S1_PURCHASED_S3_S2_s}
begin
i := i + 4*2;
name := ReadS(i);
if (name = '') then
begin
// внесем в лог (blacklist)
m.Lines.Add(TimeToStr(now)+': '+name+' purchased (BLACKLISTED)');
end
else
begin
while (InTimer = true) do i := i;

buf := #$CC;
i := int(random * jokes_real) + 1;
WriteS(jokes[i]);
WriteS(name);
SendToServer;

if (Length(m.Lines.Text) > 60000) then m.Lines.Text := '<cleared>';
// внесем в лог
m.Lines.Add(TimeToStr(now)+': '+name+' purchased');
m.Lines.Add('> ' + jokes[i]);
end;
end
end;

#$03: // CharInfo
begin
i := 4 + 4 * 4 - 2;
objid := ReadD(i);

i := FindPlayer(ObjID);

if i = -1 then
begin
i := 4 + 4 * 5 - 2;
name := ReadS(i);
// blacklist
if (name = '') then
begin
// (none)
end
else begin
// добавление
count := count + 1;
IDs[count] := ObjID;
Names[count] := name;
//m.Lines.Add(IntToStr(count) + ' - ' + Format('%x', [ObjId])+' = '+ Names[count]);
end;
end;
end;

#$04: //UserInfo
begin
i := 2 + 4*4;
MyID := ReadD(i);
MyName := ReadS(i);
t.Enabled := true;
end;

#$12: // ObjectDelete
begin
i := 2;
objid := ReadD(i);

i := FindPlayer(objid);

if i <> -1 then
begin
IDs[i] := IDs[count];
Names[i] := Names[count];
count := count - 1;
end
end;

#$29: //TargetSeleted
begin
i := 2;
objid := ReadD(i);

if ReadD(i) <> MyID then exit;

i := FindPlayer(objid);

if i <> -1 then
begin
while (InTimer = true) do i := i;

buf := #$CC;
WriteS('Привет, '+names[i]+'! Я бот! Купи у меня стрел и я, в благодарность за это, расскажу тебе анекдот или стишок на тему LineAge2! ;)');
WriteS(names[i]);
SendToServer;
// внесем в лог
m.Lines.Add(TimeToStr(now)+': '+names[i]);
end
end;
end;
end.

[mks]

Скрипт-то не плохой, да думаю бан за него долго ждать не придется....
ЗЫ Почитал анекдоты в архиве, отмороженные ЖЕСТЬ!
Юльчик не в обиду, не ты ж их придумывала)

[Юля]

Скрипт-то не плохой, да думаю бан за него долго ждать не придется....
ЗЫ Почитал анекдоты в архиве, отмороженные ЖЕСТЬ!
Юльчик не в обиду, не ты ж их придумывала)
я предварительно договорилась с администрацией об такой "изюминке" для сервера, так что никакого бана, даже наоборот две недели торговли и А грейд на х1 :))))) а анекдоты конечно не я придумывала, хотя с дюжину наверное там анекдотов понятных только игрокам нашего сервера и соответсвенно придуманных игроками.

[xkor]

надо будет сделать скриптик расказывающий цитаты с bash.org.ru )))

[Shnaider]

Может кто то,кому нетрудно переделать Юлин скрипт,так чтобы он был привязан к одному нику?,а то немогу играть в 2 окна,скрипт начинает издеваться над титулом основного чара.И ещё(если кто то конечно за это возьмётся просто так)сделать чтобы рассказывался анекдот не за то что у меня чтото купят,а наоборот продадут.Сам этого сделать точно несмогу,так как неразбираюсь,я только в титуле переписал "ANEKDOTI"на "Анекдоты" и текст обращения к игрокам,а больше ничего незнаю :oops:

[NLObP]

Может кто то,кому нетрудно переделать Юлин скрипт,так чтобы он был привязан к одному нику?,а то немогу играть в 2 окна,скрипт начинает издеваться над титулом основного чара.И ещё(если кто то конечно за это возьмётся просто так)сделать чтобы рассказывался анекдот не за то что у меня чтото купят,а наоборот продадут.Сам этого сделать точно несмогу,так как неразбираюсь,я только в титуле переписал "ANEKDOTI"на "Анекдоты" и текст обращения к игрокам,а больше ничего незнаю :oops:

// copyright (c) 2006, 2007 Puella
//модифицировано by NLObP
//Может работать одновременно несколько скриптов.
//Необходимо изменить константу MyNAME!!!

{суть проста, программа ведет учет всех персов в округе, когда по вашему
персу-торговцу кликают, она пишет в френдчат ему предложение купить стрелу
и обешание за это рассказать анекдотик. за покупку программа конечно же как
и обешала рассказывает анекдотик. как показывает практика, самая идеальная
цена чтобы клиенты купили как можно больше ваших стрел, для х1 - это не
более 3к, для х5 - 10к. а для привлечения внимания именно к вашему
торговцу, в титуле (для этого вам надо быть в клане) постоянно мигает
рожица и надпись "АНЕКДОТЫ". Все анекдоты грузяться с папки c:\l2jokes (в
аттаче уже готовый архив с 237 анекдотами), каждый анекдот в отдельном
файле, не более 255 символов}

const
MyName='впиши_сюда_имя чара';
jokes_max = 237;

var
curpos: byte;
TITLE_DATA2: array [0..16] of string;
f: TStringList;
jokes: array [1..jokes_max] of string;
jokes_real: integer;
IDs: array [1..2000] of cardinal;
Names: array [1..2000] of String;
count: Integer;
MyID: Cardinal;
//MyName: String;

frm: TForm;
m: TMemo;
t: TTimer;

InTimer: Boolean;

procedure OnTimerProc;
begin
InTimer := true;
buf := #$55;
WriteS(MyName);
WriteS(TITLE_DATA2[curpos]);
SendToServerEx(MyName);

curpos := curpos + 1;
if curpos > 16 then curpos := 0;

InTimer := false;
end;

procedure Init;
var i: byte;
begin
randomize;
count := 0;

f := TStringList.Create;
jokes_real := 0;
for i := 1 to jokes_max do
begin
try
f.LoadFromFile('C:\l2jokes\' + IntToStr(i) + '.txt');
jokes_real := jokes_real + 1;
except
end;
jokes[jokes_real] := f.Text;
end;
f.free;

TITLE_DATA2[0] := '@(o_O)@';
TITLE_DATA2[1] := '@(O_o)@';
TITLE_DATA2[2] := '@(o_O)@';
TITLE_DATA2[3] := '@(O_o)@';
TITLE_DATA2[4] := '';
TITLE_DATA2[5] := 'ANEKDOTI';
TITLE_DATA2[6] := '';
TITLE_DATA2[7] := 'ANEKDOTI';
TITLE_DATA2[8] := '';
TITLE_DATA2[9] := 'ANEKDOTI';
TITLE_DATA2[10] := '';
TITLE_DATA2[11] := '@(o_O)@';
TITLE_DATA2[12] := '@(O_o)@';
TITLE_DATA2[13] := '@(o_O)@';
TITLE_DATA2[14] := '@(O_o)@';
TITLE_DATA2[15] := '@(o_O)@';
TITLE_DATA2[16] := '@(O_o)@';

curpos := 0;

t := TTimer.Create(nil);
t.Enabled := false;
t.Interval := 2000;
t.OnTimer := @OnTimerProc;

//форма
frm := TForm.Create(nil);
frm.Caption := 'L2Jokes '+MyName;
frm.BorderStyle := bsSizeable;
frm.Position := poScreenCenter;
frm.Width:=500;
frm.Height:=500;

m:=TMemo.Create(frm);
m.parent:=frm;
m.align:=alClient;
m.ReadOnly:=true;
m.ScrollBars:=ssBoth;
m.lines.add('Анекдотов загружено: ' + inttostr(jokes_real));

frm.Show;
end;

procedure Free;
begin
m.Free;
frm.Free;

t.OnTimer := nil;
t.Enabled := false;
t.Interval := 0;
t.Free;
end;

function FindPlayer(ObjID: cardinal): integer;
var k: cardinal;
begin
result := -1;
if Count > 0 then
for k := 1 to Count do
if IDs[k] = ObjID then
begin
result := k;
break
end;
end;

var
i, k: integer;
objid: cardinal;
name: string;
begin
if (ConnectName=MyName) and FromServer then
case pck[1] of
#$64:
begin
i := 2;
if ReadD(i) = 380 then {S1_PURCHASED_S3_S2_s}
begin
i := i + 4*2;
name := ReadS(i);
if (name = '') then
begin
// внесем в лог (blacklist)
m.Lines.Add(TimeToStr(now)+': '+name+' purchased (BLACKLISTED)');
end
else
begin
while (InTimer = true) do i := i;

buf := #$CC;
i := int(random * jokes_real) + 1;
WriteS(jokes[i]);
WriteS(name);
SendToServerEx(MyName);

if (Length(m.Lines.Text) > 60000) then m.Lines.Text := '<cleared>';
// внесем в лог
m.Lines.Add(TimeToStr(now)+': '+name+' purchased');
m.Lines.Add('> ' + jokes[i]);
end;
end
end;

#$03: // CharInfo
begin
i := 4 + 4 * 4 - 2;
objid := ReadD(i);

i := FindPlayer(ObjID);

if i = -1 then
begin
i := 4 + 4 * 5 - 2;
name := ReadS(i);
// blacklist
if (name = '') then
begin
// (none)
end
else begin
// добавление
count := count + 1;
IDs[count] := ObjID;
Names[count] := name;
//m.Lines.Add(IntToStr(count) + ' - ' + Format('%x', [ObjId])+' = '+ Names[count]);
end;
end;
end;

#$04: //UserInfo
begin
i := 2 + 4*4;
MyID := ReadD(i);
//MyName := ReadS(i);
t.Enabled := true;
end;

#$12: // ObjectDelete
begin
i := 2;
objid := ReadD(i);

i := FindPlayer(objid);

if i <> -1 then
begin
IDs[i] := IDs[count];
Names[i] := Names[count];
count := count - 1;
end
end;

#$29: //TargetSeleted
begin
i := 2;
objid := ReadD(i);

if ReadD(i) <> MyID then exit;

i := FindPlayer(objid);

if i <> -1 then
begin
while (InTimer = true) do i := i;

buf := #$CC;
WriteS('Привет, '+names[i]+'! Я '+MyName+'! Купи у меня стрел и я, в благодарность за это, расскажу тебе анекдот или стишок на тему LineAge2! ;)');
WriteS(names[i]);
SendToServerEx(MyName);
// внесем в лог
m.Lines.Add(TimeToStr(now)+': '+names[i]);
end
end;
end;
end.

procedure Pause2(Timewait: Integer);
var
begin_time: double;
begin
begin_time:=now;
while Trunc(86400000*(now-begin_time))<TimeWait do ;
end;
Использовать как delay -> возврат из функции будет только после выполнения условия.

[xkor]

OllyDbg, а собсно зачем она если есть delay?

[Grinch]

xkor, подскажи плиз как запустить скрипт для автоматической сдачи манора, никак не могу понять... там вроде и описано...но чет неполучается никак :(
rexx ты попробуй есчё раз прочитать.. особенно первые строчки там про автора написано прямым текстом и попробуй тупо прочитать пол темы да будет бот и тема про манор посвещена это вопросу, и прочитай правила форума, помоч можно но задавай вопрос конкретней я думаю xkor отправил телепатов в отпуск, жаль конечно :(

нехорошо ставить слип на основной поток :<
там вместо do ; должно было быть do Application.ProcessMessages;
альтернатива делаю, только будут обрабатываться ProcessMessages...
procedure Delay(ATimeout: Integer);
var
t: Cardinal;
begin
while ATimeout > 0 do
begin
t := GetTickCount;
if MsgWaitForMultipleObjects(0, nil^, False, ATimeOut, QS_ALLINPUT) = WAIT_TIMEOUT then
Exit;
Application.ProcessMessages;
dec(ATimeout, GetTickCount - t);
end;
end;

[xkor]

нехорошо ставить слип на основной поток :<
да, логично, как то забыл что у меня эта хрень в основном потоке выполняется(

[Johnson]

Таймер со сквозным проходом (mod)
позволяет задавать переменную, по которой будет проверяться время

Код: Выделить всё
function Wait(var tick: integer;Timewait: Integer): Boolean;
// сквозная проверка без остановки скрипта (c)dmitry501
// modifed by Sh00rGo
var
t: integer;
begin
result:=false;
t:=Round(Time*86400);
if t>(tick+Timewait) then begin
if tick>0 then result:=true;
tick:=t;
end;
end;

Мучался, мучался, но так и не понял, как интервал можно сократить... подскажите подалста? Желательно, чтоб можно было задавать хотябы 0.5 секунды.

[NLObP]

Мучался, мучался, но так и не понял, как интервал можно сократить... подскажите подалста? Желательно, чтоб можно было задавать хотябы 0.5 секунды.

В такой реализации можно писать 500 - это 0,5 сек
function Wait(var tick:integer; Timewait: Integer): Boolean;
//сквозная проверка без остановки скрипта (c)dmitry501
//modifed by Sh00rGo
var
t: integer;
begin
result:=false;
t:=Round(Time*86400);
if t>(tick+Timewait/1000) then begin
if tick>0 then result:=true;
tick:=t;
end;
end;

[NLObP]

Запрещаем случайное закрытие формы.
procedure Init;
begin
//форма
frm := TForm.Create(nil);
frm.Caption := 'FishBOT '+Name;
frm.BorderStyle := bsSizeable;
frm.Position := poScreenCenter;
frm.Width:=570;
frm.Height:=500;
frm.OnClose := @FormClose;
end;

//************************************************** ****************************
procedure FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caNone;
end;

[Mavr]

В перечне функций, доступных в скриптах, очень сильно не хватает функции на блокировку пакета. Например, BlockPacket в WP PPC Саурона. Xkor подумай может стоит ее добавить.
Хотя если выполнить команду pck:=''; то пакет дальше не пойдет, но всеже хотелось бы иметь отдельную функцию.

Кто захочет может и сам сделать. Для этого в function TL2PacketHackMain.CallMethod добавляем

if MethodName = 'BLOCKPACKET' then begin
TfsScript(Integer(Params[0])).Variables['pck']:='';
end else

И в procedure TL2PacketHackMain.RefreshPrecompile добавляем

fsScript.AddMethod('procedure BlockPacket('+fss+')',CallMethod);

Ну с топик может и промахнулса, а заменить BlockPacket на просто Block ничего не мешает. Вобщем посты можете потереть, а добавлять функцию в релиз или нет решать автору.
Ну топик привёл в читабельный вид (с) Grinch

[NLObP]

А просто добавить процедуру в скрипте
procedure Block;
begin
pck:='';
end;

[Grinch]

3.20 это последняя версия этой программы насколько мне известнотак что каждый правит как ему хочиться только вот одно но сколько человек сделают также, ещё вопросы есть?

или как написал
NLObP, добаляет процедуру сами прям в скрипт, но вот это на любителя.

[Alan]

[QUOTE=NLObP;2599][code]// copyright (c) 2006, 2007 Puella
//модифицировано by NLObP
//Может работать одновременно несколько скриптов.
//Необходимо изменить константу MyNAME!!!

Сообщение от Shnaider
Может кто то,кому нетрудно переделать Юлин скрипт,так чтобы он

NLObP сломал уже мозг, как переделать Юлькин скрипт что бы на покупку тоже анеки рассказывал? Пошел опять крутить его........ ааааааааааааааааааа(звук падующего тела 8) )

[}{@KeR]

Мой вариант "инвентаризации", описание атрибутов объектов и действий над ними взял у Shura1oplot'a

При запуске этого скрипта в l2phx321 показывает ошыбкув месте гле я выделили.



{Delete}if Action=3 then begin for ij:=1 to ItemCount-1 do //Ищем удаляемый предмет
begin If Inventory[iji,2]=ReadD((j-1)*30+8) then k:=true; //Если нашли,фиксируем это
If k then //если найден удаляемы объект
for ijk:=1 to 10 do //то сдвигаем элементы массива-инвентаря
Inventory[ij,ijk]:=Inventory[ij+1,ijk];
end;
Dec(ItemCount);//Уменьшаем количество занятых слотов
end;
end;
end;



Не сваркайте меня за глупый вопрос но всётаки, пробовал запускать оба скрипта на инвентаризацию и некакой реакции, как он вобще должен работать с инвентарём обьясните нубу???????

[QaK]

Не сваркайте меня за глупый вопрос но всётаки, пробовал запускать оба скрипта на инвентаризацию и некакой реакции, как он вобще должен работать с инвентарём обьясните нубу???????там ijk должно быть, очепятка =) Скрипт ведет мониторинг инвентаря.

Добавлено через 2 минуты
ItemCount:integer; //количество занятых слотов/количество вещей
Inventory: array[1..250,1..10]of integer; //массив инвентаря
//инвентарь
//1 - ItemType1
//2 - ObjectID
//3 - ItemID
//4 - ItemCount
//5 - ItemType2
//6 - CustType1
//7 - IsEquipped
//8 - BodyPart
//9 - EnchantLevel
//10 - CustType2

описание массива инвентаря, если для тебя непонятно, что это означает, тогда исчи учебники по дельфе.

[Lelee]

ребят подскажите что означают эти цифры в скрипте Shura1oplot
procedure InventoryCreate;
var
i,k: integer;
begin
for i:=0 to 79 do
if (i<ReadH(4)) then begin
Inventory[i,0]:=ReadH(i*28+6); // itemType1
Inventory[i,1]:=ReadD(i*28+8); // ObjectId
Inventory[i,2]:=ReadD(i*28+12); // ItemID
Inventory[i,3]:=ReadD(i*28+16); // count
Inventory[i,4]:=ReadH(i*28+20); // itemType2
Inventory[i,5]:=ReadH(i*28+22); // CustType1
Inventory[i,6]:=ReadH(i*28+24); // isEquipped
Inventory[i,7]:=ReadD(i*28+26); // BodyPart
Inventory[i,8]:=ReadH(i*28+30); // EnchantLevel
Inventory[i,9]:=ReadH(i*28+32); // CustType2
число 28 а в скрипте ниже число 30 откуда это и что это?
procedure InventoryUpdate;
var
i,j,k: integer;
begin
for j:=0 to (ReadH(2)-1) do begin
case pck[j*30+4] of
#$01: k:=0; // add item, запишет на пустую ячейку
#$02: k:=ReadD(j*30+8); // mod item
#$03: begin // remove item, обнулит ячейки удаленного предмета
k:=ReadD(j*30+8);
for i:=0 to 79 do
if (Inventory[i,0]=k) then begin
for k:=0 to 9 do Inventory[i,k]:=0;
exit;
end;
end;
end;
for i:=0 to 79 do
if (Inventory[i,1]=k) then begin
Inventory[i,0]:=ReadH(j*30+6); // itemType1
Inventory[i,1]:=ReadD(j*30+8); // ObjectId
Inventory[i,2]:=ReadD(j*30+12); // ItemID
Inventory[i,3]:=ReadD(j*30+16); // count
Inventory[i,4]:=ReadH(j*30+20); // itemType2
Inventory[i,5]:=ReadH(j*30+22); // CustType1
Inventory[i,6]:=ReadH(j*30+24); // isEquipped
Inventory[i,7]:=ReadD(j*30+26); // BodyPart
Inventory[i,8]:=ReadH(j*30+30); // EnchantLevel
Inventory[i,9]:=ReadH(j*30+32); // CustType2
break;
end;
end;
end;
просто хочу адаптировать этот скрипт под грация парт 2 вот возник вопрос )

склоняюсь, что это тип пакета. поэтому и спрашиваю, на грации парт 2 все другое, примеров с Интерлюда нету (

[wanick]

не видишь в цикле написано, оно означает что каждые 28, во втором случае 30 блоков, значение определяют одно и тоже но для разных вещей

то есть другими словами что каждая вещь описана таким количеством блоков

это берется из структуры пакета.

[Lelee]

wanick,
обьясни плиз как определить это число из структуры пакета?
другими словами что надо сделать?

[NLObP]

обьясни плиз как определить это число из структуры пакета?

Два пакета (с4,с5) отвечающие за инвентарь:0x1B (ItemListPacket) и 0x27 (InventoryUpdate)

Tип: 0x1B (ItemListPacket)
Pазмер: 873+2
Время прихода: 00:02:57:611
0002 h window: 0 (0x0000)
0004 h ListCount: 31 (0x001F)
[Начало повторяющегося блока 1/31]
0006 h itemType1: 4
0008 d ObjectId: 1075665350
0012 d ItemID: Greater Healing Potion ID:1539 (0x0603)
0016 d count: 35
0020 h itemType2: 5
0022 h CustType1: 0
0024 h isEquipped: 0
0026 d BodyPart: 0
0030 h EnchantLevel: 0
0032 h CustType2: 0
[Конец повторяющегося блока 1/31]
[Начало повторяющегося блока 2/31]
0034 h itemType1: 4
...
[Конец повторяющегося блока 2/31]

первый предмет начинается со смещения 6, второй со смещения 34, разница между ними 28

Tип: 0x27 (InventoryUpdate)
Pазмер: 41+2
Время прихода: 00:35:54:781
0002 h count: 2 (0x0002)
[Начало повторяющегося блока 1/2]
0004 h 1add2mod3remove: 3
0006 h itemType1: 4
0008 d ObjectId: 269129013
0012 d ItemId: Blue Gemstone ID:6353 (0x18D1)
0016 d Count: 0
0020 h itemType2: 5
0022 h cusType1: 0
0024 h isEquipped: 0
0026 d BodyPart: 0
0030 h EnchantLevel: 0
0032 h cusType2: 0
[Конец повторяющегося блока 1/2]
[Начало повторяющегося блока 2/2]
0034 h 1add2mod3remove: 3
...
[Конец повторяющегося блока 2/2]
первый предмет начинается со смещения 4, второй со смещения 34, разница между ними 30

Для Т0 добавились
d(AugId)d(Shadowtime)
значит на 8 байт блок больше

[wanick]

вообще обсуждение не в теме, но все же в последних версиях вроде бы добавилась , еще расположение предмета в инвентаре попробуй увеличить это число

[NLObP]

Это пакет для Т1 и выше от Саурона, если его чуть поправить(последнее d(?)), то станет подходить для Грации.

11=ItemList:h(psize)c(ID)h(ShowWindow)h(count:For. 0022)h(ItemType1)d(ObjectID)d(ItemID:Get.Func01)d( LocationSlot)d(Count)h(ItemType2)h(CustomType1)h(i sEquipped)d(BodyPart)h(EnchantLevel)h(CustType2)d( AugmentationID)d(Mana)d(AttackAttrElement)d(Attack AttrElementVal)d(DefAttrFire)d(DefAttrWater)d(DefA ttrWind)d(DefAttrEarth)d(DefAttrHoly)d(DefAttrUnho ly)d(?)

PS: Для того, чтобы быстро найти пакет в просмотре надо выбрать первый и быстро набрать первые 2-3 символа названия пакета, получается типа быстрый поиск первого подходящего.

[Insane*]

Добрый день!
Я использую скрипт QaK-а с первой страницы, опечатка исправлена.
Возникает такая проблема, без изменений в скрипте я добавляю следующее:
procedure Say(msg:string);
begin
buf:=hstr('4A 00 00 00 00');
WriteD(2);
WriteS(Name);
WriteS(msg);
SendToClientEx(Name);
end;


//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
begin if (pck[1]=#$1B) then
begin CreateItemBase;
exit;
end;
if (pck[1]=#$27) then
begin UpdateItemBase;
exit;
end;
end;
if FromClient and (pck=#$1B#06#00#00#00) then begin
useitem(356);
pck:=HStr('14 CD 01 42 10 00 00 00 00 ');
SendToServer;
say('we');
end;


end.
Выделенное фиолетовым явно не выполняется (как я понял не выдирается ОИД предмета)
Хотя если я сам нахожу ОИД предмета, например стопки зелий и составляю пакет:
pck:=HStr('14 CD 01 42 10 00 00 00 00 ');
то он проходит.
Сервер на Интерлюде. Подскажите, пожалуйста в чем моя ошибка?
Заранее спасибо. :confused:
З.Ы. полный текст скрипта:
//Инвентаризация by QaK
const
name='UltraRich';


var
ItemCount:integer; //количество занятых слотов/количество вещей
Inventory: array[1..250,1..10]of integer; //массив инвентаря
//инвентарь
//1 - ItemType1
//2 - ObjectID
//3 - ItemID
//4 - ItemCount
//5 - ItemType2
//6 - CustType1
//7 - IsEquipped
//8 - BodyPart
//9 - EnchantLevel
//10 - CustType2
procedure Init; //Вызывается при включении скрипта
begin

end;

procedure Free; //Вызывается при выключении скрипта
begin

end;

//процедура считывания параметров одного предмета
procedure ItemAction(var Counter:integer;CurrentSlot:integer);
//Counter - Позиция считываемая из пакета, модифицируется функциями ReadC,ReadD
//CurrentSlot - Индекс в массиве Inventory (от 1 до 250)
var c1:integer;
begin
for c1:=1 to 10 do
begin //Если значение однобайтное
if (c1=1)or(c1=5)or(c1=6)or(c1=7)or(c1=9) then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
inc(Counter);
end;
//Если значение четырехбайтное
if (c1=2)or(c1=3)or(c1=4)or(c1=8) then
begin Inventory[CurrentSlot,c1]:=ReadD(Counter);
end;
//Если значение последнее
if c1=10 then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
Counter:=Counter+2;
end;
end;
end;

//Пакет от сервера 1В - создаем или модифицируем весь инвентарь
procedure CreateItemBase;
var
i,j: integer;
begin
ItemCount:=ReadC(4);//Считываем количество вещей в инвентаре
j:=6;
for i:=1 to ItemCount do ItemAction(j,i);
end;

//Пакет от сервера 27 - действия (доавить/изменить/удалить) над одним/несколькими предметами
procedure UpdateItemBase;
var
i,ij,ijk:integer; //простые счетчики для перебора значений
j:integer; //Текущая позиция, откуда считываем значения из пакета
count:integer; //Количество изменяемых предметов
Action: integer; //Действие над предметом
k:boolean; //Нашли ли мы удаляемый предмет?
begin
k:=false;
count:=ReadC(1);//Считываем количество изменяемых предметов
j:=4;
for i:=1 to count do
begin Action:=ReadC(j);//Считываем действие
inc(j);
{ADD} if Action=1 then
begin Inc(ItemCount);//Увеличиваем количество занятых слотов
ItemAction(j,ItemCount); //Добавляем предмет
end;
{Update}if Action=2 then for ij:=1 to ItemCount do //Ищем изменяемый предмет по ObjectID
If Inventory[ij,2]=ReadD((j-1)*30+8) then //Если нашли
begin ItemAction(j,ij); //Изменяем данные о нем
exit; //Больше проверять не надо - выходим из цикла
end;
{Delete}if Action=3 then begin for ij:=1 to ItemCount-1 do //Ищем удаляемый предмет
begin If Inventory[ijk,2]=ReadD((j-1)*30+8) then k:=true; //Если нашли,фиксируем это
If k then //если найден удаляемы объект
for ijk:=1 to 10 do //то сдвигаем элементы массива-инвентаря
Inventory[ij,ijk]:=Inventory[ij+1,ijk];
end;
Dec(ItemCount);//Уменьшаем количество занятых слотов
end;
end;
end;

//Получить ObjectID предмета, зная его ItemID
function GetInfo(ItemID:integer):integer;
var c1:integer;
begin Result:=-1;
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin Result:=Inventory[c1,2];
exit;//Если нашли - выходим из цикла
end;
end;

//Использовать предмет с заданным ItemID
procedure UseItem(ItemID:integer);
var c1:integer;
begin
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin buf:=#$14;
WriteD(Inventory[c1,2]);
WriteD(0);
SendToServer;
exit; //Чтоб не использовать несколько предметов с одинаковым ItemID (например заточки)
end;
end;

procedure Say(msg:string);
begin
buf:=hstr('4A 00 00 00 00');
WriteD(2);
WriteS(Name);
WriteS(msg);
SendToClientEx(Name);
end;


//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
begin if (pck[1]=#$1B) then
begin CreateItemBase;
exit;
end;
if (pck[1]=#$27) then
begin UpdateItemBase;
exit;
end;
end;
if FromClient and (pck=#$1B#06#00#00#00) then begin
useitem(356);
pck:=HStr('14 CD 01 42 10 00 00 00 00 ');
SendToServer;
say('we');
end;


end.

[Grinch]

Insane*, а массив заполняется инвентарём, помнится там был какой то багнутый скрипт, а если мне память не изменяет исправленный и рабочий, кроме меня и Квака ни кто не видел :)

[QaK]

Insane*, этот скрипт писался под ц4 давным-давно, нужно посотреть и , скорее всего четок переписать под ИЛ.

[Insane*]

QaK, методом тыка определил (взял другой скрипт), что проблема судя по всему в смещении. Как я понял, надо использовать формулу j*22+6 для определения ОИД.

[QaK]

Insane*, формулу сам подбери, я давно этот скрипт не юзал - поэтому не помню =) скорее всего ты прав - в смещении.

[lexayar]

Предлагаю расширенный вариант функции "Пауза". При котором можно независимо вызывать несколько пауз в разных местах скрипта.
// пауза в секундах
function Wait(var tick: integer; Timewait: Integer): Boolean;
var
t: integer;
begin
result:=false;
t:=Round(Time*86400);
if t>(tick+Timewait) then begin
if tick>0 then result:=true;
tick:=t;
end;
end;

[alexPPP]

Всем доброго времени суток.
У меня пару вопросов по скрипту "инвентаризации" от QaK. Для Gracia Part2
Код:

var
ItemCount:integer;
Inventory: array[1..75,1..22]of integer;

//процедура считывания параметров одного предмета
procedure ItemAction(var Counter:integer;CurrentSlot:integer);
var c1:integer;
begin
for c1:=1 to 22 do
begin
if (c1=1)or(c1=6)or(c1=7)or(c1=8)or(c1=11) then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
inc(Counter);
end;

if (c1=2)or(c1=3)or(c1=4)or(c1=5)or(c1=9)or(c1=12)or( c1=13)or(c1=14)or(c1=15)or(c1=16)or(c1=17)or(c1=18 )or(c1=19)or(c1=20)or(c1=21)or(c1=22) then
begin Inventory[CurrentSlot,c1]:=ReadD(Counter);
end;

if c1=10 then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
Counter:=Counter+2;
end;
end;
end;

//Пакет от сервера 11 - создаем или модифицируем весь инвентарь
procedure CreateItemBase;
var
i,j: integer;
begin
ItemCount:=ReadC(4);
j:=6;
for i:=1 to ItemCount do ItemAction(j,i);
end;

//Пакет от сервера 21 - действия (доавить/изменить) над одним/несколькими предметами
procedure UpdateItemBase;
var
i,ij,ijk:integer;
j:integer;
count:integer;
Action: integer;
k:boolean;
begin
k:=false;
count:=ReadC(1);
j:=4;
for i:=1 to count do
begin Action:=ReadC(j);
inc(j);
{ADD} if Action=1 then
begin Inc(ItemCount);

ItemAction(j,ItemCount);
end;
{Update}if Action=2 then for ij:=1 to ItemCount do //Ищем изменяемый предмет по ObjectID
If Inventory[ij,2]=ReadD((j-1)*22+6) then //Если нашли
begin ItemAction(j,ij); //Изменяем данные о нем
exit; //Больше проверять не надо - выходим из цикла
end;
end;
end;

//Получить ObjectID предмета, зная его ItemID
function GetInfo(ItemID:integer):integer;
var c1:integer;
begin Result:=-1;
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin Result:=Inventory[c1,2];
exit;//Если нашли - выходим из цикла
end;
end;


//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
begin if (pck[1]=#$11) then
begin CreateItemBase;
exit;
end;
if (pck[1]=#$21) then
begin UpdateItemBase;
exit;
end;
end;

end.


Так вот.... мне интерессно почему:
1. В оригинале скрипта:

if (c1=1)or(c1=5)or(c1=6)or(c1=7)or(c1=9) then
begin Inventory[CurrentSlot,c1]:=ReadC(Counter);

преобразовывается в ReadC, когда в самом описании пакета идет h.
2. Для чего введена переменная "j" в procedure CreateItemBase; и procedure UpdateItemBase; и какие значения она может принимать?
3. Где задаются значения переменных для {ADD} item-а ( все его 22 параметра) т.е Для создания нового предмета мне нужно "сказать" ObjID=XXXX, ItemID=XXX и т.д Где это делается.
Как я думаю нужно создать форму с инпут параметрами, которые будут принимать вводимые мною значения и что-то типа чекбокса для выполнения действий (Action=1 и Action=2) ну и кнопку чтоб запустить нужные продцедуры. Если мои предположения верны не могли бы вы
подкинуть заготовку такой лио похожей формы.

Спасибо.

И еще 1 вопрос. Получается этот скрипт работает с инвентарем на стороне клиента.
тоесть если мы добавим/редактируем свойство item-a то это изменение произойдет только на клиентской стороне, а при повторном запросе клиентом серверу о содержимом его инвентаря, он вернет значения из БД, так как будет "тягать" данные из своей БД. В соответсвии с этим у меня вопросс: Какой смысл использования этого скрипта? =)

[QaK]

1)преобразовывается в ReadC, когда в самом описании пакета идет h.
потому, что скрипт писался очень давно, не помню под какие хроники, и там я смотрел, что второй байтик всегда = 0, поэтому читал 1 байт и усё=)
2)Для чего введена переменная "j" в procedure CreateItemBase; и procedure UpdateItemBase; и какие значения она может принимать? Переменная J в CreateItemBase введена, чтоб по пакету полностью пройтись, т.к. поцедура ItemAction модифицирует значение переменной J, аналогично для UpdateItemBase.
3)
Где задаются значения переменных для {ADD} item-а ( все его 22 параметра) т.е Для создания нового предмета мне нужно "сказать" ObjID=XXXX, ItemID=XXX и т.д Где это делается.
Как я думаю нужно создать форму с инпут параметрами, которые будут принимать вводимые мною значения и что-то типа чекбокса для выполнения действий (Action=1 и Action=2) ну и кнопку чтоб запустить нужные продцедуры. Если мои предположения верны не могли бы вы
подкинуть заготовку такой лио похожей формы.
Значения переменных читаются из приходящего от сервера пакета. А то, что ты хочешь подменить ИД предмета называтся читерством, что очень сильно не есть гуд, это не чит-форум.

З.Ы. Скрипт глючный, сразы говорю, я его вроде не до конца профиксил. Возьми обработку инвентаря из скрипта Бот кач by Alexus или как-то так.

З.Ы.Ы. для грации нужно еще редактировать разборку пакетов и ИД пакетов для обработки.

[TAMBIK]

function EncodeDate(Year, Month, Day: Word): TDateTime
перевод года, месяца и дня в формат даты

procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word)
Перевод даты в года, месяц и день

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime
Перевод часов, минут и секунд в формат времени

procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word)
Перевод времени в часы, минуты и секунды

function Date: TDateTime
Текущая дата

function Time: TDateTime
Текущее время

function Now: TDateTime
Текущие дата и время

function DayOfWeek(aDate: DateTime): Integer
День недели

function IsLeapYear(Year: Word): Boolean
Високосный год

function DaysInMonth(nYear, nMonth: Integer): Integer
Дней в месяце

function IntToStr(i: Integer): String
Перевод целого в строку

function FloatToStr(e: Extended): String
Перевод числа с плавающей запятой в строку

function DateToStr(e: Extended): String
Перевод даты в строку

function TimeToStr(e: Extended): String
Перевод времени в строку

function DateTimeToStr(e: Extended): String
Перевод даты и времени в строку

function VarToStr(v: Variant): String
Перевод variant в строку

function StrToInt(s: String): Integer
Перевод строки в целое

function StrToFloat(s: String): Extended
Перевод строки в число с плавающей запятой

function StrToDate(s: String): Extended
Перевод строки в дату

function StrToTime(s: String): Extended
Перевод строки во время

function StrToDateTime(s: String): Extended
Перевод строки в дату и время

function Round(e: Extended): Integer
Округление до ближайшего

function Trunc(e: Extended): Integer
Округление до меньшего

function Int(e: Extended): Integer
Возвращает целую часть

function Frac(X: Extended): Extended
Возвращает дробную часть

function Sqrt(e: Extended): Extended
Возвращает квадратный корень

function Abs(e: Extended): Extended
Возвращает модуль числа

function Sin(e: Extended): Extended
Синус

function Cos(e: Extended): Extended
Косинус

function ArcTan(X: Extended): Extended
Арктангенс

function Tan(X: Extended): Extended
Тангенс

function Exp(X: Extended): Extended
Экспонента

function Ln(X: Extended): Extended
Натуральный логарифм

function Pi: Extended
Число Пи

[TAMBIK]

что то нашел может пригодится

Как определить, является ли символ буквой русского алфавита, буквой английского алфавита, является ли символ цифрой?

Как определить, является ли символ буквой русского алфавита?

function isAlphaRu( c: Char ): boolean;
begin
Result := Ord( c ) in [168,184,192..223,224..255];
end;

Как определить, является ли символ буквой английского алфавита?

function isAlphaEn( c: Char ): boolean;
begin
Result := Ord( c ) in [65..90,97..122];
end;

Как определить, является ли символ цифрой?

function isDigit( c: Char ): boolean;
begin
Result := Ord( c ) in [48..57];
end;

procedure Inc(var i: Integer; incr: Integer = 1)
Инкремент

procedure Dec(var i: Integer; decr: Integer = 1)
Декремент

procedure RaiseException(Param: String)
Генерация исключения

procedure ShowMessage(Msg: Variant)
Вывод сообщения

procedure Randomize
Инициализация генератора псевдослучайных чисел

function Random: Extended
Генерация псевдослучайного числа

function ValidInt(cInt: String): Boolean
Проверка валидности целого в строке

function ValidFloat(cFlt: String): Boolean
Проверка валидности цисла с плавающей запятой в строке

function ValidDate(cDate: String): Boolean
Проверка валидности даты в строке

function CreateOleObject(ClassName: String): Variant
Создание OLE-объекта

function VarArrayCreate(Bounds: Array; Typ: Integer): Variant
Создание динамического массива

[Rifleman]

Решил выложить свою разработку. Может, кому пригодится. Для Hellbound'а.
Суть кода: В массиве задаётся последовательность действий, это может быть просто пакет в формате строки (например '39 2A 01 00 00 00 00 00 00 00'), либо какая-то спец команда (например 'Attack').
Далее, по таймеру считываются последовательно строки массива, и то, что там записано отправляется на выполнение. Т.к. время на выполнение скилла может быть различное в зависимости от ситуации, то для такого случая я ввёл динамически изменяющееся время у таймера. Как только от серва приходит пакет с использованием скилла, скрипт считывает время использования и задаёт его таймеру + некоторая поправка.

Const
NICK='Указываете ваш ник';
var
tmrActions: TTimer; // Таймер для последовательность действий
Actions: Array[0..10, 0..2] of String; //Массив действий.
{Записываются в ячейки массива пакеты, которые нужно послать. Далее, по таймеру посылается следующий пакет из списка.
Первый индекс массива - номер действия, второй индекс:
0 - собственно действие, 1 - Параметр действия (напр. Ид скилла), 2 - время таймера до следующего действия
}
MyID, : Integer;
NumAct: Integer; // Номер текущего действия
IsSkill: Boolean; // Показывает, используем ли мы скилл в данный момент

Procedure UseSkill(ID: Integer); // Процедура использования скилла
begin
buf:=#$39;
WriteD(ID);
WriteD(0);
WriteC(0);
SendToServerEX(NICK);
end;

Procedure OntmrAction(Sender: TObject);
begin
Case Actions[NumAct, 0] of // Сдесь мы определяем тип действия.
'Attack': begin // Атаковать текущую цель

end;

'Use': begin // Использование предмета
UseItem(StrToInt(Actions[NumAct, 1])); // Эта процедура может быть разная, потому не привожу
end;

'Skill': begin // Использование скилла
UseSkill(StrToInt(Actions[NumAct, 1]));
IsSkill:= True;
end;
'-1': begin // Останов макроса
NumAct:=0;
tmrActions.Enabled:=False;
Times:=0;
exit;
end;
else begin // Если же не приведена внутренняя команда, то просто отсылаем пакет
buf:= Hstr(Actions[NumAct, 0]);
SendToServerEX(NICK);
end;
end;
NumAct:= NumAct+1;
If (IsSkill=False) then tmrActions.Interval:= StrToInt(Actions[NumAct, 2]); // Изменяем время у таймера до следующего пункта
//В случае скилла время изменяется считыванием нужного пакета
end;

procedure Init; //Вызывается при включении скрипта
begin
tmrActions:= TTimer.Create(nil);
tmrActions.OnTimer:= @OntmrAction;
tmrActions.Enabled:= False;
tmrActions.Interval:= 200;

// 6590 - Angel Slayer
// 6602 - Demon Splinter (один из ))))
// 425 - Hawk Spirit Totem
// Макрос представляет из себя: Одеть Сплинтеры, потом юзнуть Хавка, одеть АС, начать атаку
Actions[0, 0]:='Use';
Actions[0, 1]:='6602';
Actions[0, 2]:='300'; // Задаём время до следующего пункта, в мс

Actions[1, 0]:='Skill';
Actions[1, 1]:='425';
Actions[1, 2]:='2000'; // В принципе, можно и не ставить

Actions[2, 0]:='Use';
Actions[2, 1]:='6590';
Actions[2, 2]:='300';

Actions[3, 0]:='Attack';
Actions[3, 1]:='';
Actions[3, 2]:='300';

Actions[4, 0]:='-1';

MyID:= -1;
end;

procedure Free; //Вызывается при выключении скрипта
begin
tmrActions.free;
end;

//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;

if FromServer and (ConnectName=NICK) then case pck[1] of
#$32: Begin // User Info
If (MyID <> -1) then exit;
MyID:=ReadD(18); // запоминаем наш ИД
end;
#$11: begin; // Инвентаризация барахла в карманах
InventoryCreate; // Инвентаризацию берите, какая удобнее
end;
#$21: Begin // Обновление инвентаря
InventoryUpdate;
End;
#$48: begin // MagicSkillUse
If (ReadD(2)<>MyID) Or (IsSkill=False) then Exit; // Если не мы юзаем - не обрабатываем
tmrActions.Interval:= ReadD(18)+100; // Изменяем время у таймера с учётом времени произношения скилла, 100 - небольшая добавка, чтоб лучше работало
IsSkill:= False;
end;
end;
end.

P.S. Из кода выкинул весь мусор, что мне был нужен, просьба очень "внимательно следить за запятыми в десятичных дробях" ©Р. Хайнлайн

[Breadfan]

Автобег в указанную сторону: запустить скрипт, нажать "Приветствие", ткнуть мышкой в нужную сторону - бежит не останавливаясь пока не упрется. На ходу возможно изменение направления\шага пробежки. Интерлюд.
//interlude
//Включить\выключить - соц.действие Приветствие
Const
Name='';
var
ToX, ToY, ToZ, beg:integer;
CurX, CurY, CurZ, DeltaX, DeltaY, DeltaZ, DeltaX1, DeltaY1, DeltaZ1:integer;
ARun:Boolean; //AutoRun on\off
procedure Init; //Вызывается при включении скрипта
begin
ARun:=False;
ToX:=0;
ToY:=0;
ToZ:=0;
CurX:=0;
CurY:=0;
CurZ:=0;
DeltaX:=0;
DeltaY:=0;
DeltaZ:=0;
end;
procedure Free; //Вызывается при выключении скрипта
begin
end;
//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if FromClient and (Connectname=(name)) and (pck[1]=#$01) then begin
CurX:=ReadD(14);
CurY:=ReadD(18);
CurZ:=ReadD(22);
ToX:=ReadD(2);
ToY:=ReadD(6);
ToZ:=ReadD(10);
DeltaX:=ToX-CurX;
DeltaY:=ToY-CurY;
DeltaZ:=ToZ-CurZ;
SendMsg('CurX '+Inttostr(CurX)+' CurY '+Inttostr(CurY)+' CurZ '+Inttostr(CurZ));
SendMsg('ToX '+Inttostr(ToX)+' ToY '+Inttostr(ToY)+' ToZ '+Inttostr(ToZ));
SendMsg('DeltaX '+Inttostr(DeltaX)+' DeltaY '+Inttostr(DeltaY)+' DeltaZ '+Inttostr(DeltaZ));
end;
if FromClient and (Connectname=(name)) and (pck[1]=#$48) then begin
DeltaX1:=(ToX-(ReadD(2)));
DeltaY1:=(ToY-(ReadD(6)));
DeltaZ1:=(ToZ-(ReadD(10)));
If (DeltaX1<0) then DeltaX1:=(DeltaX1*(-1));
If (DeltaY1<0) then DeltaY1:=(DeltaY1*(-1));
If (DeltaZ1<0) then DeltaZ1:=(DeltaZ1*(-1));
end;
If (DeltaX1<200) and (DeltaY1<200) and ((ToX+ToY)<>0) and ARun then begin
SendMSG('Прибыли !');
SendMSG('Повторный клик');
DeltaX1:=200;
DeltaY1:=200;
DeltaZ1:=100;
CurX:=ToX;
CurY:=ToY;
CurZ:=ToZ;
ToX:=CurX+DeltaX;
ToY:=CurY+DeltaY;
ToZ:=CurZ+DeltaZ;
buf:=#$01;
WriteMask('ddddddd',[ToX,ToY,ToZ,CurX,CurY,CurZ,1]);
SendMsg(StrtoHex(buf));
SendtoServerex(name);
end;
If FromClient and (Connectname=name) and (pck[1]+pck[2]=#$1b+#$02) then begin
ARun:=not(Arun);
if Arun then begin
SendMSG('Run Mode on');
end else begin
SendMSG('Run Mode off');
end;
end;
end.

[brotherrus]

Часть моего бота для получения инвентаря (используется только для банок). Может кому пригодится. Использую на известном фришарде с HF P5.

const
InventoryCountMax=250;
var
Inventory:array[0..InventoryCountmax,1..3] of integer;
InventoryCount:integer;

procedure GetItemsList;
var
i:integer;
begin
InventoryCount:=readH(4);
for i:=0 to InventoryCountMax do begin
Inventory[i,1]:=0;Inventory[i,2]:=0;Inventory[i,3]:=0;
end;
for i:=0 to InventoryCount do begin
Inventory[i,1]:=ReadD(6+i*68); //ObjID
Inventory[i,2]:=ReadD(10+i*68); //ItemID
Inventory[i,3]:=ReadD(18+i*68); //Count
end;
end;

function GetFromInventoryByID(id:integer):integer;
var
i:integer;
begin
result:=-1;
for i:=0 to InventoryCount do begin
if Inventory[i,2]=id then begin
result:=i;
break;
end;
end;
end;

function GetFromInventoryByObjID(id:integer):integer;
var
i:integer;
begin
result:=-1;
for i:=0 to InventoryCount do begin
if Inventory[i,1]=id then begin
result:=i;
break;
end;
end;
end;

procedure UpdateInventory;
var
i,count,find,ObjID,m:integer;
begin
count:=readH(2);
m:=readH(4);
if m=2 then begin
for i:=0 to count do begin
ObjID:=ReadD(6+i*68);
find:=GetFromInventoryByObjID(ObjId);
if find>-1 then begin
Inventory[find,2]:=ReadD(10+i*68); //ItemID
Inventory[find,3]:=ReadD(18+i*68); //Count
end;
end;
end;
if m=3 then begin
for i:=0 to count do begin
ObjID:=ReadD(6+i*68);
find:=GetFromInventoryByObjID(ObjId);
if find>-1 then begin
Inventory[find,1]:=0;
Inventory[find,2]:=0;
Inventory[find,3]:=0;
end;
end;
end;
if m=1 then begin
for i:=0 to count do begin
InventoryCount:=InventoryCount+1;
Inventory[InventoryCount,1]:=ReadD(6+i*68); //ObjID
Inventory[InventoryCount,2]:=ReadD(10+i*68); //ItemID
Inventory[InventoryCount,3]:=ReadD(18+i*68); //Count
end;
end;
end;

#$11: GetItemsList;
#$21: UpdateInventory;
p.s. спасибо dyh9l за тег делфи)

[dyh9l]

тег делфи [ HIGHLIGHT="DELPHI"][/HIGHLIGHT]

[semiromid]

...........
end;[/code]

StrToHex преобразование
//(c) xkor
function StrToHex(packet: string):string;
var
i:integer;
tmp:byte;

function ByteToHex(b: byte): Char;
begin
if b<10 then result:=chr(b+$30)
else result:=chr(b+$37);
end;

begin
result:='';
for i:=1 to length(packet) do begin
tmp:=ord(packet[i]) div 16;
result:=result+ByteToHex(tmp);
tmp:=ord(packet[i]) - tmp*16;
result:=result+ByteToHex(tmp)+' ';
end;
end;
пример использования

hextr2:=hextostr(pck);
SHOWMESSAGE(hextr2);[/QUOTE]

Подскажите пожалуйста , как правильно пользоваться этой функцией? У меня при компиляции ошибку выдает .