MSG 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 |
D:\Temp\找图片图标\验证码\Code_8.asp 编码GB2312 函数中有无用变量[5] <%
'************************************************************
'作者:云端
'版权:源代码公开,各种用途均可免费使用。
'创建:2013-11-16
'联系:QQ313801120 交流群35915100 邮箱313801120@qq.com
'* Powered By 云端
'************************************************************
Option Explicit
'禁止缓存
'Response.Expires = -9999
Response. Buffer = True
Response. ExpiresAbsolute = Now() - 1
Response. Expires = 0
Response. CacheControl = "no-cache"
Response. AddHeader "Pragma", "no-cache"
Response. AddHeader "cache-ctrol", "no-cache"
Response. ContentType = "Image/BMP"
Rem 设置部分
Const nSaturation = 90 '色彩饱和度
Const nBlankNoisyDotOdds = 0.0 '空白处噪点率
Const nColorNoisyDotOdds = 0.0 '有色处噪点率
Const nNoisyLineCount = 1 '噪音线条数
Const nCharMin = 4 '产生的最小字符个数
Const nCharMax = 4 '产生的最大字符个数
Const nSpaceX = 2 '左右两边的空白宽度
Const nSpaceY = 2 '上下两边的空白宽度
Const nImgWidth = 60 '数据区宽度
Const nImgHeight = 16 '数据区高度
Const nCharWidthRandom = 16 '字符宽度随机量
Const nCharHeightRandom = 16 '字符高度随机量
Const nPositionXRandom = 10 '横向位置随机量
Const nPositionYRandom = 10 '纵向位置随机量
Const nAngleRandom = 6 '笔画角度随机量
Const nLengthRandom = 6 '笔画长度随机量(百分比)
Const nColorHue = -2 '显示验证码的色调(-1表示随机色调, -2表示灰度色调)
Const cCharSet = "0123456789"
'构成验证码的字符集
'如果扩充了下边的字母矢量库,则可以相应扩充这个字符集
Rem ---------------------
Randomize
Dim Buf(), DigtalStr
Dim Lines(), LineCount
Dim CursorX, CursorY, DirX, DirY, nCharCount, nPixelWidth, nPixelHeight, PicWidth, PicHeight
nCharCount = nCharMin + CInt(Rnd * (nCharMax - nCharMin))
PicWidth = nImgWidth + 2 * nSpaceX
PicHeight = nImgHeight + 2 * nSpaceY
Call CreatValidCode("qwbm_code")
Sub CDGen_Reset()
'复位矢量笔和环境变量
LineCount = 0
CursorX = 0
CursorY = 0
'初始的光笔方向是垂直向下
DirX = 0
DirY = 1
End Sub
Sub CDGen_Clear()
'清空位图阵列
Dim I, J
ReDim Buf(PicHeight - 1, PicWidth - 1)
For J = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
Buf(J, I) = 0
Next
Next
End Sub
Sub CDGen_PSet(X, Y)
'在位图阵列上画点
If X >= 0 And X < PicWidth And Y >= 0 And Y < PicHeight Then Buf(Y, X) = 1
End Sub
Sub CDGen_Line(X1, Y1, X2, Y2)
'在位图阵列上画线
Dim DX, DY, DeltaT, I
DX = X2 - X1
DY = Y2 - Y1
If Abs(DX) > Abs(DY) Then DeltaT = Abs(DX) Else DeltaT = Abs(DY)
If DeltaT = 0 Then
CDGen_PSet CInt(X1), CInt(Y1)
Else
For I = 0 To DeltaT
CDGen_PSet CInt(X1 + DX * I / DeltaT), CInt(Y1 + DY * I / DeltaT)
Next
End If
End Sub
Sub CDGen_FowardDraw(nLength)
'按当前光笔方向绘制指定长度并移动光笔,正数表示从左向右/从上向下绘制,负数表示从右向左/从下向上绘制
nLength = nLength * (1 + (Rnd * 2 - 1) * nLengthRandom / 100)
ReDim Preserve Lines(3, LineCount)
Lines(0, LineCount) = CursorX
Lines(1, LineCount) = CursorY
CursorX = CursorX + DirX * nLength
CursorY = CursorY + DirY * nLength
Lines(2, LineCount) = CursorX
Lines(3, LineCount) = CursorY
LineCount = LineCount + 1
End Sub
Sub CDGen_SetDirection(nAngle)
'按指定角度设定画笔方向, 正数表示相对当前方向顺时针改变方向,负数表示相对当前方向逆时针改变方向
Dim DX, DY
nAngle =(nAngle + (Rnd * 2 - 1) * nAngleRandom) / 180 * 3.1415926
DX = DirX
DY = DirY
DirX = DX * Cos(nAngle) - DY * Sin(nAngle)
DirY = DX * Sin(nAngle) + DY * Cos(nAngle)
End Sub
Sub CDGen_MoveToMiddle(nActionIndex, nPercent)
'将画笔光标移动到指定动作的中间点上,nPercent为中间位置的百分比
Dim DeltaX, DeltaY
DeltaX = Lines(2, nActionIndex) - Lines(0, nActionIndex)
DeltaY = Lines(3, nActionIndex) - Lines(1, nActionIndex)
CursorX = Lines(0, nActionIndex) + DeltaX * nPercent / 100
CursorY = Lines(1, nActionIndex) + DeltaY * Abs(DeltaY) * nPercent / 100
End Sub
Sub CDGen_MoveCursor(nActionIndex)
'将画笔光标移动到指定动作的起始点上
CursorX = Lines(0, nActionIndex)
CursorY = Lines(1, nActionIndex)
End Sub
Sub CDGen_Close(nActionIndex)
'将当前光笔位置与指定动作的起始点闭合并移动光笔
ReDim Preserve Lines(3, LineCount)
Lines(0, LineCount) = CursorX
Lines(1, LineCount) = CursorY
CursorX = Lines(0, nActionIndex)
CursorY = Lines(1, nActionIndex)
Lines(2, LineCount) = CursorX
Lines(3, LineCount) = CursorY
LineCount = LineCount + 1
End Sub
Sub CDGen_CloseToMiddle(nActionIndex, nPercent)
'将当前光笔位置与指定动作的中间点闭合并移动光笔,nPercent为中间位置的百分比
Dim DeltaX, DeltaY
ReDim Preserve Lines(3, LineCount)
Lines(0, LineCount) = CursorX
Lines(1, LineCount) = CursorY
DeltaX = Lines(2, nActionIndex) - Lines(0, nActionIndex)
DeltaY = Lines(3, nActionIndex) - Lines(1, nActionIndex)
CursorX = Lines(0, nActionIndex) + Sgn(DeltaX) * Abs(DeltaX) * nPercent / 100
CursorY = Lines(1, nActionIndex) + Sgn(DeltaY) * Abs(DeltaY) * nPercent / 100
Lines(2, LineCount) = CursorX
Lines(3, LineCount) = CursorY
LineCount = LineCount + 1
End Sub
Sub CDGen_Flush(X0, Y0)
'按照当前的画笔动作序列绘制位图点阵
Dim MaxX, MinX, MaxY, MinY
Dim DeltaX, DeltaY, StepX, StepY, OffsetX, OffsetY
Dim I
MaxX = MinX = MaxY = MinY = 0
For I = 0 To LineCount - 1
If MaxX < Lines(0, I) Then MaxX = Lines(0, I)
If MaxX < Lines(2, I) Then MaxX = Lines(2, I)
If MinX > Lines(0, I) Then MinX = Lines(0, I)
If MinX > Lines(2, I) Then MinX = Lines(2, I)
If MaxY < Lines(1, I) Then MaxY = Lines(1, I)
If MaxY < Lines(3, I) Then MaxY = Lines(3, I)
If MinY > Lines(1, I) Then MinY = Lines(1, I)
If MinY > Lines(3, I) Then MinY = Lines(3, I)
Next
DeltaX = MaxX - MinX
DeltaY = MaxY - MinY
If DeltaX = 0 Then DeltaX = 1
If DeltaY = 0 Then DeltaY = 1
MaxX = MinX
MaxY = MinY
If DeltaX > DeltaY Then
StepX =(nPixelWidth - 2) / DeltaX
StepY =(nPixelHeight - 2) / DeltaX
OffsetX = 0
OffsetY =(DeltaX - DeltaY) / 2
Else
StepX =(nPixelWidth - 2) / DeltaY
StepY =(nPixelHeight - 2) / DeltaY
OffsetX =(DeltaY - DeltaX) / 2
OffsetY = 0
End If
For I = 0 To LineCount - 1
Lines(0, I) = Round((Lines(0, I) - MaxX + OffsetX) * StepX, 0)
Lines(1, I) = Round((Lines(1, I) - MaxY + OffsetY) * StepY, 0)
Lines(2, I) = Round((Lines(2, I) - MinX + OffsetX) * StepX, 0)
Lines(3, I) = Round((Lines(3, I) - MinY + OffsetY) * StepY, 0)
CDGen_Line Lines(0, I) + X0 + 1, Lines(1, I) + Y0 + 1, Lines(2, I) + X0 + 1, Lines(3, I) + Y0 + 1
Next
End Sub
Sub CDGen_Char(cChar, X0, Y0)
'在指定坐标处生成指定字符的位图阵列
CDGen_Reset
Select Case cChar
Case "0"
CDGen_SetDirection - 60 '逆时针60度(相对于垂直线)
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '逆时针60度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 1.5 '绘制1.5个单位
CDGen_SetDirection - 60 '逆时针60度
CDGen_FowardDraw 0.7 '绘制0.7个单位
CDGen_SetDirection - 60 '顺时针120度
CDGen_FowardDraw 0.7 '绘制0.7个单位
CDGen_Close 0 '封闭当前笔与第0笔(0开始)
Case "1"
CDGen_SetDirection - 90 '逆时针90度(相对于垂直线)
CDGen_FowardDraw 0.5 '绘制0.5个单位
CDGen_MoveToMiddle 0, 50 '移动画笔的位置到第0笔(0开始)的50%处
CDGen_SetDirection 90 '逆时针90度
CDGen_FowardDraw - 1.4 '反方向绘制1.4个单位
CDGen_SetDirection 30 '逆时针30度
CDGen_FowardDraw 0.4 '绘制0.4个单位
Case "2"
CDGen_SetDirection 45 '顺时针45度(相对于垂直线)
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 120 '逆时针120度
CDGen_FowardDraw 0.4 '绘制0.4个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.6 '绘制0.6个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 1.6 '绘制1.6个单位
CDGen_SetDirection - 135 '逆时针135度
CDGen_FowardDraw 1.0 '绘制1.0个单位
Case "3"
CDGen_SetDirection - 90 '逆时针90度(相对于垂直线)
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection 135 '顺时针135度
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection - 120 '逆时针120度
CDGen_FowardDraw 0.6 '绘制0.6个单位
CDGen_SetDirection 80 '顺时针80度
CDGen_FowardDraw 0.5 '绘制0.5个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.5 '绘制0.5个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.5 '绘制0.5个单位
Case "4"
CDGen_SetDirection 20 '顺时针20度(相对于垂直线)
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection - 110 '逆时针110度
CDGen_FowardDraw 1.2 '绘制1.2个单位
CDGen_MoveToMiddle 1, 60 '移动画笔的位置到第1笔(0开始)的60%处
CDGen_SetDirection 90 '顺时针90度
CDGen_FowardDraw 0.7 '绘制0.7个单位
CDGen_MoveCursor 2 '移动画笔到第2笔(0开始)的开始处
CDGen_FowardDraw - 1.5 '反方向绘制1.5个单位
Case "5"
CDGen_SetDirection 90 '顺时针90度(相对于垂直线)
CDGen_FowardDraw 1.0 '绘制1.0个单位
CDGen_SetDirection - 90 '逆时针90度
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection - 90 '逆时针90度
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection 30 '顺时针30度
CDGen_FowardDraw 0.4 '绘制0.4个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.4 '绘制0.4个单位
CDGen_SetDirection 30 '顺时针30度
CDGen_FowardDraw 0.5 '绘制0.5个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.8 '绘制0.8个单位
Case "6"
CDGen_SetDirection - 60 '逆时针60度(相对于垂直线)
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '逆时针60度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 1.5 '绘制1.5个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 0.7 '绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 0.5 '绘制0.5个单位
CDGen_CloseToMiddle 2, 50 '将当前画笔位置与第2笔(0开始)的50%处封闭
Case "7"
CDGen_SetDirection 180 '顺时针180度(相对于垂直线)
CDGen_FowardDraw 0.3 '绘制0.3个单位
CDGen_SetDirection 90 '顺时针90度
CDGen_FowardDraw 0.9 '绘制0.9个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 1.3 '绘制1.3个单位
Case "8"
CDGen_SetDirection - 60 '逆时针60度(相对于垂直线)
CDGen_FowardDraw - 0.8 '反方向绘制0.8个单位
CDGen_SetDirection - 60 '逆时针60度
CDGen_FowardDraw - 0.8 '反方向绘制0.8个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection 110 '顺时针110度
CDGen_FowardDraw - 1.5 '反方向绘制1.5个单位
CDGen_SetDirection - 110 '逆时针110度
CDGen_FowardDraw 0.9 '绘制0.9个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.8 '绘制0.8个单位
CDGen_SetDirection 60 '顺时针60度
CDGen_FowardDraw 0.9 '绘制0.9个单位
CDGen_SetDirection 70 '顺时针70度
CDGen_FowardDraw 1.5 '绘制1.5个单位
CDGen_Close 0 '封闭当前笔与第0笔(0开始)
Case "9"
CDGen_SetDirection 120 '逆时针60度(相对于垂直线)
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '逆时针60度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '顺时针120度
CDGen_FowardDraw - 1.5 '绘制1.5个单位
CDGen_SetDirection - 60 '顺时针120度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '顺时针120度
CDGen_FowardDraw - 0.7 '绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '顺时针120度
CDGen_FowardDraw 0.5 '绘制0.5个单位
CDGen_CloseToMiddle 2, 50 '将当前画笔位置与第2笔(0开始)的50%处封闭
'以下为字母的矢量动作,有兴趣的可以继续
Case "A"
CDGen_SetDirection - (Rnd * 20 + 150) '逆时针150-170度(相对于垂直线)
CDGen_FowardDraw Rnd * 0.2 + 1.1 '绘制1.1-1.3个单位
CDGen_SetDirection Rnd * 20 + 140 '顺时针140-160度
CDGen_FowardDraw Rnd * 0.2 + 1.1 '绘制1.1-1.3个单位
CDGen_MoveToMiddle 0, 30 '移动画笔的位置到第1笔(0开始)的30%处
CDGen_CloseToMiddle 1, 70 '将当前画笔位置与第1笔(0开始)的70%处封闭
Case "B"
CDGen_SetDirection - (Rnd * 20 + 50) '逆时针50-70度(相对于垂直线)
CDGen_FowardDraw Rnd * 0.4 + 0.8 '绘制0.8-1.2个单位
CDGen_SetDirection Rnd * 20 + 110 '顺时针110-130度
CDGen_FowardDraw Rnd * 0.2 + 0.6 '绘制0.6-0.8个单位
CDGen_SetDirection - (Rnd * 20 + 110) '逆时针110-130度
CDGen_FowardDraw Rnd * 0.2 + 0.6 '绘制0.6-0.8个单位
CDGen_SetDirection Rnd * 20 + 110 '顺时针110-130度
CDGen_FowardDraw Rnd * 0.4 + 0.8 '绘制0.8-1.2个单位
CDGen_Close 0 '封闭当前笔与第1笔(0开始)
Case "C"
CDGen_SetDirection - 60 '逆时针60度(相对于垂直线)
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection - 60 '逆时针60度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 1.5 '绘制1.5个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw - 0.7 '反方向绘制0.7个单位
CDGen_SetDirection 120 '顺时针120度
CDGen_FowardDraw 0.7 '绘制0.7个单位
End Select
CDGen_Flush X0, Y0
End Sub
Sub CDGen_Blur()
'对产生的位图进行柔化处理
Dim I, J
For J = 1 To PicHeight - 2
For I = 1 To PicWidth - 2
If Buf(J, I) = 0 Then
If((Buf(J, I - 1) Or Buf(J + 1, I)) And 1) <> 0 Then
'如果当前点是空白点,且上下左右四个点中有一个点是有色点,则该点做柔化处理
Buf(J, I) = 2
End If
End If
Next
Next
End Sub
Sub CDGen_NoisyLine()
Dim I
For I = 1 To nNoisyLineCount
CDGen_Line Rnd * PicWidth, Rnd * PicHeight, Rnd * PicWidth, Rnd * PicHeight
Next
End Sub
Sub CDGen_NoisyDot()
'对产生的位图进行噪点处理
Dim I, J, NoisyDot, CurDot
For J = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
If Buf(J, I) <> 0 Then
If Rnd < nColorNoisyDotOdds Then
Buf(J, I) = 0
Else
Buf(J, I) = nSaturation
End If
Else
If Rnd < nBlankNoisyDotOdds Then
Buf(J, I) = nSaturation
Else
Buf(J, I) = 0
End If
End If
Next
Next
End Sub
Sub CDGen()
'生成位图阵列
Dim I, Ch, W, X, Y
DigtalStr = ""
CDGen_Clear
W = nImgWidth / nCharCount
For I = 0 To nCharCount - 1
nPixelWidth = W * (1 + (Rnd * 2 - 1) * nCharWidthRandom / 100)
nPixelHeight = nImgHeight * (1 - Rnd * nCharHeightRandom / 100)
X = nSpaceX + W * (I + (Rnd * 2 - 1) * nPositionXRandom / 100)
Y = nSpaceY + nImgHeight * (Rnd * 2 - 1) * nPositionYRandom / 100
Ch = Mid(cCharSet, Int(Rnd * Len(cCharSet)) + 1, 1)
DigtalStr = DigtalStr + Ch
CDGen_Char Ch, X, Y
Next
CDGen_Blur
CDGen_NoisyLine
CDGen_NoisyDot
End Sub
Function HSBToRGB(vH, vS, vB)
'将颜色值由HSB转换为RGB
Dim aRGB(3), RGB1st, RGB2nd, RGB3rd
Dim nH, nS, nB
Dim lH, nF, nP, nQ, nT
vH =(vH Mod 360)
If vS > 100 Then
vS = 100
ElseIf vS < 0 Then
vS = 0
End If
If vB > 100 Then
vB = 100
ElseIf vB < 0 Then
vB = 0
End If
If vS > 0 Then
nH = vH / 60
nS = vS / 100
nB = vB / 100
lH = Int(nH)
nF = nH - lH
nP = nB * (1 - nS)
nQ = nB * (1 - nS * nF)
nT = nB * (1 - nS * (1 - nF))
Select Case lH
Case 0
aRGB(0) = nB * 255
aRGB(1) = nT * 255
aRGB(2) = nP * 255
Case 1
aRGB(0) = nQ * 255
aRGB(1) = nB * 255
aRGB(2) = nP * 255
Case 2
aRGB(0) = nP * 255
aRGB(1) = nB * 255
aRGB(2) = nT * 255
Case 3
aRGB(0) = nP * 255
aRGB(1) = nQ * 255
aRGB(2) = nB * 255
Case 4
aRGB(0) = nT * 255
aRGB(1) = nP * 255
aRGB(2) = nB * 255
Case 5
aRGB(0) = nB * 255
aRGB(1) = nP * 255
aRGB(2) = nQ * 255
End Select
Else
aRGB(0) =(vB * 255) / 100
aRGB(1) = aRGB(0)
aRGB(2) = aRGB(0)
End If
HSBToRGB = ChrB(Round(aRGB(2), 0)) & ChrB(Round(aRGB(1), 0)) & ChrB(Round(aRGB(0), 0))
End Function
Sub CreatValidCode(pSN)
Dim I, J, CurColorHue
CDGen
Session(pSN) = DigtalStr '记录入Session
Dim FileSize, PicDataSize
PicDataSize = PicWidth * PicHeight * 3
FileSize = PicDataSize + 54
'输出BMP文件信息头
Response.BinaryWrite ChrB(66) & ChrB(77) & ChrB(FileSize Mod 256) & ChrB((FileSize \ 256) Mod 256) & ChrB((FileSize \ 256 \ 256) Mod 256) & ChrB(FileSize \ 256 \ 256 \ 256) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0)
'输出BMP位图信息头
Response.BinaryWrite ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(PicWidth Mod 256) & ChrB((PicWidth \ 256) Mod 256) & ChrB((PicWidth \ 256 \ 256) Mod 256) & ChrB(PicWidth \ 256 \ 256 \ 256) & ChrB(PicHeight Mod 256) & ChrB((PicHeight \ 256) Mod 256) & ChrB((PicHeight \ 256 \ 256) Mod 256) & ChrB(PicHeight \ 256 \ 256 \ 256) & ChrB(1) & ChrB(0) & ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(PicDataSize Mod 256) & ChrB((PicDataSize \ 256) Mod 256) & ChrB((PicDataSize \ 256 \ 256) Mod 256) & ChrB(PicDataSize \ 256 \ 256 \ 256) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
'逐点输出位图阵列
If nColorHue = -1 Then
CurColorHue = Int(Rnd * 360)
ElseIf nColorHue <> - 2 Then
CurColorHue = nColorHue
End If
For J = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
If nColorHue = -2 Then
Response.BinaryWrite HSBToRGB(0, 0, 100 - Buf(PicHeight - 1 - J, I))
Else
Response.BinaryWrite HSBToRGB(CurColorHue, Buf(PicHeight - 1 - J, I), 100)
End If
Next
Next
End Sub
%>
|