Полезные функции - Страница 2

lexayar · 10.03.2009, 19:23

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

Код:

// пауза в секундах
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 · 30.04.2009, 09:22

Всем доброго времени суток.
У меня пару вопросов по скрипту "инвентаризации" от 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 · 30.04.2009, 09:30

1)

Цитата:

Сообщение от alexPPP

преобразовывается в ReadC, когда в самом описании пакета идет h.

потому, что скрипт писался очень давно, не помню под какие хроники, и там я смотрел, что второй байтик всегда = 0, поэтому читал 1 байт и усё=)
2)

Цитата:

Сообщение от alexPPP

Для чего введена переменная "j" в procedure CreateItemBase; и procedure UpdateItemBase; и какие значения она может принимать?

Переменная J в CreateItemBase введена, чтоб по пакету полностью пройтись, т.к. поцедура ItemAction модифицирует значение переменной J, аналогично для UpdateItemBase.
3)

Цитата:

Сообщение от alexPPP

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

Значения переменных читаются из приходящего от сервера пакета. А то, что ты хочешь подменить ИД предмета называтся читерством, что очень сильно не есть гуд, это не чит-форум.

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

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

TAMBIK · 06.08.2009, 18:39

Код:

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 · 13.08.2009, 12:46

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

Код:

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

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

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 · 01.06.2010, 14:17

Решил выложить свою разработку. Может, кому пригодится. Для 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 · 29.07.2010, 02:30

Автобег в указанную сторону: запустить скрипт, нажать "Приветствие", ткнуть мышкой в нужную сторону - бежит не останавливаясь пока не упрется. На ходу возможно изменение направления\шага пробежки. Интерлюд.
Оффтоп

delphi Код:

//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 · 26.01.2012, 16:37

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

DELPHI Код:

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;

DELPHI Код:

#$11: GetItemsList;
#$21: UpdateInventory;

p.s. спасибо dyh9l за тег делфи)

dyh9l · 26.01.2012, 16:51

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

semiromid · 01.04.2014, 23:03

...........
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]

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