Нифега неполучаеться, может руки кривые хз(
Вот под интерлюд правильно сделал нет?
Код:
Скрипт распространяется как есть, и я не несу ответственности за то,
что ВЫ натворили у себя, его используя.
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.
NLObP, аналогично, скрипт не пашит, все по инструкции...
он не реагирует на команды( юзаю версию 3,5,9,113 сервер интерлюд
__________________
помог?СКАЖИ СПАСИБО!)
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок, а в том, чтобы писать программы, работающие при любом количестве ошибок.
Цитата:
[10-06, 14:15] efreet Заплачу за настройку l2px
[11-06, 09:25] xkor не плач)
uuu да логично) я не смог когда смотрел вчехлить нафига там 02))) спасибо
__________________
помог?СКАЖИ СПАСИБО!)
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок, а в том, чтобы писать программы, работающие при любом количестве ошибок.
Цитата:
[10-06, 14:15] efreet Заплачу за настройку l2px
[11-06, 09:25] xkor не плач)
Добавлено через 40 секунд
Уже свои заслуженые 7 банов схватил) хороший скрипт)))
__________________
помог?СКАЖИ СПАСИБО!)
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок, а в том, чтобы писать программы, работающие при любом количестве ошибок.
Цитата:
[10-06, 14:15] efreet Заплачу за настройку l2px
[11-06, 09:25] xkor не плач)
Цитата:
Сообщение от Psih
Вот еще один вопрос:Вот вчера было све нормально
Последний раз редактировалось 8tomat8, 12.06.2009 в 01:16.
Причина: Добавлено сообщение
Hi! im trying to use this script, but y do not know how to send the "load" command. I have tryed several ways but i could't, and translation doesn't help :s
What do i exactly need to write to use it??
Thx in advance, Charly.
Последний раз редактировалось charly911, 31.07.2009 в 10:04.