Форум программистов [Powered by Invision Power Board]

Код


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.

Код


// определяем 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;