现在网上大多都是用生成bmp或xbm图片的,很容易分析出来!所以前不久出现一个动网注册机!demo:http://http://www.zjjv.com///demo/VerifyCode/ShowCode.ASP?CodeName=lkhjidown::http://http://www.zjjv.com///demo/VerifyCode/VerifyCode.rar %'--------------------------------------'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 SubEnd Class% 用法%Dim GBL_CookieName GBL_CookieName = "gbl_codename"　'指定一个想对本站的cookieCall 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%