No component generates verification code-GIF format

Source: Internet
Author: User
Tags image identifier

<%
Option explicit 'display Declaration

Class com_gifcode_class
'''''''''''''''''''''''''''''''''''''''' '''''
'Author: layen support@ssaw.NET 84815733 (qq)
'Thanks: laomi, laomiao, netrube
'2006-01-02
'''''''''''''''''''''''''''''''''''''''' '''''
Public noisy, Count, width, height, angle, offset, border

Private graph (), margin (3)

Private sub class_initialize ()
Randomize
Noisy = 16' probability of occurrence of interference points
Count = 4' Character Count
Width = 80' Image Width
Height = 20' Image Height
Angle = 2' random angle variation
Offset = 20' offset random variation
Border = 1' border size
End sub

Public Function create ()

Const ccharsets = "123456789"

Dim I, X, Y

Dim vvalidcode: vvalidcode = ""
Dim vindex

Redim graph (width-1, height-1)

For I = 0 to count-1
Vindex = int (RND * Len (ccharset ))
Vvalidcode = vvalidcode + mid (ccharset, vindex + 1, 1)
Setdraw vindex, I
Next

Create = vvalidcode

End Function

Sub setdot (PX, Py)
If PX * (Width-pX-1)> = 0 and Py * (Height-pY-1)> = 0 then
Graph (PX, Py) = 1
End if
End sub

Public sub setdraw (pindex, pnumber)

'Character data
Dim dotdata (8)
Dotdata (0) = array (30, 15, 50, 1, 50,100)
Dotdata (1) = array (1, 34, 30, 1, 71, 1,100, 34, 1,100, 93,100,100, 86)
Dotdata (2) = array (1, 1,100, 1, 42, 42,100, 70, 50,100, 1, 70)
Dotdata (3) = array (100, 73, 6, 73, 75, 6, 75,100)
Dotdata (4) = array (100, 1, 1, 1, 1, 50, 50, 35,100, 55,100, 80, 50,100, 1, 95)
Dotdata (5) = array (100, 20, 70, 1, 20, 1, 1, 30, 1, 80, 30,100, 70,100,100, 80,100, 60, 70, 50, 30, 50, 1, 60)
Dotdata (6) = array (6, 26, 6, 6,100, 6, 53,100)
Dotdata (7) = array (100, 30,100, 20, 70, 1, 30, 1, 1, 20, 1, 30,100, 70,100, 80, 70,100, 30,100, 1, 80, 1, 70,100, 30)
Dotdata (8) = array (1, 80, 30,100, 80,100,100, 70,100, 20, 70, 1, 30, 1, 1, 20, 1, 40, 30, 50, 70, 50,100, 40)

Dim vextent: vextent = width/count
Margin (0) = border + vextent * (RND * offset)/100 + margin (1)
Margin (1) = vextent * (pnumber + 1)-border-vextent * (RND * offset)/100
Margin (2) = border + height * (RND * offset)/100
Margin (3) = height-border-height * (RND * offset)/100

Dim vstartx, vendx, vstarty, vendy
Dim vwidth, vheight, vdx, vdy, vdeltat

Dim vangle, vlength

Vwidth = int (margin (1)-margin (0 ))

Vheight = int (margin (3)-margin (2 ))

'Start Coordinate
Vstartx = int (dotdata (pindex) (0)-1) * vwidth/100)

Vstarty = int (dotdata (pindex) (1)-1) * vheight/100)

Dim I, j
For I = 1 to ubound (dotdata (pindex), 1)/2

If dotdata (pindex) (2 * I-2) <> 0 and dotdata (pindex) (2 * I) <> 0 then

'Terminal Coordinate
Vendx = (dotdata (pindex) (2 * I)-1) * vwidth/100

Vendy = (dotdata (pindex) (2 x I + 1)-1) * vheight/100

'Horizontal gap
Vdx = vendx-vstartx
'Vertical gap
Vdy = vendy-vstarty

'Skew Angle
If vdx = 0 then
Vangle = SGN (vdy) * 3.14/2
Else
Vangle = ATN (vdy/vdx)
End if

'Coordinate distance
If Sin (vangle) = 0 then
Vlength = vdx
Else
Vlength = vdy/sin (vangle)
End if

'Random rotation angular
Vangle = vangle + (RND-0.5) * 2 * angle * 3.14*2/100

Vdx = int (COS (vangle) * vlength)

Vdy = int (sin (vangle) * vlength)

If ABS (vdx)> ABS (vdy) Then vdeltat = ABS (vdx) else vdeltat = ABS (vdy)

For j = 1 to vdeltat
Setdot margin (0) + vstartx + J * vdx/vdeltat, margin (2) + vstarty + J * vdy/vdeltat
Next

Vstartx = vstartx + vdx

Vstarty = vstarty + vdy
End if
Next
End sub

Public sub output ()

Response. expires =-9999
Response. addheader "Pragma", "No-Cache"
Response. addheader "cache-ctrol", "No-Cache"
Response. contenttype = "image/GIF"

'File type
Response. binarywrite chrb (ASC ("G") & chrb (ASC ("I") & chrb (ASC ("F "))
'Version info
Response. binarywrite chrb (ASC ("8") & chrb (ASC ("9") & chrb (ASC (""))
'Logical screen width
Response. binarywrite chrb (width mod 256) & chrb (width/256) mod 256)
'Logical screen height
Response. binarywrite chrb (height mod 256) & chrb (height/256) mod 256)

Response. binarywrite chrb (128) & chrb (0) & chrb (0)
'Global color list
Response. binarywrite chrb (255) & chrb (255) & chrb (255)

Response. binarywrite chrb (0) & chrb (85) & chrb( 255)

'Image identifier
Response. binarywrite chrb (ASC (","))

Response. binarywrite chrb (0) & chrb (0) & chrb (0) & chrb (0)
'Image width
Response. binarywrite chrb (width mod 256) & chrb (width/256) mod 256)
'Image height
Response. binarywrite chrb (height mod 256) & chrb (height/256) mod 256)

Response. binarywrite chrb (0) & chrb (7) & chrb( 255)

Dim X, Y, I: I = 0
For y = 0 to height-1
For x = 0 to width-1
If RND <noisy/100 then
Response. binarywrite chrb (1-graph (x, y ))
Else
If X * (X-width) = 0 or y * (Y-height) = 0 then
Response. binarywrite chrb (graph (x, y ))
Else
If graph (x-1, y) = 1 or graph (x, y) or graph (x, Y-1) = 1 then
Response. binarywrite chrb (1)
Else
Response. binarywrite chrb (0)
End if
End if
End if
If (y * width + x + 1) mod 126 = 0 then
Response. binarywrite chrb( 128)
I = I + 1
End if
If (y * width + x + I + 1) mod 255 = 0 then
If (width * Height-y * width-X-1)> 255 then
Response. binarywrite chrb( 255)
Else
Response. binarywrite chrb (width * Height mod 255)
End if
End if
Next
Next
Response. binarywrite chrb (128) & chrb (0) & chrb (129) & chrb (0) & chrb (59)
End sub
End Class

Dim mcode
Set mcode = new com_gifcode_class
Session ("getcode") = mcode. Create ()
Mcode. Output ()
Set mcode = nothing
%>

Save it as an ASP file to see the effect!

 

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.