WindKer'Blog - ASP

asp验证码，很不错

470280558@qq.com(WindKer) — Fri,03 Sep 2010 10:04:38 +0800

 程序代码


<%
Const nMaxSaturation = 100            ' 最大色彩饱和度
Const nBlankNoisyDotOdds = 0  ' 空白处噪点率
Const nColorNoisyDotOdds = 0 ' 有色处噪点率
Const nCharCount = 4                        ' 产生的字符个数
Const nPixelWidth = 15                    ' 单个字符位图的宽度
Const nPixelHeight = 15                   ' 单个字符位图的高度
Const nColorHue = -2                        ' 显示验证码的色调(-1表示随机色调, -2表示灰度色调)
Const nAngleRandom = 0         ' 角度随机量
Const nLengthRandom = 0        ' 长度随机量(百分比)
Const cCharSet = "0123456789"
                                ' 构成验证码的字符集
                                ' 如果扩充了下边的字母矢量库，则可以相应扩充这个字符集

Dim Buf(), DigtalStr
Dim Lines(), LineCount
Dim CursorX, CursorY, DirX, DirY

Randomize
Call CreatValidCode("CheckCode")

Sub CDGen_Reset()
    ' 复位矢量笔和环境变量
    LineCount = 0
    CursorX = 0
    CursorY = 0
    ' 初始的光笔方向是垂直向下
    DirX = 0
    DirY = 1
End Sub

Sub CDGen_Clear()
    ' 清空位图阵列
    Dim i, j
    ReDim Buf(nPixelHeight - 1, nCharCount * nPixelWidth - 1)

    For j = 0 To nPixelHeight - 1
        For i = 0 To nCharCount * nPixelWidth - 1
            Buf(j, i) = 0
        Next
    Next
End Sub

Sub CDGen_PSet(X, Y)
    ' 在位图阵列上画点
    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)
    For i = 0 To DeltaT
        CDGen_PSet X1 + DX * i / DeltaT, Y1 + DY * i / DeltaT
    Next
End Sub

Sub CDGen_FowardDraw(nLength)
    ' 按当前光笔方向绘制指定长度并移动光笔，正数表示从左向右/从上向下绘制，负数表示从右向左/从下向上绘制
    nLength = Sgn(nLength) * Abs(nLength) * (1 - nLengthRandom / 100 + Rnd * nLenghtRandom * 2 / 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 = Sgn(nAngle) * (Abs(nAngle) - nAngleRandom + Rnd * nAngleRandom * 2) / 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) + Sgn(DeltaX) * Abs(DeltaX) * nPercent / 100
    CursorY = Lines(1, nActionIndex) + Sgn(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)
        If Lines(0, i) < 0 Then Lines(0, i) = 0
        If Lines(0, i) >= nPixelWidth - 2 Then Lines(0, i) = nPixelWidth - 3
        Lines(1, i) = Round((Lines(1, i) - MaxY + OffsetY) * StepY, 0)
        If Lines(1, i) < 0 Then Lines(1, i) = 0
        If Lines(1, i) >= nPixelHeight - 2 Then Lines(1, i) = nPixelHeight - 3
        Lines(2, i) = Round((Lines(2, i) - MinX + OffsetX) * StepX, 0)
        If Lines(2, i) < 0 Then Lines(2, i) = 0
        If Lines(2, i) >= nPixelWidth - 2 Then Lines(2, i) = nPixelWidth - 3
        Lines(3, i) = Round((Lines(3, i) - MinY + OffsetY) * StepY, 0)
        If Lines(3, i) < 0 Then Lines(3, i) = 0
        If Lines(3, i) >= nPixelHeight - 2 Then Lines(3, i) = nPixelHeight - 3
        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 nPixelHeight - 2
        For i = 1 To nCharCount * nPixelWidth - 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_NoisyDot()
    ' 对产生的位图进行噪点处理
    Dim i, j, NoisyDot, CurDot
    
    For j = 0 To nPixelHeight - 1
        For i = 0 To nCharCount * nPixelWidth - 1
            If Buf(j, i) <> 0 Then
                NoisyDot = Int(Rnd * Rnd * nMaxSaturation)
                Select Case nColorNoisyDotOdds
                Case 0
                    CurDot = nMaxSaturation
                Case 1
                    CurDot = 0
                Case Else
                    CurDot = NoisyDot
                End Select
                If Rnd < nColorNoisyDotOdds Then Buf(j, i) = CurDot Else Buf(j, i) = nMaxSaturation
            Else
                NoisyDot = Int(Rnd * nMaxSaturation)
                Select Case nBlankNoisyDotOdds
                Case 0
                    CurDot = 0
                Case 1
                    CurDot = nMaxSaturation
                Case Else
                    CurDot = NoisyDot
                End Select
                If Rnd < nBlankNoisyDotOdds Then Buf(j, i) = CurDot Else Buf(j, i) = 0
            End If
        Next
    Next
End Sub

Sub CDGen()
    ' 生成位图阵列
    Dim i, Ch
    
    DigtalStr = ""
    CDGen_Clear
    For i = 0 To nCharCount - 1
        Ch = Mid(cCharSet, Int(Rnd * Len(cCharSet)) + 1, 1)
        DigtalStr = DigtalStr + Ch
        CDGen_Char Ch, i * nPixelWidth, 0
    Next
    CDGen_Blur
    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 * 246) / 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
    
    ' 禁止缓存
    Response.Expires = -9999
    Response.AddHeader "pragma", "no-cache"
    Response.AddHeader "cache-ctrol", "no-cache"
    Response.ContentType = "image/bmp"
    
    Call CDGen
    Session(pSN) = DigtalStr    '记录入Session

    Dim PicWidth, PicHeight, FileSize, PicDataSize
    PicWidth = nCharCount * nPixelWidth
    PicHeight = nPixelHeight
    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 = 0
    Else
        CurColorHue = nColorHue
    End If
    For j = 0 To nPixelHeight - 1
        For i = 0 To Len(DigtalStr) * nPixelWidth - 1
            If nColorHue = -2 Then
                Response.BinaryWrite HSBToRGB(CurColorHue, 0, 100 - Buf(nPixelHeight - 1 - j, i))
            Else
                Response.BinaryWrite HSBToRGB(CurColorHue, Buf(nPixelHeight - 1 - j, i), 100)
            End If
        Next
    Next
End Sub
%>

将代码保存为.asp文件
获取方式

获取session为Session("CheckCode"),修改session的名称在第20行

网页输出N行N列表格的ASP实现方法

470280558@qq.com(WindKer) — Wed,14 Apr 2010 23:21:16 +0800

几乎在每个站点中我们都要使用程序来输出列表：新闻列表、产品列表等等，输出的方式也因内容的不同而不同，对于新闻列表，通常是一行一行的循环输出；对于产品列表，通常得一个单元格一个单元格的输出。下边我们就用ASP来输出一个五行四列的表格。

1.一行一行的输出

以下为引用的内容：
<%
Response.Write("")
For i=1 to 5
Response.Write("")
Next
Response.Write("

")
%>

这没什么好说的了，大家都看得明白。

2.一个单元格一个单元格的输出

以下为引用的内容：
<%
Response.Write("")
For i=1 to 18
    If i mod 4 = 1 Then Response.Write("")
    Response.Write("")
    If i mod 4 = 0 Then Response.Write("")
Next
'补足单元格
i = i - 1
If i mod 4<>0 Then
    For j=1 to 4-i mod 4
        Response.Write("")
    Next
    Response.Write("")
End If
Response.Write("

补

")
%>

这边需要说明一下：网上很多的输出N行N列表格的ASP中都没有考虑最后一行的列数是否完整，即没有上边的补足部分，结果输出一个残缺的表格。细节上的问题，毛病虽不大，但还是希望大家注意下

asp禁止某IP或者某IP段访问网站

470280558@qq.com(WindKer) — Tue,06 Apr 2010 11:53:24 +0800

程序代码如下：

 程序代码

<% 
Const IPGroup = "192.168.0.1|192.168.1.1|192.168.1.*"

If IsForbidIP(IPGroup) = True Then
    Response.Write(GetIP &"     系统禁止您的 IP 访问")
    Response.End()
End If


'****************************************************************
'以上代码设置为:如果是192.168.0.1和192.168.1.1和192.168.1.段的IP禁止访问
'参数vBadIP：要屏蔽的IP段,IP地址集合，用|符号分隔多个IP地址(段)
'返回Bool：True用户IP在被屏蔽范围，False则为允许.
'使用的方法为include文件或者放入公用文件就可以使用...
'****************************************************************
Function IsForbidIP(vBadIP)
    Dim counter, arrIPPart, arrBadIP, arrBadIPPart, i, j
   
   arrBadIP = Split(vBadIP, "|")   
   arrIPPart = Split(GetIP(), ".")
   
    For i = 0 To UBound(arrBadIP)         
        counter = 0
        arrBadIPPart = Split(arrBadIP(i), ".")        
        For j = 0 To UBound(arrIPPart)            
            If(arrBadIPPart(j)) = "*" or Cstr(arrIPPart(j)) = Cstr(arrBadIPPart(j)) Then            
                counter = counter + 1            
            End If            
        Next        
        If counter = 4 Then            
            IsForbidIP = True
            Exit Function
        End If        
    Next
    IsForbidIP = False
End Function

'***************
'返回客户IP地址
'***************
Function GetIP()
    Dim IP
    'IP="192.168.1.100" '测试IP
    IP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    If IP = "" Then IP = Request.ServerVariables("REMOTE_ADDR")
    GetIP = IP
End Function
%>

sql语句中left join/right join/inner join详解

470280558@qq.com(WindKer) — Wed,24 Mar 2010 11:27:27 +0800

例子说明
表A记录如下：
aID        aNum
1           a20050111
2           a20050112
3           a20050113
4           a20050114
5           a20050115

表B记录如下:
bID        bName
1            2006032401
2           2006032402
3           2006032403
4           2006032404
8           2006032408

实验如下:
1.left join

sql语句如下:
select * from A
left join B
on A.aID = B.bID

结果如下:
aID        aNum                   bID           bName
1            a20050111         1               2006032401
2            a20050112         2              2006032402
3            a20050113         3              2006032403
4            a20050114         4              2006032404
5            a20050115         NULL       NULL
（所影响的行数为 5 行）

结果说明:
        left join是以A表的记录为基础的,A可以看成左表,B可以看成右表,left join是以左表为准的.
换句话说,左表(A)的记录将会全部表示出来,而右表(B)只会显示符合搜索条件的记录(例子中为: A.aID = B.bID).
B表记录不足的地方均为NULL.

2.right join

sql语句如下:
select * from A
right join B
on A.aID = B.bID

结果如下:
aID        aNum                   bID           bName
1            a20050111         1               2006032401
2            a20050112         2              2006032402
3            a20050113         3              2006032403
4            a20050114         4              2006032404
NULL    NULL                     8              2006032408
（所影响的行数为 5 行）

结果说明:
        仔细观察一下,就会发现,和left join的结果刚好相反,这次是以右表(B)为基础的,A表不足的地方用NULL填充.

3.inner join/Join

sql语句如下:
select * from A
inner join B
on A.aID = B.bID
或
select * from A
join B
on A.aID = B.bID
或
select * from A
, B
where A.aID = B.bID
结果如下:
aID        aNum                   bID           bName
1            a20050111         1               2006032401
2            a20050112         2              2006032402
3            a20050113         3              2006032403
4            a20050114         4              2006032404

结果说明:
        很明显,这里只显示出了 A.aID = B.bID的记录.这说明A inner join B和A Join B和A,B并不以谁为基础,它只显示符合条件的记录.这三种情况的结果是一样的

access防下载 nodown表

470280558@qq.com(WindKer) — Tue,09 Mar 2010 12:06:13 +0800

一般网站的核心就是数据库，ASP则大多采用mdb数据库，方便网站移植，减少成功。如果其被Down了，那么这个网站也就岌岌可危了！对于数据库的防下载处理，通常都是将其格式由“MDB”改为“ASP”或“ASA”等一些扩展名，并在其中加入一个防下载字段，这个字段是如何加入的呢？
　　首先用Access打开MDB数据库，切换“对象”中的“表”为“查询”，然后双击“在设计视图中创建查询”，在弹出的“显示表”窗口中，不添加任何表，直接点“关闭”，这样“工具栏”中就多了一个“SQL”按钮，点击这个按钮或在“查询”窗口中点右键，选择其中的“SQL视图”，就会打开一个查询窗口，如图1，其实这个窗口就是Access的SQL命令输入窗口（刺猬提示：在MSSQL数据库中，有“查询分析器”可以调试SQL语句。而在ACCESS 数据库内，就可以采用这种方法来调试SQL语句了）。
接下来就可以创建防下载字段了，分两步进行：

　　第一步：先创建一个表，在SQL命令窗口内输入如下内容：“Create Table [nodown]([notdown] oleobject)”
然后点击工具栏中的“!”（运行），这样，就会在当前数据库内创建一个“nodown”表，其中的字段名称为“notdown”，字段类型为“OLE对象”。

　　第二步：将SQL查询窗口中的内容更改为如下命令：“Insert into [nodown](notdown) values(0x3C25)”
这一句的意思是向“nodown”表的“notdown”字段中插入“0x3C25”数据（“0x3C25”为字符“<%”的16进制）。

　　执行完毕后，再次查看数据库中的“表”，就会发现其中已多了一个“nodown”表，打开之后字段显示的是“长二进制数据”，瞧！是不是和某些专业ASP程序中的防下载字段模样一致！
最后，更改数据库扩展名“MDB”为“ASP”，在本地的IIS中测试，返回的信息如下：

错误类型：
Active Server Pages, ASP 0116 (0x80004005)
Script 块缺少脚本关闭标记(% >)。

　　因为前面插入的是“<%”，所以当数据库变成ASP格式后，就会出现“缺少脚本关闭标记”的错误，在这里，出现错误却是好事哟！因为它说明前面设置的防下载是成功滴！
引自：http://hi.baidu.com/55661267/blog/item/df500e2f130fae3c1f308958.html

asp动态include文件

470280558@qq.com(WindKer) — Mon,08 Mar 2010 14:06:10 +0800

以下为代码部分:

宏限制,必须存在该文件并且会预先编译（不管前面是否加以条件）

经常有这样的要求，根据不同的需求要求include不同的文件,如各个人的不同设置，所以要求能动态include文件。

代码如下：

以下为代码部分:
Function include(filename)
Dim re,content,fso,f,aspStart,aspEnd

set fso=CreateObject("Scripting.FileSystemObject")
set f=fso.OpenTextFile(server.mappath(filename))
content=f.ReadAll
f.close
set f=nothing
set fso=nothing

set re=new RegExp
re.pattern="^\s*="
aspEnd=1
aspStart=inStr(aspEnd,content,"<%")+2
do while aspStart>aspEnd+1
Response.write Mid(content,aspEnd,aspStart-aspEnd-2)
aspEnd=inStr(aspStart,content,"%\>")+2
Execute(re.replace(Mid(content,aspStart,aspEnd-aspStart-2),"Response.Write "))
aspStart=inStr(aspEnd,content,"<%")+2
loop
Response.write Mid(content,aspEnd)
set re=nothing
End Function
使用范例：

include("youinc.asp")
引自：http://hi.baidu.com/xiaoxiaolq/blog/item/48228925e780cd6335a80ff5.html

ASP中GetRows的用法详解

470280558@qq.com(WindKer) — Mon,08 Mar 2010 14:00:48 +0800

NextRecordset 和 GetRows 大家可能用的很少！
最近使用使用，不错的好东东！
对提高批量查询，查询纪录集不是巨海量的情况很有效果
NextRecordset 和 GetRows 是Recordset的两个属性（属性还是方法我是常溷淆是非#$#$，弄不清四下五除一）

GetRows ---> 将recordset记录集提取到一个二维数组中，我们对recordset数据的行为就转移到该数组，可以早早的断开纪录集，不用再使用元数据操作，rs.movnext, while not rs.eof等可以省掉

NextRecordset ----> 就是在一次提交多个查询，形成多个reordset结果集的情况下，提供一个离开当前工作的recordset，转移到第二个recordset的方法！

主要是用在多个Select形成的结果集的情况

示例如下：

dim SQL,Rs,arrA,arrB,rowsA,rowsB

'======提取数据库库记录====

（adodb.connection 的连接部分省略,假定CONN.open CONNstr）
SQL=" select Ca1,Ca2,Ca3,Ca4 from TableA " '---------------Selecta
SQL=SQL&" select Cb1,Cb2,Cb3,Cb4,Cb5 from TableB " '-------------Selectb

Set Rs=conn.execute(SQL)
'执行结果将有两个select 的结果集，当前第一个select的recordset处于激活状态

arrA=rs.GetRows '----------取得Selecta Recordset的二维数组

set rs=rs.NextRecordset
'------------最关键的一步，使用Nextrecordset激活下一个recordset

arrB=rs.GetRows '----------再次取得第二个Selectb Recordset的二维数组

Rs.close
set rs=nothing '---------尽早释放数据库对象，关闭记录集
CONN.close
set CONN=Nothing
这样，我们所有关于数据库的数据干干净净的提取完成，用最早的时间释放数据库资源
'-----------//

'========用取得的arrA arrB进行页面处理,显示数据结果======
'注意，arrA=GetRows 后得到的数组，第一维是代表列，第二维代表行

rowsA=ubound(arrA,2) '----提取arrA的第二维下标，相当于取得recordset 的记录行数
rowsB=ubound(arrB,2) '-----同上，提取arrB的第二维下标

'做数据循环：

'第一个select表的循环

ADO也提供更有效率方法来取得资料。GetRows 方法传回一个二维的阵列变数，每一行对应Recordset中的一笔记录，且每一列对应到记录中的栏位。此方法的语法如下：

varArray = rs.GetRows([Rows], [Start], [Fields])

Rows 是要读取记录的数量；如果想要取得Recordset所有记录，可用-1或省略此参数。Start 是指出第一个被读取记录的书籤；也可以是下列列举常数中的一个：0-adBookmarkCurrent（目前记录）、1-adBookmarkFirst（第一笔记录）、或2-adBookmarkLast（最后记录）。

Fields 是可选择的栏位名称阵列，其用来限制要读取的资料量。（也可指定单一栏位名称、单一栏位索引、或者一个栏位索引阵列）。当设定 Rows 为少于Recordset记录笔数时，第一笔未读取的记录变成现行记录。若省略 Rows 参数或设定为-1-adGetRowsRest或大于未读取的笔数时，GetRows 方法会读取所有记录并让Recordset在EOF状态，而不会产生任何错误。

当处理目的变数阵列的资料时，应该记得资料储存方式是有点相反的感觉：阵列中第一维定义Recordset的栏位（资料行），第二维定义Recordset的资料列。以下有个载入Recordset内所有记录某三个栏位的范例：

Dim values As Variant, fldIndex As Integer, recIndex As Integer
values = rs.GetRows(, , Array("LastName", "FirstName", "BirthDate"))
For recIndex = 0 To UBound(values, 2)
    For fldIndex = 0 To UBound(values)
        Print values(fldIndex, recIndex),
    Next
    Print
Next

GetRows 方法通常比一次读一笔记录的迴圈要来得快些，但使用这方法时，必须确定Recordset未包含太多记录；否则，会很容易以一个非常大的变数阵列来填满所有记忆体。基于相同的原因，得小心不要包括任何BLOB（Binary Large Object）或CLOB（Character Large Object）栏位；若如此做的化，应用程式一定会爆掉，特别是对于较大的Recordset而言。最后，记住此方法传回的变数阵列是以0为基底的；传回记录的笔数是UBound(values,2)+1，传回栏位数是UBound(value, 1)+1。

GetString 方法跟 GetRows 是类似的，不过其传回以单一字串形式存在的多重记录。GetString 语法如下：

GetString([Format], [NumRows], [ColDelimiter], [RowDelimiter], [NullExpr])

Format 是结果的格式。GetString 还可能支援更多格式，但是目前唯一支援的格式是2- adClipString，所以实际上没有任何选择。NumRows 是要取得的列数。（使用-1或省略此参数来读取所有剩下的记录。）ColDelimiter 是行的分隔字元（预设为Tab字元）。RowDelimiter 为记录的分隔字元（预设为换行字元）。NullExpr 是用来表示Null栏位的字串（预设为空字串）。文件中说明只有当Format= adClipString时，最后三个参数才可使用，但是这警告没有多大意义，因为（如之前所提）此格式是目前唯一支援的。以下有个例子，其透过 GetString 方法来将资料汇出成以分号分隔的文字档：

Dim i As Long
Open "datafile.txt" For Output As #1
For i = 0 To rs.Fields.Count _ 1          ' Export field names.
    If i > 0 Then Print #1, ";";
    Print #1, rs.Fields(i).Name;
Next
Print #1, ""
rs.MoveFirst                              ' Export data.
Print #1, rs.GetString(, , ";", VBCrLf); ' Don't add an extra CR-LF here.
Close #1

GetString 方法不允许只汇出栏位的子集合，也不允许修改汇出栏位的顺序。如果需要这些额外的功能，应该使用 GetRows 方法且自行建立结果字串。

大家应该都知道 Recordset 有个 GetRows 属性，但是真正使用的不多，我也是最近才用的！汗……

其实这个属性很简单，就是把数据集输出到一个数组中。但是实用性可不小，在这里我举一个例子说明一下GetRows的使用方法，大家举一反三能想到更多的用法！

比如一个分类的表 T_Cate，结构和数据如下：

ID   |   Title   | Intro
-----------------------------------------
1    |   新闻   | 这里是新闻
2    |   教程   | 这里是教程
3    |   下载   | 这里是下载

好了，表建立好了，数据也有了，下面我们就要用到GetRows咯！

程序代码：

Dim Rs_Cate
Dim Arr_Cate
Set Rs_Cate=Conn.ExeCute("Select ID,Title,Intro FROM T_Cate orDER BY ID ASC")
Arr_Cate=Rs_Cate.GetRows
Set Rs_Cate=Nothing

好了表数据已经导出到数组了！下面我们将遍历这个数组

程序代码：

Dim Arr_CateNumS,Arr_CateNumI
Arr_CateNumS=Ubound(Arr_Cate,2) '得到数组中数据的下标
For Arr_CateNumI=0 To Arr_CateNumS
    Response.Write("ID："&Arr_Cate(0,Arr_CateNumI)&" | 标题："&Arr_Cate(1,Arr_CateNumI)&" | 介绍："&Arr_Cate(2,Arr_CateNumI)&"
")
Next

呵呵，好了，输出的数据为：
ID：1 | 标题：新闻 | 介绍：这里是新闻
ID：2 | 标题：教程 | 介绍：这里是教程
ID：3 | 标题：下载 | 介绍：这里是下载

引自：http://hi.baidu.com/%B2%E8%B2%A9%CA%BF/blog/item/6cd12922bf99c0ac4723e8c0.html

发一个圣诞祝福页面的代码

470280558@qq.com(AnyTrey) — Thu,17 Dec 2009 12:58:57 +0800

在网上看了这个不错的圣诞祝福界面

于是弄下了下来，删除没有用的东西

希望大家能喜欢，呵呵！！

界面预览：

下载：

点击下载此文件

页面源自网络，仅共享之用，如有侵犯您的权利请联系我，我将在24小时内删除！

AspJpeg组件过期解决方法

470280558@qq.com(AnyTrey) — Tue,15 Dec 2009 23:14:33 +0800

网站还了服务器突然发现图片的水印失效，于是搜索了下，用比较简单的代码测试了下，现在原来是水印组件过期了,用生成文字水印测试了下，出现了如下提示错误：
AspJpeg has expired. Please visit www.aspjpeg.com to purchase a registration key.

然后查看组件是否到期的方法：
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Response.Write Jpeg.Expires

解决方法:

修改注册表：注册表中的HKEY_LOCAL_MACHINE\Software\ Persits Software\AspJpeg，只有一个Expires。在AspJpeg下新建一个项：RegKey 然后将数值更改为48958-77556-02411，就可以了

在用查看过期的方法看了下，显示为 9999-9-9 。。。成功了！！

ASP取汉字首字母

470280558@qq.com(AnyTrey) — Sat,28 Nov 2009 10:30:51 +0800

<%
function getpychar(char)
dim tmp
tmp=65536+asc(char)

if(tmp>=45217 and tmp<=45252) then
getpychar= "A"
elseif(tmp>=45253 and tmp<=45760) then
getpychar= "B"
elseif(tmp>=45761 and tmp<=46317) then
getpychar= "C"
elseif(tmp>=46318 and tmp<=46825) then
getpychar= "D"
elseif(tmp>=46826 and tmp<=47009) then
getpychar= "E"
elseif(tmp>=47010 and tmp<=47296) then
getpychar= "F"
elseif(tmp>=47297 and tmp<=47613) then
getpychar= "G"
elseif(tmp>=47614 and tmp<=48118) then
getpychar= "H"
elseif(tmp>=48119 and tmp<=49061) then
getpychar= "J"
elseif(tmp>=49062 and tmp<=49323) then
getpychar= "K"
elseif(tmp>=49324 and tmp<=49895) then
getpychar= "L"
elseif(tmp>=49896 and tmp<=50370) then
getpychar= "M"
elseif(tmp>=50371 and tmp<=50613) then
getpychar= "N"
elseif(tmp>=50614 and tmp<=50621) then
getpychar= "O"
elseif(tmp>=50622 and tmp<=50905) then
getpychar= "P"
elseif(tmp>=50906 and tmp<=51386) then
getpychar= "Q"
elseif(tmp>=51387 and tmp<=51445) then
getpychar= "R"
elseif(tmp>=51446 and tmp<=52217) then
getpychar= "S"
elseif(tmp>=52218 and tmp<=52697) then
getpychar= "T"
elseif(tmp>=52698 and tmp<=52979) then
getpychar= "W"
elseif(tmp>=52980 and tmp<=53688) then
getpychar= "X"
elseif(tmp>=53689 and tmp<=54480) then
getpychar= "Y"
elseif(tmp>=54481 and tmp<=62289) then
getpychar= "Z"
else '如果不是中文，则不处理
getpychar=char
end if
end function

function getpy(str)
getpy=getpychar(mid(str,1,1))
end function

response.Write getpy("理")
%>