📄 ftbbscode.aspx.vb
字号:
CDGen_FowardDraw ( - 0.7 ) '166
CDGen_SetDirection ( - 60 ) '167
CDGen_FowardDraw ( - 0.7 ) '168
CDGen_SetDirection ( 120 ) '169
CDGen_FowardDraw ( 1.5 ) '170
CDGen_SetDirection ( - 60 ) '171
CDGen_FowardDraw ( 0.7 ) '172
CDGen_SetDirection ( - 60 ) '173
CDGen_FowardDraw ( 0.7 ) '174
CDGen_Close ( 0 ) '175
Case "1" '176
CDGen_SetDirection ( - 90 ) '177
CDGen_FowardDraw ( 0.5 ) '178
CDGen_MoveToMiddle ( 0 , 50 ) '179
CDGen_SetDirection ( 90 ) '180
CDGen_FowardDraw ( - 1.4 ) '181
CDGen_SetDirection ( 30 ) '182
CDGen_FowardDraw ( 0.4 ) '183
Case "2" '184
CDGen_SetDirection ( 45 ) '185
CDGen_FowardDraw ( - 0.7 ) '186
CDGen_SetDirection ( - 120 ) '187
CDGen_FowardDraw ( 0.4 ) '188
CDGen_SetDirection ( 60 ) '189
CDGen_FowardDraw ( 0.6 ) '190
CDGen_SetDirection ( 60 ) '191
CDGen_FowardDraw ( 1.6 ) '192
CDGen_SetDirection ( - 135 ) '193
CDGen_FowardDraw ( 1.0 ) '194
Case "3" '195
CDGen_SetDirection ( - 90 ) '196
CDGen_FowardDraw ( 0.8 ) '197
CDGen_SetDirection ( 135 ) '198
CDGen_FowardDraw ( 0.8 ) '199
CDGen_SetDirection ( - 120 ) '200
CDGen_FowardDraw ( 0.6 ) '201
CDGen_SetDirection ( 80 ) '202
CDGen_FowardDraw ( 0.5 ) '203
CDGen_SetDirection ( 60 ) '204
CDGen_FowardDraw ( 0.5 ) '205
CDGen_SetDirection ( 60 ) '206
CDGen_FowardDraw ( 0.5 ) '207
Case "4" '208
CDGen_SetDirection ( 20 ) '209
CDGen_FowardDraw ( 0.8 ) '210
CDGen_SetDirection ( - 110 ) '211
CDGen_FowardDraw ( 1.2 ) '212
CDGen_MoveToMiddle ( 1 , 60 ) '213
CDGen_SetDirection ( 90 ) '214
CDGen_FowardDraw ( 0.7 ) '215
CDGen_MoveCursor ( 2 ) '216
CDGen_FowardDraw ( - 1.5 ) '217
Case "5" '218
CDGen_SetDirection ( 90 ) '219
CDGen_FowardDraw ( 1.0 ) '220
CDGen_SetDirection ( - 90 ) '221
CDGen_FowardDraw ( 0.8 ) '222
CDGen_SetDirection ( - 90 ) '223
CDGen_FowardDraw ( 0.8 ) '224
CDGen_SetDirection ( 30 ) '225
CDGen_FowardDraw ( 0.4 ) '226
CDGen_SetDirection ( 60 ) '227
CDGen_FowardDraw ( 0.4 ) '228
CDGen_SetDirection ( 30 ) '229
CDGen_FowardDraw ( 0.5 ) '230
CDGen_SetDirection ( 60 ) '231
CDGen_FowardDraw ( 0.8 ) '232
Case "6" '233
CDGen_SetDirection ( - 60 ) '234
CDGen_FowardDraw ( - 0.7 ) '235
CDGen_SetDirection ( - 60 ) '236
CDGen_FowardDraw ( - 0.7 ) '237
CDGen_SetDirection ( 120 ) '238
CDGen_FowardDraw ( 1.5 ) '239
CDGen_SetDirection ( 120 ) '240
CDGen_FowardDraw ( - 0.7 ) '241
CDGen_SetDirection ( 120 ) '242
CDGen_FowardDraw ( 0.7 ) '243
CDGen_SetDirection ( 120 ) '244
CDGen_FowardDraw ( - 0.7 ) '245
CDGen_SetDirection ( 120 ) '246
CDGen_FowardDraw ( 0.5 ) '247
CDGen_CloseToMiddle ( 2 , 50 ) '248
Case "7" '249
CDGen_SetDirection ( 180 ) '250
CDGen_FowardDraw ( 0.3 ) '251
CDGen_SetDirection ( 90 ) '252
CDGen_FowardDraw ( 0.9 ) '253
CDGen_SetDirection ( 120 ) '254
CDGen_FowardDraw ( 1.3 ) '255
Case "8" '256
CDGen_SetDirection ( - 60 ) '257
CDGen_FowardDraw ( - 0.8 ) '258
CDGen_SetDirection ( - 60 ) '259
CDGen_FowardDraw ( - 0.8 ) '260
CDGen_SetDirection ( 120 ) '261
CDGen_FowardDraw ( 0.8 ) '262
CDGen_SetDirection ( 110 ) '263
CDGen_FowardDraw ( - 1.5 ) '264
CDGen_SetDirection ( - 110 ) '265
CDGen_FowardDraw ( 0.9 ) '266
CDGen_SetDirection ( 60 ) '267
CDGen_FowardDraw ( 0.8 ) '268
CDGen_SetDirection ( 60 ) '269
CDGen_FowardDraw ( 0.8 ) '270
CDGen_SetDirection ( 60 ) '271
CDGen_FowardDraw ( 0.9 ) '272
CDGen_SetDirection ( 70 ) '273
CDGen_FowardDraw ( 1.5 ) '274
CDGen_Close ( 0 ) '275
Case "9" '276
CDGen_SetDirection ( 120 ) '277
CDGen_FowardDraw ( - 0.7 ) '278
CDGen_SetDirection ( - 60 ) '279
CDGen_FowardDraw ( - 0.7 ) '280
CDGen_SetDirection ( - 60 ) '281
CDGen_FowardDraw ( - 1.5 ) '282
CDGen_SetDirection ( - 60 ) '283
CDGen_FowardDraw ( - 0.7 ) '284
CDGen_SetDirection ( - 60 ) '285
CDGen_FowardDraw ( - 0.7 ) '286
CDGen_SetDirection ( 120 ) '287
CDGen_FowardDraw ( 0.7 ) '288
CDGen_SetDirection ( - 60 ) '289
CDGen_FowardDraw ( 0.5 ) '290
CDGen_CloseToMiddle ( 2 , 50 ) '291
End Select '292
CDGen_Flush ( X0 , Y0 ) '293
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Char:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Blur()
On Error Goto _AspToAspX_Err
Dim i
Dim j
For j = 1 To Val ( PicHeight ) - 2 '297
For i = 1 To Val ( PicWidth ) - 2 '298
If AspToAspX_CheckDBNull ( Buf ( j , i ) ) = 0 Then '299
If ( ( Buf ( j , i - 1 ) Or Buf ( j + 1 , i ) ) And AspToAspX_CheckDBNull ( 1 ) ) < > 0 Then '300
Buf ( j , i ) = 2 '301
End If '302
End If '303
Next '304
Next '305
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Blur:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_NoisyLine()
On Error Goto _AspToAspX_Err
Dim i
For i = 1 To Val ( nNoisyLineCount ) '309
CDGen_Line ( AspToAspX_Rnd * PicWidth , AspToAspX_Rnd * PicHeight , AspToAspX_Rnd * PicWidth , AspToAspX_Rnd * PicHeight ) '310
Next '311
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_NoisyLine:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_NoisyDot()
On Error Goto _AspToAspX_Err
Dim i
Dim j
Dim NoisyDot
Dim CurDot
For j = 0 To Val ( PicHeight ) - 1 '315
For i = 0 To Val ( PicWidth ) - 1 '316
If AspToAspX_CheckDBNull ( Buf ( j , i ) ) < > 0 Then '317
If AspToAspX_Rnd < nColorNoisyDotOdds Then '318
Buf ( j , i ) = 0 '319
Else '320
Buf ( j , i ) = nSaturation '321
End If '322
Else '323
If AspToAspX_Rnd < nBlankNoisyDotOdds Then '324
Buf ( j , i ) = nSaturation '325
Else '326
Buf ( j , i ) = 0 '327
End If '328
End If '329
Next '330
Next '331
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_NoisyDot:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen()
On Error Goto _AspToAspX_Err
Dim i
Dim Ch
Dim w
Dim x
Dim y
DigtalStr = "" '335
CDGen_Clear ( ) '336
w = nImgWidth / nCharCount '337
For i = 0 To Val ( nCharCount ) - 1 '338
nPixelWidth = w * ( 1 + ( AspToAspX_Rnd * 2 - 1 ) * nCharWidthRandom / 100 ) '339
nPixelHeight = nImgHeight * ( 1 - AspToAspX_Rnd * nCharHeightRandom / 100 ) '340
x = nSpaceX + w * ( i + ( AspToAspX_Rnd * 2 - 1 ) * nPositionXRandom / 100 ) '341
y = nSpaceY + nImgHeight * ( AspToAspX_Rnd * 2 - 1 ) * nPositionYRandom / 100 '342
Ch = Mid ( cCharSet , AspToAspX_Int ( AspToAspX_Rnd * AspToAspX_Len ( cCharSet ) ) + 1 , 1 ) '343
DigtalStr = DigtalStr + Ch '344
CDGen_Char ( Ch , x , y ) '345
Next '346
CDGen_Blur ( ) '347
CDGen_NoisyLine ( ) '348
CDGen_NoisyDot ( ) '349
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CreatValidCode(ByRef ftbbs )
On Error Goto _AspToAspX_Err
Dim i
Dim j
Dim CurColorHue
Dim FileSize
Dim PicDataSize
CDGen ( ) '410
Session ( ftbbs ) = DigtalStr '411
PicDataSize = PicWidth * PicHeight * 3 '413
FileSize = PicDataSize + 54 '414
AspToAspX_Response_BinaryWrite ( Chr ( 66 ) & Chr ( 77 ) & Chr ( FileSize Mod 256 ) & Chr ( ( FileSize \ 256 ) Mod 256 ) & Chr ( ( FileSize \ 256 \ 256 ) Mod 256 ) & Chr ( FileSize \ 256 \ 256 \ 256 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 54 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) ) '415
AspToAspX_Response_BinaryWrite ( Chr ( 40 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( PicWidth Mod 256 ) & Chr ( ( PicWidth \ 256 ) Mod 256 ) & Chr ( ( PicWidth \ 256 \ 256 ) Mod 256 ) & Chr ( PicWidth \ 256 \ 256 \ 256 ) & Chr ( PicHeight Mod 256 ) & Chr ( ( PicHeight \ 256 ) Mod 256 ) & Chr ( ( PicHeight \ 256 \ 256 ) Mod 256 ) & Chr ( PicHeight \ 256 \ 256 \ 256 ) & Chr ( 1 ) & Chr ( 0 ) & Chr ( 24 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( PicDataSize Mod 256 ) & Chr ( ( PicDataSize \ 256 ) Mod 256 ) & Chr ( ( PicDataSize \ 256 \ 256 ) Mod 256 ) & Chr ( PicDataSize \ 256 \ 256 \ 256 ) & Chr ( 18 ) & Chr ( 11 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 18 ) & Chr ( 11 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) & Chr ( 0 ) ) '416
If AspToAspX_CheckDBNull ( nColorHue ) = - 1 Then '417
CurColorHue = AspToAspX_Int ( AspToAspX_Rnd * 360 ) '418
ElseIf AspToAspX_CheckDBNull ( nColorHue ) < > - 2 Then '419
CurColorHue = nColorHue '420
End If '421
For j = 0 To Val ( PicHeight ) - 1 '422
For i = 0 To Val ( PicWidth ) - 1 '423
If AspToAspX_CheckDBNull ( nColorHue ) = - 2 Then '424
AspToAspX_Response_BinaryWrite ( HSBToRGB ( 0 , 0 , 100 - Buf ( PicHeight - 1 - j , i ) ) ) '425
Else '426
AspToAspX_Response_BinaryWrite ( HSBToRGB ( CurColorHue , Buf ( PicHeight - 1 - j , i ) , 100 ) ) '427
End If '428
Next '429
Next '430
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CreatValidCode:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Function HSBToRGB(ByRef vH,ByRef vS,ByRef vB )
On Error GoTo _AspToAspX_Err
Dim aRGB( 3 )
Dim RGB1st
Dim RGB2nd
Dim RGB3rd
Dim nH
Dim nS
Dim nB
Dim lH
Dim nF
Dim nP
Dim nQ
Dim nT
vH = ( vH Mod 360 ) '355
If AspToAspX_CheckDBNull ( vS ) > 100 Then '356
vS = 100 '357
ElseIf AspToAspX_CheckDBNull ( vS ) < 0 Then '358
vS = 0 '359
End If '360
If AspToAspX_CheckDBNull ( vB ) > 100 Then '361
vB = 100 '362
ElseIf AspToAspX_CheckDBNull ( vB ) < 0 Then '363
vB = 0 '364
End If '365
If AspToAspX_CheckDBNull ( vS ) > 0 Then '366
nH = vH / 60 '367
nS = vS / 100 '368
nB = vB / 100 '369
lH = AspToAspX_Int ( nH ) '370
nF = nH - lH '371
nP = nB * ( 1 - nS ) '372
nQ = nB * ( 1 - nS * nF ) '373
nT = nB * ( 1 - nS * ( 1 - nF ) ) '374
Select Case lH '375
Case 0 '376
aRGB ( 0 ) = nB * 255 '377
aRGB ( 1 ) = nT * 255 '378
aRGB ( 2 ) = nP * 255 '379
Case 1 '380
aRGB ( 0 ) = nQ * 255 '381
aRGB ( 1 ) = nB * 255 '382
aRGB ( 2 ) = nP * 255 '383
Case 2 '384
aRGB ( 0 ) = nP * 255 '385
aRGB ( 1 ) = nB * 255 '386
aRGB ( 2 ) = nT * 255 '387
Case 3 '388
aRGB ( 0 ) = nP * 255 '389
aRGB ( 1 ) = nQ * 255 '390
aRGB ( 2 ) = nB * 255 '391
Case 4 '392
aRGB ( 0 ) = nT * 255 '393
aRGB ( 1 ) = nP * 255 '394
aRGB ( 2 ) = nB * 255 '395
Case 5 '396
aRGB ( 0 ) = nB * 255 '397
aRGB ( 1 ) = nP * 255 '398
aRGB ( 2 ) = nQ * 255 '399
End Select '400
Else '401
aRGB ( 0 ) = ( vB * 255 ) / 100 '402
aRGB ( 1 ) = aRGB ( 0 ) '403
aRGB ( 2 ) = aRGB ( 0 ) '404
End If '405
HSBToRGB = Chr ( Round ( aRGB ( 2 ) , 0 ) ) & Chr ( Round ( aRGB ( 1 ) , 0 ) ) & Chr ( Round ( aRGB ( 0 ) , 0 ) ) '406
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP HSBToRGB:" & Err.Description)
Resume Next
End Function
#Region "..."
#End Region
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -