Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 08.04.2011, 17:43
Аватар для ALexandr555
ALexandr555 ALexandr555 вне форума
Специалист
 
Регистрация: 09.10.2010
Адрес: Тольятти
Сообщения: 803
Версия Delphi: Delphi 7
Репутация: 2064
По умолчанию не работает код

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


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:41.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025