How can I get source code from WebBrowser component?
I want to get source code of active page on WebBrowser component and write it to a Memo component.
Thanks.
You can use the IPersistStreamInit Interface and the save method to store the content of the Webbrowser in a Stream.
Uses
ActiveX;
function GetWebBrowserHTML(const WebBrowser: TWebBrowser): String;
var
LStream: TStringStream;
Stream : IStream;
LPersistStreamInit : IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then exit;
LStream := TStringStream.Create('');
try
LPersistStreamInit := WebBrowser.Document as IPersistStreamInit;
Stream := TStreamAdapter.Create(LStream,soReference);
LPersistStreamInit.Save(Stream,true);
result := LStream.DataString;
finally
LStream.Free();
end;
end;
That works well too:
uses MSHTML;
function GetHTML(w: TWebBrowser): String;
Var
e: IHTMLElement;
begin
Result := '';
if Assigned(w.Document) then
begin
e := (w.Document as IHTMLDocument2).body;
while e.parentElement <> nil do
begin
e := e.parentElement;
end;
Result := e.outerHTML;
end;
end;
This has been asked and answered many times in the Embarcadero forums, with plenty of code examples posted. Search the archives.
The gist of it is that you Navigate() to the desired URL and wait for the OnDocumentComplete event to fire, then QueryInterface() the Document property for the IPersistStreamInit interface and call its save() method. Create a TStream object instance, such as a TMemoryStream, wrap it in a TStreamAdapter object, and then pass the adapter to save(). You can then load the TStream into the TMemo as needed.
Why not Quick and Dirty:
OnNavigateComplete2()
Form1.RichEdit1.Text:=(WebBrowser1.OleObject.Document.documentElement.outerhtml);
Related
I've been working with Word2010.pas for the past week and everything went well, until I found out that if you open a document manually, edit it (but don't save), press Alt+F4, a prompt will show up saying if you want to save your document or not, leave it like that. Go into code and try to access that document, all calls will result in EOleException: Call was rejected by callee. Once you cancel that Word save prompt, everything works fine.
I came across this while writing code that periodically checks if a document is open. Here is the function that checks if the document is open: (function runs in a timer every 2 seconds)
function IsWordDocumentOpen(FileName: string): Boolean;
var
WordApp: TWordApplication;
I: Integer;
begin
Result := False;
try
WordApp := TWordApplication.Create(nil);
try
WordApp.Connect;
for I := 1 to WordApp.Documents.Count do
begin
try
if WordApp.Documents.Item(I).FullName = FileName then
begin
Result := True;
System.Break;
end;
except
on E: EOleException do
// I always end up here while the document has the prompt
end;
end;
finally
FreeAndNil(WordApp);
end;
finally
//
end;
end;
Does anyone have any experience with this? Is there some sort of a lock that I'm not aware of?
UPDATE #1: So far the only solution I could find was to implement IOleMessageFilter, this way I do not receive any exceptions but the program stops and waits on the line WordApp.Documents.Item(I).FullName, but that is not what I want. Implementation of IOleMessageFilter goes like this:
type
IOleMessageFilter = class(TInterfacedObject, IMessageFilter)
public
function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask;
dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall;
function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint;
dwRejectType: Longint): Longint;stdcall;
function MessagePending(htaskCallee: HTask; dwTickCount: Longint;
dwPendingType: Longint): Longint;stdcall;
procedure RegisterFilter();
procedure RevokeFilter();
end;
implementation
function IOleMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint;
begin
Result := 0;
end;
function IOleMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint;
begin
Result := 2 //PENDINGMSG_WAITDEFPROCESS
end;
procedure IOleMessageFilter.RegisterFilter;
var
OldFilter: IMessageFilter;
NewFilter: IMessageFilter;
begin
OldFilter := nil;
NewFilter := IOleMessageFilter.Create;
CoRegisterMessageFilter(NewFilter,OldFilter);
end;
function IOleMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint;
begin
Result := -1;
if dwRejectType = 2 then
Result := 99;
end;
procedure IOleMessageFilter.RevokeFilter;
var
OldFilter: IMessageFilter;
NewFilter: IMessageFilter;
begin
OldFilter := nil;
NewFilter := nil;
CoRegisterMessageFilter(NewFilter,OldFilter);
end;
end;
BEST SOLUTION SO FAR: I used IOleMessageFilter implementation like this: (remember this will stop and wait on the line where I previously got an exception)
function IsWordDocumentOpen(FileName: string): Boolean;
var
OleMessageFilter: IOleMessageFilter;
WordApp: TWordApplication;
I: Integer;
begin
Result := False;
try
OleMessageFilter := IOleMessageFilter.Create;
OleMessageFilter.RegisterFilter;
WordApp := TWordApplication.Create(nil);
try
WordApp.Connect;
for I := 1 to WordApp.Documents.Count do
begin
if WordApp.Documents.Item(I).FullName = FileName then
begin
Result := True;
System.Break;
end;
end;
finally
OleMessageFilter.RevokeFilter;
FreeAndNil(WordApp);
FreeAndNil(OleMessageFilter);
end;
finally
//
end;
end;
Actually, I think that the problem is simply that Word is busy doing a modal dialog and so can't respond to external COM calls. This trivial code produces the same error:
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := MSWord.ActiveDocument.Name;
end;
Probably the simplest way to avoid this problem is to head it off before if happens. If you are using the TWordApplication server that comes with Delphi (on the Servers components tab), you can attach an event handler to its OnDocumentBeforeClose and use that to present your own "Save Y/N?" dialog and set the event's Cancel param to True to prevent Word's dialog from appearing.
Update: If you try experimenting with this code while the Save dialog is popped up
procedure TForm1.Button1Click(Sender: TObject);
var
vWin,
vDoc,
vApp : OleVariant;
begin
vWin := MSWord.ActiveWindow;
Caption := vWin.Caption;
vDoc := vWin.Document;
vApp := vDoc.Application; // Attempt to read Word Document property
Caption := vDoc.Path + '\';
Caption := Caption + vDoc.Name;
end;
I think you'll find that any attempt to read from the vDoc object will result in the "Call was rejected ..." message, so I am beginning to think that this behaviour is by design - it's telling you that the object is not in a state that it can be interacted with.
Interestingly, it is possible to read the Caption property of the vWin Window object, which will tell you the filename of the file but not the file's path.
Realistically, I still think your best option is to try and get the OnDocumentBeforeClose event working. I don't have Word 2010 installed on this machine by Word 2007 works fine with the Word server objects derived from Word2000.Pas so you might try those instead of Word2010.Pas, just to see.
Another possibility is simply to catch the "Call was rejected ..." exception, maybe return "Unavailable" as the document FullName, and try again later.
If you're not using TWordApplication and don't know how to catch the OnDocumentBeforeClose for the method your using to access Word, let me know how you are accessing it and I'll see if I can dig out some code to do it.
I vaguely recall there's a way of detecting that Word is busy with a modal dialog - I'll see if I can find where I saw that a bit later if you still need it. Your IOleMessageFilter looks more promising than anything I've found as yet, though.
I want to put data from Memo1 directly to my FTP server, I've got code:
procedure TForm5.SendClick(Sender: TObject);
var K: TStream;
begin
K := TStream.Create;
Memo1.Lines.SaveToStream(K);
FTP.Host := 'localhost';
FTP.Username := 'login';
FTP.Password := 'haslo';
FTP.Connect;
if FTP.Connected then FTP.Put(K,'');
end;
But when I click "Send" button I've got two errors:
when Memo is empty
when I try send data
TStream is an abstract class. You must never instantiate it. Use a concrete class instead like, for instance, TMemoryStream.
You'll also want to destroy the stream when you are finished with it, or it will leak. Do yourself a favour and set ReportMemoryLeaksOnShutdown to True, for instance in your .dpr file. That will allow you to get a report of all the memory you are leaking when your program terminates.
Your code might run like this:
var
Stream: TMemoryStream;
....
Stream := TMemoryStream.Create;
try
// .... initialize the Indy object
if FTP.Connected then begin
// .... populate stream
Stream.Position := 0;
FTP.Put(Stream, '');
end;
finally
Stream.Free;
end;
How to convert IStream to TStreamAdapter on Delphi 7?
On Delphi XE2 I may write:
var
aStream: IStream;
aStreamAdapter: TStreamAdapter;
begin
...
aStreamAdapter := aStream as TStreamAdapter;
...
end;
But Delphi 7 writes:
Error: Operator not applicable to this operand type
That code works because of a new feature introduced in D2010, namely the ability to recover a reference to the object that implements an interface. Note though that if the IStream is implemented by something other than your Delphi code, then the cast will fail.
If you need to refer to the implementing object in older versions of Delphi then you will need to use one of the various hacks to recover it. For example:
Hallvard Vassbotn's classic approach.
Barry Kelly's more recent variant.
However, you should not need to get back to the implementing object. The fact that you do want to is a very strong indication that your design is wrong.
The unit AxCtrls has an TOleStream object to do just that.
var
aStream: IStream;
bStream: TStream;
begin
bStream := TOleStream.Create(aStream);
try
//
finally
bStream.Free;
end;
end;
You need to use the Create method like
var StreamAdapter:TStreamAdapter;
begin
StreamAdapter := TStreamAdapter.Create(aStream);
...
Sample code:
var
aFileStream: TFileStream;
iStr: TStreamAdapter;
iRes , iRes1, iRes2: Largeint;
aStreamStat: TStatStg;
aStreamContent: IStream;
begin
aFileStream := TFileStream.Create('<...>', fmCreate);
try
aStreamContent := <...> as IStream;
aStreamContent.Seek(0, 0, iRes);
iStr := TStreamAdapter.Create(aFileStream, soReference);
aStreamContent.Stat(aStreamStat, 1);
aStreamContent.CopyTo(iStr, aStreamStat.cbSize , iRes1, iRes2);
finally
aFileStream.Free;
end;
end;
Is there a way to get the RTF data from a richedit without using savetostream as in
strStream := TStringStream.Create('') ;
try
RichEdit.Lines.SaveToStream(strStream);
Text := strStream.DataString;
strStream.CleanupInstance;
finally
strStream.Free
Tim the only way to get the RTF data from an RichEdit control is using a Stream because the windows message (EM_STREAMOUT) wich retrieve the RTF Data require a EditStreamCallback structure, this is the way used by windows to transfer rtf data into or out of a richedit control.
So you can use your own sample code, or implement the call to the windows message EM_STREAMOUT.
function RichTextToStr(red : TRichEdit) : string;
var ss : TStringStream;
begin
ss := TStringStream.Create('');
try
red.Lines.SaveToStream(ss);
Result := ss.DataString;
finally
ss.Free;
end;
end;
procedure CopyRTF(redFrom,redTo : TRichEdit);
var s : TMemoryStream;
begin
s := TMemoryStream.Create;
try
redFrom.Lines.SaveToStream(s);
s.Position := 0;
redTo.Lines.LoadFromStream(s);
finally
s.Free;
end;
end;
I can attest deviation from the pattern results in frustration....
I have Midas project that uses a TDataSetProvider in one of RemoteDataModules in the Server
Currently I am making use of the following events
BeforeApplyUpdates - to create an Object
BeforeUpdateRecord - to use the object
AfterApplyUpdates - to destory the object
Question:
Will ‘ AfterApplyUpdates’ always be called even if the is an update error ?
If you look at the sourcecode:
function TCustomProvider.DoApplyUpdates(const Delta: OleVariant; MaxErrors: Integer;
out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
begin
SetActiveUpdateException(nil);
try
try
if Assigned(FOnValidate) then
FOnValidate(Delta);
DoBeforeApplyUpdates(OwnerData);
Self.OwnerData := OwnerData;
try
Result := InternalApplyUpdates(Delta, MaxErrors, ErrorCount);
finally
OwnerData := Self.OwnerData;
Self.OwnerData := unassigned;
end;
except
on E: Exception do
begin
SetActiveUpdateException(E);
raise;
end;
end;
finally
try
DoAfterApplyUpdates(OwnerData);
finally
SetActiveUpdateException(nil);
end;
end;
end;
Yoy see that DoAfterApplyUpdates is called in the finally block. This means it is always called regardles of any exception.