<%@LANGUAGE="VBSCRIPT"%> <% Dim newBitmap(21,87) Dim vRnd(8) Dim TColor(10) Dim BColor(10) Dim theRow Dim theColumn Dim colorSet LDistortNum = 0 '##### EDIT BELOW THIS LINE ##### Const CodeLength = 5 Const MaxColors = 10 Const Noise = False '##### EDIT ABOVE THIS LINE ##### Const BmpHeader = "424D8C1500000000000036000000280000005600000015000000010018000000000056150000120B0000120B00000000000000000000" Const BmpEndLine = "0000" TColor(0) = "DE622E" ' Orange on White BColor(0) = "FFFFFF" TColor(1) = "999999" ' Grey on White BColor(1) = "FFFFFF" TColor(2) = "DE622E" ' Orange on White BColor(2) = "FFFFFF" TColor(3) = "999999" ' Grey on White BColor(3) = "FFFFFF" TColor(4) = "DE622E" ' Orange on White BColor(4) = "FFFFFF" TColor(5) = "999999" ' Grey on White BColor(5) = "FFFFFF" TColor(6) = "DE622E" ' Orange on White BColor(6) = "FFFFFF" TColor(7) = "999999" ' Grey on White BColor(7) = "FFFFFF" TColor(8) = "DE622E" ' Orange on White BColor(8) = "FFFFFF" TColor(9) = "999999" ' Grey on White BColor(9) = "FFFFFF" Sub hBit(offset, iRepeat) for x = 0 to (iRepeat - 1) newBitmap(theRow, offset + theColumn + x) = TColor(colorSet) next End Sub Function Random(valMin,valMax) Randomize(timer) RangeSize = ((valMax - valMin) + 1) Random = Int((RangeSize * Rnd()) + 1) End Function Sub AddNoise() for x = 0 to 28 ColX = (x * 3) + Random(1, 3) for y = 0 to 6 RowY = (y * 3) + Random(1, 3) theRow = RowY theColumn = ColX hBit 0,1 next next End Sub Sub pixelate(valChar,iNumPart,iRow,iColumn) theRow = iRow theColumn = iColumn select case iNumPart case 1 select case valChar case 0 hBit 2,4 case 1 hBit 3,2 case 2 hBit 2,4 case 3 hBit 2,3 case 4 hBit 5,2 case 5 hBit 1,6 case 6 hBit 2,4 case 7 hBit 0,8 case 8 hBit 2,4 case 9 hBit 2,4 end select case 2 select case valChar case 0 hBit 1,6 case 1 hBit 2,3 case 2 hBit 1,6 case 3 hBit 1,6 case 4 hBit 4,3 case 5 hBit 1,6 case 6 hBit 1,6 case 7 hBit 0,8 case 8 hBit 1,6 case 9 hBit 1,6 end select case 3 select case valChar case 0 hBit 0,3 hBit 5,3 case 1 hBit 1,4 case 2 hBit 0,3 hBit 5,3 case 3 hBit 0,2 hBit 5,2 case 4 hBit 4,3 case 5 hBit 1,2 case 6 hBit 1,2 hBit 6,2 case 7 hBit 6,1 case 8 hBit 0,2 hBit 6,2 case 9 hBit 0,2 hBit 6,2 end select case 4 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 0,2 hBit 3,2 case 2 hBit 0,2 hBit 6,2 case 3 hBit 5,2 case 4 hBit 3,4 case 5 hBit 0,2 case 6 hBit 0,2 case 7 hBit 5,2 case 8 hBit 0,2 hBit 6,2 case 9 hBit 0,2 hBit 6,2 end select case 5 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 0,1 hBit 3,2 case 2 hBit 6,2 case 3 hBit 5,2 case 4 hBit 2,2 hBit 5,2 case 5 hBit 0,2 hBit 3,3 case 6 hBit 0,2 case 7 hBit 4,2 case 8 hBit 0,2 hBit 6,2 case 9 hBit 0,2 hBit 6,2 end select case 6 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 3,2 case 2 hBit 6,2 case 3 hBit 3,3 case 4 hBit 2,2 hBit 5,2 case 5 hBit 0,7 case 6 hBit 0,2 hBit 3,3 case 7 hBit 4,2 case 8 hBit 1,6 case 9 hBit 0,2 hBit 5,3 end select case 7 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 3,2 case 2 hBit 5,2 case 3 hBit 3,4 case 4 hBit 1,2 hBit 5,2 case 5 hBit 0,2 hBit 6,2 case 6 hBit 0,7 case 7 hBit 3,2 case 8 hBit 1,6 case 9 hBit 1,7 end select case 8 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 3,2 case 2 hBit 4,2 case 3 hBit 6,2 case 4 hBit 0,2 hBit 5,2 case 5 hBit 6,2 case 6 hBit 0,3 hBit 6,2 case 7 hBit 3,2 case 8 hBit 0,2 hBit 6,2 case 9 hBit 2,3 hBit 6,2 end select case 9 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 3,2 case 2 hBit 3,2 case 3 hBit 6,2 case 4 hBit 0,9 case 5 hBit 6,2 case 6 hBit 0,2 hBit 6,2 case 7 hBit 3,2 case 8 hBit 0,2 hBit 6,2 case 9 hBit 6,2 end select case 10 select case valChar case 0 hBit 0,2 hBit 6,2 case 1 hBit 3,2 case 2 hBit 2,2 case 3 hBit 0,2 hBit 6,2 case 4 hBit 0,9 case 5 hBit 0,2 hBit 6,2 case 6 hBit 0,2 hBit 6,2 case 7 hBit 3,2 case 8 hBit 0,2 hBit 6,2 case 9 hBit 6,2 end select case 11 select case valChar case 0 hBit 0,3 hBit 5,3 case 1 hBit 3,2 case 2 hBit 1,2 case 3 hBit 0,2 hBit 6,2 case 4 hBit 5,2 case 5 hBit 0,2 hBit 6,2 case 6 hBit 1,2 hBit 6,2 case 7 hBit 2,2 case 8 hBit 0,2 hBit 6,2 case 9 hBit 0,2 hBit 5,2 end select case 12 select case valChar case 0 hBit 1,6 case 1 hBit 3,2 case 2 hBit 0,8 case 3 hBit 1,6 case 4 hBit 5,2 case 5 hBit 1,6 case 6 hBit 1,6 case 7 hBit 2,2 case 8 hBit 1,6 case 9 hBit 1,6 end select case 13 select case valChar case 0 hBit 2,4 case 1 hBit 3,2 case 2 hBit 0,8 case 3 hBit 2,4 case 4 hBit 5,2 case 5 hBit 2,4 case 6 hBit 2,4 case 7 hBit 2,2 case 8 hBit 2,4 case 9 hBit 2,4 end select end select End Sub Function LeftTracking(iNumber) select case iNumber case 1 LeftTracking = 2 case 4 LeftTracking = 0 case else LeftTracking = 1 end select End Function Function CreateCAPT(tmpLength) Randomize Timer Dim tmpCounter, tmpCAPT Const strValid = "01234567890" For tmpCounter = 1 To tmpLength tmpCAPT = tmpCAPT & Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1) Next CreateCAPT = tmpCAPT 'Generate Color Set colorSet = Int(Rnd(1) * MaxColors) End Function Function GetStartColumn(iNumber,iLine) DistortNum = (Random(1, 3) - 1) if DistortNum = 0 then DistortNum = LDistortNum end if LDistortNum = DistortNum GetStartColumn = 4 + ((10 * (iLine - 1)) + LeftTracking(iNumber)) + DistortNum End Function Sub SendBit(valBit) for i = 1 to Len(valBit) strBit = "&H" & Mid(valBit, i, 2) Response.BinaryWrite ChrB(CInt(strBit)) i = i + 1 next End Sub Sub SendClient() Response.Buffer = True Response.ContentType = "image/bmp" Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" Response.Expires = -1 If Noise = True then AddNoise() SendBit(BmpHeader) for y = 1 to 21 for x = 1 to 86 tmpBit = newBitmap(y, x) if tmpBit = vbNullString then if CInt(Rnd(1) * 19) > 1 then SendBit(BColor(colorSet)) else SendBit("99ffff") end if else SendBit(tmpBit) end if if x=86 then SendBit(BmpEndLine) end if next next SendBit(BmpEndLine) Response.Flush End Sub %> <% secureCode = CreateCAPT(CodeLength) Session("Secret") = secureCode for i = 1 to 13 rowNum = (21 - (4 + (i - 1))) for j = 1 to Len(secureCode) if (i = 1) then vRnd(j) = (Random(1, 6) - 3) end if tmpNum = CInt(Mid(secureCode,j,1)) clmNum = GetStartColumn(tmpNum,j) pixelate tmpNum, i, rowNum + vRnd(j), clmNum next next SendClient() %>