Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1337
  • Last Modified:

Load html file from TStrings to webbrowser and do not save to harddisk,Thank you.

Hello Experts.
I load html file from database(TStrings) to webbrowser do not save to harddisk.

 Thanks you

//load
function ShowHtmls(mWebBrowser: TWebBrowser; mStrings: TStrings): Boolean; overload;
var
  vMemoryStream: TMemoryStream;
begin
  Result := False;
  if not (Assigned(mStrings) and Assigned(mWebBrowser)) then Exit;
  if not Assigned(mWebBrowser.Document) then Exit;
  vMemoryStream := TMemoryStream.Create;
  try
    mStrings.SaveToStream(vMemoryStream);
    try
      vMemoryStream.Position := 0;
      Application.ProcessMessages;
      (mWebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(vMemoryStream));
    except
      Exit;
    end;
  finally
    vMemoryStream.Free;
  end;
  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S: TStringStream;
begin
  S:= TStringStream.Create('<html><h1>Stream Test</h1><p>:This HTML content ' +
         'is being loaded from a stream.</html>');
  try
    LoadStream(WebBrowser1, S);
  finally
    S.Free;
  end;

End;


//save
procedure TForm1.Button2Click(Sender: TObject);
begin
  //WebBrowser1.ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_PROMPTUSER);
  WebBrowser1.ExecWB(OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT,
                   EmptyParam,
                   EmptyParam);
end;

Result is NUll
0
Dlwxn
Asked:
Dlwxn
  • 7
  • 3
1 Solution
 
ginsonicCommented:
procedure AssignDocument(Browser: TWebBrowser; Text: String);
var
  Document: OleVariant;
  {$ifdef PERSIST_STREAM}
  InStream: TStream;
  Persist: IPersistStreamInit;  {Declared in ActiveX}
  {$endif}
begin
  {$ifdef WRITE_FILE}
  Document := LocalServerPath('temp.html');
  WriteTextFile(Document, Text);  {utility function}
  Browser.Navigate2(Document);
  {$endif}
  {$ifdef PERSIST_STREAM}
  Document := 'about:blank';
  Browser.Navigate2(Document);
  InStream := TStringStream.Create(Text);
  try
    Persist := (Browser.Document as IPersistStreamInit);
    Persist.Load(TStreamAdapter.Create(InStream));
  finally
    InStream.Free;
  end;
  {$endif}
  {$ifdef DISPATCH_DOC}
  Document := 'about:blank';
  Browser.Navigate2(Document);
  Document := Browser.Document as IDispatch;
  Document.Open;
  try
    Document.Write(Text);
  finally
    Document.Close;
  end;
  {$endif}
end;
0
 
ginsonicCommented:
OR:

uses ActiveX;

procedure LoadStream(WebBrowser: TWebBrowser; Stream: TStream);
var
   PersistStreamInit: IPersistStreamInit;
   StreamAdapter: IStream;
   MemoryStream: TMemoryStream;
begin
   WebBrowser.Navigate('about:blank');
   repeat
     Application.ProcessMessages;
     Sleep(0);
   until
      WebBrowser.ReadyState = READYSTATE_COMPLETE;
   if WebBrowser.Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then begin
     if PersistStreamInit.InitNew = S_OK then begin
       MemoryStream:= TMemoryStream.Create;
       try
         MemoryStream.CopyFrom(Stream, 0);        
         MemoryStream.Position:= 0;
       except
         MemoryStream.Free;
         raise;
       end;
         StreamAdapter:= TStreamAdapter.Create(MemoryStream, soOwned);
         PersistStreamInit.Load(StreamAdapter);
     end;
  end;
end;

Call with:
..............................
var
  S: TStringStream;
begin
  S:= TStringStream.Create(YourHTMLString');
  try
    LoadStream(WebBrowser1, S);
  finally
    S.Free;
  end;
end;
0
 
ginsonicCommented:
Don't understand from your question if you wish to save the HTML doc ... but if the answer is yes ...

function SaveHTMLCode(WebBrowser: TWebBrowser; const FileName: TFileName): Boolean;
var
  ps: IPersistStreamInit;
  fs: TFileStream;
  sa: IStream;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  fs := TFileStream.Create(FileName, fmCreate);
  try
    sa := TStreamAdapter.Create(fs, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, True));
  finally
    fs.Free;
  end;
end;

Call with:
  SaveHTMLCode(WebBrowser1, 'C:\MyHTMLDoc.html');
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
DlwxnAuthor Commented:
Thank you

How save to harddisk?

Here is my code:

//save
procedure TForm1.Button2Click(Sender: TObject);
begin
  //WebBrowser1.ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_PROMPTUSER);
  WebBrowser1.ExecWB(OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT,
                   EmptyParam,
                   EmptyParam);
end;

0
 
ginsonicCommented:
For save read my previous somment. This save your document to 'C:\MyHTMLDoc.html'
0
 
ginsonicCommented:
Another way:

HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save('t1.tmp', true);

or:
0
 
ginsonicCommented:
or.. not sure if you wish to save not to harddisk but to your database then save the doc to a stream...

uses
  ActiveX;

procedure SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream);
var
  PersistStreamInit: IPersistStreamInit;
  StreamAdapter: IStream;
begin
  Stream.Size := 0;
  Stream.Position := 0;
  if Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then
  begin
    StreamAdapter := TStreamAdapter.Create(Stream, soReference);
    PersistStreamInit.Save(StreamAdapter, False);
    StreamAdapter := nil;
  end;
end;
0
 
DlwxnAuthor Commented:
ok ,thank you.

I am Chinese.  
Date: 09/29/2004 13:00PM  Beijing
0
 
DlwxnAuthor Commented:
sorry!

Split Points:

"At least 2 Answers are required"
0
 
ginsonicCommented:
Glad to help you :)

I'm from Romania!
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 7
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now