[Delphi]DismemberCode v0.5.3-1

*提取网页信息,兼容HTML 4.01 / XHTML 1.0
*测试页面代码来源:http://magiccards.info/m12/cn/3.html
e69caae6a087e9a298-2

更新记录

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
6febd59dtaa688ecfb11a690
#更新判断逻辑,关键结构只按照<和>。
#“自由段”改为“段落模式”,即可选择不换行,如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
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 := '&lt;'+copy(strSource, 2, intTagAft-2)+'&gt;';
                    delete(strSource, 1, intTagAft-1);
                end
                else
                begin
                  intTagAft := AnsiPos('-->', strSource);
                  strInfo := '&lt;'+copy(strSource, 2, intTagAft)+'&gt;';
                  //处理注释里的代码可见,<、>其中一个即可
                  strInfo := StringReplace(strInfo, '<', '&lt;', [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 := '&ensp;'+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;

发表评论

此站点使用Akismet来减少垃圾评论。了解我们如何处理您的评论数据