recomend

[klizmabeqa1992]

delpi cod :

 

{ Юля Сегодня, 11:46

Помню этот небольшой скриптик принес мне просто бешеное богатсво на сервере

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

проста, программа ведет учет всех персов в округе, когда по вашему

персу-торговцу кликают, она пишет в френдчат ему предложение купить стрелу

и обешание за это рассказать анекдотик. за покупку программа конечно же как

и обешала рассказывает анекдотик. как показывает практика, самая идеальная

цена чтобы клиенты купили как можно больше ваших стрел, для х1 - это не

более 3к, для х5 - 10к. а для привлечения внимания именно к вашему

торговцу, в титуле (для этого вам надо быть в клане) постоянно мигает

рожица и надпись "АНЕКДОТЫ". Все анекдоты грузяться с папки c:\l2jokes (в

аттаче уже готовый архив с 237 анекдотами), каждый анекдот в отдельном

файле, не более 255 символов. Пользуйтесь на здоровье

}

// copyright © 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);

          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);

        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 := IDs[count];

        Names := 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+'! Я бот! Купи у меня стрел и я, в благодарность за это, расскажу тебе анекдот или стишок на тему LineAge2! ;)');

        WriteS(names);

        SendToServer;

        // внесем в лог

        m.Lines.Add(TimeToStr(now)+': '+names);

      end

    end;

  end;

end.