'*************************************** ***********
'Function ID: 0034 [this parameter is used to right-fill a specified number of characters to reach the standard length]
'Function name: rpad
'Usage: Fill in a specified number of characters on the right to reach the standard length.
'Parameter: desstr ---- target character
'Parameter: padchar ---- fill character
'Parameter: lenint ---- the total length of the filled characters
'Return value: return character
'Example: Response. Write rpad ('A',). The result is 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
'*************************************** ***********
'Function ID: 0035 [format time (displayed)]
'Function name: format_time
'For use: Format time (displayed)
'Parameter: s_time ---- time variable
'Parameter: n_flag ---- time style type code
'1: "yyyy-mm-dd hh: mm: SS"
'2: "yyyy-mm-dd"
'3: "HH: mm: SS"
'4: "mm DD, YYYY"
'5: "yyyymmdd"
'6: "mm/DD"
'Return value: return the formatted time.
'Example: 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 & "year" & M & "month" & D & "day"
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
'*************************************** ***********
'Function ID: 0036 [test whether the database exists]
'Function name: testdbok
'Usage: test whether the database exists
'Parameter: testconnstr ---- database link string
'Return value: true if the test is successful, or false if the test is successful.
'Example: 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
'*************************************** ***********
'Function ID: 0037 [test whether the table in the database exists]
'Function name: testtbok
'Usage: test whether the table in the database exists
'Parameter: objconnname ---- database link Definition
'Parameter: testdbname ---- name of the table to be tested
'Return value: true if the test is successful, or false if the test is successful.
'Example: 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
'*************************************** ***********
'*************************************** ***********
'Function ID: 0039 [judge whether the number is odd]
'Function name: is_js
'Usage: judge whether the number is odd
'Parameter: num ---- number to be judged
'Return value: true; otherwise, 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
'*************************************** ***********
'Function ID: 0040 [generating the verification code image BMP]
'Function name: grapcode
'Usage: Generate Verification Code Image
'Parameter: mzygcstr ---- the character of the image to be generated
'Parameter: Noisy ---- noise rate (an integer greater than 0)
'Parameter: bkcolor ---- pattern background color (Format: R | G | B)
'Parameter: fncolor ---- Character Color (Format: R | G | B)
'Parameter: nocolor ---- noise color (Format: R | G | B)
'Return value: Verification Code Image
'Example: response. write "'*************************************** ***********
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 = "0123456789 abcdefghijklmnopqrstuvwxyz"
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 alignment Processing
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
'*************************************** ***********