gif验证码生成技术

<%
'--------------------------------------
'Fly38.com - VerifyCode Class
' gif 验证码生成类
' 原作者：NetRube
'--------------------------------------
Class Fly38_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 ImgWrite()
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
%>
用法

<%
Dim GBL_CookieName
GBL_CookieName = "gbl_codename"　'指定一个想对本站的cookie

Call ShowCode(GBL_CookieName & Request("CodeName")) 'request("CodeName")指定一个相对验证码的cookie
'验证码
Sub ShowCode(ShowCodeName)
Set img = New fly38_VerifyCode
Randomize
Dim code
code = Int(Rnd * 9000 + 1000)
Session(ShowCodeName) = code
img.BGroundColor = "#FFFFFF" ' 图片背景颜色
img.FGroundColor = "#FF0000" ' 前景（文本）颜色
Call img.VerifyCode(code, False) ' 处理验证码，第二个参数为是否显示彩色文本
Call img.Noises(100, True) ' 添加杂点，第一个参数为杂点数量，第二个参数为是否显示彩色杂点
img.ImgWrite ' 输出图片
End Sub
%>