来一段asp 防复制的代码

小叶 · 2006-03-06

PHP:

<% '作用:文字防复制乱码函数 '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,"") 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=""&result&"" str=replace(str,"",result&"<'/p>",1,1) k=instr(str,"") loop str=replace(str,"<'/p>","") k=instr(str," ") 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=""&result&"" str=replace(str," ",result&"<'br>",1,1) k=instr(str," ") loop str=replace(str,"<'br>"," ") ReadToCode=str&"<div align=right style='color=gray'>[版权归原作者及"&Str1&"共同拥有，转载请注明出处]</div>" End Function Dim a a="嘎嘎，一篇 不错的好文章哦 我艹，，让你偷。。木　JJ的家伙,嬲。。" 'Only For Test response.write (a) Dim b '为配合转换,字符串ａ的大小都替换成小写 b=ReadToCode(LCase(a),"blue2004","www.xxx.com") 'Output response.write b %>

orochi · 2006-03-06

ok 收下

风狼 · 2006-03-07

a="嘎嘎，一篇 不错的好文章哦 我艹，，让你偷。。木　JJ的家伙,嬲。。"

。。。。。够狠。。小叶个***的家伙。收了

dull · 2006-03-11

:heart: 来嘴一个. 另有ASP版的不?

comic · 2006-03-11

作者: dull:

:heart: 来嘴一个. 另有ASP版的不?
点击展开...

这个不是asp的吖？

muyufan · 2006-03-11

高手给个php的吧

yybase · 2006-03-12

***

tiandi · 2006-03-12

blue2004 又现身了.

sluke · 2006-03-12

看不懂

空心菜 · 2006-04-05

怎么用哦??

风狼 · 2006-04-06

作者: 空心菜:

怎么用哦??
点击展开...

楼上不会用的从文章头开始看~

erentan · 2006-04-07

好东东

空心菜 · 2006-04-07

具体应该怎么用??

小叶 · 2006-04-07

前面的Function

end Function
的你不用去鸟它,直接看后面的

Dim a
a="嘎嘎，一篇 不错的好文章哦 我艹，，让你偷。。木　JJ的家伙,嬲。。"

'Only For Test
response.write (a)
Dim b
'为配合转换,字符串ａ的大小都替换成小写
b=ReadToCode(LCase(a),"blue2004","www.xxx.com")
'Output
response.write b
点击展开...

a 其实就是如你的一篇文章的正文,,好多好多的内容哦...
就是数据库中保存的原文
b 就是用上面的那个函数ReadToCode(LCase(a),"blue2004","www.xxx.com")转换后的结果,

至于中间的两参数blue2004 www.xxx.com就设置你自己的网站或ID,

以后输出的时候就输出b就可以了.

如果还不明白,我没辙了.

空心菜 · 2006-04-07

LZ是好人
不过我想您可能还没明白我的意思
我是说asp里可以这样来调用

你的这个函数怎么调用呢/??

小叶 · 2006-04-08

你在其他页面只要使用 ReadToCode(LCase(a),"blue2004","www.xxx.com")

这样转换,你要防复制的原文就可以了.

空心菜 · 2006-04-08

这里调用我能弄好

整个文件是在下面:

代码:

<%
'---------------------------------------
'模板类，使用系统自定义标记语言输出文件
'---------------------------------------

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 writefile(filepath,str)
on error resume next
Set stm = server.createobject("ADODB.Stream";)
stm.Charset = "gb2312"
stm.Open
str=ReadToCode(LCase(a),"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
%>

下面请问您提供的那个代码应该放在什么地方??

不学无术 · 2006-04-08

将他的代码保存为一个文件，在需要使用该函数的页面中包含该页面，在需要使用的地方调用该函数，即可。

空心菜 · 2006-04-08

作者: 不学无术:

将他的代码保存为一个文件，在需要使用该函数的页面中包含该页面，在需要使用的地方调用该函数，即可。
点击展开...

在需要使用该函数的页面中包含该页面
请问具体代码怎么写??
把他的代码保存为php文件吧?然后呢??顺便说一下,我上面发的代码是asp的

空心菜 · 2006-04-08

代码:

这样用有问题吗??
<%
'---------------------------------------
'模板类，使用系统自定义标记语言输出文件
'---------------------------------------

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
%>

论坛

来一段asp 防复制的代码

小叶 New Member

orochi New Member

风狼 New Member

dull New Member

comic New Member

muyufan New Member

yybase New Member

tiandi New Member

sluke New Member

空心菜 New Member

风狼 New Member

erentan New Member

空心菜 New Member

小叶 New Member

空心菜 New Member

小叶 New Member

空心菜 New Member

不学无术 Ulysses 的元神

空心菜 New Member

空心菜 New Member

快捷检索

来一段asp 防复制的代码

小叶 New Member

orochi New Member

风狼 New Member

dull New Member

comic New Member

muyufan New Member

yybase New Member

tiandi New Member

sluke New Member

空心菜 New Member

风狼 New Member

erentan New Member

空心菜 New Member

小叶 New Member

空心菜 New Member

小叶 New Member

空心菜 New Member

不学无术 Ulysses 的元神

空心菜 New Member

空心菜 New Member