[z0mbie]

Нифега неполучаеться, может руки кривые хз(
Вот под интерлюд правильно сделал нет?

Скрипт распространяется как есть, и я не несу ответственности за то,
что ВЫ натворили у себя, его используя.

1.Как обычно правим NAME
2.Запускаем скрипт
3.В папке \scripts должен лежать файл с текстовым рисунком picture.txt
4.загружаем командой> load=picture
5.сообщаем в какой чат писать, командой> dest=0 (0 - общий чат и т.д.)
6.запускаем на исполнение> start или run
7.экстренная остановка скрипта> stop 
8.после вывода картинки скрипт останавливается сам.
}
//******************************************************************************
program Risuem_w_chat2;
const
  Name='*Imperator*';     //имя персонажа в игре

  Pathtxt='.\scripts\';   //путь к файлу
  NameTxt='picture.txt';  //имя файла с рисунком

  debug=false;
  
  DefaultExecuteDelay=500;
//..............................................................................
var
  TextPic : TStringlist;    //сюда загружаем текст из файла
  ExecuteTimer: Ttimer;     //основной таймер исполнения команд
  ExecuteDelay: integer;    //задержка между командами валкера

  strIndex: integer;        //номер строки
  chat: integer;            //в какой чат слать 

//******************************************************************************
procedure Init; //Вызывается при включении скрипта
var
  i, j :integer;
begin
  TextPic:=TStringList.Create;
  //загружаем скрипт валкера из файла
  TextPic.LoadFromFile(PathTxt+NameTxt);

  strIndex:=0; //начинаем с первой строки

  ExecuteDelay:=DefaultExecuteDelay; //задержка между сообщениями в чат

  ExecuteTimer:=TTimer.Create(nil);
  ExecuteTimer.Enabled:=false;          
  ExecuteTimer.Interval:=ExecuteDelay; //время задержки
  ExecuteTimer.OnTimer:=@OnExecute;
end;
//..............................................................................
procedure Free; //Вызывается при выключении скрипта
begin
  ExecuteTimer.Enabled:=False; //остановим на всякий случай
  Executetimer.Free;
  TextPic.free;
end;
//******************************************************************************
{
Вспомогательные процедуры и функции
}
//******************************************************************************
procedure debugMsg(msg: string);
begin
  if debug then
  begin
    sendMSG(msg);
    SendMessage(msg);
  end;
end;
//******************************************************************************
{
Посылаем пакеты
}
//******************************************************************************
//послать сообщение в чат
//use: SendMessage(msg);
procedure SendMessage(msg:string);  //отправка системных сообщений клиенту
begin
  buf:=#$4A;
  WriteD(0);
  WriteD(10);
  WriteS('');
  WriteS(msg);
  SendToClientEx(Name);
end;

//49=Say2:s(Text)d(Type)s(Target)
procedure SendMs(msg: string; dest: integer);
begin
  //buf:=#$49;  //Грация
  buf:=#$38;  //Интерлюдия
  WriteS(Msg);
  WriteD(dest);
  WriteS('');
  SendToServerEx(Name);
end;


//..............................................................................
function ExtractValue(sData, sFind: string;): string;
{возвращаем конец строки после найденного символа}
var
  s: string;
  i,j: integer;
begin
  i:=0;
  result:='';
  i:=find(sData, sFind);
  if i>0 then  result:=copy(sData, i+length(sFind), length(sData));
end;
function RtrimEx(sData, sDelimiter: string): string;
{Удаление из строки S заданные символы справа}
var
  m,i : integer;
  s: string;
begin
  s:=sData;
  i:=0;
  while i=0 do
  begin
      m:=length(s);
      if m>0 then begin
         if s[m]<>sDelimiter then i:=1;
         if s[m]=sDelimiter then delete(s,m,1);
      end;
      if m <= 0 then i:=1;
  end;
  result:=s;
end;
//..............................................................................
function LtrimEx(sData, sDelimiter:String): string;
{Удаление из строки S заданные символы слева}
var
  m,i : integer;
  s: string;
begin
  s:=sData;
  i:=0;
  while i=0 do
  begin
      m := length(s);
      if m > 0 then
      begin
         if s[1]<>sDelimiter then i:=1;
         if s[1]=sDelimiter then delete(s,1,1);
      end;
      if m <= 0 then i:=1;
  end;
  result:=s;
end;
//..............................................................................
function Ltrim(sData:String): string;
{Удаление из строки S заданные символы слева}
begin
  result:=LtrimEx(sData,' ');
end;
//..............................................................................
function Rtrim(sData:String): string;
{Удаление из строки S заданные символы слева}
begin
  result:=RtrimEx(sData,' ');
end;
//..............................................................................
function AllTrimEx(sData, sDelimiterLeft, sDelimiterRight: String): string;
{Удаление из строки S заданные символы слева и справа}
begin
  result:=LtrimEx(RtrimEx(sData, sDelimiterRight), sDelimiterLeft);
end;
//..............................................................................
function AllTrim(sData: String): string;
{Удаление из строки S заданные символы слева и справа}
begin
  result:=Ltrim(Rtrim(sData));
end;
//..............................................................................
function ExtractName(sData, sFind: string): string;
{возвращаем строку до найденного символа}
var
  i: integer;
begin
  i:=0;
  result:='';
  i:=find(sData, sFind);
  if i>0 then result:=copy(sData, 1, i-length(sFind)+1);
end;
//..............................................................................
function Find(const S, P: string): Integer;
{Функция Find ищет подстроку P в строке S и возвращает индекс первого символа
подстроки или 0, если подстрока не найдена. Хотя в общем случае этот метод,
как и большинство методов грубой силы, малоэффективен, в некоторых ситуациях
он вполне приемлем.}
var
  i, j: Integer;
begin
  Result:=0;
  if Length(P)>Length(S) then
  begin
    debugMSG('Несоответствие длин: p='+inttostr(Length(P))+' > S='+inttostr(Length(s)));
    debugMSG('Строка: '+inttostr(strIndex));
    Exit;
  end;
  for i:=1 to Length(S)-Length(P)+1 do //x0 начало смещения для поиска в строке
  begin
    for j:=1 to Length(P) do
    begin
      if P[j]<>S[i+j-1] then
        Break
      else if j=Length(P) then
      begin
        Result:=i;
        Exit;
      end;
    end;
  end;
end;

//******************************************************************************
// Парсер/Исполнитель: главный цикл обработки команд Валкера
//******************************************************************************
function OnExecute(Sender: TObject): integer; //CommandList: TStringList
var
  s, cmd, param : string;
begin
  try
    s:=TextPic[strIndex]; //считываем команду из листа
    SendMs(s, chat);
    inc(strIndex);
  except
    ExecuteTimer.Enabled:=False; //остановим
  end;
end;

procedure UserCommands;    //комманды пользователя
var
  s, cmd: string;
begin //если комманда обработана удачно, то в чат сообщение не попадет, а будет выдано системное сообщение прямо в клиент
  s:=ReadS(2);
  debugMsg(s);
  s:=s+'='; //чтобы можно было взять число в конце
  cmd:=RTrimEx(ExtractName(s, '='), '=');  //получили строку вплодь до найденного символа
  cmd:=UpperCase(alltrim(cmd));
  case cmd of
    //команда загрузки скрипта>  load=picture
    'LOAD': begin
        s:=ExtractValue(s, '=');  //получили остаток строки начиная с искомого символа
        s:=RTrimEx(ExtractName(s, '='), '=');  //получили строку вплодь до найденного символа
        TextPic.clear;
        TextPic.LoadFromFile(PathTxt+s+'.txt'); //загружаем скрипт
        pck:='';
    end;
    'START','RUN': begin
        strIndex:=0; //начинаем с первой строки
        ExecuteDelay:=DefaultExecuteDelay; //задержка между командами валкера
        ExecuteTimer.Enabled:=true; //включим интерпретацию скрипта валкера
        pck:='';
    end;
    'STOP': begin
        ExecuteTimer.Enabled:=false; //выключим интерпретацию скрипта валкера
        pck:='';
    end;
    'DEST': begin
        s:=ExtractValue(s, '=');  //получили остаток строки начиная с искомого символа
        s:=RTrimEx(ExtractName(s, '='), '=');  //получили строку вплодь до найденного символа
        chat:=strtoint(s); //сохраним тип чата куда слать сообщение
        pck:='';
    end;
  end;
end;

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

  //****************************************************************************
  if (ConnectName=Name) and FromClient then
  begin
    case pck[1] of
      //************************************************************************
      //#$49: UserCommands; //Say2:s(Text)d(Type)s(Target) Грация
      #$02: UserCommands; //Say2:s(Text)d(Type)s(Target) Интерлюдия
    end;
  end;
end.