VPF::Использование потока - Форум программистов

MrDmitry

Дата 16.12.2011, 16:39 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Здравствуйте. Бьюсь над проблемой уже несколько дней и в конце концов решил обратится за помощью к вам.

Написал небольшую dll библиотеку в которой создается Tidhttp. Примерно выглядит так

Код


function query(http, action, key ): string; stdcall; export;
var
  data: TIdMultiPartFormDataStream;
  IdHTTP1: TIdHTTP;
begin
  IdHTTP1 := TIdHTTP.Create;
  data := TIdMultiPartFormDataStream.Create;
  try
  ...
  finally
    data.Free;
  end;

Таких функций в моей библиотеки несколько, каждая для своих целей.

Пока работает IdHTTP1 основная форма зависает. Поэтому было решено использовать потоки. Но проблема в том что по мимо того что до этого я не работал с потоками так тут еще нужно выполнить функции в потоке из библиотеки в теле самой программы. В идеале должно получится. Нажали кнопку на панели появляется надпись "Запрос отправлен, пожалуйста подождите." Если все успешно отправилось то появляется временная надпись "Операция успешна завершена" если ошибка то появляется в той же панели "Ошибка при отправки запроса". По потокам читал интереснейшую статью на этом форуме Многопоточность - как это делается в Дельфи и попытался сделать все сам. Создал скелет модуля thread (file->new->thread object) засунул туда обращение к dll

Код


function query(http, action, key):string; stdcall; external 'proc.dll';

Дальше попытался это запустить в потоке и вошел в ступор. Уже голова пухнет. Так что буду рад любой помощи

Это сообщение отредактировал(а) MrDmitry - 16.12.2011, 16:45

MetalFan

Дата 16.12.2011, 21:03 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(MrDmitry @ 16.12.2011, 16:39

)

засунул туда обращение к dll

И это скомпилилось???

--------------------

There are always someone smarter than you...

MrDmitry

Дата 17.12.2011, 14:13 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

нет. Поэтому и обращаюсь за помощью к вам

MetalFan

Дата 17.12.2011, 15:22 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

MrDmitry, может стоит учебник по делфи для начала почитать... тип параметров в функции кто будет указывать?

--------------------

There are always someone smarter than you...

Akella

Дата 17.12.2011, 15:23 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Цитата(MrDmitry @ 16.12.2011, 16:39

)

finally
data.Free;

а где уничтожение IdHTTP1?

MrDmitry

Дата 18.12.2011, 12:48 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Цитата(MetalFan @ 17.12.2011, 15:22)

MrDmitry, может стоит учебник по делфи для начала почитать... тип параметров в функции кто будет указывать?

парни. Эту функцию я указал как пример. Ну да забыл указать тип параметров. библиотека работает. вопрос в том как заставит работать созданный обьект Idhttp через потоки чтоб не подвисала программа. Вот для людей которые сразу кидаются, рабочий участок кода из длл(без потока)

Код


function Translit(Srt: string): string; stdcall; export;
var                                                                         //++
  len,i:integer;                                                            //++
  TRstr:string;                                                             //++
begin                                                                       //++
                                                                            //++
      len:= Length(Srt);                                                    //++
      if len>0 then                                                         //++
      for i:= 0 to len do                                                   //++
      Begin                                                                 //++
//ЗНАКИ МИНИМАЛ++++++++++++++++++++                                         //++
       case Srt[i] of          //++                                         //++
       '.': TRstr:=TRstr+'.';  //++                                         //++
       ',': TRstr:=TRstr+',';  //++                                         //++
       ' ': TRstr:=TRstr+' ';  //++                                         //++
       '_': TRstr:=TRstr+' ';  //++                                         //++
//+++++++++++++++++++++++++++++++++                                         //++
                                                                            //++
//ЦИФРЫ МИНИМАЛ++++++++++++++++++++                                         //++
       '0': TRstr:=TRstr+'0';  //++                                         //++
       '1': TRstr:=TRstr+'1';  //++                                         //++
       '2': TRstr:=TRstr+'2';  //++                                         //++
       '3': TRstr:=TRstr+'3';  //++                                         //++
       '4': TRstr:=TRstr+'4';  //++                                         //++
       '5': TRstr:=TRstr+'5';  //++                                         //++
       '6': TRstr:=TRstr+'6';  //++                                         //++
       '7': TRstr:=TRstr+'7';  //++                                         //++
       '8': TRstr:=TRstr+'8';  //++                                         //++
       '9': TRstr:=TRstr+'9';  //++                                         //++
//+++++++++++++++++++++++++++++++++                                         //++
                                                                            //++
//RUS TO EN++++++++++++++++++++++++                                         //++
       'й': TRstr:=TRstr+'j';  //++                                         //++
       'ц': TRstr:=TRstr+'c';  //++                                         //++
       'у': TRstr:=TRstr+'u';  //++                                         //++
       'к': TRstr:=TRstr+'k';  //++                                         //++
       'е': TRstr:=TRstr+'e';  //++                                         //++
       'н': TRstr:=TRstr+'n';  //++                                         //++
       'г': TRstr:=TRstr+'g';  //++                                         //++
       'ш': TRstr:=TRstr+'sh'; //++                                         //++
       'щ': TRstr:=TRstr+'w';  //++                                         //++
       'з': TRstr:=TRstr+'z';  //++                                         //++
       'х': TRstr:=TRstr+'x';  //++                                         //++
       'ъ': TRstr:=TRstr+'qh'; //++                                         //++
       'ф': TRstr:=TRstr+'f';  //++                                         //++
       'ы': TRstr:=TRstr+'y';  //++                                         //++
       'в': TRstr:=TRstr+'v';  //++                                         //++
       'а': TRstr:=TRstr+'a';  //++                                         //++
       'п': TRstr:=TRstr+'p';  //++                                         //++
       'р': TRstr:=TRstr+'r';  //++                                         //++
       'о': TRstr:=TRstr+'o';  //++                                         //++
       'л': TRstr:=TRstr+'l';  //++                                         //++
       'д': TRstr:=TRstr+'d';  //++                                         //++
       'ж': TRstr:=TRstr+'zh'; //++                                         //++
       'э': TRstr:=TRstr+'eh'; //++                                         //++
       'я': TRstr:=TRstr+'ja'; //++                                         //++
       'ч': TRstr:=TRstr+'ch'; //++                                         //++
       'с': TRstr:=TRstr+'s';  //++                                         //++
       'м': TRstr:=TRstr+'m';  //++                                         //++
       'и': TRstr:=TRstr+'i';  //++                                         //++
       'т': TRstr:=TRstr+'t';  //++                                         //++
       'ь': TRstr:=TRstr+'q';  //++                                         //++
       'б': TRstr:=TRstr+'b';  //++                                         //++
       'ю': TRstr:=TRstr+'ju'; //++                                         //++
       'ё': TRstr:=TRstr+'oh'; //++                                         //++
//UPRUS TO UPEN+++++++++++++++++++++                                        //++
       'Й': TRstr:=TRstr+'J';  //++                                         //++
       'Ц': TRstr:=TRstr+'C';  //++                                         //++
       'У': TRstr:=TRstr+'U';  //++                                         //++
       'К': TRstr:=TRstr+'K';  //++                                         //++
       'Е': TRstr:=TRstr+'E';  //++                                         //++
       'Н': TRstr:=TRstr+'N';  //++                                         //++
       'Г': TRstr:=TRstr+'G';  //++                                         //++
       'Ш': TRstr:=TRstr+'SH'; //++                                         //++
       'Щ': TRstr:=TRstr+'W';  //++                                         //++
       'З': TRstr:=TRstr+'Z';  //++                                         //++
       'Х': TRstr:=TRstr+'X';  //++                                         //++
       'Ъ': TRstr:=TRstr+'QH'; //++                                         //++
       'Ф': TRstr:=TRstr+'F';  //++                                         //++
       'Ы': TRstr:=TRstr+'Y';  //++                                         //++
       'В': TRstr:=TRstr+'V';  //++                                         //++
       'А': TRstr:=TRstr+'A';  //++                                         //++
       'П': TRstr:=TRstr+'P';  //++                                         //++
       'Р': TRstr:=TRstr+'R';  //++                                         //++
       'О': TRstr:=TRstr+'O';  //++                                         //++
       'Л': TRstr:=TRstr+'L';  //++                                         //++
       'Д': TRstr:=TRstr+'D';  //++                                         //++
       'Ж': TRstr:=TRstr+'ZH'; //++                                         //++
       'Э': TRstr:=TRstr+'EH'; //++                                         //++
       'Я': TRstr:=TRstr+'JA'; //++                                         //++
       'Ч': TRstr:=TRstr+'CH'; //++                                         //++
       'С': TRstr:=TRstr+'S';  //++                                         //++
       'М': TRstr:=TRstr+'M';  //++                                         //++
       'И': TRstr:=TRstr+'I';  //++                                         //++
       'Т': TRstr:=TRstr+'T';  //++                                         //++
       'Ь': TRstr:=TRstr+'Q';  //++                                         //++
       'Б': TRstr:=TRstr+'B';  //++                                         //++
       'Ю': TRstr:=TRstr+'JU'; //++                                         //++
       'Ё': TRstr:=TRstr+'OH'; //++                                         //++
//+++++++++++++++++++++++++++++++++                                         //++
 
      End;                                                                  //++

result:=TRstr;                                                            //++

end;

procedure prox(ip: string; port: integer; user, pass:string)stdcall; export;
begin
  ips:=ip;
  ports:=port;
  users:=user;
  password:=pass;
end;

procedure registration(http, key, phone:string; name, surname, patronamic,
  birth: string)stdcall; export;
var
  data: TIdMultiPartFormDataStream;
  IdHTTP1: TIdHTTP;
  url:string;
  res: string;
begin
  url:=http + 'action=2&session_key=' + key + '&phone=' + phone + '&name=' + Translit(name) + '&surname=' + Translit(surname) + '&patronymic=' + Translit(patronamic) + '&birth=' + birth+sms;
  IdHTTP1 := TIdHTTP.Create;
  data := TIdMultiPartFormDataStream.Create;
  try
   if (ips<>' ') or (ips<>'') then
    begin
     IdHTTP1.ProxyParams.ProxyServer:=ips;
     IdHTTP1.ProxyParams.ProxyPort:=ports;
     IdHTTP1.ProxyParams.ProxyUsername:=users;
     IdHTTP1.ProxyParams.ProxyPassword:=password;
    end;
    res:=IdHTTP1.get(url);
  finally
    data.Free;
  end;
end;

MetalFan

Дата 18.12.2011, 20:43 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

MrDmitry, зачем указывать изначально неверные примеры?
Вообще наверное стоит сначала попробовать реализовать работу с IdHTTP в потоке без выноса кода в dll...
Да и на один явный ляп Akella уже указал.
И вообще, ВОПРОС какой стоял? "Использование потока"...
Сами же писали:

Цитата(MrDmitry @ 16.12.2011, 16:39

)

Дальше попытался это запустить в потоке и вошел в ступор.

Где код с попыткой обернуть вызов функции из dll в поток?

p.s. string'и используются, а sharemem в uses указан, где надо?

--------------------

There are always someone smarter than you...

MrDmitry

Дата 19.12.2011, 14:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Да что вы привязались к dll? Я же говорю что библиотека работает.

Давайте поставим вопрос проще. Уйдем от Длл. Как сделать чтоб при работе idhttp программа подвисала, при помощи потока?

MetalFan

Дата 19.12.2011, 17:38 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(MrDmitry @ 19.12.2011, 14:18

)

Да что вы привязались к dll? Я же говорю что библиотека работает.

кто привязался?
см.

Цитата(MetalFan @ 18.12.2011, 20:43

)

Где код с попыткой обернуть вызов функции из dll в поток?

--------------------

There are always someone smarter than you...

MrDmitry

Дата 19.1.2012, 16:09 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Очень долго не писал ) Но проблему на некоторое время забросил и не решал. Собственно повторю суть вопроса. Нужно вызвать из dll поток. Обработать в нем данные и вернуть в основной модуль программы.

Вот какая dll получилась

Код


library proc;
{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  ShareMem,
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  query_thread,
  Dialogs,
  xmldom,
  XMLIntf,
  msxmldom,
  XMLDoc,
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdHTTP,
  StdCtrls,
  IdURI,
  IdMultipartFormData,
  ExtCtrls,
  ComCtrls,
  Unit1 in 'Unit1.pas';

{$R *.res}


function card_info(http, action, key, cardid:string):mytype; stdcall; export;
var
  NewThread: cards_info;
begin
  result.balance:='';
  Result.name:='';
  Result.surname:='';
  Result.pat:='';
  Result.bonus:='';
  Result.last:='';
  Result.reg:='';
  Result.birth:='';
  Result.succes:='';
  Result.test:='';
  NewThread := cards_info.Create(True);
  NewThread.FreeOnTerminate := True;
  try
    NewThread.http_thread := http;
    NewThread.action_thread := action;
    NewThread.key_thread := key;
    NewThread.cardid_thread := cardid;
    NewThread.Priority:=tpLower;
    NewThread.resume;
  except on EConvertError do
    begin
      NewThread.Free;
      result.succes:='0';
    end;
  end;
  Result:=res;
end;


Exports card_info;

begin

end.

Тут собственно вызывается поток.

Код


unit query_thread;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdHTTP,
  StdCtrls,
  IdURI,
  IdMultipartFormData,
  ExtCtrls,
  ComCtrls,
  Unit1,
  nativexml;

type
  cards_info = class(TThread)
  private
     fhttp_thread:string;
     faction_thread:string;
     fkey_thread:string;
     fcardid_thread:string;
  protected
    procedure card_info;
    procedure Execute; override;
  public
     property http_thread: string write fhttp_thread;
     property action_thread: string write faction_thread;
     property key_thread: string write fkey_thread;
     property cardid_thread: string write fcardid_thread;
     Constructor Create; overload;   // Этот конструктор использует умолчания
  end;

procedure cards_info.card_info;
var
data: TIdMultiPartFormDataStream;
xml_string:UTF8String;
IdHTTP1: TIdHTTP;
XMLDoc: TNativeXml; //объект XML-документа
NodeList: TXmlNodeList;//список узлов
begin
IdHTTP1 := TIdHTTP.Create;
  data := TIdMultiPartFormDataStream.Create;
  try
  if idHTTP1.Response.ResponseText='HTTP/1.0 200 OK' then
   res.succes:='0'
  else
   begin
   if (ips<>' ') or (ips<>'') then
    begin
     IdHTTP1.ProxyParams.ProxyServer:=ips;
     IdHTTP1.ProxyParams.ProxyPort:=ports;
     IdHTTP1.ProxyParams.ProxyUsername:=users;
     IdHTTP1.ProxyParams.ProxyPassword:=password;
    end;

    url:=fhttp_thread+'action='+faction_thread+'&session_key=' + fkey_thread +
          '&card='+fcardid_thread+sms;
   xml_string := UTF8Encode(IdHTTP1.Get(url));
    end;
     finally
   data.Free;
  end;

  XMLDoc:=TNativeXml.Create;//создаем экземпляр класса

  XMLDoc.ReadFromString(xml_string);

  if XMLDoc.IsEmpty then
    raise Exception.Create('Пустой XML! Работа прервана!');
   NodeList:=TXmlNodeList.Create;
   XMLDoc.Root.FindNodes('balance',NodeList);//получаем список узлов Item
  res.balance := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('name',NodeList);//получаем список узлов Item
  res.name := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('surname',NodeList);//получаем список узлов Item
  res.surname := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('patronymic',NodeList);//получаем список узлов Item
  res.pat := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('bonus',NodeList);//получаем список узлов Item
  res.bonus := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('lastdate',NodeList);//получаем список узлов Item
  res.last := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('regdate',NodeList);//получаем список узлов Item
  res.reg := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('birth',NodeList);//получаем список узлов Item
  res.birth := NodeList.items[0].ValueAsUnicodeString;
  XMLDoc.Root.FindNodes('success',NodeList);//получаем список узлов Item
  res.succes := NodeList.items[0].ValueAsUnicodeString;
   end;

procedure cards_info.Execute;
begin
 card_info;
end;

Тут обрабатывается сам поток

Код


unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  ExtCtrls,
  ComCtrls;

 type mytype=record
   balance, name, surname, pat, bonus, last, reg, birth, succes, test:string;
  end;

var
res:mytype;

implementation
end.

Только не смейтесь. Этот модуль служит для связи основного модуля библиотеки и потока. Долго ломал голову как передать данные из mytype в основную функцию библиотеки, в итоге додумался до такого варианта )

Код


type
  mytype = record
    balance, name, surname, pat, bonus, last, reg, birth, succes, test: string;
  end;
...
procedure TForm1.Button1Click(Sender: TObject);
var
  res: mytype;
begin
  res := card_info('сайт.ру/test.php?', '323', sesion_key, '1111111');
ShowMessage(res.balance);
end;

Вот такой вызов dll

при первом нажатии кнопки res.balance возвращается пустым. ((( При повторном возвращается то что нужно.

Это сообщение отредактировал(а) MrDmitry - 19.1.2012, 16:16

MrDmitry

Дата 20.1.2012, 14:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Так что у меня не так? Дайте пищу для размышлений а то мыслей уже не осталось

MrDmitry

Дата 20.1.2012, 21:09 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Похоже что нужно использовать SYNCHRONIZE но все мои попытки синхронизации четны. (((((

MetalFan

Дата 21.1.2012, 14:01 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Сделай тестовый проект/группу, чтобы можно было сразу ошибку твою "поймать", и приложи аттачем.
Но код у тебя ужасно отформатирован. просто нет слов.

Это сообщение отредактировал(а) MetalFan - 21.1.2012, 14:04

--------------------

There are always someone smarter than you...

MrDmitry

Дата 21.1.2012, 15:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

Вот

Насчет форматирования. Первоначально оно было, но после того как я уже переписал все 100 раз на форматирование я уже перестал обращать внимания

Присоединённый файл ( Кол-во скачиваний: 3 )

test.rar 782,44 Kb

MrDmitry

Дата 22.1.2012, 13:53 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

С исходниками стало еще тяжелее помочь? (

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »