散分..... 希望能稍带着把问题帮我解决了，谢谢

Question

需要完成以下的工作：
1:将HTML源码 不通过临时文件就转化成网页；
2:将一个网页直接转化成HTML源码；
3:将一个网页直接转化成在页面显示的文本；
4:不是捣乱的朋友都有分。现在完成的进度：1、2都已经完成了，3只完成了一部分，就是可以转化成文本，但是格式如何也能转化正确？问题4就在于你们了；

Answer 1

TO cgh1970(阿刀)
谢谢；
吃饭先....

Answer 2

TO dyf2001(西风) 
3Q.....

Answer 3

2,3.
uses MSHTML;
IHtmlDocument2(WebBrowser.Document).body.outerText;
IHtmlDocument2(WebBrowser.Document).body.outerHTML;

Answer 4

To zswang(伴水清清)(专家门诊清洁工)
这些我已经解决了，关键是没有办法得到它的格式
用它的属性好像也不行.
....

Answer 5

procedure TForm1.SetHtml(const WebBrowser: TWebBrowser;
  const Html: string);
var
  Stream: IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
  if not Assigned(WebBrowser.Document) then
  begin
    Exit;
  end;
  hHTMLText := GlobalAlloc(GPTR, Length(Html) + 1);
  if 0 = hHTMLText then
    RaiseLastWin32Error;
  CopyMemory(Pointer(hHTMLText),
  PChar(Html), Length(Html));  OleCheck(CreateStreamOnHGlobal
  (hHTMLText, True, Stream));
  try
    OleCheck(WebBrowser.Document.
    QueryInterface(IPersistStreamInit, psi));
    try
      OleCheck(psi.InitNew);
      OleCheck(psi.Load(Stream));
    finally
      psi := nil;
    end;
  finally
    Stream := nil;
  end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
  SetHtml(WebBrowser1,RichEdit1.Lines.GetText);
end;initialization
 OleInitialize(nil);finalization
  try
    OleUninitialize;
  except
  end;
end.

Answer 6

begin
  RichEdit1.Clear;
  //RichEdit1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);
  RichEdit1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).title );
  //RichEdit1.Lines.Add(IHTMLDocument2Disp(WebBrowser1.Document).)
  //RichEdit1.Font.Style := DispHTMLStyle(WebBrowser1.Document).getAttribute(IHtmlDocument2(WebBrowser1.Document).body.outerText));// .font;
end;
我调用了它的格式接口也不对哎.....

Answer 7

To jackie168(星星知我心) 
3Q.....
亲一个....
呵呵~~~~~~~~~~~

Answer 8

小小，你的问题没有说清楚吧 ^_*!1:将HTML源码 不通过临时文件就转化成网页；  HTML文件就是网页文件呀？！
2:将一个网页直接转化成HTML源码；           网页里就是HTML源码呀
3:将一个网页直接转化成在页面显示的文本；   hehe^^
4:不是捣乱的朋友都有分。                   我可没有捣乱呀看了你的程序我才知道你要做什么.....等我一下，我整理一下....

Answer 9

function GetHtml(const WebBrowser:
TWebBrowser): string;
const
  BufSize = $10000;
var
  Size: Int64;
  Stream: IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
  if not Assigned(WebBrowser.Document) then Exit;  OleCheck(WebBrowser.Document.QueryInterface(IPersistStreamInit, psi));
  try
  //OleCheck(psi.GetSizeMax(Size));
    hHTMLText := GlobalAlloc(GPTR, BufSize);
    if 0 = hHTMLText then RaiseLastWin32Error;
    OleCheck(CreateStreamOnHGlobal(hHTMLText,True, Stream));
    try
      OleCheck(psi.Save(Stream, False));
      Size := StrLen(PChar(hHTMLText));
      SetLength(Result, Size);
      CopyMemory(PChar(Result), Pointer(hHTMLText), Size);
    finally
      Stream := nil;
    end;
  finally
    psi := nil;
  end;
end;

Answer 10

Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);

Answer 11

procedure GetCurrentDoc(var theList: TStringList);
  var
    all:IHTMLElementcollection;
    doc:IHTMLDocument2;
    item:OleVariant;
  begin
      doc := Browser.document as ihtmldocument2;
      all:=doc.all;
      item:=all.item(0,varEmpty);      //item.innerhtml是源文件的<title>到</body>
      //item.outerhtml是全文      theList.Add( item.innerhtml );
  end; 
全都是转的 hehe^^

Answer 12

是这样的：
1:将HTML源码 不通过临时文件就转化成网页；  HTML文件就是网页文件呀？！
2:将一个网页直接转化成HTML源码；           网页里就是HTML源码呀
3:将一个网页直接转化成在页面显示的文本；   hehe^^
4:不是捣乱的朋友都有分。                   我可没有捣乱呀其中1、2在我提问之前我就实现了，而第3个问题，我只实现了一部分，就是那将一个网页直接转化成文本文件，当然，是没有任何标记语言，可是，现在的问题是转化过来的文字字体格式不对。这就是问题的所在之处；
1：将HTML源码 不通过临时文件就转化成网页  -> 不能通过临时文件，所以也就不是HTML文件，只是一个String Value ，如果是一个HTML文件的话，那还用转？{问题已经解决}
2：将一个网页直接转化成HTML源码； ->就是给你一个接口，你通过调用一个方法就转化过成HTML，其中HTML肯定也不能是一个文件，你总不应该会将先转化成一个文件再取出来吧:){问题已经解决}
3：可以转化成了一段文本了{当然，也不可能产生临时文件}，问题就是它们的格式{是字体格式}全丢了，这就是你要帮我解决的问题；
4：你捣乱没？嘻嘻.........

Answer 13

讨~~讨厌~~~啦，人家又不是玻璃...
O......o...O..... (吐呀吐呀的就习惯了)

Answer 14

哦，我是明白你的意思了..... ~_^!不过....还真的是....不用HTML临时文件中转不行呀字体类型丢失...

Answer 15

有点像，不过好像不对；
doc := Browser.document as ihtmldocument2;
      all:=doc.all;if not Assigned(WebBrowser.Document) then Exit;
All := ihtmldocument2(Browser.document ).All;
有时觉的用As不是很好

Answer 16

CDSoftwareWj(95927) ( ) 信誉：100  2003-02-27 14:14:00  得分:0 
 
 
  讨~~讨厌~~~啦，人家又不是玻璃...
O......o...O..... (吐呀吐呀的就习惯了)
---------------------------------------------
我倒，好像我是玻璃一样啊。。冤枉................
泪水中泡个澡..........
  
 

Answer 17

M := TMemoryStream.Create;
                memo1.Lines.SaveToStream(M);
                M.seek(0, 0);
                if not Assigned(ADform.WebBrowser1.document) then begin
                    ADform.WebBrowser1.navigate('about:blank');
                    while ADform.WebBrowser1.ReadyState <> READYSTATE_COMPLETE  do Forms.Application.ProcessMessages;
                end;
                ( ADform.WebBrowser1.Document as IPersistStreamInit).Load(TStreamadapter.Create(M));
                ADform.WebBrowser1.Show;试试看！！！！！！！！！！！！！！！！！！！！！！不知道有没有用！

Answer 18

帮你顶，好不容易有空上一下CSDN，看到你的帖子当然要顶了！
可是我的帖子就很少人顶了。：（

Answer 19

To  jenemery(小熊)
你用Memo肯定不行。。
试试先....

Answer 20

jenemery(小熊)是装载，我要的是获取有文子.....

Answer 21

//ParseURL.pas
unit parseURL;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;type
  PURLData = ^TURLData;
  TURLData = record
    URL: string;
    Title: string;
  end;  TURL = class
  private
    FList: TList;
    FStream: TMemoryStream;
    FFileName: string;
    function GetURL(const Index: Integer): TURLData;
    function GetURLCount: Integer;
    procedure SetFileName(const Value: string);
  public
    constructor Create;
    destructor Destroy; override;
    procedure ClearURL;
    procedure ExtractURL;    property URL[const Index: Integer]: TURLData read GetURL;
    property URLCount: Integer read GetURLCount;
    property FileName: string read FFileName write SetFileName;
  end;  TForm1 = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
  private
    FURL: TURL;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;var
  Form1: TForm1;implementation{$R *.dfm}{ TURL }procedure TURL.ClearURL;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    FreeMem(FList[i]);
  FList.Clear;
end;constructor TURL.Create;
begin
  FList := TList.Create;
  FStream := TMemoryStream.Create;
end;destructor TURL.Destroy;
begin
  ClearURL;
  FStream.Free;
  inherited Destroy;
end;
procedure TURL.SetFileName(const Value: string);
var
  C: Char;
begin
  if Value = FFileName then Exit;
  FFileName := Value;
  FStream.LoadFromFile(FFileName);
  C := #0;
  FStream.Position := FStream.Size;
  FStream.Write(C, 1);
  ExtractURL;
end;procedure TURL.ExtractURL;
const
  HREF: array [0..3] of Char = ('H', 'R', 'E', 'F');
var
  P, S: PChar;
  Data: TURLData;  function CompHREF: Boolean;
  var
    T: PChar;
    I: Integer;
  begin
    T := P;
    for I := 0 to SizeOf(HREF) - 1 do
    begin
      Result := UpCase(T^) = HREF[I];
      if not Result then
        break;
      Inc(T);
    end;
  end;  procedure SkipBlanks;
  begin
    while P^ <> #0 do
    begin
      if P^ in [#33..#255, #10] then
        break;
      Inc(P);
    end;
  end;  procedure AddURL;
  var
    D: PURLData;
  begin
    New(D);
    D^.URL := Data.URL;
    D^.Title := Data.Title;
    FList.Add(D);
  end;  procedure GetURL;
  var
    Len: Integer;
  begin
    SkipBlanks;
    if CompHREF then
    begin
      Inc(P, SizeOf(HREF));
      SkipBlanks;
      if P^ = '=' then Inc(P);
      SkipBlanks;
      case P^ of
        '"', '''':
        begin
          { URL }
          Inc(P);
          S := P;
          while not (P^ in ['"', '''']) do Inc(P);
          Len := P - S;
          SetLength(Data.URL, Len);
          Move(S^, Data.URL[1], Len);          { GetTitle }
          Inc(P);
          SkipBlanks;
          while P^ <> '>' do Inc(P);
          Inc(P);
          SkipBlanks;
          
          S := P;
          while True do
            case P^ of
              '<':
              begin
                if P = S then
                begin
                  Inc(P);
                  Continue;
                end else
                begin
                  Inc(P);
                  case P^ of
                    '/':
                    begin
                      Len := P - S - 1;
                      SetLength(Data.Title, Len);
                      Move(S^, Data.Title[1], Len);
                      AddURL;
                      Exit;
                    end;
                  end;
                end;
              end;
              '>':
              begin
                Inc(P);
                S := P;
              end;
            else
              Inc(P);
            end;
        end;
      end;
    end;
  end;begin
  P := FStream.Memory;
  SkipBlanks;
  while True do
  begin
    case P^ of
      '<':
      begin
        Inc(P);
        SkipBlanks;
        case P^ of
          'a', 'A':
          begin
            Inc(P);
            GetURL;
          end;
        end;
      end;
      #0: break;
    end;
    Inc(P);
  end;
end;function TURL.GetURL(const Index: Integer): TURLData;
begin
  if Index in [0..(FList.Count - 1)] then
    Result := PURLData(FList[Index])^
  else
    raise Exception.Create('Error');
end;function TURL.GetURLCount: Integer;
begin
  Result := FList.Count;
end;constructor TForm1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FURL := TURL.Create;
end;destructor TForm1.Destroy;
begin
  FURL.Free;
  inherited Destroy;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  FURL.FileName := 'a.txt';  //将HTML文件给FileName，进行解析
  ListView1.Items.Count := FURL.URLCount;
end;procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  Data: TURLData;
begin
  Data := FURL.URL[Item.Index];
  Item.Caption := Data.Title;
  Item.SubItems.Add(Data.URL)
end;end.//ParseURL.dfm
object Form1: TForm1
  Left = 192
  Top = 106
  Width = 544
  Height = 375
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 448
    Top = 24
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ListView1: TListView
    Left = 8
    Top = 16
    Width = 433
    Height = 321
    Columns = <
      item
        Caption = 'Title'
        Width = 100
      end
      item
        AutoSize = True
        Caption = 'URL'
      end>
    MultiSelect = True
    OwnerData = True
    TabOrder = 1
    ViewStyle = vsReport
    OnData = ListView1Data
  end
end

Answer 22

这是前段写的解析HTML的URL的，写的还不完整，大概给你个思路，你看能不能解析你对应的文字。那么IE的接口，俺不懂ing

Answer 23

我有个同学，用perl编了一个类似的东东
不知他是怎么编的，先请教一下再说吧

Answer 24

帮不上了，Up
记得有组件可以掉用IE引擎的
忘记了，到Google去找...

Answer 25

或者对你有帮助的
http://renzhen.org/article/list.asp?id=187

Answer 26

★我是初学者，想和大家交个朋友,我的yahoo ID是onlydelphi，我们用yahoo通聊吧！（推荐！
请到：
http://cn.yahoo.com 下载yahoo通，然后申请个免费yahoo电邮就行了）
我的MSN是：[email protected]
我感觉yahoo通比MSN好很多，不信你试试。
请留下你的ID，谢谢！

Answer 27

To chenam
感情你踢的很爽啊，那多帮我踢几脚......
问题解决再给你200分.OK

Answer 28

To copy_paste(木石三) 
现在可以取出其文本，就存在格式的问题；To All这周的灌水到此为....那位如何能帮我解决了，请给我留个言  
有心的话再帮我踢一脚...
[email protected]  or [email protected] 
3Q
{一个月后如果有机会再来结贴，大家不要骂啊，唾沫中飞跑......}