verifycode.asp
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit
Session.CodePage = 65001
Response.Charset = "UTF-8"
Response.Expires = -1
Response.AddHeader "Pragma", "no-cache"
Response.AddHeader "cache-ctrol", "no-cache"
'**********************************************
' File: NetRube_VerifyCode.asp
' Version: NetRube VerifyCode Class Version 1.0 Build 20041228
' Author: NetRube
' Email: NetRube@126.com
' Date: 12/28/2004
' Comments: The code for the VerifyCode GIF image.
' This can free usage, but please
' not to delete this copyright information.
' If you have a modification version,
' Please send out a duplicate to me.
'**********************************************
' 文件名: NetRube_VerifyCode.asp
' 版本: NetRube VerifyCode Class Version 1.0 Build 20041228
' 作者: NetRube(网络乡巴佬)
' 电子邮件: NetRube@126.com
' 日期: 2004年12月28日
' 声明: 验证码图片生成类
' 本代码可以自由使用,但请保留此版权声明信息
' 如果您对本上传类进行修改增强,
' 请发送一份给俺。
'**********************************************
Class NetRube_VerifyCode
Public GlobalColorTable(), LocalColorTable()
Public TransparentColorIndex, UseTransparency
Public GIF89a
Public Comment
Private FGroundColorIndex, BGroundColorIndex
Private Image
Private GlobalColorTableSize, GlobalColorTableFlag, LocalColorTableSize, LocalColorTableFlag
Private Width_, Height_
Private LeftPosition, TopPosition
Private Bits, ColorResolution, CodeSize
Private PixelAspectRatio
Private SortFlag, InterlaceFlag
Private Seperator, GraphicControl, EndOfImage
Private Reserved
Private Font
Private Letter(19)
Private Sub Class_Initialize()
Image = ""
GIF89a = False
ReDim GlobalColorTable(256)
GlobalColorTableSize = 7
GlobalColorTableFlag = True
GlobalColorTable(2) = RGB(255, 0, 0)
GlobalColorTable(3) = RGB(0, 255, 0)
GlobalColorTable(4) = RGB(0, 0, 255)
GlobalColorTable(5) = RGB(255, 255, 0)
GlobalColorTable(6) = RGB(0, 255, 255)
GlobalColorTable(7) = RGB(255, 0, 255)
ReDim LocalColorTable(0)
LocalColorTableSize = 0
LocalColorTableFlag = False
ColorResolution = 7
Bits = 7
CodeSize = 7
BGroundColorIndex = 0
FGroundColorIndex = 1
TransparentColorIndex = 0
UseTransparency = False
LeftPosition = 0
TopPosition = 0
Width_ = 20
Height_ = 20
Clear
PixelAspectRatio = 0
SortFlag = False
InterlaceFlag = False
Seperator = Asc(",")
GraphicControl = Asc("!")
EndOfImage = Asc(";")
Comment = ""
Reserved = 0
Set Font = Server.CreateObject("Scripting.Dictionary")
Letter(0) = "00000000000000"
Letter(1) = "00001111100000"
Letter(2) = "00011111110000"
Letter(3) = "00111000111000"
Letter(4) = "00110000011100"
Letter(5) = "01110000001100"
Letter(6) = "01100000001110"
Letter(7) = "01100000001110"
Letter(8) = "11100000001110"
Letter(9) = "11000000001110"
Letter(10) = "11000000001110"
Letter(11) = "11100000001110"
Letter(12) = "11100000001100"
Letter(13) = "11100000001100"
Letter(14) = "01100000001100"
Letter(15) = "01110000011100"
Letter(15) = "00111000011000"
Letter(16) = "00011111110000"
Letter(17) = "00001111100000"
Letter(18) = "00000000000000"
Font.Add "0", Letter
Letter(0) = "00000000000000"
Letter(1) = "00000001110000"
Letter(2) = "00000001110000"
Letter(3) = "00000011100000"
Letter(4) = "00000011000000"
Letter(5) = "00000011000000"
Letter(6) = "00000011000000"
Letter(7) = "00000111000000"
Letter(8) = "00000111000000"
Letter(9) = "00000111000000"
Letter(10) = "00000110000000"
Letter(11) = "00000110000000"
Letter(12) = "00000110000000"
Letter(13) = "00000110000000"
Letter(14) = "00000110000000"
Letter(15) = "00000110000000"
Letter(15) = "00000110000000"
Letter(16) = "00000110000000"
Letter(17) = "00000010000000"
Letter(18) = "00000000000000"
Font.Add "1", Letter
Letter(0) = "00000000000000"
Letter(1) = "00001111110000"
Letter(2) = "00011111111000"
Letter(3) = "00111000011100"
Letter(4) = "01110000011100"
Letter(5) = "01110000011000"
Letter(6) = "01100000011000"
Letter(7) = "00000000111000"
Letter(8) = "00000001110000"
Letter(9) = "00000001110000"
Letter(10) = "00000011000000"
Letter(11) = "00000111000000"
Letter(12) = "00001110000000"
Letter(13) = "00011000000000"
Letter(14) = "00011000000000"
Letter(15) = "00110000011100"
Letter(16) = "01101111111100"
Letter(17) = "01111111111110"
Letter(18) = "01111100000000"
Letter(19) = "00000000000000"
Font.Add "2", Letter
Letter(0) = "00000000000000"
Letter(1) = "00001111111000"
Letter(2) = "00111111111000"
Letter(3) = "01110000111100"
Letter(4) = "01100000011000"
Letter(5) = "01000000111000"
Letter(6) = "00000000111000"
Letter(7) = "00000001110000"
Letter(8) = "00000011000000"
Letter(9) = "00000111110000"
Letter(10) = "00000100111000"
Letter(11) = "00000000011100"
Letter(12) = "00000000011100"
Letter(13) = "00000000011100"
Letter(14) = "00000000011100"
Letter(15) = "00000000011000"
Letter(16) = "11100000111000"
Letter(17) = "11111111110000"
Letter(18) = "01111111100000"
Letter(19) = "00000000000000"
Font.Add "3", Letter
Letter(0) = "00000000000000"
Letter(1) = "00000000111000"
Letter(2) = "00000001111000"
Letter(3) = "00000011100000"
Letter(4) = "00000111011100"
Letter(5) = "00001110011100"
Letter(6) = "00001100011000"
Letter(7) = "00011000111000"
Letter(8) = "00111000110000"
Letter(9) = "01110000110000"
Letter(10) = "01100000110000"
Letter(11) = "01100000110000"
Letter(12) = "11000111111110"
Letter(13) = "11111111111100"
Letter(14) = "11111111100000"
Letter(15) = "11100001100000"
Letter(16) = "00000001110000"
Letter(17) = "00000000110000"
Letter(18) = "00000000110000"
Letter(19) = "00000000100000"
Font.Add "4", Letter
Letter(0) = "00000000000000"
Letter(1) = "00001100000100"
Letter(2) = "00011111111110"
Letter(3) = "00011111111100"
Letter(4) = "00011110000000"
Letter(5) = "00011000000000"
Letter(6) = "00111000000000"
Letter(7) = "00111000000000"
Letter(8) = "00111111110000"
Letter(9) = "00111111111000"
Letter(10) = "00000000011000"
Letter(11) = "00000000011000"
Letter(12) = "00000000011000"
Letter(13) = "00000000011000"
Letter(14) = "00000000011000"
Letter(15) = "00000000011000"
Letter(16) = "00000001111000"
Letter(17) = "01111111110000"
Letter(18) = "00111111000000"
Letter(19) = "00000000100000"
Font.Add "5", Letter
Letter(0) = "00000000000000"
Letter(1) = "00000011110000"
Letter(2) = "00000111100000"
Letter(3) = "00001110000000"
Letter(4) = "00011100000000"
Letter(5) = "00111000000000"
Letter(6) = "00110000000000"
Letter(7) = "00110000000000"
Letter(8) = "01111111110000"
Letter(9) = "01111111111000"
Letter(10) = "01110000011100"
Letter(11) = "01100000001100"
Letter(12) = "01100000001100"
Letter(13) = "01100000001100"
Letter(14) = "01100000001100"
Letter(15) = "01110000011100"
Letter(16) = "00110000011100"
Letter(17) = "00111111111000"
Letter(18) = "00011111110000"
Letter(19) = "00000000000000"
Font.Add "6", Letter
Letter(0) = "00000000000000"
Letter(1) = "00100111111110"
Letter(2) = "01111111111100"
Letter(3) = "01111110011100"
Letter(4) = "00000000011000"
Letter(5) = "00000000111000"
Letter(6) = "00000000110000"
Letter(7) = "00000000110000"
Letter(8) = "00000000110000"
Letter(9) = "00000001110000"
Letter(10) = "00000001100000"
Letter(11) = "00000001100000"
Letter(12) = "00000001100000"
Letter(13) = "00000001100000"
Letter(14) = "00000011100000"
Letter(15) = "00000011100000"
Letter(16) = "00000011100000"
Letter(17) = "00000001000000"
Letter(18) = "00000001000000"
Letter(19) = "00000000000000"
Font.Add "7", Letter
Letter(0) = "00000000000000"
Letter(1) = "00001111110000"
Letter(2) = "00011111111000"
Letter(3) = "00111000011000"
Letter(4) = "00110000011000"
Letter(5) = "01110000011100"
Letter(6) = "01110000011000"
Letter(7) = "00110000011000"
Letter(8) = "00111101111000"
Letter(9) = "00011111111000"
Letter(10) = "00111000111100"
Letter(11) = "01110000001100"
Letter(12) = "01110000001100"
Letter(13) = "01100000001110"
Letter(14) = "01100000001100"
Letter(15) = "01100000001100"
Letter(16) = "01110000011100"
Letter(17) = "00111111111100"
Letter(18) = "00011111110000"
Letter(19) = "00000000000000"
Font.Add "8", Letter
Letter(0) = "00000000000000"
Letter(1) = "00011111110000"
Letter(2) = "00111111111000"
Letter(3) = "01110000111000"
Letter(4) = "01110000011100"
Letter(5) = "01100000001100"
Letter(6) = "01100000001100"
Letter(7) = "01100000001100"
Letter(8) = "01100000001100"
Letter(9) = "01110000011100"
Letter(10) = "00111111111100"
Letter(11) = "00011111111100"
Letter(12) = "00000000011000"
Letter(13) = "00000000011000"
Letter(14) = "00000000111000"
Letter(15) = "00000001110000"
Letter(16) = "00000011100000"
Letter(17) = "00000111000000"
Letter(18) = "00011110000000"
Letter(19) = "00000000000000"
Font.Add "9", Letter
End Sub
Private Sub Class_Terminate()
Font.RemoveAll
Set Font = Nothing
End Sub
Public Property Get Width()
Width = Width_
End Property
Public Property Get Height()
Height = Height_
End Property
Public Property Get Version()
Version = "NetRube VerifyCode Class 1.0 Build 20041225"
End Property
Public Property Let BGroundColor(ByVal Color)
GlobalColorTable(0) = MakeColor(Color)
BGroundColorIndex = 0
End Property
Public Property Let FGroundColor(ByVal Color)
GlobalColorTable(1) = MakeColor(Color)
FGroundColorIndex = 1
End Property
Public Property Get Pixel(ByVal PX, ByVal PY)
If (PX > 0 And PX <= Width_) And (PY > 0 And PY <= Height_) Then
Pixel = AscB(MidB(Image, (Width_ * (PY - 1)) + PX, 1))
Else
Pixel = 0
End If
End Property
Public Property Let Pixel(ByVal PX, ByVal PY, PValue)
Dim Offset
PX = Int(PX)
PY = Int(PY)
PValue = Int(PValue)
Offset = Width_ * (PY - 1)
If (PX > 0 And PX <= Width_) And (PY > 0 And PY <= Height_) Then
Image = LeftB(Image, Offset + (PX - 1)) & ChrB(PValue) & RightB(Image, LenB(Image) - (Offset + PX))
End If
End Property
Public Sub Clear()
Image = String(Width_ * (Height_ + 1) / 2, ChrB(BGroundColorIndex) & ChrB(BGroundColorIndex))
End Sub
Public Sub Resize(ByVal NewWidth, ByVal NewHeight, RPreserve)
Dim OldImage, OldWidth, OldHeight
Dim CopyWidth, CopyHeight
Dim X, Y
If RPreserve Then
OldImage = Image
OldWidth = Width_
OldHeight = Height_
End If
Width_ = NewWidth
Height_ = NewHeight
Clear
If RPreserve Then
If NewWidth > OldWidth Then CopyWidth = OldWidth Else CopyWidth = NewWidth
If NewHeight > OldHeight Then CopyHeight = OldHeight Else CopyHeight = NewHeight
Width_ = NewWidth
Height_ = NewHeight
For Y = 1 To CopyHeight
For X = 1 To CopyWidth
Pixel(X, Y) = AscB(MidB(OldImage, (OldWidth * (Y - 1)) + X, 1))
Next
Next
End If
End Sub
Private Function ShiftLeft(SLValue, SLBits)
ShiftLeft = SLValue * (2 ^ SLBits)
End Function
Private Function ShiftRight(SRValue, SRBits)
ShiftRight = Int(SRValue / (2 ^ SRBits))
End Function
Private Function Low(LValue)
Low = LValue And &HFF
End Function
Private Function High(HValue)
High = ShiftRight(HValue, 8)
End Function
Private Function Blue(BValue)
Blue = Low(ShiftRight(BValue, 16))
End Function
Private Function Green(GValue)
Green = Low(ShiftRight(GValue, 8))
End Function
Private Function Red(RValue)
Red = Low(RValue)
End Function
Private Function MakeColor(MCValue)
MakeColor = CLng("&H" & Right(MCValue, 2) & Mid(MCValue, 4, 2) & Mid(MCValue, 2, 2))
End Function
Private Function GetWord(GWValue)
GetWord = ShiftLeft(AscB(RightB(GWValue, 1)), 8) Or AscB(LeftB(GWValue, 1))
End Function
Private Function MakeWord(MWValue)
MakeWord = ChrB(Low(MWValue)) & ChrB(High(MWValue))
End Function
Private Function MakeByte(MBValue)
MakeByte = ChrB(Low(MBValue))
End Function
Private Function UncompressedData()
Dim ClearCode, ChunkMax, EndOfStream
Dim UDData, UD, U
UncompressedData = ""
ClearCode = 2 ^ Bits
ChunkMax = 2 ^ Bits - 2
EndOfStream = ClearCode + 1
UDData = ""
For U = 1 To LenB(Image) Step ChunkMax
UDData = UDData & MidB(Image, U, ChunkMax) & ChrB(ClearCode)
Next
For U = 1 To LenB(UDData) Step &HFF
UD = MidB(UDData, U, &HFF)
UncompressedData = UncompressedData & MakeByte(LenB(UD)) & UD
Next
UncompressedData = UncompressedData & MakeByte(&H00)
UncompressedData = UncompressedData & MakeByte(EndOfStream)
End Function
Private Function GetGColorTable()
Dim GGCT
GetGColorTable = ""
For GGCT = 0 To UBound(GlobalColorTable) - 1
GetGColorTable = GetGColorTable & MakeByte(Red(GlobalColorTable(GGCT)))
GetGColorTable = GetGColorTable & MakeByte(Green(GlobalColorTable(GGCT)))
GetGColorTable = GetGColorTable & MakeByte(Blue(GlobalColorTable(GGCT)))
Next
End Function
Private Function GetLColorTable()
Dim GLCT
GetLColorTable = ""
For GLCT = 0 To UBound(LocalColorTable) - 1
GetLColorTable = GetLColorTable & MakeByte(Red(LocalColorTable(GLCT)))
GetLColorTable = GetLColorTable & MakeByte(Green(LocalColorTable(GLCT)))
GetLColorTable = GetLColorTable & MakeByte(Blue(LocalColorTable(GLCT)))
Next
End Function
Private Function GlobalDescriptor()
GlobalDescriptor = 0
If GlobalColorTableFlag Then GlobalDescriptor = GlobalDescriptor Or ShiftLeft(1, 7)
GlobalDescriptor = GlobalDescriptor Or ShiftLeft(ColorResolution, 7)
If SortFlag Then GlobalDescriptor = GlobalDescriptor Or ShiftLeft(1, 3)
GlobalDescriptor = GlobalDescriptor Or GlobalColorTableSize
End Function
Private Function LocalDescriptor()
LocalDescriptor = 0
If LocalColorTableFlag Then LocalDescriptor = LocalDescriptor Or ShiftLeft(1, 7)
If InterlaceFlag Then LocalDescriptor = LocalDescriptor Or ShiftLeft(1, 6)
If SortFlag Then LocalDescriptor = LocallDescriptor Or ShiftLeft(1, 5)
LocalDescriptor = LocalDescriptor Or ShiftLeft(Reserved, 3)
LocalDescriptor = LocalDescriptor Or LocalColorTableSize
End Function
Private Property Get ImageData()
Dim Text, I
ImageData = GIFHeader
ImageData = ImageData & MakeWord(Width_)
ImageData = ImageData & MakeWord(Height_)
ImageData = ImageData & MakeByte(GlobalDescriptor)
ImageData = ImageData & MakeByte(BGroundColorIndex)
ImageData = ImageData & MakeByte(PixelAspectRatio)
ImageData = ImageData & GetGColorTable
If GIF89a Then
If UseTransparency Then
ImageData = ImageData & MakeByte(GraphicControl)
ImageData = ImageData & MakeByte(&HF9)
ImageData = ImageData & MakeByte(&H04)
ImageData = ImageData & MakeByte(&H01)
ImageData = ImageData & MakeByte(&H00)
ImageData = ImageData & MakeByte(TransparentColorIndex)
ImageData = ImageData & MakeByte(&H00)
End If
If Comment <> "" Then
ImageData = ImageData & MakeByte(GraphicControl)
ImageData = ImageData & MakeByte(&HFE)
Text = Left(Comment, &HFF)
ImageData = ImageData & MakeByte(Len(Text))
For I = 1 To Len(Text)
ImageData = ImageData & MakeByte(Asc(Mid(Text, I, 1)))
Next
ImageData = ImageData & MakeByte(&H00)
End If
End If
ImageData = ImageData & MakeByte(Seperator)
ImageData = ImageData & MakeWord(LeftPosition)
ImageData = ImageData & MakeWord(TopPosition)
ImageData = ImageData & MakeWord(Width_)
ImageData = ImageData & MakeWord(Height_)
ImageData = ImageData & MakeByte(LocalDescriptor)
ImageData = ImageData & MakeByte(CodeSize)
ImageData = ImageData & UncompressedData
ImageData = ImageData & MakeByte(&H00)
ImageData = ImageData & MakeByte(EndOfImage)
End Property
Public Sub Write()
Response.ContentType = "image/gif"
Response.BinaryWrite ImageData
End Sub
Private Function GIFHeader()
GIFHeader = ""
GIFHeader = GIFHeader & ChrB(Asc("G"))
GIFHeader = GIFHeader & ChrB(Asc("I"))
GIFHeader = GIFHeader & ChrB(Asc("F"))
GIFHeader = GIFHeader & ChrB(Asc("8"))
If GIF89a Then GIFHeader = GIFHeader & ChrB(Asc("9")) Else GIFHeader = GIFHeader & ChrB(Asc("7")) End If
GIFHeader = GIFHeader & ChrB(Asc("a"))
End Function
Public Sub VerifyCode(Text, VCColor)
Dim I1, I2, I3
Dim VCX, VCY, VCIndex
Resize 14 * Len(Text) + 10, UBound(Letter) + 10, False
Randomize
VCX = Int(Rnd * 10)
VCY = Int(Rnd * (Height_ - UBound(Letter)))
For I1 = 0 To UBound(Letter) - 1
For I2 = 1 To Len(Text)
For I3 = 1 To Len(Font(Mid(Text, I2, 1))(I1))
VCIndex = CLng(Mid(Font(Mid(Text, I2, 1))(I1), I3, 1))
If VCIndex <> 0 Then
If VCColor Then
Randomize
VCIndex = Int(Rnd * 7)
End If
Pixel(VCX + ((I2 - 1) * Len(Letter(0))) + I3, VCY + I1) = VCIndex
End If
Next
Next
Next
End Sub
Public Sub Noises(Amount, NColor)
Dim NI, NIndex
For NI = 1 To Amount
NIndex = 1
If NColor Then
Randomize
NIndex = Int(Rnd * 7)
End If
Pixel(Int(Rnd * Width_), Int(Rnd * Height_)) = NIndex
Next
End Sub
End Class
%>
showcode.asp
<!--#include file="verifycode.asp" -->
<%
Dim VC, Code
Randomize
Set VC = New NetRube_VerifyCode
With VC
Select Case Request.QueryString("type")
Case "2"
Code = Int(Rnd * 900000 + 100000)
Session("VerifyCode") = Code
.BGroundColor = "#FFFF00"
.FGroundColor = "#FF0000"
.VerifyCode Code, False
.Noises 100, False
.Write
Case "3"
Code = Int(Rnd * 90000 + 10000)
Session("VerifyCode") = Code
.BGroundColor = "#000000"
.FGroundColor = "#FFFFFF"
.VerifyCode Code, False
.Noises 50, True
.Write
Case "4"
Code = Int(Rnd * 900000 + 100000)
Session("VerifyCode") = Code
.BGroundColor = "#FFFFFF"
.FGroundColor = "#000000"
.VerifyCode Code, True
.Noises 100, True
.Write
Case Else
Code = Int(Rnd * 90000 + 10000)
Session("VerifyCode") = Code
.BGroundColor = "#FFFFFF" ' 图片背景颜色
.FGroundColor = "#000000" ' 前景(文本)颜色
.VerifyCode Code, False ' 处理验证码,第二个参数为是否显示彩色文本
.Noises 50, False ' 添加杂点,第一个参数为杂点数量,第二个参数为是否显示彩色杂点
.Write ' 输出图片
End Select
End With
Set VC = Nothing
%>