ASP verification code source code

<%
'------------------
'Image Verification Code
'Netdust
'05-8-29 release
'The previous image verification code is very easy to crack, so it is improved based on it, even if you know the source code
'Is also difficult to crack.
'The interference frequency is increased by about 100*100 times per 1-> the price of the brute-force method
'Setting the probability of noise can effectively reduce the accuracy rate of software recognition.
'05-12-20 corrected an error.
'------------------

Option explicit

Call com_creatvalidcode ("getcode ")

Rem generates Verification Code Image
Sub com_creatvalidcode (PSN)
Const codelen = 4' number of digits of the Verification Code
Const codds = 3' probability of occurrence of a random dot
Const dbttimes = 1' interference count (security considerations, preferably not less than 3)

Const camount = 10' font count
Const cCode = "0123456789" 'Character Library
Const unitwidth = 16' (to be a multiple of 4)
Const unitheight = 13' text height
Const dotslimit = 5' maximum number of valid points to be deleted each time (to avoid human recognition failures)
Const trycount = 5' prevent attempts to delete valid points from exceeding the upper limit

'-----------

Randomize
Dim I, II, III

'Prohibit caching
Response. expires =-9999
Response. addheader "Pragma", "No-Cache"
Response. addheader "cache-ctrol", "No-Cache"
Response. contenttype = "image/BMP"

'Number of colors? Character, background)
Dim vcolordata (1)
Vcolordata (0) = chrb (0) & chrb (0) & chrb (0) 'Blue 0, green 0, red 0 (black)
Vcolordata (1) = chrb (255) & chrb (255) & chrb (255) 'Blue 250, green 236, red 211 (light blue)

'Character data (you can modify it yourself. If you modify the size, remember to change the previous settings)
Dim vnumberdata (9)
Vnumberdata (0) = "1111000000001111111000000000011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100000000001111111000000001111"
Vnumberdata (1) = "1111110001111111111100000111111111100000011111111100110001111111111111000111111111111100011111111111110001111111111111000111111111111100011111111111110001111111111111000111111111100000000011111110000000001111"
Vnumberdata (2) = "1111110000011111111110000000111111110001110011111110001111001111111111111001111111111111001111111111111001111111111111001111111111111001111111111111001111001111111001111100111111100000000011111110000000001111"
Vnumberdata (3) = "1111100000011111111100000000111111100111111001111110011111001111111111111001111111111110001111111111111000111111111111111001111111111111110011111110011111100111111001111110011111110000000011111111100000011111"
Vnumberdata (4) = "1111111100111111111110110011111111110011001111111111001100111111111001110011111111001111001111111000000000000011100000000000001111111111001111111111111100111111111111110011111111111111001111111111111100111111"
Vnumberdata (5) = "1110000000000111110011111111111111001111111111111100111111111111110011111111111111001100000011111100000111100111111111111110011111111111111001111111111111100111110011111110011111001111111001111110000000001111"
Vnumberdata (6) = "1111110000011111111110000000111111110011111001111110011111111111111001111111111111100100000111111110000000001111111000111110011111100111111001111110011111100111111001111110011111110000000011111111100000011111"
Vnumberdata (7) = "1110000000000111111000000000011111100111111001111110011111100111111111111100111111111111110011111111111110011111111111110011111111111111001111111111111100111111111111110011111111111111001111111111111100111111"
Vnumberdata (8) = "1111100000011111111100000000111111100111111001111110011111100111111001111110011111110000000011111111000000001111111100111100111111100111111001111110011111100111111001111110011111110000000011111111100000011111"
Vnumberdata (9) = "1111100000011111111100000000111111100111111001111110011111100111111001111110011111110000000001111111000000100111111111111110011111111111111001111111111111100111111001111100111111110000000011111111100000011111"

'Randomly generated characters
Dim vcodes
Redim vcode (codeLen-1)
For I = 0 to codeLen-1
Vcode (I) = int (RND * camount)
Vcodes = vcodes & Mid (cCode, vcode (I) + 1, 1)
Vcode (I) = pcd_doubter (vnumberdata (vcode (I), unitwidth, unitheight, dotslimit, trycount, dbttimes)
Next

Session (PSN) = vcodes 'record the session

'Output image file headers
Response. binarywrite chrb (66) & chrb (77) & num2chrb (54 + unitwidth * unitheight * codelen * 3,4) & chrb (0) & chrb (0 )&_
Chrb (0) & chrb (0) & chrb (54) & chrb (0) & chrb (0) & chrb (0) & chrb (40) & chrb (0) &_
Chrb (0) & chrb (0) & num2chrb (unitwidth * codelen, 4) & num2chrb (unitheight, 4 )&_
Chrb (1) & chrb (0)

'Output Image Information Headers
Response. binarywrite chrb (24) & chrb (0) & chrb (0) & chrb (0) & chrb (0) & chrb (0) & num2chrb (unitwidth * unitheight * codelen * 3, 4 )&_
Chrb (18) & chrb (11) & chrb (0) & chrb (0) & chrb (18) & chrb (11 )&_
Chrb (0) & chrb (0) & chrb (0) & chrb (0) & chrb (0) & chrb (0) & chrb (0) & chrb (0) &_
Chrb (0) & chrb (0)

For I = UnitHeight-1 to 0 step-1 'goes through all rows
For II = 0 to codeLen-1 'goes through all words
For IIi = 1 to unitwidth' goes through all pixels
If RND * 99 + 1> = codds then' output image data row by row, word by word, and pixel by Pixel
Response. binarywrite vcolordata (mid (vcode (II), I * unitwidth + III, 1 ))
Else' random generation of vertices
Response. binarywrite vcolordata (1-cint (mid (vcode (II), I * unitwidth + III, 1 )))
End if
Next
Next
Next
End sub

Rem interferes with the lattice of a single word
Rem Interference Idea: randomly generate two endpoints in the dot matrix range, connect them, and create a horizontal axis with a large displacement. Delete the points on the line first, move the vertices (randomly determined) above or below the vertical axis of the deleted vertex to the deleted vertex, and then fill the blank space with the background color.
Function pcd_doubter (byval STR, unitwidth, unitheight, dotslimit, trycount, dbttimes)
Randomize
Dim x1, x2, Y1, Y2, xoffset, yoffset, direction, flag, rows, step, Yu, yustr, I, II, III, F1, F2
For F1 = 1 to dbttimes interference count
For F2 = 1 to trycount 'Avoid the number of attempts to delete a valid vertex that exceeds the upper limit
'Randomly determine two endpoints
X1 = int (RND * unitwidth)
X2 = int (RND * unitwidth)
Y1 = int (RND * unitheight)
Y2 = int (RND * unitheight)
'X, y displacement
Xoffset = ABS (x2-x1)
Yoffset = ABS (y2-y1)
If xoffset> = yoffset then', the horizontal axis is made based on the displacement.
Direction = "X"
Redim ary (xoffset) 'is used to record the Y value of each point of the link.
'X2, Y2 stores vertices with a large x value
If X2 <X1 then
I = x1
X1 = x2
X2 = I
I = Y1
Y1 = Y2
Y2 = I
End if
'Judging from x1-> X2 is increasing or decreasing in the vertical axis
If Y2> = Y1 then
Flag = 1
Else
Flag =-1
End if
'Calculate the distribution of points on the line below (first, the points of each row are evenly allocated, and then the remaining points are randomly allocated to each row)
Rows = yoffset + 1'
Step = (xoffset + 1)/rows 'average distribution points of each row
Yu = (xoffset + 1) mod rows 'remaining points
Redim ary2 (rows-1) 'is used to record the random allocation of the remaining points.
While Yu> 0
I = int (RND * Rows)
Ary2 (I) = ary2 (I) & "." 'adds a character to the row to be allocated "."
Yu = Yu-1
Wend
IIi = 0
'Record the vertex information of the link to the array.
For I = 0 to rows-1
For II = 1 to step + Len (ary2 (I ))
Ary (iii) = Y1 + I * flag
IIi = III + 1
Next
Next
II = 0
'Count the number of valid points on the Link
For I = 0 to xoffset
If pcd_getdot (X1 + I, Ary (I), STR, unitwidth) = "0" then II = II + 1
Next
Else
'Y is used as the horizontal axis. The principle is the same as that of X.
Direction = "Y"
Redim ary (yoffset)
If Y2 <Y1 then
I = x1
X1 = x2
X2 = I
I = Y1
Y1 = Y2
Y2 = I
End if
If X2> = x1 then
Flag = 1
Else
Flag =-1
End if
Rows = xoffset + 1
Step = (yoffset + 1)/rows
Yu = (yoffset + 1) mod rows
Redim ary2 (rows-1)
While Yu> 0
I = int (RND * 10)
If I <rows then
Ary2 (I) = ary2 (I )&"."
Yu = Yu-1
End if
Wend
IIi = 0
For I = 0 to rows-1
For II = 1 to step + Len (ary2 (I ))
Ary (iii) = X1 + I * flag
IIi = III + 1
Next
Next
II = 0
For I = 0 to yoffset
If pcd_getdot (ary (I), Y1 + I, STR, unitwidth) = "0" then II = II + 1
Next
End if
'If the valid point limit is not exceeded, the loop jumps out and the interference is executed.
If II <= dotslimit then exit
Next

If direction = "X" then
'Randomly move up or down the vertical axis
If int (RND * 10)> 4 then
'Point on Variable Line
For I = 0 to xoffset
'Traverse and move
For II = ary (I) to 1 step-1
Call pcd_setdot (X1 + I, ii, STR, pcd_getdot (X1 + I, II-1, STR, unitwidth), unitwidth)
Next
'Fill Blank
Call pcd_setdot (X1 + I, 0, STR, "1", unitwidth)
Next
Else
For I = 0 to xoffset
For II = ary (I) to UnitHeight-2
Call pcd_setdot (X1 + I, ii, STR, pcd_getdot (X1 + I, II + 1, STR, unitwidth), unitwidth)
Next
Calls pcd_setdot (X1 + I, UnitHeight-1, STR, "1", unitwidth)
Next
End if
Else
If int (RND * 10)> 4 then
For I = 0 to yoffset
For II = ary (I) to 1 step-1
Call pcd_setdot (II, Y1 + I, STR, pcd_getdot (II-1, Y1 + I, STR, unitwidth), unitwidth)
Next
Call pcd_setdot (0, Y1 + I, STR, "1", unitwidth)
Next
Else
For I = 0 to yoffset
For II = ary (I) to UnitWidth-2
Call pcd_setdot (II, Y1 + I, STR, pcd_getdot (II + 1, Y1 + I, STR, unitwidth), unitwidth)
Next
Call pcd_setdot (UnitWidth-1, Y1 + I, STR, "1", unitwidth)
Next
End if
End if
Next
Pcd_doubter = Str
End Function

Rem obtains the characters of a vertex.
Function pcd_getdot (X, Y, STR, unitwidth)
Pcd_getdot = mid (STR, x + 1 + y * unitwidth, 1)
End Function

Rem sets the characters of a vertex
Sub pcd_setdot (X, Y, byref STR, newdot, unitwidth)
STR = left (STR, x + y * unitwidth) & newdot & right (STR, Len (STR)-x-y * UnitWidth-1)
End sub

The format required for converting the number into BMP is the length of the Target byte.
Function num2chrb (Num, lens)
Dim ret, I
Ret = ""
While (Num> 0)
Ret = RET & chrb (Num mod 256)
Num = num/ 256
Wend
For I = lenb (RET) to lens-1
Ret = RET & chrb (0)
Next
Num2chrb = RET
End Function
%>

Save as code. asp

Use

Verify the Function

Code: function codepass ()
Dim codestr
Codestr = trim (Request ("codestr "))
If CSTR (Session ("getcode") = CSTR (codestr) and codestr <> "then
Codepass = true
'Session ("getcode") = empty
Else
Codepass = false
'Session ("getcode") = empty
End if
End function <% if trim (request. form ("validate_code") = empty or trim (Session ("getcode") <> trim (request. form ("validate_code") then
Response. Write ("<script language = JavaScript> alert ('Enter the verification code correctly '); javascript: window. History. Go (-1); </SCRIPT> ")

Response. End
End if %>
<%
Option explicit
Response. Buffer = true
Numcode (8) 'note:, is color background type, is black and white type, 9, 12, 15, 18 is noise type
Function numcode (codetype)
Response. expires =-1
Response. addheader "Pragma", "No-Cache"
Response. addheader "cache-ctrol", "No-Cache"
On Error resume next
Dim znum, rnum, I, j, listnum, listcode
Dim Ados, ados1
Listcode = "0123456789 abcdefghijklmnopqrstuvwxyz"
Randomize Timer
Dim zimg (6), NSTR
For I = 0 to 5
Rnum = CSTR (CINT (35 * RND) 'change 35 to 9 to use a pure digital password.
Zimg (I) = rnum
Listnum = listnum & Mid (listcode, rnum + 1, 1)
Next
Session ("checkcode") = listnum
Dim POS
Set Ados = server. Createobject ("ADODB. Stream ")
Ados. mode = 3
Ados. type = 1
Ados. Open
Set ados1 = server. Createobject ("ADODB. Stream ")
Ados1.mode = 3
Ados1.type = 1
Ados1.open
Ados. loadfromfile (server. mappath ("../images/body" & codetype & ". Fix "))
Ados1.write Ados. Read (1, 2880)
For I = 0 to 5
Ados. Position = (35-zimg (I) * 480
Ados1.position = I * 480
Ados1.write Ados. Read (1, 480)
Next
Ados. loadfromfile (server. mappath ("../images/head. Fix "))
Pos = lenb (Ados. Read ())
Ados. Position = POS
For I = 0 to 15 Step 1
For J = 0 to 5
Ados1.position = I x 32 + J x 480
Ados. Position = POS + 30 * j + I * 270
Ados. Write ados1.read (30)
Next
Next
Response. contenttype = "image/BMP"
Ados. Position = 0
Response. binarywrite Ados. Read ()
Ados. Close: Set Ados = nothing
Ados1.close: Set ados1 = nothing
'If err then Session ("checkcode") = "999999"
End Function
%>