[Delphi]DismemberCode v0.5.3-1
*提取网页信息，兼容HTML 4.01 / XHTML 1.0
*测试页面代码来源：http://magiccards.info/m12/cn/3.html
更新记录
v0.5.3-1.1 20110831
@目标：标签领地arrTagManor存储标签索，并能快速定位（深度+标签结构）。
#重新定义intInfoType，并加入显示模式选择modType。
/// 0:内容 /// 1: /// 2: /// 3: /// 4:段落模式 /// 5:段落模式 /// 6:段落模式 /// 7:独行模式 /// 8:独行模式 /// 9:独行模式
v0.5.3-1.0 20110830
#优化intErrType信息提示方式。
#新增arrTag
6:独行模式 0+6:普通的标签<…> <…/>
#新增intInfoType，独行模式
6 : 独行模式 0+6:普通的标签<…> <…/>
7 : 独行模式 1+6:
v0.5.3 20110822
#修正0.5.2的深度错误。
#优化intInfoType，值如下
0 : 1 : 3 : 段模式下的 内容 4 : 段模式下的 9 : 不显示的标签 0+9:不显示
#更新arrTag索引
0:普通 1: 3:段落模式 0+3:普通的标签 5:段落模式 2+3:、、!DOCTYPE标签 9:不显示的 0+9:不显示
#增加intErrType，处理错误信息。
#新增boolNoInfo，修正在新逻辑下<标签>内容为空时的深度错误。
#修正最后产生空字符串的处理。
#修正<!–注释–>的处理。
#标签领地arrTagManor包括段落模式的<…>。
#暂时取消intInfoType:9不显示功能。
#暂时取消隐藏标签功能。
v0.5.2 20110821
#重写标签核对，更改成arrTag索引，取消段落模式可选。能够验证标签是否合法，并提速37%。
0:普通 1: 2: 3:段落模式 0+3:普通的标签 5:段落模式 2+3:标签 9:不显示的 0+9:不显示
#优化intLinefeedType，并显示行数。
#生成临时HTML展现结果代码，同时避免Delphi字符串包含&的特殊功能、自动转换&#编码。
#避免< >、< />、、<这里>等类似字符串容易被判定为标签。
#增加intInfoType值10，当标签不为合法时，则为10。
#深度值intDepth。
#修正标签领地arrTagManor。
#修正intInfoType，并解决最后会多出一行空内容。
#修正<标签>内容为空时的深度错误。
#更改boolBatter“连击状态”为intOldInfoType“标签类型”，记录之前标签的类型。
0:<标签> 1: 其他:段落模式
v0.5.1 20110815
#精确strTagName
#函数返回值改为TStringList
#更改并添加arrPartTag层级
0 不显示的标签，该标签内所有内容不显示 1 <…/> 2 段落模式的标签
#修正针对<!– –>的BUG
v0.5.0 20110814
#更新判断逻辑，关键结构只按照<和>。
#“自由段”改为“段落模式”，即可选择不换行，如a img br a标签带文本等
#不按照/>或/ >来判定不加深度，因为HTML 4.01下
是正确的写法。
#重写属性和标签名字判断部分
#重写<标签>内部判断逻辑，先判断类型，消除过多的多重IF。
#优化代码，提速33%-50%。
#“标签领地”概念，加快“自定义段”的标签在中的验证。
#“连击状态”概念，处理针对连续出现<标签>的#13关系。
#暂时取消检查标签的属性中带有 / 的合法性。
#暂时取消深度。
///内容类型判断 intInfoType////////////////////////////////////////////////////////////////////////
┌有<
│└┬虚内容<标签>
│ │└┬<标签>
│ │ │ └┬先处理<标签 / >右侧的空格
│ │ │ │默认<标签> //intInfoType:=0;
│ │ │ ├ //intInfoType:=9;
│ │ │ └ //intInfoType:=1;
│ │ │ └┬<标签/> //intInfoType:=2;
│ │ │ └自定义段 //intInfoType:=3;
│ │ └虚内容<标签> 提取虚内容 可能是最开始的。 //intInfoType:=7;
│ └虚内容>内容< │ └┬>内容< //intInfoType:=6; │ └虚内容+非标签的>+内容< //intInfoType:=7;
└>内容 最后的内容 //intInfoType:=8;
///////////////////////////////////////////////////////////////////////////////////////////////////
v0.4.1 20110808
#修正针对非规范写法代码的判断。如：<br > <br / > <br/ > <br>，规范的是<br />。
#提取标签名 strTagName
v0.4.0 20110807
#更换判断逻辑，只按照<、>、/判断
#针对标签的属性中带有 / 的合法进行判定。
待处理
@把Copy换成MidStr
@使用LowerCase UpperCase
@针对intErrType各个错误的补救办法。
@能够隐藏标签，直接显示内容。
@能够按照指定层级数显示。
@intInfoType:9不显示功能。
@支持、//、’等其他注释，支持样式表提取。
@结构出错时（如缺少)的处理方式。
@精确查找，减少提取的多余页面代码
@实战提取http://magiccards.info
@简化内容类型判断 intInfoType
@隐藏标签下…,里,会换行。
@针对原始页面代码中换行的部分进行修正
@对大小写的分辨
@遇到相同，如，即使td是段落模式，换行.
@支持对HTTP 消息的转换
@支持对属性的支持
@不显示标签后的内容要分段。
@减少arr for do的搜索时间
@按照指定格式进行显示 如 a href text
@对整个页面进行抓取，主要处理Head中的杂乱代码
@拆分标签中的属性及值
@判定HTML版本，并支持HTML5
源代码 v0.5.3 20110822
function aDismemberCode(strSource: string): TStringList;
var
//标签定位
intTagBef, intTagAft, intTagMark: Integer;
//arrTag的定位
intTagNth, intTagAbc:integer;
//内容类型，上一个内容类型，错误提示类型
intInfoType, intOldInfoType, intErrType: integer;
//错误提示信息
strErrType: string;
//内容，标签，标签名
strInfo, strTag, strTagName: string;
//是标签，没有内容
boolIsTag, boolNoInfo: boolean;
//换行模式，深度
intLinefeedType, intDepth: integer;
arrTagManor, arrTagManorTemp: TStringList; //标签领地 不记录<.../>
//boolTagHide: boolean; //隐藏标签
i:integer;
const
////////////////////////////////////////////////////////////////////////////
/// 0:普通
/// 1:</...>
/// 3:段落模式 0+3:普通的标签
/// 5:段落模式 2+3:<.../>、<!---->、!DOCTYPE标签
/// 9:不显示的 0+9:不显示
arrTag : array[0..24,0..21] of string = (('!--','!DOCTYPE','','','','','','','','','',
'5', '5', '','','','','','','','',''),
('a','area','abbr','acronym','address','applet','','','','','',
'3', '5', '0', '0', '0', '0', '','','','',''),
('br','b','body','base','basefont','bdo','big','blockquote','button','','',
'5', '3','0', '5', '5', '0', '0', '0', '0', '',''),
('col','caption','center','cite','code','colgroup','','','','','',
'5', '0', '0', '0', '0', '0', '','','','',''),
('div','dd','dl','dt','del','dir','dfn','','','','',
'0', '0', '0', '0', '0', '0', '0', '','','',''),
('em','','','','','','','','','','',
'0', '','','','','','','','','',''),
('font','form','frame','frameset','fieldset','','','','','','',
'0', '0', '5', '0', '0', '','','','','',''),
('','','','','','','','','','','',
'','','','','','','','','','',''),
('hr','html','head','h1','h2','h3','h4','h5','h6','','',
'5', '0', '0', '0', '0', '0', '0', '0', '0', '',''),
('img','input','i','iframe','ins','isindex','','','','','',
'5', '5', '3','0', '0', '0', '','','','',''),
('','','','','','','','','','','',
'','','','','','','','','','',''),
('kbd','','','','','','','','','','',
'0', '','','','','','','','','',''),
('li','label','link','legend','','','','','','','',
'3', '3', '5', '0', '','','','','','',''),
('meta','map','menu','','','','','','','','',
'5', '0', '0', '','','','','','','',''),
('noframes','noscript','','','','','','','','','',
'0', '0', '','','','','','','','',''),
('option','optgroup','object','ol','','','','','','','',
'3', '3', '0', '0', '','','','','','',''),
('p','param','pre','','','','','','','','',
'0','5', '0', '','','','','','','',''),
('q','','','','','','','','','','',
'0','','','','','','','','','',''),
('','','','','','','','','','','',
'','','','','','','','','','',''),
('span','style','strong','script','select','small','s','samp','strike','sub','sup',
'3', '0', '0', '0', '3', '3', '0','0', '0', '0', '0'),
('table','tbody','td','tr','thead','th','title','textarea','tfoot','tt','',
'0', '0', '0', '0', '0', '0', '3', '0', '0', '0', ''),
('ul','u','','','','','','','','','',
'0', '3','','','','','','','','',''),
('var','','','','','','','','','','',
'0', '','','','','','','','','',''),
('','','','','','','','','','','',
'','','','','','','','','','',''),
('xmp','','','','','','','','','','',
'0', '','','','','','','','','','')
);
begin
//标签定位
intTagAft := 0;
//arrTag的定位
intTagNth := 0;
intTagAbc := 0;
//内容类型，上一个内容类型，错误提示类型
intInfoType := 0;
intOldInfoType := 0;
intErrType := 0;
//是标签，没有内容
//
boolNoInfo := false;
//换行模式，深度
intLinefeedType := 0;
intDepth := -1;
arrTagManor := TStringList.Create; //标签领地
arrTagManorTemp := TStringList.Create;
//boolTagHide := false;//隐藏标签
Result := TStringList.Create;
try
repeat
boolIsTag := false;
// intInfoType
intTagBef := AnsiPos('<', strSource);
if intTagBef <> 0 then
begin //<
intTagAft := AnsiPos('>', strSource);
if intTagBef < intTagAft then
begin //虚内容<标签>
if intTagBef = 1 then
begin //<标签>
boolIsTag := true;
strTag := trim(copy(strSource, intTagBef+1, intTagAft-2)); // 去掉<、>、左右空格的标签
strTag := '<'+trim(strTag)+'>';
if AnsiPos('/', strTag) = 2 then
begin
strTagName := copy(strTag, 3, length(strTag)-3);
if arrTagManor.Count > 0 then
begin
arrTagManorTemp.CommaText := arrTagManor[arrTagManor.Count-1];
if arrTagManorTemp[0] = strTagName then
begin
arrTagManor.Delete(arrTagManor.Count-1);
if arrTagManorTemp[1] = '0' then
intInfoType := 1
else
intInfoType := 4;
end
else
intErrType := 1;
end
else
intErrType := 3;
end
else
begin
//strTagName
intTagMark := AnsiPos(' ', strTag);
if intTagMark <> 0 then
strTagName := copy(strTag, 2, intTagMark-2)
else
begin
intTagMark := AnsiPos('/', strTag);
if intTagMark <> 0 then
strTagName := copy(strTag, 2, intTagMark-2)
else
strTagName := copy(strTag, 2, AnsiPos('>', strTag)-2);
end;
//!特殊标签
if strTagName[1] <> '!' then
intTagAbc := ord(strTagName[1])-96 //a 97-96=1
else
begin
intTagAbc := 0; //! 33
if AnsiPos('!--', strTagName) = 1 then strTagName := '!--';
end;
//arrTag
intErrType := 4; //只有符合arrTag才是合法标签
if (intTagAbc <= high(arrTag)) and (intTagAbc >= low(arrTag)) then //不超过a~x
begin
for intTagNth := low(arrTag[intTagAbc]) to high(arrTag[intTagAbc]) do
begin
if arrTag[intTagAbc][intTagNth] = strTagName then
begin
intInfoType := strtoint(arrTag[intTagAbc][intTagNth+11]);
case intInfoType of
5 : intInfoType := 3;
else
arrTagManor.add(strTagName+','+inttostr(intInfoType));
end;
intErrType := 0;
break;
end;
end;
end;
end;
end
else
intInfoType := 3; //虚内容<标签> 提取虚内容 可能是最开始的
end
else
intInfoType := 3; // >内容< 虚内容+非标签的>+内容<
end
else
intInfoType := 3;
//空内容处理
if boolNoInfo then
begin
if intInfoType = 1 then intDepth := intDepth+1;
boolNoInfo := false;
end;
//内容处理
if boolIsTag then
begin
if strTagName <> '!--' then
begin
strInfo := '<'+copy(strSource, 2, intTagAft-2)+'>';
delete(strSource, 1, intTagAft-1);
end
else
begin
intTagAft := AnsiPos('-->', strSource);
strInfo := '<'+copy(strSource, 2, intTagAft)+'>';
//处理注释里的代码可见，<、>其中一个即可
strInfo := StringReplace(strInfo, '<', '<', [rfReplaceAll]);
delete(strSource, 1, intTagAft+1);
end;
end
else
begin
if intTagBef <> 0 then
begin
strInfo := copy(strSource, 1, intTagBef-1);
delete(strSource, 1, intTagBef-1);
if strInfo[1] = '>' then delete(strInfo, 1, 1); //去掉>
if trim(strInfo) = '' then //空内容处理
begin
if intOldInfoType in [0] then boolNoInfo := true;
continue;
end;
end
else
begin //>内容结束
delete(strSource, 1, 1);
strInfo := strSource;
if trim(strInfo) = '' then continue; //</标签>结尾
end;
end;
strInfo:=trim(strInfo);
//intInfoType 深度、段落、结构
case intInfoType of
0 : begin //<...> <.../>
intLinefeedType := 1;
if intOldInfoType = 0 then intDepth := intDepth+1;
//if intOldInfoType = 3 then intErrType := 2;
end;
1 : begin //</...>
if intInfoType <> 3 then
begin //非段落<...>
intLinefeedType := 1;
intDepth := intDepth-1;
end
else
intErrType := 1;
end;
3 : begin //段模式下的 <...> <.../> 内容
if intOldInfoType in [3,4] then //是段落模式
intLinefeedType := 0
else
begin
intLinefeedType := 1;
if intOldInfoType = 0 then intDepth := intDepth+1; //是<...>
end;
end;
4 : begin //段模式下的 </...>
if intOldInfoType in [3,4] then //是段落模式
intLinefeedType := 0
else
begin
if intInfoType <> 0 then
begin
intLinefeedType := 1;
intDepth := intDepth-1;
end
else
intErrType:=1;
end;
end;
9 : begin //不显示的标签 0+9:不显示
//continue;
end
else
intErrType := 11;
end;
intOldInfoType := intInfoType; //上一个内容类型记录
//intErrType
case intErrType of
0 : begin
//没有错误；
end;
1 : begin
strErrType := '结构出错，需要</'+arrTagManorTemp[0]+'>'+'但结构中是</'+strTagName+'>'+#13+'第'+inttostr(Result.Count)+'行';
end;
2 : begin
strErrType := '段内交错！';
end;
3 : begin
strErrType := '</...>在<...>前或数量比对应<...>多';
end;
4 : begin
strErrType := strTag+'不是合法的标签';
end;
11 : begin
strErrType := '值:'+inttostr(intInfoType)+'超出intInfoType范围'+#13+'相关的arrTag取值为:'+arrTag[intTagAbc][intTagNth+11];
end
else
strErrType := '值:'+inttostr(intErrType)+'超出intErrType范围';
end;
if intErrType in [1,2,3,4,11] then
begin
form1.Caption := form1.Caption+strErrType;
intLinefeedType := 0; //错误解决办法
intErrType :=0;
end;
//输出
if Result.Count = 0 then intLinefeedType := 1; //防止刚开始count-1
case intLinefeedType of
0 : begin //+内容
Result.Strings[Result.Count-1] := Result.Strings[Result.Count-1]+strInfo;
end;
1 : begin //#13+内容
for i := 1 to intDepth do strInfo := ' '+strInfo; //深度
Result.add('<br /><a style="width:50px;">'+'['+inttostr(Result.count)+']'+inttostr(intDepth)+'</a>|'+strInfo);
end;
end;
until AnsiPos('>',strSource) = 0 ;
Result.Insert(0,'行：'+inttostr(Result.Count)+'<style type="text/css">body,td,th {font-size: 11px;}</style>');
Result.SaveToFile(ExtractFilePath(Application.ExeName)+'tmp.html');
finally
arrTagManor.Clear;
arrTagManor.Free;
arrTagManorTemp.Clear;
arrTagManorTemp.Free;
end;
end;