Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Kako da kreiram komponentu sa events?

[es] :: Pascal / Delphi / Kylix :: Kako da kreiram komponentu sa events?

[ Pregleda: 1721 | Odgovora: 6 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

sojic
Dalibor Sojic
Makedonija

Član broj: 7051
Poruke: 796
*.162.225.0

Sajt: right-sock.net


+1 Profil

icon Kako da kreiram komponentu sa events?05.12.2006. u 16:22 - pre 210 meseci
Pratio sam uputstvo http://www.elitesecurity.org/t...iranje-novih-komponenti-Delphi i pokusavam da napravim moju komponentu.

Komponenta treba da se uloguje na sajt, da "isparsuje" html kod, t.e. da nadje odredjeni deo.

evo koda:

Code:

unit Account;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, SHDocVw,
  FastStringFuncs, StdCtrls;

type
  TAccount = class(TPanel)
  private
    { Private declarations }
    Timer: TTimer;
    Browser: TWebBrowser;
    Code: TMemo;

    function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string):boolean;
    function SubmitForm(WebBrowser: TWebBrowser): Boolean;
    function stratpos(FindWhat, FindWhere: string): integer;
    function CutStr(Tekst, StartString, EndString: string):string;
    function FindLineNo(FindWhat: string; FindWhere: TStrings):integer;

    procedure FillLogin();            
    procedure DocComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
    procedure ParseBalance();

  protected
    { Protected declarations } 
  public
    { Public declarations }
    Account       : string;
    Pin           : string;
    Rate          : real;
    CheckAfter    : integer;
    RealBalance   : real;
    Balance       : real;
    Test          : string;

    URL           : String;



    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Navigate(URL: string);
    function GetHTML: String;

  published
    { Published declarations }

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Moi', [TAccount]);
end;



function TAccount.FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
  i, j: Integer;
  FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then Exit;
  for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
  begin
  FormItem := WebBrowser.OleObject.Document.forms.Item(I);
    for j := 0 to FormItem.Length - 1 do
    begin
      if (UpperCase(FormItem.Item(j).Type) = 'TEXT') or (UpperCase(FormItem.Item(j).Type) = 'TEXTAREA') or (UpperCase(FormItem.Item(j).Type) = 'PASSWORD') then
        if (FormItem.Item(j).Name = FieldName) then
        begin
          FormItem.Item(j).Value := Value;
          Result := True;
        end;
    end;
  end;
end;

function TAccount.SubmitForm(WebBrowser: TWebBrowser): Boolean;
var
  i, j: Integer;
  FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then Exit;
  for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
  begin
  FormItem := WebBrowser.OleObject.Document.forms.Item(I);
    for j := 0 to FormItem.Length - 1 do
    begin
      if (UpperCase(FormItem.Item(j).Type) = 'SUBMIT') then
      begin
      FormItem.Item(j).click;
      Result := True;
      end;
    end;
  end;
end;

      
function TAccount.stratpos(FindWhat, FindWhere: string): integer;
var Rezultat: integer;
  i: integer;
begin
  Rezultat := -1;
  for i:=1 to length(FindWhere)-length(FindWhat) do
    if copy(FindWhere, i, length(FindWhat)) = FindWhat then
      Rezultat := i;
  Result:=Rezultat;
end;

function TAccount.CutStr(Tekst, StartString, EndString: string):string;
var
  StartPos, EndPos: integer;
begin
    StartPos:=stratpos(StartString, Tekst)+length(StartString);
    EndPos:=stratpos(EndString, Tekst);
    Result:=copy(Tekst, StartPos, EndPos-StartPos);
end;


function TAccount.FindLineNo(FindWhat: string; FindWhere: TStrings):integer;
var i:integer;
  finded:boolean;
begin
  finded:=false;
  i:=1;
  while (not finded) and (i<=FindWhere.Count) do
  begin
    if stratpos(FindWhat, FindWhere[i])>-1 then
      finded:=true
    else
      i:=i+1;
  end;
  if Finded then
    Result:=i
  else
    Result:=-1;
end;


procedure TAccount.FillLogin();
begin
    FillForm(Browser, 'p_sa', Account);
    FillForm(Browser, 'p_pin', Pin);
    SubmitForm(Browser);
end;

procedure TAccount.DocComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
begin
   Test:=TWebBrowser(Sender).LocationURL;
  if stratpos('login', TWebBrowser(Sender).LocationURL)>0 then
    FillLogin;


  if stratpos('account',TWebBrowser(Sender).LocationURL)>0 then
    ParseBalance;

end;

procedure TAccount.ParseBalance(); 
var
  LineNo: integer;
  Linija, TempBalance: string;
begin
  Code.Text:=Browser.OleObject.document.Body.innerHTML;
  LineNo:=FindLineNo('<P>Account Balance: <B>US$',Code.Lines);

  if LineNo>=0 then
  begin
    Linija:=Code.Lines.Strings[LineNo];

    TempBalance:=CutStr(Linija, '<B>US$', '</B>');
    TempBalance := StringReplace(TempBalance, '.', ',',[rfReplaceAll, rfIgnoreCase]);
    RealBalance:=StrToFloat(TempBalance);
    Balance:=RealBalance*Rate;
  end;

end;

constructor TAccount.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Timer := TTimer.Create(Self);       
  Code:=TMemo.Create(Self);
  Browser:=TWebBrowser.Create(Self);
  Browser.OnDocumentComplete:=DocComplete;
end;

destructor TAccount.Destroy;
begin
  Timer.Free;
  Browser.Free;
  Code.Free;
  inherited;
end;

procedure TAccount.Navigate(URL: string);
begin
  Browser.Navigate(URL);
end;


function TAccount.GetHTML: string;
begin
  Result:=Browser.OleObject.document.Body.innerHTML;

end;


end.


Nesto mi ne radi OnDocumentComplete. Kako da napravim svoje properties i svoje evente?

Recimo, kad "nadje" balance, da ima event OnBalance (recimo).
routing protocols enable routers to route routed protocols!
 
Odgovor na temu

Miloš Baić
Miloš Baić
ERP (Dynamics NAV) programer
Beograd

Član broj: 72468
Poruke: 1155
*.dialup.neobee.net.



Profil

icon Re: Kako da kreiram komponentu sa events?05.12.2006. u 20:05 - pre 210 meseci
Pozdrav,

pročitaj ponovo taj tutorijal za kreiranje novih komponenti, koliko se sećam Srki_82 je to lepo opisao. Property -je i events -e deklarišeš prvo u odeljku published, potom ih ispisuješ.
Someone's sitting in the shade today because someone planted a tree a long time ago.
 
Odgovor na temu

sojic
Dalibor Sojic
Makedonija

Član broj: 7051
Poruke: 796
62.162.225.*

Sajt: right-sock.net


+1 Profil

icon Re: Kako da kreiram komponentu sa events?06.12.2006. u 20:21 - pre 210 meseci
Kazem da sam procitao, ali nisam rekao da dobjem sledece:

property OnReceive does not exist in base class

Evo deo koda:

Code:

    procedure procOnReceive();
  private
    { Private declarations }

  published
    property onReceive write procOnReceive();

routing protocols enable routers to route routed protocols!
 
Odgovor na temu

_v!rus_
BGD

Član broj: 40451
Poruke: 313
*.dsl.siol.net.



+1 Profil

icon Re: Kako da kreiram komponentu sa events?06.12.2006. u 21:08 - pre 210 meseci
Code:

type
  TOnRecieveEvent = procedure(Sender: TObject...) of object;

type
  TMyClass = class
  private
    FOnRecieve: TOnRecieveEvent;
  ...

  public
    property OnRecieve: TOnRecieveEvent read FOnRecieve write FOnRecieve;

  ...

implementation

  ...

procedure TMyClass.SomeMethod;
begin
  ...
  //Recieve data
  ...
  if Assigned(FOnRecieve) then
    FOnRecieve(Self, ...);
end;
 
Odgovor na temu

sojic
Dalibor Sojic
Makedonija

Član broj: 7051
Poruke: 796
62.162.225.*

Sajt: right-sock.net


+1 Profil

icon Re: Kako da kreiram komponentu sa events?06.12.2006. u 21:22 - pre 210 meseci
E, super (nisam probao jos, ali pretpostavljam da je to).

Sad jos nesto.

Imam:

MainForm (glavni formular), a u njemu:
ComPort (TComport)
Protocol (TProtocol)

TComport je komponenta za komunikaciju preko COM port a prtocol je neki koji koristi COM port komponentu

Protocol pisem ja.

Trenutno imam glupo resenje:

Code:

TProtocol = class
....

uses MainForm;
....

MainForm.ComPort.write....


Kako da napravim sledece:

u mainForm unitu hocu da imam:
Code:

Protocol.comport=mainform.comport;


Pretpostavljam da ovde treba da radim sa pointere!
routing protocols enable routers to route routed protocols!
 
Odgovor na temu

_v!rus_
BGD

Član broj: 40451
Poruke: 313
*.dsl.siol.net.



+1 Profil

icon Re: Kako da kreiram komponentu sa events?06.12.2006. u 21:39 - pre 210 meseci
Ako ti je TProtocol runtime klasa:
Code:

type TProtocol = class
  ...
private
  FComPort: TComPort;
  ...
public
  constructor Create(...AComPort: TComPort);
  ...
implementation
 ...  
constructor TProtocol.Create(...AComPort: TComPort);
begin
  ...
  FComPort := AComPort;
  ...
end;  


Ako ti je TProtocol designtime komponenta:
Code:

type TProtocol = class(TComponent);
  ...
private
  FComPort: TComPort;  
  ...
  procedure SetComPort(AValue: TComPort);
  ...
public
  ...
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  ...
published
  ...
  property ComPort: TComPort read FComPort write SetComPort;  
  ...
implementation
 ...  
procedure TComPort.SetComPort(AValue: TComPort);
begin
  if Assigned(FComPort) then
    FComPort.RemoveFreeNotification(Self);  

  FComPort := AValue;

  if Assigned(FComPort) then
    FComPort.FreeNotification(Self);
end;

procedure TComPort.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (AComponent = FComPort) and (Operation=opRemove) then
    FComPort := nil;
end;



 
Odgovor na temu

sojic
Dalibor Sojic
Makedonija

Član broj: 7051
Poruke: 796
62.162.224.*

Sajt: right-sock.net


+1 Profil

icon Re: Kako da kreiram komponentu sa events?08.12.2006. u 16:05 - pre 210 meseci
Danke bite, to je to. Sve radi.
routing protocols enable routers to route routed protocols!
 
Odgovor na temu

[es] :: Pascal / Delphi / Kylix :: Kako da kreiram komponentu sa events?

[ Pregleda: 1721 | Odgovora: 6 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.