Скачать: CL | DM;

работа с потоками   Найти похожие ветки 

← →
Ekate ©   (2007-08-03 11:32) [0]

Здравствуйте,уважаемые эксперты!
Снова обращаюсь за вашей помощью.
Я вызываю дочерний поток (далее поток_2) из потока(поток_1),который опять же является дочерним к основной программе.
Поток_2 имеет параметр,значение которого передается потоком_1.
Т.е. конструктор потока_2 выглядит следующим образом:

constructor TBr.create(param: string; createsuspended: boolean);
begin
 inherited create(true);
 par := param;
 if not createsuspended then
 resume
end;


При чем, в зависимости от определенного условия поток_2 необходимо перезапускать с новым значением параметра.

Код перезапуска потока_2

//if process is runnig then terminate it
       if (br<>nil) then
       begin
           br.Terminate;
           br.WaitFor;
           br := nil;
       end;

       //and run it again with certain parameters
       br:=TBr.Create(anotherParam,true);
       br.Resume;
       br.Priority:=tpnormal;
       


Поток_2 представляет собой сканирование URL активного окна браузера и выполняет работу с тектовым файлом.

Основные процедуры потока_2

function GetUrl:string;
var Winds: IShellWindows;
   IEWB: IWebBrowser2;
   i: integer;
   Doc: IHtmlDocument2;
begin
 Winds:=CoShellWindows.Create;
 for i:=0 to Winds.Count-1 do
 if (Winds.Item(i) as IWEbBrowser2).Document<>nil then
 begin
   IEWB:=Winds.Item(i) as IWEbBrowser2;
   if IEWB.Document.QueryInterface(IhtmlDocument2, Doc)= S_OK
   then Result:=Doc.url;
 end;
end;

procedure TBr.Execute;
var
 f:textFile;
 s:string;
begin
CoInitialize(nil);
while not Terminated do begin
   s:=GetURL;
   if IfExists(param+"@"+s)=false then  // if record doesn"t exist then append it to the file
   begin
     assignFile(f,"toy.txt");
     append(f);
     writeln(f,param+"@"+s);
     CloseFile(F);
   end ;

end;
 CoUnInitialize;
 exit;
end;


Собственно вопрос:
При работе приложения выскакивает следующая ошибка:
Project raised exception class EOleException with message "Unspecified error".

Ругается на строку

if (Winds.Item(i) as IWEbBrowser2).Document<>nil then...
в функции GetUrl

Если поток не останавливать и не перезапускать,то все работает.Но мне необходимо делать перезапуск при выполнении определнного условия.

Подскажите,в чем может быть ошибка.

Всего наилучшего,
Ekate

---

← →
Игорь Шевченко ©   (2007-08-03 11:35) [1]

Попробуй CoInitFlags установить в COINIT_MULTITHREADED в самом начале проекта

---

← →
Ekate ©   (2007-08-03 11:51) [2]

Хм,почему то говорит

Undeclared identifier: "COINIT_MULTITHREADED"

---

← →
Игорь Шевченко ©   (2007-08-03 11:53) [3]

> Undeclared identifier: "COINIT_MULTITHREADED"


uses ActiveX;

---

← →
Ekate ©   (2007-08-03 11:58) [4]

Нет, это не решило проблему. Более того, теперь вообще потоки не запускают IE  и не хотят с ним работать

---

← →
Сергей М. ©   (2007-08-03 12:02) [5]

> теперь вообще потоки не запускают IE


А где твои потоки запускали IE до этого ?

Что-то не вижу никаких запусков ..

---

← →
Ekate ©   (2007-08-03 12:06) [6]

Запуск IE идет в потоке_1 до вызова потока_2.
Участок  кода  потока_1 следующий


//поток выполняется себе, но как только удовлетворяет условию, то
  if checking(sSnr) = false then
     begin
       ShellExecute(Handle,"open",Pchar("http://localhost/static/userlogin.php?param1="+sSnr),nil,nil, SW_SHOWNORMAL);
   
        //if process is runnig then terminate it
        if (br<>nil) then
        begin
           br.Terminate;
           br.WaitFor;
           br := nil;
        end;

        //and run it again with certain parameters
        br:=TBr.Create(sSnr,true);
        br.Resume;
        br.Priority:=tpnormal;
       
     end;


---

← →
Сергей М. ©   (2007-08-03 12:16) [7]

Хм ..

Мне совершенно непонятна логика ф-ции GetURL.

Ф-ция всегда возвращает URL документа самого последнего (в списке интерфейса Winds) найденного экз-ра IE.

А остальные экз-ры что, не интересуют ?

---

← →
Ekate ©   (2007-08-03 12:21) [8]

Спасибо за участие,

Сергей,
Не интересуют, мне необходимо знать только URL активной в данный момент странички

---

← →
Сергей М. ©   (2007-08-03 12:25) [9]

> активной в данный момент странички


И где происходит проверка на активность ?

---

← →
Ekate ©   (2007-08-03 12:49) [10]

ну как видите проверки на активность нет,пока необходимо заставить работать хотя бы так,красоту позже наведу.

---

← →
Сергей М. ©   (2007-08-03 13:00) [11]

Это

http://www.rusdoc.ru/articles/9308/

читала ?

---

← →
Ekate ©   (2007-08-03 13:07) [12]

ну,конечно, читала. В коде так и делается, подключаемся к запущенному браузеру.

---

← →
Сергей М. ©   (2007-08-03 13:21) [13]

> Project raised exception class EOleException with message
> "Unspecified error".


Чему при этом равна i ?

Чему равно OleException.ErrorCode ?

---

← →
Ekate ©   (2007-08-03 13:29) [14]

Странно, первый раз все работает ок,т.е. браузер запускает и т.д., но при ошибке i=0


> Чему равно OleException.ErrorCode ?


а как я могу получить код ошибки? он его не выдает.

---

← →
Сергей М. ©   (2007-08-03 13:51) [15]

> Ekate ©   (03.08.07 13:29) [14]


Предвар. диагноз : стартованный тобой в потоке_1 процесс IE не успевает зарегистрировать себя как активный объект автоматизации на момент твоей попытки обращения к оному из потока_2.

Лечение: вместо ShellExecute использовать CreateProcess + WaitForInputIdle.


> как я могу получить код ошибки?


try
.. здесь строка, вызывающая исключение ..
except
 on e: EOleException do
  .. в e.ErrorCode - искомое значение ...
end;

---

← →
Ekate ©   (2007-08-03 16:37) [16]

Спасибо, Сергей .

Код ошибки -2147467259

---

← →
Ekate ©   (2007-08-05 20:50) [17]

Странно,если проигнорировать данную ошибку,то все далее работает правильно.

> Лечение: вместо ShellExecute использовать CreateProcess
> + WaitForInputIdle

Та же проблема

---

← →
MetalFan ©   (2007-08-05 21:48) [18]

можно 5 копеек?
1) Нигде не вижу освобождение ресурсов наследника TThread... ни Free ни FreeOnTerminate.
2) Зачем отдаете Handle в ShellExecute? это же не хэндл окна!
3)
> //if process is runnig then terminate it

не вижу проверки запущенности процесса...

в общем код в большей части бредовый либо не полностью показанный.
выложи тестовое приложение, в котором явно проявляются баги, а то так телепатией заниматься ;)

---

← →
Ekate ©   (2007-08-06 12:39) [19]

> в общем код в большей части бредовый

Подскажите тогда, как правильно...
Вот тестовый пример с подобной структурой потоков как и в основном приложении.
Имеется форма, на ней 2 кнопки (одна стартует поток,другая останавливает), так же метка,в которую выводится текущее значение (в данном случае просто число)
код основного приложения:

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Label1: TLabel;
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
   co:TCountObj;
   br:TBr;
   public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
     co:=TCountObj.Create(true);
     co.Resume;
     co.Priority:=tplower;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

    br.Terminate;
    co.Terminate;
end;

end.


код потока , который запускается с формы

unit MyThread;

interface

uses
 Classes,SysUtils,ShellApi,Windows,Unit2;

type
 TCountObj = class(TThread)

 private
   { Private declarations }
   index:integer;
   br : TBr;
 protected
   procedure Execute; override;
   procedure UpdateLabel;
    procedure Monitoring(s:string);
 end;

implementation
uses
Unit1;

procedure TCountObj.Execute;
begin
 { Place thread code here }
 index:=1;
 br:=nil;
 while index>=0 do
 begin
   Synchronize(Updatelabel);
   Inc(index);
   if index>1000000 then
   index:=0;
   if terminated then
   exit;
 end;
end;

procedure TCountObj.Monitoring (s:string);
begin
        if (br<>nil) then
        begin
           br.Terminate();
           br.WaitFor();
           br.Free;
           br := nil;
        end;
        br:=TBr.Create(s,true);
        br.Resume;
        br.Priority:=tpnormal;
end;

procedure TCountObj.Updatelabel;
begin
 Form1.Label1.Caption:=inttostr(index);
 if index=500000 then
 begin
    ShellExecute(0,"open",Pchar("http://www.mysql.com"),nil,nil, SW_SHOWNORMAL);
    Monitoring(IntToStr(index));
 end;
 if index=1000000 then
 begin
    ShellExecute(0,"open",Pchar("http://www.google.com"),nil,nil, SW_SHOWNORMAL);
    Monitoring(IntToStr(index));
 end;
end;
end.


Код процесса мониторинга

unit Unit2;

interface

uses
 SysUtils,Classes,Controls,shdocvw,Messages,Windows,StdCtrls,ActiveX,ComObj,Dialo gs;

type
 TBr = class(TThread)
 private
 tag_sn:string;
   { Private declarations }
 public
 constructor create(tag_s_n:string;createsuspended:boolean);
 protected

  IE:TInternetExplorer;
   procedure Execute; override;

 end;

implementation

uses MSHTML_TLB;

{ TBr }

constructor TBr.create(tag_s_n: string; createsuspended: boolean);
begin
 inherited create(true);
 tag_sn := tag_s_n;
 if not createsuspended then
 resume
end;

//checking if this record already exists in the toy file

function IfExists(s:string):boolean;
var
 z:textFile;
 i:integer;
 r:string;
begin
 i:=1;
  AssignFile(z,"toy.txt");
  Reset(z);
  while not eof(z) do
  begin
   Readln(z,r);
   if (CompareStr(r,s)=0) then i:=i*0 else i:=i*1;
  end;
  CloseFile(z);
  if i=1 then result:=false else result:=true;

end;

//getting the url from the web page in the Internet Explorer

function GetUrl:string;
var Winds: IShellWindows;
   IEWB: IWebBrowser2;
   i: integer;
   Doc: IHtmlDocument2;
begin
 Winds:=CoShellWindows.Create;
 for i:=0 to Winds.Count-1 do

 try

 if (Winds.Item(i) as IWEbBrowser2).Document<>nil then
 begin
   IEWB:=Winds.Item(i) as IWEbBrowser2;
   if IEWB.Document.QueryInterface(IhtmlDocument2, Doc)= S_OK
   then Result:=Doc.url;
 end;

 except
on e: EOleException do
   showmessage(intToStr(e.ErrorCode));
end;
end;

procedure TBr.Execute;
var
 f:textFile;
 s:string;
begin
CoInitialize(nil);
while not Terminated do begin
    s:=GetURL;
    if IfExists(tag_sn+"@"+s)=false then  // if record doesn"t exist then append it to the file
    begin
     assignFile(f,"toy.txt");
     append(f);
     writeln(f,tag_sn+"@"+s);
     CloseFile(F);
    end ;
end;
CoUnInitialize;
exit;
end;
end.


MetalFan, рассчитываю на Вашу помощь

---

← →
Ekate ©   (2007-08-07 09:36) [20]

Ребята, ну подскажите,очень нужна ваша помощь.Я уверена,что для выс это пустяковый вопрос.

---

← →
Сергей М. ©   (2007-08-07 10:26) [21]

> Ekate ©   (07.08.07 09:36) [20]


Приводи код с учетом CreateProcess + WaitForInputIdle

---

← →
Ekate ©   (2007-08-07 10:46) [22]

ok,изменится только модуль MyThread


unit MyThread;

interface

uses
 Classes,SysUtils,ShellApi,Windows,Unit2;

type
 TCountObj = class(TThread)

 private
   { Private declarations }
   index:integer;
   br : TBr;
 protected
   procedure Execute; override;
   procedure UpdateLabel;
    procedure Monitoring(s:string);
 end;

implementation
uses
Unit1;

procedure TCountObj.Execute;
begin
 { Place thread code here }
 index:=1;
 br:=nil;
 while index>=0 do
 begin
   Synchronize(Updatelabel);
   Inc(index);
   if index>1000000 then
   index:=0;
   if terminated then
   exit;
 end;
end;

procedure TCountObj.Monitoring (s:string);
begin
        if (br<>nil) then
        begin
           br.Terminate();
           br.WaitFor();
           br.Free;
           br := nil;
        end;
        br:=TBr.Create(s,true);
        br.Resume;
        br.Priority:=tpnormal;
end;

procedure TCountObj.Updatelabel;
var
 si:TStartupInfo;
 pi:TProcessInformation;
 cmdline:string;

begin
 Form1.Label1.Caption:=inttostr(index);

 if index=10 then cmdline:="c:\program files\internet explorer\iexplore.exe www.google.com";
 if index=20 then cmdline:="c:\program files\internet explorer\iexplore.exe www.mysql.com";

   ZeroMemory(@si,sizeof(si));
   si.cb:=SizeOf(si);
   if not CreateProcess( nil,PChar(cmdline),nil,nil,False,0,nil,nil,si,pi)
   then Exit
   else  WaitForInputIdle(pi.hProcess, INFINITE);
   Monitoring(IntToStr(index));

end;
end.


Ситуация точно такая же как и с ShellExecute...
Но в данном тестовом приложении выкидывает ошибку Access violation at address 0045D958 in module.Read of address 00000000.

---

← →
Сергей М. ©   (2007-08-07 10:55) [23]

> в данном тестовом приложении выкидывает ошибку


Что говорит отладчик по этому поводу ?

---

← →
Ekate ©   (2007-08-07 11:06) [24]

На той же строчке вываливает, i=0
Т.е. получается на новом окне браузера

---

← →
Сергей М. ©   (2007-08-07 11:13) [25]

А что тебе мешает работать с IE как с объектом автоматизации ?

---

← →
Ekate ©   (2007-08-07 11:22) [26]

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

> А что тебе мешает работать с IE как с объектом автоматизации
> ?

Я пыталась, но в потоке это работает некорректно

---

← →
Сергей М. ©   (2007-08-07 11:29) [27]

> Ekate ©   (07.08.07 11:22) [26]



> пыталась, но в потоке это работает некорректно


Показывай как пыталась ..

Еще раз повторяю - нельзя полагаться на корректную работу при выбраннром тобой подходе (старт процесса и тут же попытка обратиться к нему как к объекту автоматизации). В ряде случаев WaitForInputIdle может и прокатить, но очевидно не в случае с процессом IE.

---

← →
Сергей М. ©   (2007-08-07 12:23) [28]

Вот простейший пример для осн.потока:

procedure TfrmMain.Button2Click(Sender: TObject);
var
 ie: TInternetExplorer;
begin
 ie := TInternetExplorer.Create(nil);
 try
   ie.Visible := True;
   ie.Navigate("http://delphimaster.net/view/1-1186126337/");
   while ie.Busy do
     Application.ProcessMessages;
   try
     ShowMessage((ie.Document as IhtmlDocument2).URL);
   except
     on e: EOleException do
     ShowMessage(e.ClassName + " " + e.Message + " " + IntToHex(e.ErrorCode, 8));
   end;
 finally
   ie.Free;
 end;
end;

Выделенное жирным - ключевой момент в коде, без этого ты практически стопроцентно получишь ту самую свою ошибку.

Ну а адаптировать код к работе в доп. потоке - плевое дело)

---

← →
Lacmus ©   (2007-08-07 12:37) [29]

>Ekate ©

Попробуйте отладить GetURL не в потоках, например проверять Winds.Item(i) на nil, пропускать те Winds.Item(i), для которых обращение к IEWB.Document происходит с ошибкой.

---

← →
Сергей М. ©   (2007-08-07 12:45) [30]

> Lacmus ©   (07.08.07 12:37) [29]


Да все и так понятно - Автор не анализирует св-во Busy, оттого и напоролась на засаду.

Вообще-то об асинхронности навигационных вызовов упоминается и в справке и в MSDN)

---

← →
Сергей М. ©   (2007-08-07 12:52) [31]

> мне нравится...обращаюсь за помощью, а в результате или
> пустые понты или попросту бесконечные вопросы


Ей, видишь ли, нравится фраза "пустые понты")

А справку она, видишь ли, читать не желает - не царское ж дело)

---

← →
Ekate ©   (2007-08-07 13:18) [32]

> Ей, видишь ли, нравится фраза "пустые понты")

Данная фраза относилась (может и незаслуженно) к MetalFun, поскольку человек  очень категорично отреагировал (может и по поводу, конечно), но после его нелестных высказываний ничего не последовало...


> А справку она, видишь ли, читать не желает - не царское
> ж дело)

Тут я не согласна.

И вообще,Сергей, спасибо Вам за терпение и отзывчивость.

---

← →
Anatoly Podgoretsky ©   (2007-08-07 13:20) [33]

> Ekate  (07.08.2007 10:46:22)  [22]

> Но в данном тестовом приложении выкидывает ошибку Access violation at address 0045D958 in module.Read of address 00000000.

Ну эта ошибка одназначная, какой то объект не создан, значение nil
Надо отладчиком найти.

---

← →
Сергей М. ©   (2007-08-07 13:25) [34]

> Ekate ©   (07.08.07 13:18) [32]


Самое главное чтобы ты поняла [30] - остальное неважно)

---

← →
MetalFan ©   (2007-08-07 17:00) [35]

> Данная фраза относилась (может и незаслуженно) к MetalFun,
>  поскольку человек  очень категорично отреагировал (может
> и по поводу, конечно), но после его нелестных высказываний
> ничего не последовало...

сорри конечно, а я что льстить должен???
я указал бросившиеся в глаза ошибки...
а отлаживать приведенный код...
разве что сделаешь и выложишь тестовый проект)

---

← →
Ekate ©   (2007-08-08 09:36) [36]

> сорри конечно, а я что льстить должен???

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


> Сергей М. ©

Спасибо большое,разобралась, код "починила". Теперь работает.
В основном потоке создаю объект IE и перехожу на нужную страничку, а когда Busy становится false подключаюсь к браузеру и запускаю дочерний поток.Функцию GetUrl пришлось изменить.
Выглядит она следующим образом:

function GetUrl:string;
var
 wh,al:hwnd;
 Buffer : array[0..255] of Char;
begin
  try
 wh:=findwindow("ieframe", nil);
 if wh>0 then
 begin
   al := FindWindowEx(wh, 0, "WorkerW", nil);
   if al>0 then
   begin
     al := FindWindowEx(al, 0, "ReBarWindow32", nil);
     if al > 0 then
     begin
       al := FindWindowEx(al, 0,"Address Band Root", nil);
       if al > 0 then
       begin
         al:=FindWindowEx(al,0,"ComboBoxEx32", nil);
         if al>0 then
         begin
         SendMessage(al, WM_GETTEXT, 255, integer(@Buffer));
         result:=Buffer;
       end; end;
     end;
   end;
 end;
 except
on e: EOleException do
   showmessage(intToStr(e.ErrorCode));
end;
end;


Еще разспасибо всем,принимавшим участие в обсуждении.
Всего наилучшего,
Ekate

---

← →
Сергей М. ©   (2007-08-08 09:48) [37]

> Ekate ©   (08.08.07 09:36) [36]


Не понял ..

К чему эти извраты с поиском окна адресной строки, когда все тоже самое с успехом и изящно делается обращением к св-ву IHTMLDocument2.URL ?

Можно даже еще проще сделать - перед вызовом метода Navigate установить обработчик события OnDocumentComplete, тогда браузер сообщит о завершении загрузки документа вызовом этого обработчика, передав последним параметром готовую строку с URL этого документа.

---

← →
MetalFan ©   (2007-08-08 09:49) [38]

> подключаюсь к браузеру и запускаю дочерний поток.Функцию
> GetUrl пришлось изменить.

1) зачем, в случае использования последней версии GetUrl [36] подключаться к браузеру?
2) Зачем такую "легкую" функцию (GetUrl [36]) выносить в отдельный поток? ))

---

← →
Ekate ©   (2007-08-08 09:58) [39]

> 1) зачем, в случае использования последней версии GetUrl
> [36] подключаться к браузеру?
> 2) Зачем такую "легкую" функцию (GetUrl [36]) выносить в
> отдельный поток? ))



> К чему эти извраты с поиском окна адресной строки

Потому что подключение к уже запущенному браузеру ведется из другого потока.Я этим потоком сканирую посещенные страницы и выполняю ряд действий.

---

← →
Сергей М. ©   (2007-08-08 10:02) [40]

Я тоже так и не понял, к чему здесь доп.потоки.

Navgiate работает асинхронно. Можно прямо в основном потоке запустить нужное кол-во браузеров, передав им для загрузки нужные URL и установив единый обработчик OnDocumentComplete для всех экз-ров IE. Тогда браузеры последовательно отрапортуют о результатах загрузки вызовами этого обработчика. Можно сделать тоже самое и в одном-единственном доп.потоке, но зачем плодить другие "подключающиеся" доп.потоки - вот это совершенно непонятно.

---

Страницы: 1 2 вся ветка

Скачать: CL | DM;



Память: 0.58 MB
Время: 0.014 c