www.gusucode.com > 艺帆全站DIV+CSS体育用品公司网站源码 1.7.5源码程序 > safecode.asp
<% Option Explicit 'Session.CodePage = 65001 'Response.Charset = "UTF-8" Response.Expires = -1 Response.AddHeader "Pragma", "no-cache" Response.AddHeader "cache-ctrol", "no-cache" Dim VC, Code Randomize Set VC = New NetRube_VerifyCode With VC Code = Int(Rnd * 9000 + 1000) Session("firstecode") = ""&Code .BGroundColor = "#e4e9ee" ' 图片背景颜色 .FGroundColor = "#000000" ' 前景(文本)颜色 .VerifyCode Code, false'False ' 处理验证码,第二个参数为是否显示彩色文本 .Noises 50, true ' 添加杂点,第一个参数为杂点数量,第二个参数为是否显示彩色杂点 .Write ' 输出图片 End With Set VC = Nothing 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 %>