当前位置:首页>>开发编程>>ASP>>新闻内容
利用XBM制作的验证码程序
作者:原作:vifo 发布时间:2003-10-8 2:32:45 文章来源:weste.net整理

主程序共三个

我的调用方式 <script language="javascript" src="/verify/num.asp"></script>
验证方式 if trim(Loginnum)<>trim(session("Loginnum")) then
Response.Write Error("验证码错误!")
Response.End
end if


num.asp

<%
'### To encrypt/decrypt include this code in your page
'### strMyEncryptedString = EncryptString(strString)
'### strMyDecryptedString = DeCryptString(strMyEncryptedString)
'### You are free to use this code as long as credits remain in place
'### also if you improve this code let me know.

Private Function EncryptString(strString)
'####################################################################
'### Crypt Function ? 2001 by Slavic Kozyuk grindkore@yahoo.com ###
'### Arguments: strString <--- String you wish to encrypt ###
'### Output: Encrypted HEX string ###
'####################################################################

Dim CharHexSet, intStringLen, strTemp, strRAW, I, intKey, intOffSet
Randomize Timer

intKey = Round((RND * 1000000) + 1000000) '##### Key Bitsize
intOffSet = Round((RND * 1000000) + 1000000) '##### KeyOffSet Bitsize

If IsNull(strString) = False Then
strRAW = strString
intStringLen = Len(strRAW)

For i = 0 to intStringLen - 1
strTemp = Left(strRAW, 1)
strRAW = Right(strRAW, Len(strRAW) - 1)
CharHexSet = CharHexSet & Hex(Asc(strTemp) * intKey)& Hex(intKey)
Next

EncryptString = CharHexSet & "|" & Hex(intOffSet + intKey) & "|" & Hex(intOffSet)
Else
EncryptString = ""
End If
End Function




Private Function DeCryptString(strCryptString)
'####################################################################
'### Crypt Function ? 2001 by Slavic Kozyuk grindkore@yahoo.com ###
'### Arguments: Encrypted HEX stringt ###
'### Output: Decrypted ASCII string ###
'####################################################################
'### Note this function uses HexConv() and get_hxno() functions ###
'### so make sure they are not removed ###
'####################################################################

Dim strRAW, arHexCharSet, I, intKey, intOffSet, strRawKey, strHexCrypData


strRawKey = Right(strCryptString, Len(strCryptString) - InStr(strCryptString, "|"))
intOffSet = Right(strRawKey, Len(strRawKey) - InStr(strRawKey,"|"))
intKey = HexConv(Left(strRawKey, InStr(strRawKey, "|") - 1)) - HexConv(intOffSet)
strHexCrypData = Left(strCryptString, Len(strCryptString) - (Len(strRawKey) + 1))


arHexCharSet = Split(strHexCrypData, Hex(intKey))

For i=0 to Ubound(arHexCharSet)
strRAW = strRAW & Chr(HexConv(arHexCharSet(i))/intKey)
Next

DeCryptString = strRAW
End Function



Private Function HexConv(hexVar)
Dim hxx, hxx_var, multiply
IF hexVar <> "" THEN
hexVar = UCASE(hexVar)
hexVar = StrReverse(hexVar)
DIM hx()
REDIM hx(LEN(hexVar))
hxx = 0
hxx_var = 0
FOR hxx = 1 TO LEN(hexVar)
IF multiply = "" THEN multiply = 1
hx(hxx) = mid(hexVar,hxx,1)
hxx_var = (get_hxno(hx(hxx)) * multiply) + hxx_var
multiply = (multiply * 16)
NEXT
hexVar = hxx_var
HexConv = hexVar
END IF
End Function

Private Function get_hxno(ghx)
If ghx = "A" Then
ghx = 10
ElseIf ghx = "B" Then
ghx = 11
ElseIf ghx = "C" Then
ghx = 12
ElseIf ghx = "D" Then
ghx = 13
ElseIf ghx = "E" Then
ghx = 14
ElseIf ghx = "F" Then
ghx = 15
End If
get_hxno = ghx
End Function

randomize
num = int(7999*rnd+2000) '计数器的值
num2 = EncryptString(num)
session("Loginnum")=num
%>
document.write("<img src='/verify/count.asp?sksid=<%=num2%>'>") ' 这里是调用图片的路径

count.asp


<!--#include file="numimg.asp"-->

<%
'### To encrypt/decrypt include this code in your page
'### strMyEncryptedString = EncryptString(strString)
'### strMyDecryptedString = DeCryptString(strMyEncryptedString)
'### You are free to use this code as long as credits remain in place
'### also if you improve this code let me know.

Private Function EncryptString(strString)
'####################################################################
'### Crypt Function ? 2001 by Slavic Kozyuk grindkore@yahoo.com ###
'### Arguments: strString <--- String you wish to encrypt ###
'### Output: Encrypted HEX string ###
'####################################################################

Dim CharHexSet, intStringLen, strTemp, strRAW, I, intKey, intOffSet
Randomize Timer

intKey = Round((RND * 1000000) + 1000000) '##### Key Bitsize
intOffSet = Round((RND * 1000000) + 1000000) '##### KeyOffSet Bitsize

If IsNull(strString) = False Then
strRAW = strString
intStringLen = Len(strRAW)

For i = 0 to intStringLen - 1
strTemp = Left(strRAW, 1)
strRAW = Right(strRAW, Len(strRAW) - 1)
CharHexSet = CharHexSet & Hex(Asc(strTemp) * intKey)& Hex(intKey)
Next

EncryptString = CharHexSet & "|" & Hex(intOffSet + intKey) & "|" & Hex(intOffSet)
Else
EncryptString = ""
End If
End Function




Private Function DeCryptString(strCryptString)
'####################################################################
'### Crypt Function ? 2001 by Slavic Kozyuk grindkore@yahoo.com ###
'### Arguments: Encrypted HEX stringt ###
'### Output: Decrypted ASCII string ###
'####################################################################
'### Note this function uses HexConv() and get_hxno() functions ###
'### so make sure they are not removed ###
'####################################################################

Dim strRAW, arHexCharSet, I, intKey, intOffSet, strRawKey, strHexCrypData


strRawKey = Right(strCryptString, Len(strCryptString) - InStr(strCryptString, "|"))
intOffSet = Right(strRawKey, Len(strRawKey) - InStr(strRawKey,"|"))
intKey = HexConv(Left(strRawKey, InStr(strRawKey, "|") - 1)) - HexConv(intOffSet)
strHexCrypData = Left(strCryptString, Len(strCryptString) - (Len(strRawKey) + 1))


arHexCharSet = Split(strHexCrypData, Hex(intKey))

For i=0 to Ubound(arHexCharSet)
strRAW = strRAW & Chr(HexConv(arHexCharSet(i))/intKey)
Next

DeCryptString = strRAW
End Function



Private Function HexConv(hexVar)
Dim hxx, hxx_var, multiply
IF hexVar <> "" THEN
hexVar = UCASE(hexVar)
hexVar = StrReverse(hexVar)
DIM hx()
REDIM hx(LEN(hexVar))
hxx = 0
hxx_var = 0
FOR hxx = 1 TO LEN(hexVar)
IF multiply = "" THEN multiply = 1
hx(hxx) = mid(hexVar,hxx,1)
hxx_var = (get_hxno(hx(hxx)) * multiply) + hxx_var
multiply = (multiply * 16)
NEXT
hexVar = hxx_var
HexConv = hexVar
END IF
End Function

Private Function get_hxno(ghx)
If ghx = "A" Then
ghx = 10
ElseIf ghx = "B" Then
ghx = 11
ElseIf ghx = "C" Then
ghx = 12
ElseIf ghx = "D" Then
ghx = 13
ElseIf ghx = "E" Then
ghx = 14
ElseIf ghx = "F" Then
ghx = 15
End If
get_hxno = ghx
End Function


%>


<%
Dim Image
Dim Width, Height
Dim num
Dim digtal
Dim Length
Dim sort
Length = 4 '自定计数器长度

Redim sort( Length )

num=cint(DeCryptString(request.querystring("sksid")))
digital = ""
For I = 1 To Length -Len( num ) '补0
digital = digital & "0"
Next
For I = 1 To Len( num )
digital = digital & Mid( num, I, 1 )
Next
For I = 1 To Len( digital )
sort(I) = Mid( digital, I, 1 )
Next
Width = 8 * Len( digital ) '图像的宽度
Height = 10 '图像的高度,在本例中为固定值


Response.ContentType="image/x-xbitmap"

hc=chr(13) & chr(10)

Image = "#define counter_width " & Width & hc
Image = Image & "#define counter_height " & Height & hc
Image = Image & "static unsigned char counter_bits[]={" & hc

For I = 1 To Height
For J = 1 To Length
Image = Image & a(sort(J),I) & ","
Next
Next

Image = Left( Image, Len( Image ) - 1 ) '去掉最后一个逗号
Image = Image & "};" & hc
%>
<%
Response.Write Image

%>



numimg.asp



<%
Dim a(10,10)

a(0,1) = "0x3c" '数字0
a(0,2) = "0x66"
a(0,3) = "0xc3"
a(0,4) = "0xc3"
a(0,5) = "0xc3"
a(0,6) = "0xc3"
a(0,7) = "0xc3"
a(0,8) = "0xc3"
a(0,9) = "0x66"
a(0,10)= "0x3c"

a(1,1) = "0x18" '数字1
a(1,2) = "0x1c"
a(1,3) = "0x18"
a(1,4) = "0x18"
a(1,5) = "0x18"
a(1,6) = "0x18"
a(1,7) = "0x18"
a(1,8) = "0x18"
a(1,9) = "0x18"
a(0,10)= "0x7e"


a(2,1) = "0x3c" '数字2
a(2,2) = "0x66"
a(2,3) = "0x60"
a(2,4) = "0x60"
a(2,5) = "0x30"
a(2,6) = "0x18"
a(2,7) = "0x0c"
a(2,8) = "0x06"
a(2,9) = "0x06"
a(2,10)= "0x7e"

a(3,1) = "0x3c" '数字3
a(3,2) = "0x66"
a(3,3) = "0xc0"
a(3,4) = "0x60"
a(3,5) = "0x1c"
a(3,6) = "0x60"
a(3,7) = "0xc0"
a(3,8) = "0xc0"
a(3,9) = "0x66"
a(3,10)= "0x38"

a(4,1) = "0x38" '数字4
a(4,2) = "0x3c"
a(4,3) = "0x36"
a(4,4) = "0x33"
a(4,5) = "0x33"
a(4,6) = "0x33"
a(4,7) = "0xff"
a(4,8) = "0x30"
a(4,9) = "0x30"
a(4,10)= "0xfe"

a(5,1) = "0xfe" '数字5
a(5,2) = "0xfe"
a(5,3) = "0x06"
a(5,4) = "0x06"
a(5,5) = "0x3e"
a(5,6) = "0x60"
a(5,7) = "0xc0"
a(5,8) = "0xc3"
a(5,9) = "0x66"
a(5,10)= "0x3c"

a(6,1) = "0x60" '数字6
a(6,2) = "0x30"
a(6,3) = "0x18"
a(6,4) = "0x0c"
a(6,5) = "0x3e"
a(6,6) = "0x63"
a(6,7) = "0xc3"
a(6,8) = "0xc3"
a(6,9) = "0x66"
a(6,10) ="0x3c"

a(7,1) = "0xff" '数字7
a(7,2) = "0xc0"
a(7,3) = "0x60"
a(7,4) = "0x30"
a(7,5) = "0x18"
a(7,6) = "0x18"
a(7,7) = "0x18"
a(7,8) = "0x18"
a(7,9) = "0x18"
a(7,10)= "0x18"

a(8,1) = "0x3c" '数字8
a(8,2) = "0x66"
a(8,3) = "0xc3"
a(8,4) = "0x66"
a(8,5) = "0x3c"
a(8,6) = "0x66"
a(8,7) = "0xc3"
a(8,8) = "0xc3"
a(8,9) = "0x66"
a(8,10)= "0x3c"

a(9,1) = "0x3c" '数字9
a(9,2) = "0x66"
a(9,3) = "0xc3"
a(9,4) = "0xc3"
a(9,5) = "0x66"
a(9,6) = "0x3c"
a(9,7) = "0x18"
a(9,8) = "0x0c"
a(9,9) = "0x06"
a(9,10)= "0x03"

%>

-----------------------------------------------------------------------------------
icech将以上的程序根据实际的要求做了一点点的修改。因为我在使用这段程序中,发现XBM只能显示黑白两种颜色,0代表白色,1代表黑色,因此将以上1~9的数字进行转换,将0变为1,1变为0,就可以制作出一个黑底白字的随机数XBM图像。
<%
Dim b(10,10)

b(0,1) = "0xc3" '数字0
b(0,2) = "0x99"
b(0,3) = "0x3c"
b(0,4) = "0x3c"
b(0,5) = "0x3c"
b(0,6) = "0x3c"
b(0,7) = "0x3c"
b(0,8) = "0x3c"
b(0,9) = "0x99"
b(0,10)= "0xc3"

b(1,1) = "0xe7"    '数字1
b(1,2) = "0xe3"
b(1,3) = "0xe7"
b(1,4) = "0xe7"
b(1,5) = "0xe7"
b(1,6) = "0xe7"
b(1,7) = "0xe7"
b(1,8) = "0xe7"
b(1,9) = "0xe7"
b(0,10)= "0x81"

b(2,1) = "0xc3" '数字2
b(2,2) = "0x99"
b(2,3) = "0x9f"
b(2,4) = "0x9f"
b(2,5) = "0xcf"
b(2,6) = "0xe7"
b(2,7) = "0xf3"
b(2,8) = "0xf9"
b(2,9) = "0xf9"
b(2,10)= "0x81"

b(3,1) = "0xc3" '数字3
b(3,2) = "0x99"
b(3,3) = "0x3f"
b(3,4) = "0x9f"
b(3,5) = "0xe3"
b(3,6) = "0x9f"
b(3,7) = "0x3f"
b(3,8) = "0x3f"
b(3,9) = "0x99"
b(3,10)= "0xc7"

b(4,1) = "0xc7" '数字4
b(4,2) = "0xc3"
b(4,3) = "0xc9"
b(4,4) = "0xcc"
b(4,5) = "0xcc"
b(4,6) = "0xcc"
b(4,7) = "0x00"
b(4,8) = "0xcf"
b(4,9) = "0xcf"
b(4,10)= "0x01"

b(5,1) = "0x01" '数字5
b(5,2) = "0x01"
b(5,3) = "0xf9"
b(5,4) = "0xf9"
b(5,5) = "0xc1"
b(5,6) = "0x9f"
b(5,7) = "0x3f"
b(5,8) = "0x3c"
b(5,9) = "0x99"
b(5,10)= "0xc3"

b(6,1) = "0x9f" '数字6
b(6,2) = "0xcf"
b(6,3) = "0xef"
b(6,4) = "0xf3"
b(6,5) = "0xc1"
b(6,6) = "0x9c"
b(6,7) = "0x3c"
b(6,8) = "0x3c"
b(6,9) = "0x99"
b(6,10) ="0xc3"

b(7,1) = "0x00" '数字7
b(7,2) = "0x3f"
b(7,3) = "0x9f"
b(7,4) = "0xcf"
b(7,5) = "0xe7"
b(7,6) = "0xe7"
b(7,7) = "0xe7"
b(7,8) = "0xe7"
b(7,9) = "0xe7"
b(7,10)= "0xe7"

b(8,1) = "0xc3" '数字8
b(8,2) = "0x99"
b(8,3) = "0x3c"
b(8,4) = "0x99"
b(8,5) = "0xc3"
b(8,6) = "0x99"
b(8,7) = "0x3c"
b(8,8) = "0x3c"
b(8,9) = "0x99"
b(8,10)= "0xc3"

b(9,1) = "0xc3" '数字9
b(9,2) = "0x99"
b(9,3) = "0x3c"
b(9,4) = "0x3c"
b(9,5) = "0x99"
b(9,6) = "0xc3"
b(9,7) = "0xe7"
b(9,8) = "0xf3"
b(9,9) = "0xf9"
b(9,10)= "0xf7"
%>
    这样就可以了,多想想就会做出你所需要的。


最新更新
·数据库被挂马的ASP处理方法
·ASP快速获取远程文件大小的方
·用ASP屏蔽迅雷和旋风下载工具
·解决ASP中传送中文参数乱码的
·ASP+AJAX做类似Google的搜索
·ASP的一个非常棒的Debug类(
·ASP中常用的服务器检测源代码
·优化ASP中执行SQL效率的五个
·ASP种msxml3.dll 800c0005错
·挂QQ的ASP版本网页源代码
相关信息
画心
愚爱
偏爱
火苗
白狐
画沙
犯错
歌曲
传奇
稻香
小酒窝
狮子座
小情歌
全是爱
棉花糖
海豚音
我相信
甩葱歌
这叫爱
shero
走天涯
琉璃月
Nobody
我爱他
套马杆
爱是你我
最后一次
少女时代
灰色头像
断桥残雪
美了美了
狼的诱惑
我很快乐
星月神话
心痛2009
爱丫爱丫
半城烟沙
旗开得胜
郎的诱惑
爱情买卖
2010等你来
我叫小沈阳
i miss you
姑娘我爱你
我们都一样
其实很寂寞
我爱雨夜花
变心的玫瑰
犀利哥之歌
你是我的眼
你是我的OK绷
贝多芬的悲伤
哥只是个传说
丢了幸福的猪
找个人来爱我
要嫁就嫁灰太狼
如果这就是爱情
我们没有在一起
寂寞在唱什么歌
斯琴高丽的伤心
别在我离开之前离开
不是因为寂寞才想你
爱上你等于爱上了错
在心里从此永远有个你
一个人的寂寞两个人的错