<%@LANGUAGE="VBSCRIPT"%>
<%
'Copyright 2005 Emir Tüzül
'Project Name: ASP Security Image Generator
'Version: 1.0 - 31/10/2005
'Description: Generate images with number to make a CAPTCHA test
'Project URL: http://www.tipstricks.org
'License: GNU General Public License (GPL)
'Author: Emir Tüzül
'For correspondence or non support questions contact:
'emirtuzul@gmail.com
%>
<%
Dim newBitmap(21,86) '86x21
Dim vDistort(8)
Const LeftMargin = 4
Const BottomMargin = 4
Const CharWidth = 10
Const CharHeight = 13
Const CodeLength = 8 'Secure Code Length (Max:8)
Const Distort = False 'Image Distortion True/False
Const TClr = "00 00 CC" 'Text Color #CC0000
Const BClr = "FF FF FF" 'Background Color #FFFFFF
Const BmpHeader = "42 4D 8C 15 00 00 00 00 00 00 36 00 00 00 28 00 00 00 56 00 00 00 15 00 00 00 01 00 18 00 00 00 00 00 56 15 00 00 12 0B 00 00 12 0B 00 00 00 00 00 00 00 00 00 00"
Const BmpEndLine = "00 00"

Function IHex(iRow,iColumn,strHex,iRepeat)
	for x=0 to (iRepeat-1)
		newBitmap(iRow,iColumn+x) = strHex
	next
End Function

Function WriteCanvas(valChar,iNumPart,iRow,iColumn)
	select case iNumPart
		case 1
			select case valChar
				case 0
					IHex iRow,iColumn+2,TClr,4
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+2,TClr,4
				case 3
					IHex iRow,iColumn+2,TClr,3
				case 4
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn+1,TClr,6
				case 6
					IHex iRow,iColumn+2,TClr,4
				case 7
					IHex iRow,iColumn,TClr,8
				case 8
					IHex iRow,iColumn+2,TClr,4
				case 9
					IHex iRow,iColumn+2,TClr,4
			end select
		case 2
			select case valChar
				case 0
					IHex iRow,iColumn+1,TClr,6
				case 1
					IHex iRow,iColumn+2,TClr,3
				case 2
					IHex iRow,iColumn+1,TClr,6
				case 3
					IHex iRow,iColumn+1,TClr,6
				case 4
					IHex iRow,iColumn+4,TClr,3
				case 5
					IHex iRow,iColumn+1,TClr,6
				case 6
					IHex iRow,iColumn+1,TClr,6
				case 7
					IHex iRow,iColumn,TClr,8
				case 8
					IHex iRow,iColumn+1,TClr,6
				case 9
					IHex iRow,iColumn+1,TClr,6
			end select
		case 3
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,3
					IHex iRow,iColumn+5,TClr,3
				case 1
					IHex iRow,iColumn+1,TClr,4
				case 2
					IHex iRow,iColumn,TClr,3
					IHex iRow,iColumn+5,TClr,3
				case 3
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+5,TClr,2
				case 4
					IHex iRow,iColumn+4,TClr,3
				case 5
					IHex iRow,iColumn+1,TClr,2
				case 6
					IHex iRow,iColumn+1,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 7
					IHex iRow,iColumn+6,TClr,1
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
			end select
		case 4
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 3
					IHex iRow,iColumn+5,TClr,2
				case 4
					IHex iRow,iColumn+3,TClr,4
				case 5
					IHex iRow,iColumn,TClr,2
				case 6
					IHex iRow,iColumn,TClr,2
				case 7
					IHex iRow,iColumn+5,TClr,2
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
			end select
		case 5
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn,TClr,1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+6,TClr,2
				case 3
					IHex iRow,iColumn+5,TClr,2
				case 4
					IHex iRow,iColumn+2,TClr,2
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+3,TClr,3
				case 6
					IHex iRow,iColumn,TClr,2
				case 7
					IHex iRow,iColumn+4,TClr,2
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
			end select
		case 6
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+6,TClr,2
				case 3
					IHex iRow,iColumn+3,TClr,3
				case 4
					IHex iRow,iColumn+2,TClr,2
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn,TClr,7
				case 6
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+3,TClr,3
				case 7
					IHex iRow,iColumn+4,TClr,2
				case 8
					IHex iRow,iColumn+1,TClr,6
				case 9
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+5,TClr,3
			end select
		case 7
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+5,TClr,2
				case 3
					IHex iRow,iColumn+3,TClr,4
				case 4
					IHex iRow,iColumn+1,TClr,2
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 6
					IHex iRow,iColumn,TClr,7
				case 7
					IHex iRow,iColumn+3,TClr,2
				case 8
					IHex iRow,iColumn+1,TClr,6
				case 9
					IHex iRow,iColumn+1,TClr,7
			end select
		case 8
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+4,TClr,2
				case 3
					IHex iRow,iColumn+6,TClr,2
				case 4
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn+6,TClr,2
				case 6
					IHex iRow,iColumn,TClr,3
					IHex iRow,iColumn+6,TClr,2
				case 7
					IHex iRow,iColumn+3,TClr,2
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn+2,TClr,3
					IHex iRow,iColumn+6,TClr,2
			end select
		case 9
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+3,TClr,2
				case 3
					IHex iRow,iColumn+6,TClr,2
				case 4
					IHex iRow,iColumn,TClr,9
				case 5
					IHex iRow,iColumn+6,TClr,2
				case 6
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 7
					IHex iRow,iColumn+3,TClr,2
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn+6,TClr,2
			end select
		case 10
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+2,TClr,2
				case 3
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 4
					IHex iRow,iColumn,TClr,9
				case 5
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 6
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 7
					IHex iRow,iColumn+3,TClr,2
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn+6,TClr,2
			end select
		case 11
			select case valChar
				case 0
					IHex iRow,iColumn,TClr,3
					IHex iRow,iColumn+5,TClr,3
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn+1,TClr,2
				case 3
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 4
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 6
					IHex iRow,iColumn+1,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 7
					IHex iRow,iColumn+2,TClr,2
				case 8
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+6,TClr,2
				case 9
					IHex iRow,iColumn,TClr,2
					IHex iRow,iColumn+5,TClr,2
			end select
		case 12
			select case valChar
				case 0
					IHex iRow,iColumn+1,TClr,6
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn,TClr,8
				case 3
					IHex iRow,iColumn+1,TClr,6
				case 4
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn+1,TClr,6
				case 6
					IHex iRow,iColumn+1,TClr,6
				case 7
					IHex iRow,iColumn+2,TClr,2
				case 8
					IHex iRow,iColumn+1,TClr,6
				case 9
					IHex iRow,iColumn+1,TClr,6
			end select
		case 13
			select case valChar
				case 0
					IHex iRow,iColumn+2,TClr,4
				case 1
					IHex iRow,iColumn+3,TClr,2
				case 2
					IHex iRow,iColumn,TClr,8
				case 3
					IHex iRow,iColumn+2,TClr,4
				case 4
					IHex iRow,iColumn+5,TClr,2
				case 5
					IHex iRow,iColumn+2,TClr,4
				case 6
					IHex iRow,iColumn+2,TClr,4
				case 7
					IHex iRow,iColumn+2,TClr,2
				case 8
					IHex iRow,iColumn+2,TClr,4
				case 9
					IHex iRow,iColumn+2,TClr,4
			end select
	end select
End Function

Function LeftTracking(iNumber)
	select case iNumber
		case 1
			LeftTracking = 2
		case 4
			LeftTracking = 0
		case else
			LeftTracking = 1
	end select
End Function

'http://support.microsoft.com/default.aspx?scid=kb;en-us;320375
Function CreateGUID(tmpLength)
  Randomize Timer
  Dim tmpCounter,tmpGUID
  Const strValid = "01234567890"
  For tmpCounter = 1 To tmpLength
    tmpGUID = tmpGUID & Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1)
  Next
  CreateGUID = tmpGUID
End Function

Function GetStartColumn(iNumber,iLine)
	if Distort = true then
		Randomize Timer
		DistortNum = (Rnd(4) - 2)
	else
		DistortNum = 0
	end if
	GetStartColumn =  LeftMargin + ((CharWidth * (iLine-1)) + LeftTracking(iNumber)) + DistortNum
End Function

Function SendHex(valArrHex)
	arrHex = Split(valArrHex," ")
	for i=0 to UBound(arrHex)
		strHex = "&H" & arrHex(i)
		Response.BinaryWrite ChrB(CInt(strHex))
	next
End Function

Function SendClient()
	Response.Buffer = True
	Response.ContentType = "image/bmp"
	Response.CacheControl = "no-cache"
	Response.AddHeader "Pragma", "no-cache"
	Response.Expires = -1

	SendHex(BmpHeader)
	for y=1 to 21
		for x=1 to 86
			tmpHex = newBitmap(y,x)
			if tmpHex = vbNullString then
				SendHex(BClr)
			else
				SendHex(tmpHex)
			end if

			if x=86 then
				SendHex(BmpEndLine)
			end if
		next
	next
	SendHex(BmpEndLine)
	Response.End
End Function
%>

<%
secureCode = CreateGUID(CodeLength)
Session("CAPTCHA_" & Session.SessionID) = secureCode

if IsNumeric(secureCode) = true then
	for i=1 to CharHeight
		rowNum = (21 - (BottomMargin + (i-1))) '21 bitmap height
		for j=1 to Len(secureCode)
			if (Distort = true) and (i=1) then
				Randomize Timer
				vDistort(j) = (Rnd(6) - 3)
			elseif (i=1) then
				vDistort(j) = 0
			end if
			tmpNum = CInt(Mid(secureCode,j,1))
			clmNum = GetStartColumn(tmpNum,j)
			WriteCanvas tmpNum,i,rowNum+vDistort(j),clmNum
		next
	next

	SendClient()
end if
%>