Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2007.10.21;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "Основная";
Текущий архив: 2007.10.21;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.62 MB
Время: 0.041 c
1-1186549318
lecavalie
2007-08-08 09:01
2007.10.21
Подскажите плз. Delphi + Web/wap интерфейс


6-1163414321
anis
2006-11-13 13:38
2007.10.21
Как отобразить ход выполнения закачки IdFTP?


1-1186483022
OlegM
2007-08-07 14:37
2007.10.21
Незакрываються динамически созданные Panel


2-1190800377
O.O
2007-09-26 13:52
2007.10.21
Как удалить файл с атрибутом "только для чтения"


2-1190954902
fend
2007-09-28 08:48
2007.10.21
Длина строковой переменной





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский