Eine web-site aufrufen und speichern

[Jens Schumann]

Hallo Marco,<br>wie es sich bei einer automatischen Konfiguration verhält weiß ich nicht. Frag doch mal Euren ProxyAdmin nach dem Port.
Wenn ich versuche die MSN Seite über TWebBrowser zu laden passiert etwas sehr sonderbares. Die Body - Eigenschaft ist NIL. Bei der Entwickler Seite und anderen Seiten klappt es prima.
<br><pre><font size="1" face="Verdana">
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var
HTMLText : TStringList;
vHTML : OleVariant;
Doc2 : IHtmlDocument2;
Body : IHtmlElement;
begin
HTMLText:=TStringList.Create;
Try
Doc2:=WebBrowser1.Document as IHtmlDocument2;
Body:=Doc2.scripts.item('body',EmptyParam) as IHtmlElement;
ShowMessage(Doc2.body.innerHTML); // Bei der MSN Seite ist Body hier nil, bei der Entwickler Seite nicht !!!
Finally
HTMLText.Free;
end;
end;
</font></pre>
Daher vermute ich, das es irgendetwas im HTML Code der MSN Seite gibt, dass die Body Interface auf nil setzt. Aber was, weiß ich noch nicht<br>Jens Schuman

[Jens Schumann]

Hallo,<br>es liegt scheinbar am JavaScript. Wenn ich die Scripts aus der Seite entferne, funktioniert die Sache.<br>Jens Schuman

[Jens Schumann]

Hallo,<br>es ist das OnNavigateComplete2 Event von TWebBowser. Wenn JavaScprit eingesetzt wird, schein es zu früh zu feuern.<br>Jens Schuman

[Jens Schumann]

Hallo,<br>wer zu früh kommt, den bestrafen die Events. Das OnDocumentComplete Event ist genau das richtige.<br>Damit sollte es klappen<br>
<pre><font size="1" face="Verdana">
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, SHDocVw, StdCtrls;

type
TForm1 = class(TForm)
btnNavigateMSN: TButton;
WebBrowser1: TWebBrowser;
btnNavigateEntwickler: TButton;
procedure btnNavigateMSNClick(Sender: TObject);
procedure btnNavigateEntwicklerClick(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
procedure GetInnerHtml;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnNavigateMSNClick(Sender: TObject);
begin
WebBrowser1.Navigate('http://de.moneycentral.msn.com/investor/quotes/quotes.asp?Symbol=DE:871460');
end;

procedure TForm1.btnNavigateEntwicklerClick(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.entwickler.com');
end;

procedure TForm1.GetInnerHtml;
var
HTMLText : TStringList;
begin
HTMLText:=TStringList.Create;
Try
if not VarIsEmpty(WebBrowser1.Document) then;
begin
HTMLText.Text:=OleVariant(WebBrowser1.Document).Sc ript.Document.Body.InnerHTML;
HTMLText.SaveToFile('c:\kurs.html');
end;
Finally
HTMLText.Free;
end;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
GetInnerHtml;
end;

end.
</font></pre>
Jens Schuman

[Marco E.]

Hallo Jens,<br>
<br>
Dein Letzter Beitrag ist der Schlüssel zum Erfolg gewesen.<br>
ES FUNKTIONIERT ! ! !<br>
Vielen Dank für Deinen Einsatz und Deine Mühe.<br>
<br>
Jetzt muß ich nur noch herausfinden, wie ich es schaffe, dass das Programm sich zu bestimmten Zeiten ins Internet einwählt, die Seite Speichert und dann wieder automatisch ofline geht.<br>
Ich muß doch einfach nur die dfü-Verbindung starten....aber wie starte ich diese Application aus dem Programm heraus?<br>
<br>
Viele Grüße,<br>
Marc

[Andreas Kosch]

Hallo,

auf der <i>Borland Community</i>-Webseite lag vor einigen Monaten das folgende Beispiel rum (Beitrag "The freshest bits"), das genau diese Funktion demonstriert. Wenn <b>InternetOpen</b> das automatische Wählen nicht schafft, würde ich hier im FORUM nach der Zeichenkette "InternetConnect" suchen.
<pre>
function GetLatestBuild: Integer;
// Hilfsprozedur
procedure Check(Error: Boolean);
var
errCode: DWORD;
S: string;
begin
if not Error then Exit; errCode := GetLastError;
SetLength(S, 256);
FormatMessage(
FORMAT_MESSAGE_FROM_HMODULE,
Pointer(GetModuleHandle(
'wininet.dll')),errCode, 0,
PChar(S), Length(S), nil);
SetLength(S, StrLen(PChar(S)));
raise Exception.Create(S);
end;
// Ende der Hilfsprozedur
var
hNet, hUrl: HINTERNET;
dwc: DWORD;
sVersion: string;
begin
Result := 0; // initialize WinInet
hNet := InternetOpen('DevNews FreshBits', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
Check(hNet = nil); try
// open the file
hUrl := InternetOpenUrl(hNet,'http://bobs.org/latest/latest.version',nil, 0,
INTERNET_FLAG_PRAGMA_NOCACHE, 0);
Check(hUrl = nil); try
// read and return the
// build number
SetLength(sVersion, 1024);
Check(not InternetReadFile(hUrl, PChar(sVersion), Length(sVersion), dwc));
SetLength(sVersion, dwc);
Result := StrToInt(sVersion);
finally
InternetCloseHandle(hUrl);
end; finally
InternetCloseHandle(hNet);
end;
end;
</pre>
Aufruf:
<pre>
...
var
latestBuild: Integer;
const
thisBuild = 1234;
v1Builds = 1000;
v2Builds = 2000;
begin
latestBuild := GetLatestBuild; // assumes that the next major
// release of FreshBits will
// renumber builds starting at 2000
if latestBuild >= v2Builds then
begin
ShowMessage('Your copy of FreshBits is obsolete!'+ #13#10+'Click OK '+
'to buy the latest version.');
ShellExecute(0, 'open', 'http://bobs.org/latest/','', '', SW_SHOWNORMAL); // all public builds must update
// build number
end else
if latestBuild > thisBuild then
begin
ShowMessage('There is a newer release available.'+#13#10+
'Click OK to get it.');
ShellExecute(0, 'open','http://bobs.org/latest/','', '', SW_SHOWNORMAL); // the user's bits are fresh
end else
ShowMessage('You have the latest release.');
end;
</pre>
Wenn sogar der Download ohne Beteiligung des Internet Explorers erledigt werden soll, bietet sich FTP an:
<pre>
procedure TForm1.Button1Click(Sender: TObject);
var
hSession : HInternet;
hConnect : HInternet;
begin
hSession := InternetOpen('FTPDownload',
INTERNET_OPEN_TYPE_DIRECT,
nil, nil, 0);
if hSession = nil then
begin
Showmessage('hSession = nil !');
end;
hConnect := InternetConnect(hSession,
PChar('ftp.microsoft.com'),
INTERNET_DEFAULT_FTP_PORT,
PChar('anonymous'),
PChar('[email protected]'),
INTERNET_SERVICE_FTP,
INTERNET_FLAG_PASSIVE, 0);
if hConnect = nil then
begin
Showmessage('hConnect = nil !');
end;
if FtpGetFile(hConnect,
PChar('dirmap.txt'),
PChar('C:\Disk_A\dirmap.txt'),
False, INTERNET_FLAG_RELOAD,
FTP_TRANSFER_TYPE_BINARY, 0)
then
begin
Showmessage('Download Complete!');
end
else
begin
Showmessage('Download Failed!');
end;
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;
</pre&gt