![]() |
|
#1
|
||||
|
||||
![]() прикрепляю файл с исходником программы и плагина в нижнее поле нужно писать
"гороскоп (знак)" гороскоп лев к примеру и он в плагине обрабатывает, из плагина почемуто не тянет полученную информацию ошибку выдает с процессом закину еще код программа Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type PPluginInfo = ^TPluginInfo; TPluginInfo = record CommandWord: String[10]; Index: Integer; Handle: THandle; end; type TForm1 = class(TForm) TestLog: TMemo; SendTest: TMemo; procedure SendTestKeyPress(Sender: TObject; var Key: Char); procedure komands(UIN, Msg: String; nomer: integer); procedure LoadPlug(fileName: string); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var Form1: TForm1; listKomand: TList; listPlug: TStringList; implementation {$R *.dfm} procedure TForm1.SendTestKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then begin key:= Char(0); komands('4815162342',SendTest.Text,666); SendTest.Clear; end; end; procedure TForm1.FormCreate(Sender: TObject); var SearchRec : TSearchRec; begin listPlug:=TStringList.Create; listkomand:=TList.Create; if FindFirst('*.lol',faAnyFile, SearchRec) = 0 then begin LoadPlug(SearchRec.name); //Загружаем первый найденный файл while FindNext(SearchRec) = 0 do LoadPlug(SearchRec.name); //Загружаем последующий FindClose(SearchRec); //Закрываем поиск end; end; procedure TForm1.LoadPlug(fileName: string); var PlugName : function : PChar; PlugKomand : function : PChar; handle : THandle; k,i:integer; p: PPluginInfo; komand: string; LoadMain: procedure; begin handle := LoadLibrary(Pchar(FileName)); //загружаем dll if handle <> 0 then //Если удачно, то идём дальше... begin @PlugName := GetProcAddress(handle,'PluginName'); //грузим процедуру if @PlugName <> nil then begin//Добавляем название dl; @PlugKomand:=GetProcAddress(handle,'Pluginkomand'); @LoadMain := GetProcAddress(handle,'LoadMain'); LoadMain; listPlug.Add(IntToStr(handle)); i:=0; komand:=PlugKomand; for k:=1 to Length(komand) do if(komand[k] = ';') then inc(i); if i>0 then for k:=1 to i do begin New(p); p.CommandWord :=copy(komand,1,pos(';',komand)-1); p.Index := k-1; p.Handle :=handle; listKomand.Add(p); komand:=copy(komand,pos(';',komand)+1,length(komand)); end; New(p); p.CommandWord :=komand; p.Index := k-1; p.Handle :=handle; listKomand.Add(p); end else ShowMessage('.lol not identifi '); //Иначе, выдаём сообщение об ошибке end; end; procedure TForm1.komands(UIN, Msg: String; nomer: integer); var n1,n2: integer; PlugExec : function(Uin,Msg:String; index: integer): PChar; komand: string; Result: string; begin msg:=trim(msg); n2:=pos(' ',Msg); if n2>0 then komand:=copy(Msg,1,n2-1) else komand:=Msg; for n1:=0 to listKomand.Count-1 do if komand = PPluginInfo(listKomand.Items[n1])^.CommandWord then begin @plugExec := GetProcAddress(PPluginInfo(listKomand.Items[n1])^.handle,'PluginExec'); Result:=PlugExec(UIN, Msg,PPluginInfo(listKomand.Items[n1])^.Index); TestLog.Lines.Add(Result); TestLog.Lines.Add('############################'); end; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var k: integer; handle: Thandle; UnLoadMain: procedure; begin for k:=0 To listPlug.Count-1 do begin handle:=StrToInt(listPlug.Strings[k]); @UnLoadMain := GetProcAddress(handle,'UnLoadMain'); UnLoadMain; FreeLibrary(handle) end; end; end. Код:
{$E lol} library plug; uses SysUtils, graphics, Classes, windows,RegExpr,IdHTTP; var IdHTTP1: TIdHTTP; function Pluginkomand : Pchar; begin Pluginkomand := 'гороскоп'; end; function PluginName:Pchar; begin //Вот оно, название плагина. Эта строчка будет в менюшке PluginName := 'blablabla'; end; procedure LoadMain; begin end; function PluginExec(Uin,Msg:String; index: integer): PChar; var n1,n2: integer; znak,dob,html: string; begin IdHTTP1:=TIdHTTP.Create(nil); IdHTTP1.HandleRedirects:=true; znak:=copy(msg,9,length(msg)); znak:=trim(znak); result:='Знак зодиака не верный! Пишутся маленькими буквами: Пример "гороскоп близнецы".'; if znak ='овен' then znak:='ОВЕН (21 марта - 20 апреля)' else if znak ='телец' then znak:='ТЕЛЕЦ (21 апреля - 21 мая)' else if znak ='близнецы' then znak:='БЛИЗНЕЦЫ (22 мая - 21 июня)' else if znak ='рак' then znak:='РАК (22 июня - 23 июля)' else if znak ='лев' then znak:='ЛЕВ (24 июля - 23 августа)' else if znak ='дева' then znak:='ДЕВА (24 августа - 23 сентября)' else if znak ='весы' then znak:='ВЕСЫ (24 сентября - 23 октября)' else if znak ='скорпион' then znak:='СКОРПИОН (24 октября - 22 ноября)' else if znak ='стрелец' then znak:='СТРЕЛЕЦ (23 ноября - 21 декабря)' else if znak ='козерог' then znak:='КОЗЕРОГ (22 декабря - 20 января)' else if znak ='водолей' then znak:='ВОДОЛЕЙ (21 января - 19 февраля)' else if znak ='рыбы' then znak:='РЫБЫ (20 февраля - 20 марта)' else exit; html:=UTF8ToAnsi(IdHTTP1.Get('http://rssportal.ru/feed/12480.xml')); n1:=pos('<description><![CDATA[',html)+22; n2:=pos(']></description>',html)-1; dob:=copy(html,n1,n2-n1); n1:=pos(znak,html)+7; n2:=pos('</rss>',html); html:=copy(html,n1,n2-n1); n1:=pos('<description><![CDATA[',html)+22; n2:=pos(']]></description>',html); html:=copy(html,n1,n2-n1); html:=dob+#10#13+#10#13+znak+#10#13+html; result:=PChar(html); IdHTTP1.Free; end; procedure UnLoadMain; begin end; exports Pluginkomand, PluginName, PluginExec,LoadMain,UnLoadMain; end. |