[Ссылки могут видеть только зарегистрированные пользователи. ]
PHP код:
var
Form1: TForm1;
old: array of string;
//Парсер самодельный)) удалим все что не нужно
procedure TForm1.ToolButton5Click(Sender: TObject);
var
i: integer;
s: string;
begin
for i := 0 to SynEdit1.Lines.Count - 1 do
begin
s := StringReplace(SynEdit1.Lines[i], ')', '', [rfReplaceAll, rfIgnoreCase]);
s := StringReplace(s, '(', '', [rfReplaceAll, rfIgnoreCase]);
s := StringReplace(s, ',', ' ', [rfReplaceAll, rfIgnoreCase]);
s := StringReplace(s, 'Send', '', [rfReplaceAll, rfIgnoreCase]);
s := StringReplace(s, ';', ' ', [rfReplaceAll, rfIgnoreCase]);
SetLength(old, i + 1);
old[i] := s;
end;
olds; //Отправим в процедуру инфу отчищенную от лишнего вот результат для отправки 9504200 F1 100 1 0 0 0 0
end;
//Тут я написал процедуру подготовки для отправки на выполнение в компонент разбивая полученный текст по отдельности
//таймер клавиши т.п и вношу в массив в ячейки с 1 по 8
procedure TForm1.olds;
var
i, j, l: integer;
T, st: string;
K: array [1..8] of string;
begin
T := '';
l := 1;
for j := 0 to High(old) do
begin
st := old[j];
for i := 1 to UTF8Length(st) do
if st[i] <> ' ' then
T := T + st[i]
else //если наткнулись на пробел
begin
K[l] := T;
T := ''; //снова обнуляем строку и сначала...
Inc(l);
end;
l := 1;
//Отправляем что собрали это мой компонент
LINEAGE1.Key(StrToInt(K[1]), K[2], StrToInt(K[3]), StrToInt(K[4]), K[5],
StrToInt(K[6]), StrToInt(K[7]), StrToInt(K[8]));
end;
end;
Re: Как написать свой скриптовый движок для своих нужд?
Пожалуй один из самых простых вариантов написания своего варианта скриптового движка, для встраивания в свои приложения это движок UOpilot. Основан на разборе строк.
Сурс взят с сайта [Ссылки могут видеть только зарегистрированные пользователи. ]
Код:
procedure TfmMain.Scan(ind:integer);
var i,k,sel,key,nif,c,nrepeat,nElse:integer; s,str,command:string; FirstTick:Longint; DC:HDC; pt,pt1:integer; //str - временная строка
procedure Delay(ms:string); // пауза в миллисекундах
begin
if (ms='') or (ms='0') then exit;
FirstTick := GetTickCount;
repeat
if doScript=false then begin btStart.Down:=false; mmScript.Enabled:=true; exit; end; // если отжали кнопку старта скрипта
Application.ProcessMessages;
until GetTickCount - FirstTick >= strtoint(ms);
end;
begin
try
{сканирование и выполнение скрипта}
if mmScript.Text='' then begin btStart.Down:=false; mmScript.Enabled:=true; exit; end; // пустой скрипт, выход
i:=ind; // это если мы начинаем не с начала скрипта, например, цикл или условие if
while i<mmScript.Lines.Count do begin // для каждой строки скрипта...
Delay(edPause.Text); // пауза между строками скрипта
if mmScript.Lines.Strings[i]='' then begin inc(i); continue; end; // текущая строчка пустая
if doScript=false then begin btStart.Down:=false; mmScript.Enabled:=true; exit; end; // если отжали кнопку старта скрипта
s:=mmScript.Lines.Strings[i]; //текущая строка
//--- сейчас выделим первый символ в текущей строке (блин, неужто это я сам написал? :-))
sel:=0;
for k:=0 to i do sel:=sel+(length(mmScript.Lines.Strings[k])+2);
sel:=sel-(length(mmScript.Lines.Strings[i])+2);
mmScript.SelStart:=sel;mmScript.SelLength:=1;
//---
// ----- далее обрабатываем комманды --------------
command:=GetWord(s,0); // чтобы для одной строчки несколько раз не рассчитывать команду (первое слово)
if command='wait' then delay(GetWord(s,1)); // -wait
//----------------------------------------
if command='msg' then showmessage(GetWord(s,-1));
//----------------------------------------
if command='say' then begin
str:=GetWord(s,-1);
for k:=1 to length(str) do begin
PostMessage(wnd1,WM_KEYDOWN,ord(str[k]),0);
PostMessage(wnd1,WM_CHAR,ord(str[k]),0);
PostMessage(wnd1,WM_KEYUP,ord(str[k]),0);
end;// - for
PostMessage(wnd1,WM_CHAR,VK_RETURN,0);
end; // -say
//----------------------------------------
if command='send' then begin
str:=GetWord(s,1); // клавиша типа backspace (учтите, что LowerCase(keylabels[k]), т.к. сравниваем строки, а при GetWord получаем в нижнем регистре)
for k:=0 to high(keylabels) do if comparetext(str,LowerCase(keylabels[k]))=0 then key:=keycodes[k];
PostMessage(wnd1,WM_KEYDOWN ,key,0);
PostMessage(wnd1,WM_KEYUP,key,0);
if GetWord(s,2)<>'' then Delay(GetWord(s,2)); // задержка после нажатия на клавишу (если есть)
end;
//----------------------------------------
if (command='if')or(command='if_not') then begin
//ИДЕЯ: если соотв. условие выполняется, то вызов Scan(i+1), если нет то ищем наш else и Scan(numElse). После этого ищем наш end_if и переходим на него (а т.к. в конце inc(i), то попадем на следующую строчку после него)
//--- Ищем наш end_if и nElse - номер строки с нашим else:
k:=i+1; // номер строки с нашим end_if , начинаем считать кол-во вложенных условий if и if_not со след. от текущей
nif:=0; // текущее кол-во вложенных условий if и if-not. если <0 то мы нашли наш end_if
nElse:=0; // номер строки с нашим else, если есть. если нету, то 0
while k<mmScript.Lines.Count do begin
if (GetWord(mmScript.Lines.Strings[k],0)='if') or (GetWord(mmScript.Lines.Strings[k],0)='if_not') then inc(nif);
if GetWord(mmScript.Lines.Strings[k],0)='end_if' then dec(nif);
if GetWord(mmScript.Lines.Strings[k],0)='else' then if nif=0 then nElse:=k; // если кол-во вложен. условий=0 (т.е. наше условие)
if nif<0 then begin break; end; // k=номеру строки с нашим end_if
inc(k);
end;
if k=mmScript.Lines.Count then begin doScript:=false; btStart.Down:=false; mmScript.Enabled:=true; showmessage('Не могу найти конец условия: "End_IF", проверьте скрипт'); exit; end; // цикл while дошел до конца скрипта и не нашел end_if
//--- теперь определим, равен ли цвет точки или нет.
DC:=GetDC(wnd1);
c:=GetPixel(DC,strtoint(GetWord(s,1)),strtoint(GetWord(s,2))); // 1 и 2 параметры -координаты точки, 3 - цвет точки, с кот. надо сравнить
ReleaseDC(wnd1,DC);
//--- переход согласно условию (а если есть else, то на него, если условие не выполняется)
if GetWord(s,4)='' then begin // это если четко указан цвет
if command='if' then if c=strtoint(GetWord(s,3)) then Scan(i+1) else if nElse<>0 then Scan(nElse+1);
if command='if_not' then if c<>strtoint(GetWord(s,3)) then Scan(i+1) else if nElse<>0 then Scan(nElse+1);
end
else begin // это если указан диапазон цвета
if command='if' then if ((c>=strtoint(GetWord(s,3)))and(c<=strtoint(GetWord(s,4)))) then Scan(i+1) else if nElse<>0 then Scan(nElse+1);
if command='if_not' then if not ((c>=strtoint(GetWord(s,3))) and(c<=strtoint(GetWord(s,4)))) then Scan(i+1) else if nElse<>0 then Scan(nElse+1);
end;
//---
i:=k; // k=end_repeat, а в самом конце inc(i), поэтому попадем на следующую строчку после end_if
end; // -"if"
//------------------------------------------
if command='left' then begin
MouseClick(1,MakeLong(strtoint(GetWord(s,1)),strtoint(GetWord(s,2))));
end else // -left
if command='right' then begin
MouseClick(2,MakeLong(strtoint(GetWord(s,1)),strtoint(GetWord(s,2))));
end; // -left
if command='double_left' then begin
MouseClick(11,MakeLong(strtoint(GetWord(s,1)),strtoint(GetWord(s,2))));
end; // -double left & right
if command='double_right' then begin
MouseClick(22,MakeLong(strtoint(GetWord(s,1)),strtoint(GetWord(s,2))));
end; // -double left & right
//-------------------------------------------------
if command='alarm' then begin
PlaySound(pChar('Msg.wav'), 0, SND_FILENAME or SND_ASYNC or SND_NOWAIT);
delay('400'); // время на проигрывание файла.
end; //alarm
//--------------------------------------------------
if command='drag' then begin
pt:=MakeLong(strtoint(GetWord(s,1)),strtoint(GetWord(s,2))); // (x1,y1) (x2,y2) (кoличество, если не указано или all, то все)
pt1:=MakeLong(strtoint(GetWord(s,3)),strtoint(GetWord(s,4)));
// --- собственно перетаскивание:
PostMessage(wnd1, WM_LBUTTONDOWN,0,pt);
PostMessage(wnd1, WM_SETCURSOR, wnd1, MakeLong(HTCLIENT,WM_LBUTTONDOWN));
PostMessage(wnd1, WM_MOUSEMOVE,0,pt1);
PostMessage(wnd1, WM_SETCURSOR, wnd1, MakeLong(HTCLIENT,WM_MOUSEMOVE));
delay('400'); // иначе не просекает...
PostMessage(wnd1, WM_LBUTTONUP,0,pt1);
PostMessage(wnd1, WM_SETCURSOR, wnd1, MakeLong(HTCLIENT,WM_LBUTTONUP));
str:=GetWord(s,5); // Это строковое представление кол-ва перетаскиваемых объектов
//введем сколько (достаточно WM_CHAR, а WM_KEYDOWN/UP и не надо???)
if (str<>'')and(str<>'all') then for k:=1 to length(str) do begin PostMessage(wnd1,WM_CHAR,ord(str[k]),0);end;
//в любом случае нажмем Enter, а если перед этим с клавиатуры не ввели число, то значит все
PostMessage(wnd1,WM_CHAR,VK_RETURN,0);
// щелкнем, чтобы бросить
PostMessage(wnd1, WM_LBUTTONDOWN,0,pt1);
PostMessage(wnd1, WM_SETCURSOR, wnd1, MakeLong(HTCLIENT,WM_LBUTTONDOWN));
PostMessage(wnd1, WM_LBUTTONUP,0,pt1);
PostMessage(wnd1, WM_SETCURSOR, wnd1, MakeLong(HTCLIENT,WM_LBUTTONUP));
end; // -drag
//--------------------------------------------------
if command='end_script' then doScript:=false; // потому что эту функцию (Scan) мы можем вызывать рекурсивно, так что просто выход не поможет
//--------------------------------------------------
if (command='end_repeat') or (command='continue') or (command='else') or (command='end_if') then exit; // в родительскую процедуру, возможно, сами себе (рекурсия)
//--------------------------------------------------
if command='break' then begin if (GetWord(s,1)='')or (GetWord(s,1)='0') then doBreak:=1 else doBreak:=strtoint(GetWord(s,1)); exit; end; // в родительскую процедуру, возможно, сами себе (рекурсия)
//--------------------------------------------------
if command='repeat' then begin
//ИДЕЯ: вначале вызовем сколько надо раз scan(i+1) (тогда при встрече end_repeat вернемся в эту точку), а потом перескочим на строчку с нашим end_repeat.
for k:=1 to strtoint(GetWord(s,1)) do begin
if doBreak>0 then begin doBreak:=doBreak-1; break; end; // если в теле цикла встретим break , то прекратим выполнение текущего цикла.
Scan(i+1);
end;
//--- перескочим на наш end_repeat
k:=i+1; // Номер след. строки после repeat
nrepeat:=0; // число вложенных циклов
while k<mmScript.Lines.Count do begin
if GetWord(mmScript.Lines.Strings[k],0)='repeat' then inc(nrepeat);
if GetWord(mmScript.Lines.Strings[k],0)='end_repeat' then dec(nrepeat);
if nrepeat<0 then begin i:=k; break; end; // сейчас i=k=номеру с нашим end_repeat, увеличится этот номер строки в конце общего цикла, в итоге перескочим на строку после endrepeat
inc(k);
end;
if k=mmScript.Lines.Count then begin doScript:=false; btStart.Down:=false; mmScript.Enabled:=true; showmessage('Не могу найти конец цикла: "End_Repeat", проверьте скрипт'); exit; end; // не нашли соотв. конец цикла end_repeat
//---
end; // -repeat
//--------------------------------------------------
if command='move' then begin // сдвигаем курсор, аналог SetCursorPos(x,y);
PostMessage(wnd1,WM_MOUSEMOVE,0,MakeLong(strtoint(GetWord(s,1)),strtoint(GetWord(s,2))));
end;
//--------------------------------------------------
//------------------- конец проверки операторов (команд) -----------------------
inc(i); // увеличиваем номер строки в мактросе
end; //-while обработка строки
Application.ProcessMessages;
if doScript then Scan(0) else begin btStart.Down:=false; mmScript.Enabled:=true; exit; end;
except
doScript:=false; btStart.Down:=false; mmScript.Enabled:=true; showmessage('Ошибка! Проверьте правильность скрипта!');
end;
end; //процедуры Scan
________________ Dinmaite пишет с меня, когда забывает пароль от Dinmaite[work] и сидит не со своего IP.
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Как написать свой скриптовый движок для своих нужд?
