Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

работа с потоками


Страницы:   1 2 3

Ekate ©   (2007-08-03 11:32:00) 

Здравствуйте,уважаемые эксперты!
Снова обращаюсь за вашей помощью.
Я вызываю дочерний поток (далее поток_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

Lacmus   (2007-08-07 12:37:00) [21]

>Ekate ©

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

Сергей М.   (2007-08-07 12:23:00) [22]

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

procedure TfrmMain.Button2Click(Sender: TObject);
var
 ie: TInternetExplorer;
begin
 ie := TInternetExplorer.Create(nil);
 try
   ie.Visible := True;
   ie.Navigate(' http://www.delphimaster.ru/cgi-bin/forum.pl?id=1186126337&n=0');
   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;

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

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

Сергей М.   (2007-08-07 11:29:00) [23]


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



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


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

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

Ekate   (2007-08-07 11:22:00) [24]

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

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

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

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

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

Ekate   (2007-08-07 11:06:00) [26]

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

Сергей М.   (2007-08-07 10:55:00) [27]


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


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

Ekate   (2007-08-07 10:46:00) [28]

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:26:00) [29]


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


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

Ekate   (2007-08-07 09:36:00) [30]

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

Ekate   (2007-08-06 12:39:00) [31]


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

Подскажите тогда, как правильно...
Вот тестовый пример с подобной структурой потоков как и в основном приложении.
Имеется форма, на ней 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, рассчитываю на Вашу помощь

MetalFan   (2007-08-05 21:48:00) [32]

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

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

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

Ekate   (2007-08-05 20:50:00) [33]

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

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

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

Ekate   (2007-08-03 16:37:00) [34]

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

Код ошибки -2147467259

Сергей М.   (2007-08-03 13:51:00) [35]


> 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 13:29:00) [36]

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


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


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

Сергей М.   (2007-08-03 13:21:00) [37]


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


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

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

Ekate   (2007-08-03 13:07:00) [38]

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

Сергей М.   (2007-08-03 13:00:00) [39]

Это

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

читала ?

Ekate   (2007-08-03 12:49:00) [40]

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

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо