'**************************************************
'函数ID：0034[用于右填充指定数量的字符,以达到规范长度]
'函数名：rpad
'作 用：用于右填充指定数量的字符,以达到规范长度
'参 数：desstr ---- 目标字符
'参 数：padchar ---- 填充字符
'参 数：lenint ---- 填充后的字符总长度
'返回值：返回字符
'示 例：response.write rpad('a',0,5),结果显示a0000
'**************************************************
Public Function rpad(ByVal desstr,ByVal padchar,ByVal lenint)
dim d,p,t
d = cstr(desstr)
p = cstr(padchar)
rpad=""
for t=1 to lenint-len(d)
rpad = p & rpad
next
rpad = d & rpad
end function
'**************************************************
'函数ID：0035[格式化时间(显示)]
'函数名：Format_Time
'作 用：格式化时间(显示)
'参 数：s_Time ---- 时间变量
'参 数：n_Flag ---- 时间样式类型代码
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' 6:"MM/DD"
'返回值：返回格式化后时间
'示 例：response.write Format_Time(now(),4)
'**************************************************
Public Function Format_Time(ByVal s_Time,ByVal n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
Case 6
'mm/dd
Format_Time = m & "/" & d
case 7
Format_Time = m & "/" & d & "/" & right(y,2)
End Select
End Function
'**************************************************
'函数ID：0036[测试数据库是否存在]
'函数名：TestDBOK
'作 用：测试数据库是否存在
'参 数：TestConnStr ---- 数据库链接字串
'返回值：测试成功返回 True 否则 False
'示 例：TestDBOK("testConnString")
'**************************************************
Public Function TestDBOK(ByVal TestConnStr)
TestDBOK=False
DIM fu_Conn
Set fu_Conn=server.createobject("ADODB.Connection")
On Error GoTo 0
On Error Resume Next
fu_Conn.open TestConnStr
If Err.Number = 0 Then
TestDBOK=True
End If
On Error GoTo 0
Set fu_Conn = Nothing
End Function
'**************************************************
'函数ID：0037[测试数据库中的表是否存在]
'函数名：TestTbOK
'作 用：测试数据库中的表是否存在
'参 数：ObjConnName ---- 数据库链接定义
'参 数：TestDbname ---- 被测试表的名称
'返回值：测试成功返回 True 否则 False
'示 例：TestTbOK(TestConn,"tbname")
'**************************************************
Public Function TestTbOK(ByVal ObjConnName,ByVal TestDbname)
TestTbOK=False
DIM fu_Rs
Set fu_Rs=server.createobject("ADODB.Recordset")
On Error GoTo 0
On Error Resume Next
fu_Rs.open "SELECT * FROM "&TestDbname,ObjConnName,1,1
fu_Rs.Close
If Err.Number = 0 Then
TestTbOK=True
End If
On Error GoTo 0
Set fu_Rs = Nothing
End Function
'**************************************************
'**************************************************
'函数ID：0039[判断是否奇数]
'函数名：Is_JS
'作 用：判断是否奇数
'参 数：num ---- 要判断的数
'返回值：返回True,否则False
'**************************************************
Public Function Is_JS(ByVal num)
n=num mod 2
if n=1 then
Is_JS=true
else
Is_JS=false
end if
end function
'**************************************************
'函数ID：0040[生成验证码图像BMP]
'函数名：GrapCode
'作 用：生成验证码图像
'参 数：MZYGCstr ---- 要生成的图像的字符
'参 数：Noisy ---- 噪点率(大于0的整数)
'参 数：BkColor ---- 图案背景色(格式：R|G|B)
'参 数：FnColor ---- 字符颜色(格式：R|G|B)
'参 数：NoColor ---- 噪点颜色(格式：R|G|B)
'返回值：验证码图像
'示 例：Response.Write "<img src='" &GrapCode(Request("n"),6,"10|40|100","255|255|255","100|100|100")&"'>"
'**************************************************
Public Function GrapCode(ByVal MZYGCstr,ByVal Noisy,ByVal BkColor,ByVal FnColor,ByVal NoColor)
If Len(Trim(MZYGCstr))>1 Then
Dim imgsize,pimgsize
Const cAmount = 36
Const cCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim ColorV(2)
tmp=""
tmp=Split(BkColor,"|")
ColorV(0) =""
For i = LBound(tmp) To UBound(tmp)
ColorV(0) = ColorV(0) & ChrB(CInt(tmp(i)))
Next
tmp=""
tmp=Split(FnColor,"|")
ColorV(1) =""
For i = LBound(tmp) To UBound(tmp)
ColorV(1) = ColorV(1) & ChrB(CInt(tmp(i)))
Next
tmp=""
tmp=Split(NoColor,"|")
ColorV(2) =""
For i = LBound(tmp) To UBound(tmp)
ColorV(2) = ColorV(2) & ChrB(CInt(tmp(i)))
Next
imgsize=10*Len(MZYGCstr)*10*24/8
pimgsize=10*Len(MZYGCstr)*10*24/8
If Is_JS(Len(MZYGCstr)) Then
imgsize=imgsize+74
pimgsize=pimgsize+20
Else
imgsize=imgsize+54
End If
imgsize =Hex(imgsize)
pimgsize=Hex(pimgsize)
imgsize =Cstr(imgsize)
pimgsize=Cstr(pimgsize)
'dword对齐处理
Dim length, byteCount,BytePatch
length = Len(MZYGCstr)
byteCount=((length*10*3) mod 4)
If byteCount>0 Then
byteCount= 4 - ((length*10*3) Mod 4)
For i=1 To byteCount : BytePatch = BytePatch & chrB(00) : Next
End If
tmp=""
For i=1 to len(imgsize) step 2
If (i < len(imgsize)) Then
tmp=tmp & Mid(imgsize,i,2) & "|"
Else
tmp=tmp & Mid(imgsize,i,2)
End If
Next
imgsize=StrReverse(tmp)
tmp=""
tmp=Split(imgsize,"|")
imgsize=""
For i = 0 To 3
If (i <= UBound(tmp)) Then
imgsize=imgsize & ChrB("&H"&tmp(i))
Else
imgsize=imgsize & ChrB(0)
End If
Next
ptmp=""
For i=1 to len(pimgsize) step 2
If (i < len(pimgsize)) Then
ptmp=ptmp & Mid(pimgsize,i,2) & "|"
Else
ptmp=ptmp & Mid(pimgsize,i,2)
End If
Next
pimgsize=StrReverse(ptmp)
ptmp=""
ptmp=Split(pimgsize,"|")
pimgsize=""
For i = 0 To 3
If (i <= UBound(ptmp)) Then
pimgsize=pimgsize & ChrB("&H"&ptmp(i))
Else
pimgsize=pimgsize & ChrB(0)
End If
Next
MZYGCstr=UCase(MZYGCstr)
tmp=""
For i = 0 To (Len(MZYGCstr)-1)
If i<>(Len(MZYGCstr)-1) Then
tmp =tmp & InStr(cCode,Mid(MZYGCstr,i+1,1))-1 &"|"
Else
tmp =tmp & InStr(cCode,Mid(MZYGCstr,i+1,1))-1
End If
Next
Dim vCode
vCode=Split(tmp,"|")
Response.Expires = -9999
Response.AddHeader "pragma", "no-cache"
Response.AddHeader "cache-ctrol", "no-cache"
Response.Buffer = TRUE
Response.ContentType="image/bmp"
Response.Flush
Response.BinaryWrite ChrB(66) & ChrB(77) & imgsize & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(10*Len(MZYGCstr)) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(12) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0)
Response.BinaryWrite ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & pimgsize & 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)
Dim NsD(35)
NsD(0) = "111111111111100001111101111011110111101111010010111101001011110100101111010010111101111011110111101111100001111111111111"
NsD(1) = "111111111111110111111100011111111101111111110111111111011111111101111111110111111111011111111101111111000001111111111111"
NsD(2) = "111111111111100001111101111011110111101111111110111111110111111110111111110111111110111111110111101111000000111111111111"
NsD(3) = "111111111111100001111101111011110111101111111101111111001111111111011111111110111101111011110111101111100001111111111111"
NsD(4) = "111111111111111011111111101111111100111111101011111101101111110110111111000000111111101111111110111111110000111111111111"
NsD(5) = "111111111111000000111101111111110111111111010001111100111011111111101111111110111101111011110111101111100001111111111111"
NsD(6) = "111111111111110001111110111011110111111111011111111101000111110011101111011110111101111011110111101111100001111111111111"
NsD(7) = "111111111111000000111101110111110111011111111011111111101111111101111111110111111111011111111101111111110111111111111111"
NsD(8) = "111111111111100001111101111011110111101111011110111110000111111011011111011110111101111011110111101111100001111111111111"
NsD(9) = "111111111111100011111101110111110111101111011110111101110011111000101111111110111111111011110111011111100011111111111111"
NsD(10) = "111111111111110111111111011111111010111111101011111110101111111010111111000001111101110111110111011110001000111111111111"
NsD(11) = "111111111110000001111101111011110111101111011101111100001111110111011111011110111101111011110111101110000001111111111111"
NsD(12) = "111111111111100000111101111011101111101110111111111011111111101111111110111111111011111011110111011111100011111111111111"
NsD(13) = "111111111110000011111101110111110111101111011110111101111011110111101111011110111101111011110111011110000011111111111111"
NsD(14) = "111111111110000001111101111011110110111111011011111100001111110110111111011011111101111111110111101110000001111111111111"
NsD(15) = "111111111110000001111101111011110110111111011011111100001111110110111111011011111101111111110111111110001111111111111111"
NsD(16) = "111111111111100001111101110111101111011110111111111011111111101111111110111000111011110111110111011111100011111111111111"
NsD(17) = "111111111110001000111101110111110111011111011101111100000111110111011111011101111101110111110111011110001000111111111111"
NsD(18) = "111111111111000001111111011111111101111111110111111111011111111101111111110111111111011111111101111111000001111111111111"
NsD(19) = "111111111111100000111111101111111110111111111011111111101111111110111111111011111111101111101110111110000111111111111111"
NsD(20) = "111111111110001000111101110111110110111111010111111100011111110101111111011011111101101111110111011110001000111111111111"
NsD(21) = "111111111110001111111101111111110111111111011111111101111111110111111111011111111101111111110111101110000000111111111111"
NsD(22) = "111111111110001000111100100111110010011111001001111101010111110101011111010101111101010111110101011110010100111111111111"
NsD(23) = "111111111110001000111100110111110011011111010101111101010111110101011111011001111101100111110110011110001101111111111111"
NsD(24) = "111111111111100011111101110111101111101110111110111011111011101111101110111110111011111011110111011111100011111111111111"
NsD(25) = "111111111110000001111101111011110111101111011110111100000111110111111111011111111101111111110111111110001111111111111111"
NsD(26) = "111111111111100011111101110111101111101110111110111011111011101111101110111110111010011011110110011111100010111111111111"
NsD(27) = "111111111110000011111101110111110111011111011101111100001111110101111111011011111101101111110111011110001100111111111111"
NsD(28) = "111111111111100000111101111011110111101111011111111110011111111110011111111110111101111011110111101111000001111111111111"
NsD(29) = "111111111110000000111011011011111101111111110111111111011111111101111111110111111111011111111101111111100011111111111111"
NsD(30) = "111111111110001000111101110111110111011111011101111101110111110111011111011101111101110111110111011111100011111111111111"
NsD(31) = "111111111110001000111101110111110111011111011101111110101111111010111111101011111110101111111101111111110111111111111111"
NsD(32) = "111111111110010100111101010111110101011111010101111101010111110010011111101011111110101111111010111111101011111111111111"
NsD(33) = "111111111110001000111101110111111010111111101011111111011111111101111111101011111110101111110111011110001000111111111111"
NsD(34) = "111111111110001000111101110111110111011111101011111110101111111101111111110111111111011111111101111111100011111111111111"
NsD(35) = "111111111111000000111101110111111111011111111011111111101111111101111111110111111110111111111011101111000000111111111111"
Dim a,b,c
For a=11 to 0 Step -1
For c=0 to UBound(vCode)
For b=1 to 10
If Rnd * 99 + 1 < Noisy Then
Response.BinaryWrite ColorV(2)
Else
Response.BinaryWrite ColorV(Mid(NsD(CInt(vCode(c))),a*10+b,1))
End If
Next
Next
If byteCount>0 Then Response.BinaryWrite BytePatch
Next
End If
End Function
'**************************************************