Рисунки символами в чате

[z0mbie]

Здраствуйте я хотел бы спрасить как сделать из этого скрипта чтоб можно было рисовать рисунки в чате типа:
____________$$$$$$$*$______$$$$$$$$$
__________$$$$$$$$$*$$$__$$$$$$$__$$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
__________$$$$$$$$$*$$$$$$$$$$$$$__$$$
____________$$$$$$$*$$$$$$$$$$$$$$$$
_______________$$$$*$$$$$$$$$$$$$
_________________$$*$$$$$$$$$$$
___________________*_$$$$$$$
Вот и сам скрипт как его можно переделать?
const
MaxMessages = 1000;
var
m: TMemo;
frm:TForm;
penel: TPanel;
etext: tedit;
button: tbutton;
box : TCheckBox;
every : TEdit;
_Name : TEdit;
i: Integer;
tm:TTimer;
Message, Name: String;

procedure SendMs(Sender: TObject);
var
Msg, Nm: String;
dd: integer;
begin
if etext.text<>'' then begin
buf:=#$38;
case etext.text[1] of
'!': begin
Msg:=Copy(etext.text,2,1000);
dd:=1;
nm:='';
end;
'$': begin
Msg:=Copy(etext.text,2,1000);
dd:=9;
nm:='';
end;
'+': begin
Msg:=Copy(etext.text,2,1000);
dd:=8;
nm:='';
end;
'"': begin
dd:=pos(' ', etext.text);
Msg:=Copy(etext.text,dd+1,1000);
nm:=Copy(etext.text,2,dd-3);
dd:=2;
end;
'#': begin
Msg:=Copy(etext.text,2,1000);
dd:=3;
nm:='';
end;
'@': begin
Msg:=Copy(etext.text,2,1000);
dd:=4;
nm:='';
end;
else begin
Msg:=etext.text;
dd:=0;
nm:='';
end;
end;
WriteS(Msg);
WriteD(dd);
if nm<>'' then WriteS(Nm);
SendToServerEx(_Name.Text);
end;
end;
procedure onNewCommand(obj:TObject;key:string);
var i:integer;
var symbol:Variant;
var after:string;
begin
if (key[1]=#$0D) then begin
SendMs(obj);
symbol := etext.Text[1];
after := '';
if symbol = '#' then after := '#';
if symbol = '!' then after := '!';
if symbol = '@' then after := '@';
if symbol = '$' then after := '$';
etext.Text := after;
end;
end;
procedure onTimer(Sender:TObject);
begin
tm.Interval := StrToInt(every.Text);
if box.checked = true then SendMs(Sender);
end;
procedure Init;
begin
frm := TForm.Create(nil);
frm.Caption := 'Chat';
frm.BorderStyle := bsSizeable;
frm.Position := poDesigned ;
frm.Width:=400;
frm.Height:=600;
m:=TMemo.Create(frm);
m.parent:=frm;
m.align:=alClient;
m.ReadOnly:=true;
m.ScrollBars:=ssBoth;
penel:=TPanel.Create(frm);
penel.parent:=frm;
penel.align:=alBottom;
penel.height:=48;
etext:=tedit.Create(penel);
etext.parent:=penel;
etext.align:=alTop;
button:=tbutton.Create(penel);
button.parent:=penel;
button.top := etext.height;
button.caption:='Send';
button.onClick:=@SendMs;
box := TCheckBox.Create(penel);
box.parent := penel;
box.Top := etext.height + 2;
box.Left := button.width + button.left +2;
box.Caption := 'Шторм через: ';
every:=tedit.Create(penel);
every.parent:=penel;
every.Left := box.Left + box.Width;
every.Top := button.top;
every.Text := IntToStr(3000);
tm := TTimer.Create(frm);
tm.Interval := 1000;
tm.Enabled := true;
tm.OnTimer := @OnTimer;
etext.OnKeyPress := @onNewCommand;
_Name:=tedit.Create(frm);
_Name.parent:=frm;
_Name.align := alTop;
_Name.Text := '';
frm.Show;
end;

procedure SaveToFile(prefix:string);
var name:string;
begin
name := prefix+'.'+ConnectName+'.'+DateToStr(Date)+'.'+Tim eToStr(Time)+'.txt';
while Pos(':',name) <> 0 do begin
name[Pos(':',name)] := '-';
end;
m.Lines.SaveToFile(name);
end;

procedure Free;
begin
SaveToFile('ChatLog');
box.Free;
every.Free;
tm.Free;
etext.Free;
button.Free;
penel.Free;
m.Free;
frm.Free;
end;



var tp:integer;
var ct:string;
var MessageCounter:integer;
begin
if _Name.Text = '' then _Name.Text := ConnectName;
if FromServer and (ConnectName = _Name.Text) and (pck[1]=#$4a) then
begin
i:=10;
name:=ReadS(i);
message:=ReadS(i);
tp := ReadD(6);
ct := '???';
if tp = 0 then ct := 'GNR';
if tp = 8 then ct := 'TRD';
if tp = 3 then ct := 'PRT';
if tp = 4 then ct := 'CLN';
if tp = 9 then ct := 'ALY';

ct := DateToStr(Date) + ' '+ TimeToStr(Time) + ', '+ ct;

if name='' then name:='Объявление: ';
m.Lines.Add('['+ct+'] '+Name+': '+message);

if MessageCounter > MaxMessages then begin
SaveToFile('Backup');
//m.Lines.Add('BACKUPED');
MessageCounter := 0;
end;
MessageCounter := MessageCounter+1;
end;
end.


Добавлено через 16 часов 56 минут
Вот делал в клан чат т.к. в обычный неполучиться нада чтоб все заткнулись а то вручную делать долго и пока ты 1 строку делать будешь там докуя строк будет (
http://s50.radikal.ru/i127/0906/cf/4b8b1f00e006.jpg

Добавлено через 2 часа 49 минут
Чё никто неможет переделать скрипт? мне хотябы чтоб вылазило несколько окошек чтоб я каждую строчку в окошко писал и отправлял всё по одному нажатию

[NLObP]

Набросал на скорую руку для Грации

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

put script and file, which you want to draw in chat then

1.Change NAME constant
2.Run script
3.In folder \scripts\ must be *.txt file? for example picture.txt
4.Load file with send to chat command> load=picture, where "picture" is filename with strings
5.Then we should set the chat type> dest=1 or chat=1 ,where 1 - is chat type
6.To start drawing in chat use command> start or run
7.To stop drawing use command> stop
8.After drawing all pictire/text script stop automaticaly.


____________$$$$$$$*$______$$$$$$$$$
__________$$$$$$$$$*$$$__$$$$$$$__$$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
_________$$$$$$$$$$*$$$$$$$$$$$$$$__$$$
__________$$$$$$$$$*$$$$$$$$$$$$$__$$$
____________$$$$$$$*$$$$$$$$$$$$$$$$
_______________$$$$*$$$$$$$$$$$$$
_________________$$*$$$$$$$$$$$
____________________$$$$$$$$
_____________________$$$$$
______________________$$$
_______________________$

[z0mbie]

NLObP, респект спасибо огоромное ща буду тестить)

[NLObP]

z0mbie, смотри чтобы не забанили :D

[z0mbie]

Млин нифега невыходит, я ставлю галочку чтоб скрипт запустить и всё больше ничего не происходит
//nlobp:ты мое сообщение внимательно читал?

Добавлено через 24 минуты
Да читал тока я непонял как его запустить какой командой, то есть в чате писать load=picture ? или что?

[NLObP]

4.загружаем командой> load=picture
5.сообщаем в какой чат писать, командой> dest=0 (0 - общий чат и т.д.)
6.запускаем на исполнение> start или run

PS: на картинке видно команды запуска
PPS: можно после включения скрипта написать в чат run, картинка из picture.txt (файл по умолчанию) будет выводиться в общий чат

[z0mbie]

Если чесно нифега непонял как ты загрузил командой:unknw:

[NLObP]

:mad: в чат пиши RUN

PS: Ты сообщение (http://coderx.ru/showpost.php?p=31386&postcount=2) читал, как надо делать 1,2,3 и т.д?
PPS: пиши как ты его запускал, по шагам, а то разговор глухого со слепым.

[z0mbie]

Писал я в чат и RUN и .run и >run нифега неполучаеться)

[Breadfan]

а хроники то какие ?

[NLObP]

Скрипт для Грации. Самостоятельно измените ID пакетов для других хроник.
procedure SendMs(msg: string; dest: integer);
begin
buf:=#$49; //Грация
//buf:=#$38; //Интерлюдия
WriteS(Msg);
WriteD(dest);
WriteS('');
SendToServerEx(Name);
end;
...
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;

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

[NLObP]

Да. Попробуй исправь эту стрчку
ExecuteTimer.Enabled:=false;
на эту
ExecuteTimer.Enabled:=true;
тогда при включении скрипта сразу начнет в чат выводить.

Добавлено через 1 минуту
Напиши, что ты сделал по шагам, начиная с копирования скрипта с форума.

[8tomat8]

NLObP, аналогично, скрипт не пашит, все по инструкции...
он не реагирует на команды( юзаю версию 3,5,9,113 сервер интерлюд

[NLObP]

8tomat8, глянул, нашел ошибку в айди пакета, должно быть так

#$38: UserCommands; //Say2:s(Text)d(Type)s(Target) Интерлюдия

PS: обновил скрипт

[8tomat8]

uuu да логично) я не смог когда смотрел вчехлить нафига там 02))) спасибо

[NLObP]

8tomat8, получилось?

[8tomat8]

да все пашит) спасиб еще раз

Добавлено через 40 секунд
Уже свои заслуженые 7 банов схватил):D хороший скрипт)))

[NLObP]

:D

[charly911]

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.

[QaK]

charly911, put script and file, which you want to draw in chat then

1.Change NAME constant
2.Run script
3.In folder \scripts\ must be *.txt file? for example picture.txt
4.Load file with send to chat command> load=picture, where "picture" is filename with strings
5.Then we should set the chat type> dest=1 or chat=1 ,where 1 - is chat type
6.To start drawing in chat use command> start or run
7.To stop drawing use command> stop
8.After drawing all pictire/text script stop automaticaly.

[z0mbie]

первая строка только в чат пишит

[NLObP]

первая строка только в чат пишит

Не понял, поясни.

[z0mbie]

Ну первая строчка рисунка в чате пишеться и всё

[charly911]

Worked! :D , but not 100%.
Only the first line is showed :confused:

Charly.

[z0mbie]

charly911, у меня также!

[charly911]

Solution:


try
s:=TextPic[strIndex]; //????????? ?????? ???????
SendMs(s, chat); //??????? ? ???
inc(strIndex); //????????? ??????
Except // <--<-- Change this!!
ExecuteTimer.Enabled:=False; //?????????
end;


:D ;)

Charly.

[SexGuru]

играю на интерлюде , ставлю правленный скрипт от зомби, ставлю галочку , вписываю команды, ничего не происходит