не работает код
прикрепляю файл с исходником программы и плагина в нижнее поле нужно писать
"гороскоп (знак)"
гороскоп лев к примеру
и он в плагине обрабатывает, из плагина почемуто не тянет полученную информацию ошибку выдает с процессом
закину еще код
программа
Код:
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.
|