потоки

← →
Ekate © (2007-07-27 11:55) [0]

Здравствуйте,уважаемые эксперты.
Пытаюсь создать простенький поток,но не получается.
Поток читает адресную строку открытого браузера и если таковой в текстовом файле нет, то помещает ее в текстовый файл.
Ниже исходный код,Unit1 - основное приложение,Unit2-поток

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private

co:TBr;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

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

procedure TForm1.Button2Click(Sender: TObject);
begin
co.Terminate;
end;

end.

unit Unit2;

interface

uses
SysUtils,Classes,Controls,StdCtrls,ddeman;

type
TBr = class(TThread)
private
{ Private declarations }
protected
tr:string;
procedure Execute; override;
procedure Up;

end;

implementation

uses Unit1;

{ TBr }

function Get_URL(Servicio: string): String;
var
Cliente_DDE: TDDEClientConv;
temp:PChar;
begin
Result := "";
Cliente_DDE:= TDDEClientConv.Create( nil );
with Cliente_DDE do
begin
SetLink( Servicio,"WWW_GetWindowInfo");
temp := RequestData("0xFFFFFFFF");
Result := StrPas(temp);
StrDispose(temp);
CloseLink;
end;
Cliente_DDE.Free;
end;

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

end;

procedure TBr.Execute;
var
F:textFile;
s:string;
a:boolean;
begin
while not Terminated do begin
s:=Get_URL("firefox");
tr:=s;
a:=IfExists(s);
if a<>true then
begin
assignFile(F,"toy.txt");
append(f);
writeln(f,s);
tr:=s;
Synchronize(Up);
end ;

end;
CloseFile(F);
exit;

end;

procedure TBr.Up;
begin
Form1.Label1.Caption := tr;
end;

end.

← →
Dib@zol © (2007-07-27 11:57) [1]

> procedure TBr.Up;
> begin
> Form1.Label1.Caption := tr;
> end;

Метод Synchronize?

← →
Однокамушкин (2007-07-27 11:59) [2]

DDE работает через оконные сообщения, так что в нити, в которой нет петли сообщений, никакое DDE работать не будет... Читайте справку по GetMessage и DispatchMessage

← →
Ekate © (2007-07-29 10:57) [3]

Не подскажите, как их применить здесь? Я не совсем понимаю

Спасибо

← →
Leonid Troyanovsky © (2007-07-29 11:26) [4]

> Ekate © (29.07.07 10:57) [3]

> Не подскажите, как их применить здесь? Я не совсем понимаю

Вторичный поток с окном:
http://www.rsdn.ru/Forum/Message.aspx?mid=883505&only=1

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

--
Regards, LVT.

← →
Ekate © (2007-07-31 00:50) [5]

Спасибо,Леонид...
Но если честно я в тупике...ничего так и не выходит. Видимо я просто не могу понять основного принцыпа...Обидно,какой день бьюсь и все без толку.

← →
Однокамушкин (2007-07-31 08:50) [6]

Есть у меня большие подозрения, что DDE в неглавной нити может вообще не заработать, всё-таки устаревшая технология... А ваш этот firefox случайно COM не поддерживает? Это решило бы все проблемы...

Спасибо за помощь, но не могли бы Вы привести реализацию подобного потока хотя бы для Internet Explorer ? Мне кажется, что я неправильно применяю сообщения :(

Заранее спасибо

Для IE я написала (без применения сообщений), но для FireFox вопрос открыт.

код потока

unit Unit2; interface uses SysUtils,Classes,Controls,shdocvw,Messages,Windows,StdCtrls,ActiveX; type TBr = class(TThread) private { Private declarations } protected tr:string; IE:TInternetExplorer; procedure Execute; override; end; implementation uses Unit1,MSHTML_TLB; { TBr } 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; 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(s)=false then begin assignFile(f,"toy.txt"); append(f); writeln(f,s); CloseFile(F); end ; end; exit; end; end.

Спасибо

потоки Найти похожие ветки