GraNIT
31.07.2009, 17:19
Скрипт для рисунков в чате {Gracia Part 2} program Risuem_w_chat2;
const
Name='NAME'; //имя персонажа в игре
Pathtxt='.\scripts\'; //путь к файлу
NameTxt='picture.txt'; //имя файла с рисунком (текстом)
debug=true; //true - чтобы видеть команды в чате
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
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); //следующая строка
finally
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','CHAT': 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) Грация
#$38: UserCommands; //Say2:s(Text)d(Type)s(Target) Интерлюдия
end;
end;
end.
Picture.txt____________$$$$$$$*$______$$$$$$$$$
__________$$$$$$$$$*$$$__$$$$$$$__$$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
__________$$$$$$$$$*$$$$$$$$$$$$$__$$$
____________$$$$$$$*$$$$$$$$$$$$$$$$
_______________$$$$*$$$$$$$$$$$$$
_________________$$*$$$$$$$$$$$
____________________$$$$$$$$
_____________________$$$$$
______________________$$$
_______________________$
Инструкция по использованию:
1.Как обычно правим NAME
2.Запускаем скрипт
3.В папке \scripts\picture.txt должен лежать файл с текстом или рисунком
4.загружаем командой в чате> load=picture
5.сообщаем в какой чат писать, командой в чате> dest=1 или chat=1 (0 - общий чат и т.д.)
6.запускаем на исполнение, командой в чате> start или run
7.экстренная остановка скрипта, командой в чате> stop
8.после вывода картинки скрипт останавливается сам.
Пример:[Ссылки могут видеть только зарегистрированные и активированные пользователи] ([Ссылки могут видеть только зарегистрированные и активированные пользователи])
ЗЫ:Нашел на Coderx.ru:ban:
const
Name='NAME'; //имя персонажа в игре
Pathtxt='.\scripts\'; //путь к файлу
NameTxt='picture.txt'; //имя файла с рисунком (текстом)
debug=true; //true - чтобы видеть команды в чате
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
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); //следующая строка
finally
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','CHAT': 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) Грация
#$38: UserCommands; //Say2:s(Text)d(Type)s(Target) Интерлюдия
end;
end;
end.
Picture.txt____________$$$$$$$*$______$$$$$$$$$
__________$$$$$$$$$*$$$__$$$$$$$__$$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
__________$$$$$$$$$*$$$$$$$$$$$$$__$$$
____________$$$$$$$*$$$$$$$$$$$$$$$$
_______________$$$$*$$$$$$$$$$$$$
_________________$$*$$$$$$$$$$$
____________________$$$$$$$$
_____________________$$$$$
______________________$$$
_______________________$
Инструкция по использованию:
1.Как обычно правим NAME
2.Запускаем скрипт
3.В папке \scripts\picture.txt должен лежать файл с текстом или рисунком
4.загружаем командой в чате> load=picture
5.сообщаем в какой чат писать, командой в чате> dest=1 или chat=1 (0 - общий чат и т.д.)
6.запускаем на исполнение, командой в чате> start или run
7.экстренная остановка скрипта, командой в чате> stop
8.после вывода картинки скрипт останавливается сам.
Пример:[Ссылки могут видеть только зарегистрированные и активированные пользователи] ([Ссылки могут видеть только зарегистрированные и активированные пользователи])
ЗЫ:Нашел на Coderx.ru:ban: