台灣最大程式設計社群網站
線上人數
1548		  
會員總數：246740
討論主題：190153
歡迎您免費加入會員
討論區選單
開發工具
行動裝置開發
資料庫
多媒體 / 網管
綜合
文章區
討論區列表 >> 專欄文章 >> ASP無組件產生驗證碼
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
ASP無組件產生驗證碼
價值 : 0 QP  點閱數:2964 回應數:0
樓主

Sdany
中級顧問
45676 77
16725 5369
發送站內信

捐贈 VP 給 Sdany
自動產生邊框及底寬的部份，蠻複雜的
希望有人能幫忙簡化


<%'ASP無組件產生驗證碼 By Sdany
'參考資料
'http://140.130.175.70/DOC2/BMP.doc
'http://www.blueshop.com.tw/board/show.asp?subcde=BRD200504291407098IT&fumcde=
'天下文章一大抄，真正原作是誰呢？
'原始圖檔為24Bit，只能產生 4 位文字 大小為 40x10
'以下程式參考資料後，
'引用了「參考資料的圖點數據(字符的數據)」，及「共同宣告」部份，
'其它部份由個人撰寫，如有雷同，純屬巧合。
'增加項目：可設定字數、背景底寬、邊框寬

Option Explicit
Response.Expires = 0
Response.AddHeader "Pragma","no-cache"
Response.AddHeader "cache-ctrol","no-cache"
Response.ContentType = "Image/BMP"
Randomize Timer

Const dds = 25 '雜點率
Const TextLen = 4 '字數
Const Border = 1 '邊框加寬度
Const Padding = 3 '背景邊寬度
Const Amount = 36 ' 文字數量
Const TextCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Dim BorderColor,BGColor,FGColor
'邊框顏色
BorderColor = ChrB(&H99) & ChrB(0) & ChrB(0)
'背景顏色
'藍250，綠236，紅211（淺藍色）
BGColor = ChrB(&HFF) & ChrB(&HFF) & ChrB(&HE0)
'前景顏色(字)
FGColor = ChrB(0) & ChrB(0) & ChrB(0)

Dim I,J,K,L

'亂數取得文字
Dim SafeCodes
ReDim SafeCode(TextLen)
For I = 1 To TextLen
SafeCode(I-1) = Int(Rnd * Amount)
SafeCodes = SafeCodes & Mid(TextCode, SafeCode(I-1) + 1, 1)
Next
Session("SafeCode")=SafeCodes

'0-9 A-Z
Dim TextData(35)
TextData(0) = "0001111000001000010000100001000010110100001011010000101101000010110100001000010000100001000001111000"
TextData(1) = "0000100000001110000000001000000000100000000010000000001000000000100000000010000000001000000011111000"
TextData(2) = "0001111000001000010000100001000000000100000000100000000100000000100000000100000000100001000011111100"
TextData(3) = "0001111000001000010000100001000000001000000011000000000010000000000100001000010000100001000001111000"
TextData(4) = "0000010000000001000000001100000001010000001001000000100100000011111100000001000000000100000000111100"
TextData(5) = "0011111100001000000000100000000010111000001100010000000001000000000100001000010000100001000001111000"
TextData(6) = "0000111000000100010000100000000010000000001011100000110001000010000100001000010000100001000001111000"
TextData(7) = "0011111100001000100000100010000000010000000001000000001000000000100000000010000000001000000000100000"
TextData(8) = "0001111000001000010000100001000010000100000111100000010010000010000100001000010000100001000001111000"
TextData(9) = "0001110000001000100000100001000010000100001000110000011101000000000100000000010000100010000001110000"
TextData(10) = "0000100000000010000000010100000001010000000101000000010100000011111000001000100000100010000111011100"
TextData(11) = "0111111000001000010000100001000010001000001111000000100010000010000100001000010000100001000111111000"
TextData(12) = "0001111100001000010001000001000100000000010000000001000000000100000000010000010000100010000001110000"
TextData(13) = "0111110000001000100000100001000010000100001000010000100001000010000100001000010000100010000111110000"
TextData(14) = "0111111000001000010000100100000010010000001111000000100100000010010000001000000000100001000111111000"
TextData(15) = "0111111000001000010000100100000010010000001111000000100100000010010000001000000000100000000111000000"
TextData(16) = "0001111000001000100001000010000100000000010000000001000000000100011100010000100000100010000001110000"
TextData(17) = "0111011100001000100000100010000010001000001111100000100010000010001000001000100000100010000111011100"
TextData(18) = "0011111000000010000000001000000000100000000010000000001000000000100000000010000000001000000011111000"
TextData(19) = "0001111100000001000000000100000000010000000001000000000100000000010000000001000001000100000111100000"
TextData(20) = "0111011100001000100000100100000010100000001110000000101000000010010000001001000000100010000111011100"
TextData(21) = "0111000000001000000000100000000010000000001000000000100000000010000000001000000000100001000111111100"
TextData(22) = "0111011100001101100000110110000011011000001010100000101010000010101000001010100000101010000110101100"
TextData(23) = "0111011100001100100000110010000010101000001010100000101010000010011000001001100000100110000111001000"
TextData(24) = "0001110000001000100001000001000100000100010000010001000001000100000100010000010000100010000001110000"
TextData(25) = "0111111000001000010000100001000010000100001111100000100000000010000000001000000000100000000111000000"
TextData(26) = "0001110000001000100001000001000100000100010000010001000001000100000100010110010000100110000001110100"
TextData(27) = "0111110000001000100000100010000010001000001111000000101000000010010000001001000000100010000111001100"
TextData(28) = "0001111100001000010000100001000010000000000110000000000110000000000100001000010000100001000011111000"
TextData(29) = "0111111100010010010000001000000000100000000010000000001000000000100000000010000000001000000001110000"
TextData(30) = "0111011100001000100000100010000010001000001000100000100010000010001000001000100000100010000001110000"
TextData(31) = "0111011100001000100000100010000010001000000101000000010100000001010000000101000000001000000000100000"
TextData(32) = "0110101100001010100000101010000010101000001010100000110110000001010000000101000000010100000001010000"
TextData(33) = "0111011100001000100000010100000001010000000010000000001000000001010000000101000000100010000111011100"
TextData(34) = "0111011100001000100000100010000001010000000101000000001000000000100000000010000000001000000001110000"
TextData(35) = "0011111100001000100000000010000000010000000001000000001000000000100000000100000000010001000011111100"

'TextData 字的寬度
Const TextWidth = 10
'TextData 字的高度
Const TextHeight = 10
Dim ByteSize,Bmp,Width,Height,WH
'邊寬+底寬
WH = Border*2+Padding*2
'圖的總寬度
Width = TextWidth*TextLen+WH
'圖的總高度
Height = TextHeight+WH
'圖的大小
ByteSize = Int((Width*3)/4+0.9)*4*(Height)

'每個1個高度最後要補充的空Byte數
Dim SpaceByte
SpaceByte = 4-((Width*3) Mod 4)

'BMP格式 固定不變
Bmp = Bmp & ChrB(&H42) & ChrB(&H4D)
'檔案大小
Bmp = Bmp & ChrB((ByteSize+54) Mod 256) & ChrB((ByteSize+54)\256) & ChrB(0) & ChrB(0)
Bmp = Bmp & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
'起始Byte 固定不變
Bmp = Bmp & ChrB(&H36) & ChrB(0) & ChrB(0) & ChrB(0)
'結構的大小 固定不變
Bmp = Bmp & ChrB(&H28) & ChrB(0) & ChrB(0) & ChrB(0)
'寬度
Bmp = Bmp & ChrB(Width Mod 256) & ChrB(Width\256) & ChrB(0) & ChrB(0)
'高度
Bmp = Bmp & ChrB(Height Mod 256) & ChrB(Height\256) & ChrB(0) & ChrB(0)
'每個圖點的顏色位元數，3Byte表示(24/8) 固定不變
Bmp = Bmp & ChrB(1) & ChrB(0) & ChrB(24) & ChrB(0)
Bmp = Bmp & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
'圖點大小
Bmp = Bmp & ChrB(ByteSize Mod 256) & ChrB(ByteSize\256) & ChrB(0) & ChrB(0)
Bmp = Bmp & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
Bmp = Bmp & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
Bmp = Bmp & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
Bmp = Bmp & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)

Response.BinaryWrite Bmp


Function GetBGColor()
Dim TB
'隨機生成雜點[干擾用]
If Rnd * 99 + 1 < dds Then
TB = Int(Rnd * 100) + 156
GetBGColor = ChrB(&HFF) & ChrB(&HFF) & ChrB(TB)
Else
GetBGColor = BGColor
End if
End function

Function GetFGColor()
'隨機生成雜點[干擾用]
If Rnd * 99 + 1 < dds Then
GetFGColor = ChrB(Int(Rnd * 256)) & ChrB(Int(Rnd * 256)) & ChrB(Int(Rnd * 256))
Else
GetFGColor = FGColor
End if
End function


'邊寬
If Border > 0 then
For I = 1 to Border
'設置底邊寬
For L = 1 to Width
Response.BinaryWrite BorderColor
Next
'設置空白
If SpaceByte < 4 then
For J = 1 to SpaceByte
Response.BinaryWrite ChrB(0)
Next
End If
Next
End if
'底寬
If Padding > 0 then
For I = 1 to Padding
'設置左邊框
If Border > 0 then
For L = 1 to Border
Response.BinaryWrite BorderColor
Next
End if
'設置底寬
For L = 1 to Width-Border*2
Response.BinaryWrite GetBGColor
Next
'設置右邊框
If Border > 0 then
For L = 1 to Border
Response.BinaryWrite BorderColor
Next
End if
'設置空白
If SpaceByte < 4 then
For J = 1 to SpaceByte
Response.BinaryWrite ChrB(0)
Next
End If
Next
End if

For I = TextHeight to 1 step -1
'設置左邊框
If Border > 0 then
For L = 1 to Border
Response.BinaryWrite BorderColor
Next
End if
'設置左底寬
If Padding > 0 then
For L = 1 to Padding
Response.BinaryWrite GetBGColor
Next
End if
'設置文字
For J = 1 to TextLen
For K = 1 to TextWidth
'字元圖形資料輸出BMP圖點
If Mid(TextData(SafeCode(J-1)), (I-1) * TextWidth + K, 1) = "1" then
Response.BinaryWrite GetFGColor
Else
Response.BinaryWrite GetBGColor
End if
Next
Next
'設置右底寬
If Padding > 0 then
For L = 1 to Padding
Response.BinaryWrite GetBGColor
Next
End if
'設置右邊框
If Border > 0 then
For L = 1 to Border
Response.BinaryWrite BorderColor
Next
End if

'設置空白
If SpaceByte < 4 then
For K = 1 to SpaceByte
Response.BinaryWrite ChrB(0)
Next
End If
Next

'底寬
If Padding > 0 then
For I = 1 to Padding
'設置左邊框
If Border > 0 then
For L = 1 to Border
Response.BinaryWrite BorderColor
Next
End if
'設置底寬
For L = 1 to Width-Border*2
Response.BinaryWrite GetBGColor
Next
'設置右邊框
If Border > 0 then
For L = 1 to Border
Response.BinaryWrite BorderColor
Next
End if
'設置空白
If SpaceByte < 4 then
For J = 1 to SpaceByte
Response.BinaryWrite ChrB(0)
Next
End If
Next
End if
'邊寬
If Border > 0 then
For I = 1 to Border
'設置頂邊寬
For L = 1 to Width
Response.BinaryWrite BorderColor
Next
'設置空白
If SpaceByte < 4 then
For J = 1 to SpaceByte
Response.BinaryWrite ChrB(0)
Next
End If
Next
End if


%>
搜尋相關Tags的文章： [ ASP ] , [ 無組件 ] , [ 驗證碼 ] , [ Sdany ] , [ BMP ] ,
本篇文章發表於2007-07-24 11:31
== 簽名檔 ==
經驗是不斷累積來的,答案是Google來的XD
目前尚無任何回覆
   

回覆
如要回應,請先登入.