ASP full High Security authentication code generation program

<% @CodePage = "65001"%>
<script language= "VBScript" runat= "Server" >
Option Explicit ' Display declaration
Dim showerrorimg
Showerrorimg = False

function Chkpost ()
Dim server_v1,server_v2
Chkpost=false
Server_v1=cstr (Request.ServerVariables ("Http_referer"))
Server_v2=cstr (Request.ServerVariables ("SERVER_NAME"))
If Mid (Server_v1,8,len (SERVER_V2)) <>server_v2 Then
Chkpost=false
Else
Chkpost=true
End If
End Function

If not Chkpost () Then
Showerrorimg = True
End If


'''''''''''''''''''''''''''''''''''''''''''''
' Author:layen support@ssaw.net 84815733 (QQ)
' Thanks:laomi, Laomiao, Netrube
' 2006-01-02
' url:http://www.111cn.net/
'''''''''''''''''''''''''''''''''''''''''''''

Class Com_gifcode_class
Public noisy, Count, Width, Height, Angle, Offset, Border
Private Graph (), Margin (3)
Private Sub Class_Initialize ()
Randomize
Noisy = 3 ' probability of interference points appearing
Count = 4 ' character quantity
width = 40 ' picture widths
Height = 20 ' picture Heights
Angle = 2 ' angular random change amount
offset = 6 ' offset random change amount
Border = 1.5 ' border size
End Sub

Public Function Create2 (str)
Dim I
Dim Vindex
ReDim Graph (Width-1, Height-1)
For i = 0 to Count-1
Vindex=cint (Mid (str,i+1,1)-1)
Setdraw Vindex, I
Next
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 dictionary
If pindex=-1 Then pindex=9

Dim Dotdata (9)
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)
Dotdata (9) = Array (100, 20, 70, 1, 20, 1, 1, 30, 1, 80, 30, 100, 70, 100, 100, 80, 100, 60, 90, 20, 80,3)

Dim vextent:vextent = Width/count

Margin (0) = Border + vextent * (RND * Offset)/MB + 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))
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
Vendx = (Dotdata (pindex) (2*i)-1) * vwidth/100
Vendy = (Dotdata (pindex) (2*i+1)-1) * vheight/100
VDX = Vendx-vstartx
Vdy = Vendy-vstarty
If VDX = 0 Then
Vangle = SGN (vdy) * 3.14/2
Else
Vangle = Atn (VDY/VDX)
End If
If Sin (Vangle) = 0 Then
Vlength = VDX
Else
Vlength = Vdy/sin (vangle)
End If
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"
Response.BinaryWrite ChrB (ASC ("G")) & ChrB (ASC ("I")) & ChrB (ASC ("F"))
Response.BinaryWrite ChrB (ASC ("8")) & ChrB (ASC ("9")) & ChrB (ASC ("a"))
Response.BinaryWrite ChrB (width mod 256) & ChrB ((width 256) mod 256)
Response.BinaryWrite ChrB (height mod 256) & ChrB ((height 256) mod 256)
Response.BinaryWrite ChrB (128) & ChrB (0) & ChrB (0)
Response.BinaryWrite ChrB (& ChrB) & ChrB (250)
Response.BinaryWrite ChrB (0) & ChrB (0) & ChrB (0)
Response.BinaryWrite ChrB (ASC (","))
Response.BinaryWrite ChrB (0) & ChrB (0) & ChrB (0) & ChrB (0)
Response.BinaryWrite ChrB (width mod 256) & ChrB ((width 256) mod 256)
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))
ElseIf x * (x-width) = 0 Or y * (y-height) = 0 Then
Response.BinaryWrite ChrB (Graph (x, y))
ElseIf 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

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

Randomize
Dim Code
Code = INT (RND * 9000 + 1000)
If showerrorimg Then
Session ("Rcode_") = Int (RND * 9000 + 1000)
Else
Session ("Rcode_") = code
End If
Mcode.create2 (Code)
Mcode.output ()
Set Mcode = Nothing
</script>