Autor Beitrag
UserMP
Hält's aus hier
Beiträge: 14

Windows 2000
D7
BeitragVerfasst: Mo 25.04.05 13:46 
Hallo

hab folgendes Problem
die seite wird nie aufgerufen bzw das Ereignis das die seite fertiggeladen
ist wird nie ausgeführt

webbrowser ist zur laufzeit erzeugt worden in:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
unit webcomponent;

interface
  uses  deklarations,SySUtils,ShDocVw,ExtCtrls,MSHTML;

  type Tbrowser = class


    private
    { Private-Deklarationen }
      webbrowser:TWebBrowser;
      uhr:TTimer;
      webbrowser_stop:boolean;
      //uhrereignis für reload falls seite nicht aufgebaut bis ablauf
      procedure uhrTimer(Sender: TObject);
      //falls keine verbindung zum netz besteht
      function connected():boolean;
      procedure webbrowserdocumentcomplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);

    public
    { Public-Deklarationen }
      //initiation
      constructor create(ver,zeit:integer);
      procedure setmaxreloadversuche(i:integer);
      procedure setreloadtime(i:integer);
      //laden
      procedure loadsite(site1:widestring);
      function geladen():boolean;
      //status
      function hasconnection():boolean;
      //finden
     

  end;

implementation
var maxreloadversuche,loadversuch:integer;

    quellcode:ansistring;
    uquellcode:ansistring;
    geloadet:Boolean;
    site:widestring;
    flags:OleVariant;
    connectionerror:boolean;
    geladene_frames:integer;
constructor Tbrowser.create(ver,zeit:integer);
begin
  uhr:=TTimer.Create(nil);
  uhr.enabled:=false;
  uhr.Interval:=zeit;
  uhr.OnTimer:=uhrTimer;
  webbrowser:=TWebbrowser.Create(nil);
  //busy
  webbrowser.OnDocumentComplete:=webbrowserdocumentcomplete;
  maxreloadversuche:=ver;
  connectionerror:=false;
  geloadet:=true;
  quellcode:='';
  site:='';
  flags:=14;
end;
procedure Tbrowser.setmaxreloadversuche(i:integer);
begin
 maxreloadversuche:=i;
end;
procedure Tbrowser.setreloadtime(i:integer);
begin
  uhr.Interval:=i;
end;
function Tbrowser.connected():boolean;
begin
  connectionerror:=findtext(getframe(0),'Die Seite kann nicht angezeigt werden.');
  connected:=not connectionerror;
end;
procedure Tbrowser.loadsite(site1:widestring);
begin
  geloadet:=false;
  geladene_frames:=0;
  loadversuch:=1;
  site:=site1;
  uhr.enabled:=true;
  webbrowser.navigate(site1,flags);
end;
procedure Tbrowser.uhrTimer(Sender: TObject);
begin
  webbrowser_stop:=true;
  uhr.enabled:=false;
  webbrowser.stop();

  if(maxreloadversuche<=loadversuch)then
   begin
    connectionerror:=true;
    exit;
   end
  else
    begin
      loadversuch:=loadversuch+1;
      uhr.enabled:=true;
      webbrowser.navigate(site,flags);
    end;
end;
function Tbrowser.geladen():boolean;
begin
 geladen:=geloadet;
end
procedure Tbrowser.webbrowserdocumentcomplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
var b:boolean;
begin
  geloadet:=true;
end;

das main:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
   
    procedure Button1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
   
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  browser:Tbrowser;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 browser:=Tbrowser.create(5,25000);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  browser.loadsite('D:/seite/index.html');//seite existiert auch
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if browser.geladen=true then label1.caption:='true'
   else label1.caption:='false';
end;
end.


ich hoff mir kann noch gehofen werden :roll:
kann man den Twebbrowser überhaupt so nutzen
weil ja keine oberfläche da ist?

MfG
UserMP

Moderiert von user profile iconGausi: Code- durch Delphi-Tags ersetzt.
toms
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1099
Erhaltene Danke: 2



BeitragVerfasst: Mo 25.04.05 15:09 
Zitat:

Poste mal ein Demo Projekt. So kann man das doch nicht testen!


Meinte Damit eher ein Demo Projekt mit allen Dateien (dpr, pas usw)
Gibt ja nun die tolle Moeglichkeit, Anhaenge anzuhaengen.


Zuletzt bearbeitet von toms am Mo 25.04.05 16:00, insgesamt 1-mal bearbeitet
UserMP Threadstarter
Hält's aus hier
Beiträge: 14

Windows 2000
D7
BeitragVerfasst: Mo 25.04.05 15:49 
user profile icontoms hat folgendes geschrieben:
Hi!

Poste mal ein Demo Projekt. So kann man das doch nicht testen!


hi das war schon die abgespeckte version
ich kann noch mal die ganze ganze webcomponent posten:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
unit webcomponent;

interface
  uses  deklarations,SySUtils,ShDocVw,ExtCtrls,MSHTML;

  type Tbrowser = class


    private
    { Private-Deklarationen }
      webbrowser:TWebBrowser;
      uhr:TTimer;
      webbrowser_stop:boolean;
      //uhrereignis für reload falls seite nicht aufgebaut bis ablauf
      procedure uhrTimer(Sender: TObject);
      //falls keine verbindung zum netz besteht
      function connected():boolean;
      procedure webbrowserdocumentcomplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);

    public
    { Public-Deklarationen }
      //initiation
      constructor create(ver,zeit:integer);
      procedure setmaxreloadversuche(i:integer);
      procedure setreloadtime(i:integer);
      //laden
      procedure loadsite(site1:widestring);
      function geladen():boolean;
      //status
      function hasconnection():boolean;
      //finden
     

      function findform(i:integer):boolean;
      function findtext(str:string;doc:OleVariant):boolean;
      function getlinkurl(str:string;den:integer;doc:OleVariant):widestring;
      function getselectbox(form:OleVariant;str:string):astring;
      function geturl():widestring;
      function getinnerHTML(doc:OleVariant):widestring;
      function getinnertext(doc:OleVariant):widestring;
      //setzen
      function setinput(form:OleVariant;name:string;Value:string):boolean;
    //function setradiobutton(form:integer;name:string;Value:string)
    //function setcheckbox(form:integer;name:string:checked:boolean):boolean;
      function setselectbox(form:OleVariant;name:string;index:integer):boolean;
    //function setmemofeld(form:integer;name:string;text:widestring):boolean;
      //sende funktionen
      function sendform(form:OleVariant):boolean;
      procedure clicklink(str:widestring;isaurl:boolean;doc:OleVariant);
      procedure clickbutton(form:OleVariant;str:string;isaname:boolean);
      //procedure clickimage(str:string;isaurl:boolean);
      //frames und forms
      function getanzahlFrames:integer;
      function getanzahlForms(frame:OleVariant):integer;
      function getFrame(frame:integer):OleVariant;
      function getForm(frame:OleVariant;form:integer):OleVariant;


  end;

implementation
var maxreloadversuche,loadversuch:integer;

    quellcode:ansistring;
    uquellcode:ansistring;
    geloadet:Boolean;
    site:widestring;
    flags:OleVariant;
    connectionerror:boolean;
    geladene_frames:integer;
constructor Tbrowser.create(ver,zeit:integer);
begin
  uhr:=TTimer.Create(nil);
  uhr.enabled:=false;
  uhr.Interval:=zeit;
  uhr.OnTimer:=uhrTimer;
  webbrowser:=TWebbrowser.Create(nil);
  //busy
  webbrowser.OnDocumentComplete:=webbrowserdocumentcomplete;
  maxreloadversuche:=ver;
  connectionerror:=false;
  geloadet:=true;
  quellcode:='';
  site:='';
  flags:=14;
end;
procedure Tbrowser.setmaxreloadversuche(i:integer);
begin
 maxreloadversuche:=i;
end;
procedure Tbrowser.setreloadtime(i:integer);
begin
  uhr.Interval:=i;
end;
function Tbrowser.connected():boolean;
begin
  connectionerror:=findtext(getframe(0),'Die Seite kann nicht angezeigt werden.');
  connected:=not connectionerror;
end;
procedure Tbrowser.loadsite(site1:widestring);
begin
  geloadet:=false;
  geladene_frames:=0;
  loadversuch:=1;
  site:=site1;
  uhr.enabled:=true;
  webbrowser.navigate(site1,flags);
end;
procedure Tbrowser.uhrTimer(Sender: TObject);
begin
  webbrowser_stop:=true;
  uhr.enabled:=false;
  webbrowser.stop();

  if(maxreloadversuche<=loadversuch)then
   begin
    connectionerror:=true;
    exit;
   end
  else
    begin
      loadversuch:=loadversuch+1;
      uhr.enabled:=true;
      webbrowser.navigate(site,flags);
    end;
end;
function Tbrowser.geladen():boolean;
begin
 geladen:=geloadet;
end;
function Tbrowser.findform(i:integer):Boolean;
begin
end;
function Tbrowser.setinput(form:OleVariant;name:string;Value:string):boolean;
//von text and password
var ovElements:OleVariant;
    i:integer;
begin
   for i:=0 to(form.length-1)do
    if (uppercase(form.item(i).tagName)='INPUT')
        and(uppercase(form.item(i).name)=uppercase(name))
        and( (uppercase(form.item(i).type)='TEXT')
              or(uppercase(form.item(i).type)='PASSWORD'))then
              begin
                form.item(i).Value:=Value;
                break;
              end;
end;
function Tbrowser.setselectbox(form:OleVariant;name:string;index:integer):boolean;
var ovElements:OleVariant;
    i:integer;
begin
   for i:=0 to(form.length-1)do
    if (uppercase(form.item(i).tagName)='SELECT')
        and(uppercase(form.item(i).name)=uppercase(name))then
        begin
          form.item(i).selectedIndex:=Index;
          break;
        end;
end;
function Tbrowser.getselectbox(form:OleVariant;str:string):astring;
var
    i,z:integer;
    txt:widestring;
    astr:astring;
begin
   for i:=0 to(form.length-1)do
    if (uppercase(form.item(i).tagName)='SELECT')
        and(uppercase(form.item(i).name)=uppercase(str))then
        begin
          txt:=form.item(i).innerHTML;
          z:=-1;
          while length(txt)>0 do
            begin
              z:=z+1;
              delete(txt,1,ansipos('>',txt));
              setlength(astr,z+1);
              astr[z]:=copy(txt,0,ansipos('<',txt)-1);
              delete(txt,1,ansipos('>',txt));
            end;
          getselectbox:=astr;  
          break;
        end;
end;
function Tbrowser.sendform(form:oleVariant):boolean;
begin
 form.submit;
end;
function Tbrowser.findtext(str:string;doc:OleVariant):boolean;
begin
  if ansipos(str,doc.documentelement.innerHTML)<>0 then findtext:=true
  else findtext:=false;
end;
function Tbrowser.getlinkurl(str:string;den:integer;doc:OleVariant):widestring;
var txt:string;
  i,z:integer;
  gefunden:integer;
begin
  getlinkurl:='false';
  gefunden:=0;
  for i := 0 to doc.Length - 1 do
      if (uppercase(doc.item(i).tagName)='A'then
       begin
         txt:=doc.Item(i).innerHTML;
         z:=1;
         while txt[z]='<' do
          begin
           while txt[z]<>'>'do z:=z+1;
           txt:=copy(txt,z+1,length(txt)-z);
          end;
         if pos('<',txt)>0 then delete(txt,pos('<',txt),length(txt));
         if(str=txt)then
            begin
              gefunden:=gefunden+1;
              getlinkurl:=doc.Item(i);
              if den=gefunden then exit;
            end;
       end;
end;
procedure Tbrowser.clicklink(str:widestring;isaurl:boolean;doc:OleVariant);
var txt:string;
    i,z:integer;
begin
    for i := 0 to doc.Length - 1 do
      if (uppercase(doc.item(i).tagName)='A'then
        begin
          if(isaurl=true)
          and(uppercase(doc.item(i))=str)then
            begin
              doc.item(i).click;
              exit;
            end
          else
            begin
              txt:=doc.Item(i).innerHTML;
              z:=1;
              while txt[z]='<' do
                begin
                  while txt[z]<>'>'do z:=z+1;
                  txt:=copy(txt,z+1,length(txt)-z);
                end;
              if pos('<',txt)>0 then delete(txt,pos('<',txt),length(txt));
              if(str=txt)then
                begin
                  doc.Item(i).click;
                  exit;
                end;
            end;
        end;
end;
function Tbrowser.getinnerHTML(doc:OleVariant):widestring;
begin
  getinnerHTML:=doc.documentelement.innerHTML;
end;
function Tbrowser.getinnerText(doc:OleVariant):widestring;
begin
  getinnerText:=doc.documentelement.innerText;
end;
function Tbrowser.getUrl():widestring;
begin
 getUrl:=webbrowser.LocationURL;
end;
procedure Tbrowser.clickbutton(form:OleVariant;str:string;isaname:boolean);
begin
end;
function Tbrowser.hasconnection():boolean;
begin
  hasconnection:=not connectionerror;
end;
procedure Tbrowser.webbrowserdocumentcomplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
var b:boolean;
begin
  if webbrowser_stop=true then
    begin
      webbrowser_stop:=false;
    end
  else
    begin
      geladene_frames:=geladene_frames+1;
      if geladene_frames=webbrowser.OleObject.Document.Frames.length+1 then
        begin
          uhr.Enabled:=false;
          b:=connected();
          if b=false then
            begin

            end
          else
            begin
              geloadet:=true;
            end;
        end;
    end;
end;
function Tbrowser.getanzahlFrames:integer;
begin
  getanzahlFrames:=webbrowser.OleObject.Document.Frames.length;
end;
function Tbrowser.getanzahlForms(frame:OleVariant):integer;
begin
  getanzahlForms:=frame.Forms.length;
end;
function Tbrowser.getFrame(frame:integer):OleVariant;
begin
  if (frame>0)and(frame<getanzahlFrames+1)then getFrame:=webbrowser.OleObject.Document.Frames.item(frame-1).Document
  else getFrame:=webbrowser.OleObject.Document;
end;
function Tbrowser.getForm(frame:OleVariant;form:integer):OleVariant;
begin
  if (form>0)and(form<frame.forms.length+1)then getForm:=frame.forms.item(form-1).elements
  else getForm:=frame.all;
end;
end.

so jetzt haste noch mehr code
die meisten function/proceduren hab ich schon getestet
mir einfach n form genommen Twebbrowser drauf
und gehen

ich hab ja das problem, das das Ereignis 'webdocumentComplete' nicht ausgelöst wir
ich den das das daran liegt das die komponente(TWebBrowser) VCL ist
ich aber sie als CXL benutze :!:

UserMP

Moderiert von user profile iconraziel: Code- durch Delphi-Tags ersetzt.
toms
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1099
Erhaltene Danke: 2



BeitragVerfasst: Mo 02.05.05 07:49 
Zitat:
Meinte Damit eher ein Demo Projekt mit allen Dateien (dpr, pas usw)
Gibt ja nun die tolle Moeglichkeit, Anhaenge anzuhaengen.


Naja, dann hast du wohl kein Interesse, dass dir jemand hilft.
(Ausser du hast es schon selber geloest)