code.asp

本息统基于中国网站技术人员最熟悉WindowsNT环境和Asp语言

		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
%>