verifycode.asp

官方最新的南方数据v12生成静态商业版。全站生成静态。

                  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.Buffer = True 
				  Response.Expires = 0 
				  Response.CacheControl = "no-cache" 
				  Response.AddHeader "Pragma", "No-Cache" 
                  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

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