VPF::поток - Форум программистов

Ekate

Дата 28.7.2007, 09:07 (ссылка)

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

Загрузка ...

Шустрый

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

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

Добрый день,уважаемые эксперты

Стоит задача потоком отслеживать активные странички в браузере и записывать их в файл,если таковой там еще нет.
Не подскажите?

Основное приложение

Код


unit Unit1;

interface

uses
  ...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');
     if IfExists(s)=false 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.

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

MetalFan

Дата 28.7.2007, 17:43 (ссылка)

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

Загрузка ...

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

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

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

мм.. а в чом собственно вопрос то? код не работает или где?

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

There are always someone smarter than you...

Ekate

Дата 28.7.2007, 21:24 (ссылка)

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

Загрузка ...

Шустрый

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

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

Да, не работает,не знаю где может быть ошибка

_hunter

Дата 30.7.2007, 11:21 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

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

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

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

Tempora mutantur, et nos mutamur in illis...

Ekate

Дата 30.7.2007, 21:04 (ссылка)

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

Загрузка ...

Шустрый

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

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

Все сначала и было реализовано без потока,все работант отлично.
Тут вот подсказали,что т.к. это DDE , то необходма петля сообщений...тут меня и застопорило, подскажите, пожалуйста... smile

Domoffou

Дата 7.7.2008, 23:40 (ссылка)

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

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 60
Регистрация: 22.6.2008
Где: Северная Венеция

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

up!
Вот полный код программы, думаю, что проблема также.
Тоже пытаюсь получить список сайтов, но посредством TimeSetEvent,
который, как я подозреваю, работает тоже в потоках:

Код


// определяем URL
function GetMyURL(Servicio: string): String;
var
Cliente_DDE: TDDEClientConv;
temp:PChar; //<<-------------------------This is new
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;

procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD); pascal;
 begin
  Form1.Caption := GetMyURL('firefox');
 end;

// запускаем таймер
procedure TForm1.Button1Click(Sender: TObject);
var
  url: string;
begin
mmResult := TimeSetEvent(2000, 0, @TimeCallBack, 0, TIME_PERIODIC);
end;

// останавливаем таймер
procedure TForm1.Button2Click(Sender: TObject);
begin
TimeKillEvent(mmResult);
end;

// запускаем процедуру без потоков и таймеров
procedure TForm1.Button3Click(Sender: TObject);
begin
Form1.Caption := GetMyURL('Firefox');
end;

Как видите, все работает без таймера, и, соответственно, с таймером не работает :(
Если кто-то подскажет, буду благодарен!

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