怎样获取 html 中的文字? (只要文字,html一个都不要)太难了!!!!!!!!! (20分)

  • 主题发起人 主题发起人 tulpar
  • 开始时间 开始时间
T

tulpar

Unregistered / Unconfirmed
GUEST, unregistred user!
form上有两个memo 控件, memo1 的内容是一个 html程序
能不能获取 memo1 中的 文字 内容?
////////////////////////
( 按回车是 在 memo2 上 显示 纯 网页文字内容)
必须用memo,或 richedit 控件
需要网页上能看得见的文字, 其他的不要!!
 
要这个吗?
function HtmlToTxt(HtmlString : string) : string;
var
strTextReadDo : string; //处理一部分文本框的字符串
boolEndChange : Boolean; //处理结束标志
nChangeIndex : integer; //转换位置
strSelString : string; //选择的部分
j, k, L : integer;
begin
strTextReadDo := HtmlString; //初始化转换文本框
boolEndChange := False; //写标志:没有结束处理
nChangeIndex := 1; //从第1位开始搜索

//替换指定的字符
ReplaceSubString(' ', ' ', strTextReadDo);
ReplaceSubString('"', '"', strTextReadDo);
ReplaceSubString('<br>', c_strReturn, strTextReadDo);
ReplaceSubString('<p>', c_strReturn, strTextReadDo);

//替换Html字符
while not boolEndChange do
begin
//搜索<...>内容
L := Length(strTextReadDo);
j := pos('<', Copy(strTextReadDo, nChangeIndex, L - nChangeIndex + 1));
k := pos('>', Copy(strTextReadDo, nChangeIndex, L - nChangeIndex + 1));

if (j = 0) or (k = 0) or (nChangeIndex > L) then
boolEndChange := True
else
begin
if (j < k) then
begin
//得到选择内容
strSelString := LowerCase(Copy(strTextReadDo,
nChangeIndex + j - 1,
k - j + 1));

//处理<...>内容
if strSelString = '' then
begin
//
end
else
begin
Delete(strTextReadDo,
nChangeIndex + j - 1,
k - j + 1);

//删除后面的回车、换行
if LowerCase(Copy(strTextReadDo, nChangeIndex + j - 1, 2)) = c_strReturn then
Delete(strTextReadDo,
nChangeIndex + j - 1,
2);

dec(j);
end;
end
else
begin
dec(j);
end;

//搜索重定位
inc(nChangeIndex, j);
end;
end;

//得到转换后的文本
Result := strTextReadDo;
end;
 
这个程序好象有问题!!!

有没有更简单的办法?
 
uses
mshtml;
{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);//网页显示后再执行这个
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
webbrowser1.Navigate(edit1.text);//先执行这个
end;
 
有高手,可是看你的分太少了;)
 
to: pjessica 朋友 现在没有办法增加分数
希望高手们能帮我一个忙!!!!!!
 
procedure TForm1.Button1Click(Sender: TObject);
var
sels,sele:longint;
s:string;
begin
s := richedit1.Text;
screen.Cursor := crHourGlass;
while pos('<',s) <> 0 do
begin
sels := pos('<',s);
sele := pos('>',s);
if sele = 0 then break;
if sels > sele then break;
delete(s,sels,sele-sels+1);
end;
richedit1.Text := s;
richedit1.perform(wm_vscroll,sb_top,0);
screen.Cursor := crDefault;
end;
 
to:影 子
朋友,我需要 html 当中得到 文字内容的代码
(结果不能包含任何html部分,)(我试了sohu首页的html内容,有点问题)

有没有好的办法!
 
更改后的代码,分条件判断。由于是重复查找,效率极差,懒得去改。
我不想再看到这段代码了[:(]

procedure TForm1.Button1Click(Sender: TObject);
var
sels,sele:longint;
s:string;
begin
s := richedit1.Text;
screen.Cursor := crHourGlass;

while pos('<!--',s) <> 0 do
begin
sels := pos('<!--',s);
sele := pos('-->',s);
if sele = 0 then break;
if sels < sele then
delete(s,sels,sele-sels+3);
end;

while pos('<style',s) <> 0 do
begin
sels := pos('<style',s);
sele := pos('</style>',s);
if sele = 0 then break;
if sels < sele then
delete(s,sels,sele-sels+8);
end;

while pos('<script',s) <> 0 do
begin
sels := pos('<script',s);
sele := pos('</script>',s);
if sele = 0 then break;
if sels < sele then
delete(s,sels,sele-sels+9);
end;

while pos('<',s) <> 0 do
begin
sels := pos('<',s);
sele := pos('>',s);
if sele = 0 then break;
if sels > sele then break;
delete(s,sels,sele-sels+1);
end;

richedit1.Text := s;
richedit1.perform(wm_vscroll,sb_top,0);
screen.Cursor := crDefault;
end;
 
后退
顶部