代码: 这样用有问题吗?? <% '--------------------------------------- '模板类，使用系统自定义标记语言输出文件 '--------------------------------------- Class clsTemplate Private adSaveCreateOverWrite Private adSaveCreateNotExist '开始标记 Public starttag '结束标记 Public endtag '定义文件名 Public filename Dim key_arr() Dim val_arr() Public content Public total Public contenta() '块的内容(解析后的) Public BlockContent Public block_begin_delim Public block_end_delim Public block_begin_word Public block_END_word Public block_null '类的初始化 Sub Class_Initialize() Redim key_arr(0) Redim val_arr(0) Redim contenta(0) adSaveCreateOverWrite = 2 adSaveCreateNotExist = 1 starttag = "{" endtag = "}" total = 0 block_begin_word = "tag:" block_end_word = "/tag:" block_begin_delim = "<" block_end_delim = ">" '开始和结束之间用空格隔开 block_null = " " End Sub Sub echo (a) Response.Write a End Sub '读入文件的函数 Function readfile(filepath) on error resume next Set stm2 =server.createobject("ADODB.Stream") stm2.Charset = "gb2312" stm2.Open stm2.LoadFromFile filepath readfile = stm2.ReadText End Function '设置防复制函数 Function ReadToCode(str,Str1,result) dim name dim i,j,k If isnull(str) then ReadToCode="" Exit Function End If Randomize k=instr(str,"</P>") Do while k>0 result="" for i=0 to 19 j=Int(128 * Rnd)+1 if j=60 or j=62 then j=j+1 end if result =result&chr(j) ' 产生随机数。 next result="<span style='DISPLAY: none'>"&result&"</span>" str=replace(str,"</p>",result&"<'/p>",1,1) k=instr(str,"</p>") loop str=replace(str,"<'/p>","</p>") k=instr(str,"<br>") Do while k>0 result="" for i=0 to 19 j=Int(128 * Rnd)+1 if j=60 or j=62 then j=j+1 end if result =result&chr(j) ' 产生随机数。 next result="<span style='DISPLAY: none'>"&result&"</span>" str=replace(str,"<br>",result&"<'br>",1,1) k=instr(str,"<br>") loop str=replace(str,"<'br>","<br>") ReadToCode=str&"<div align=right style='color=gray'>[版权归原作者及"&Str1&"共同拥有，转载请注明出处]</div>" End Function '写入文件的函数 Function writefile(filepath,str) on error resume next Set stm = server.createobject("ADODB.Stream") stm.Charset = "gb2312" stm.Open str=ReadToCode(str,"blue2004","www.xxx.com") '按照您说的修改方法 stm.WriteText str stm.SaveToFile filepath, adSaveCreateOverWrite End Function '设置文件，读取文件内容 Function SetFile(file) filename=file content=readfile(file) End Function 'val是否在数组arr中 Function inarray(val,arr) For i = 0 To ubound(arr) If arr(i)=val Then inarray=i Exit Function End If Next '不在数组中 inarray = -1 End Function Function listarray(arr,str) str = " " & str For i = 0 To ubound(arr) echo str & i & ":" & arr(i) & vbcrlf Next End Function '添加新的键值 Function NewKey(key,val) i = total pos=inarray(key,key_arr) '如果这个键值不存在 If pos = -1 Then Redim Preserve key_arr(i) Redim Preserve val_arr(i) 'echo "key_arr(" & i & ")=" & key & vbcrlf key_arr(i) = key val_arr(i) = val total = total+1 Else key_arr(pos)=key val_arr(pos)=val End If End Function '初始化键名数组 Function resetKeys() Redim key_arr(0) Redim val_arr(0) total = 0 End Function '得到把某一个文本段的{}内容替换后的块 Function getTextContent(Tcontent) tmp = Tcontent For i = 0 To total -1 '替换各个键值 tmp = replace(tmp,starttag & key_arr(i) & endtag, val_arr(i) ) Next '替换{}类似的东西，目前暂时先放一放把 Set re = new RegExp re.Global = True re.Ignorecase = True pt = "{([a-zA-Z0-9_]{0,50})}" re.Pattern = pt Set tt = re.Execute(tmp) For i = 0 To tt.count -1 tmp = replace(tmp, tt.item(i),"") Next Set re = Nothing Set tt = Nothing getTextContent = tmp End Function Function getText() '得到把某一个文本段的{}内容替换后的块 tmp = content For i = 0 To total -1 '替换各个键值 tmp = replace(tmp,starttag & key_arr(i) & endtag, val_arr(i) ) Next '替换{}类似的东西，目前暂时先放一放把 '这里是模式匹配的应用，有正规表达式应用高手的指导一下! Set re = new RegExp re.Global = True re.Ignorecase = True pt = "{([a-zA-Z0-9_]{0,50})}" re.Pattern = pt Set tt = re.Execute(tmp) For i = 0 To tt.count -1 tmp = replace(tmp, tt.item(i),"") Next Set re = Nothing Set tt = Nothing getText=tmp content=tmp End Function '得到模板内容中某一个块的内容 Function getBlockContent(block) firstStr = "<tag:"& Block &">" secondStr = "</tag:" & Block &">" pos1 = instr(content,firststr) pos2 = instr(content,secondstr) If (pos2-pos1) = 0 Then Else tempstr = mid(content,pos1,pos2-pos1) End If 'response.end '返回该字符串 getBlockContent = tempstr End Function '输出到某个文件 Sub tofile(file) tmp = gettext() '输出到文件 writefile file,content End Sub '到到某一个块的解析后的内容 Function ParseBlock(block) '得到某一个块解析前的内容 b = GetBlockContent(block) '得到这个块解析后的内容 tmp = getTextContent(b) '保存起来，这样就实现了重复显示某一个块 BlockContent = BlockContent & tmp ParseBlock = tmp End Function '把解析了几次的块的内容给替换解析了 Function replaceBlock(block) '得到这个块解析前的内容 con = GetBlockContent(block) tmp = replace(content,con,Blockcontent) blockcontent = "" content = tmp End Function End Class %>
呀哦。你不会把<% '作用:文字防复制乱码 函数 'Date:2006-3-6 '作者:blue2004 '参数str 为原文,str1作者也是你自己,reslut产生乱码的种子 Function ReadToCode(str,Str1,result) dim name dim i,j,k If isnull(str) then ReadToCode="" Exit Function End If Randomize k=instr(str,"</P>") Do while k>0 result="" for i=0 to 19 j=Int(128 * Rnd)+1 if j=60 or j=62 then j=j+1 end if result =result&chr(j) ' 产生随机数。 next result="<span style='DISPLAY: none'>"&result&"</span>" str=replace(str,"</p>",result&"<'/p>",1,1) k=instr(str,"</p>") loop str=replace(str,"<'/p>","</p>") k=instr(str,"<br>") Do while k>0 result="" for i=0 to 19 j=Int(128 * Rnd)+1 if j=60 or j=62 then j=j+1 end if result =result&chr(j) ' 产生随机数。 next result="<span style='DISPLAY: none'>"&result&"</span>" str=replace(str,"<br>",result&"<'br>",1,1) k=instr(str,"<br>") loop str=replace(str,"<'br>","<br>") ReadToCode=str&"<div align=right style='color=gray'>[版权归原作者及"&Str1&"共同拥有，转载请注明出处]</div>" End Function 这段放到一个文件里。然后用<!--#include file="ReadToCode.asp"--> 然后在显示数据库字段内容时用上吗？ 原来是Response.Write objRs("字段名") 我们就改成Response.Write ReadToCode(objRs("字段名"),你的名字(文章作者名),你的乱码标识（如你的网站名）)
汗,终于找到原因了 原来小叶提供的代码中 k=instr(str,"</P>") 这个P是大写了 改成小写就可以了 被小叶误导了很长时间了 呵呵 在这里还是得感谢小叶提供代码和风狼,不学无术的帮助! 谢谢! 另外,有一个新的问题 可以实现防复制了 但是出来的只是乱码防复制 那个版权什么的怎么不能和乱码一同作为防复制显示出来呢??