動網中用到的幾個Function和一個JS[base64encode,base64decode,md5,sendmail,js]
<%dim sBASE_64_CHARACTERS
dim len1,k
dim asc1,asContents1
dim varchar,varasc,varHex,varlow,varhigh
sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
Function strUnicodeLen(asContents)
'計算unicode字符串的Ansi編碼的長度
asContents1="a"&asContents
len1=len(asContents1)
k=0
for i=1 to len1
asc1=asc(mid(asContents1,i,1))
if asc1<0 then asc1=65536+asc1
if asc1>255 then
k=k+2
else
k=k+1
end if
next
strUnicodeLen=k-1
End Function
Function strUnicode2Ansi(asContents)
'將Unicode編碼的字符串，轉換成Ansi編碼的字符串
strUnicode2Ansi=""
len1=len(asContents)
for i=1 to len1
varchar=mid(asContents,i,1)
varasc=asc(varchar)
if varasc<0 then varasc=varasc+65536
if varasc>255 then
varHex=Hex(varasc)
varlow=left(varHex,2)
varhigh=right(varHex,2)
strUnicode2Ansi=strUnicode2Ansi & chrb("&H" & varlow ) & chrb("&H" & varhigh )
else
strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
end if
next
End function
Function strAnsi2Unicode(asContents)
'將Ansi編碼的字符串，轉換成Unicode編碼的字符串
strAnsi2Unicode = ""
if isnull(asContents) or asContents="" then exit function
len1=lenb(asContents)
if len1=0 then exit function
for i=1 to len1
varchar=midb(asContents,i,1)
varasc=ascb(varchar)
if varasc > 127then
if midb(asContents,i+1,1)<>"" then
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
end if
i=i+1
else
strAnsi2Unicode = strAnsi2Unicode & chr(varasc)
end if
next
End function
Function Base64encode(asContents)
'將Ansi編碼的字符串進行Base64編碼
'asContents應當是ANSI編碼的字符串（二進制的字符串也可以）
Dim lnPosition
Dim lsResult
Dim Char1
Dim Char2
Dim Char3
Dim Char4
Dim Byte1
Dim Byte2
Dim Byte3
Dim SaveBits1
Dim SaveBits2
Dim lsGroupBinary
Dim lsGroup64
Dim m3,m4,len1,len2
len1=Lenb(asContents)
if len1<1 then
Base64encode=""
exit Function
end if
m3=Len1 Mod 3
If M3 > 0 Then asContents = asContents & String(3-M3, chrb(0))
'補足位數是為了便於計算
IF m3 > 0 THEN
len1=len1+(3-m3)
len2=len1-3
else
len2=len1
end if
lsResult = ""
For lnPosition = 1 To len2 Step 3
lsGroup64 = ""
lsGroupBinary = Midb(asContents, lnPosition, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
lsGroup64 = Char1 & Char2 & Char3 & Char4
lsResult = lsResult & lsGroup64
Next
'處理最後剩餘的幾個字符
if M3 > 0then
lsGroup64 = ""
lsGroupBinary = Midb(asContents, len2+1, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
if M3=1 then
lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) '用=號補足位數
else
lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) '用=號補足位數
end if
lsResult = lsResult & lsGroup64
end if
Base64encode = lsResult
End Function
Function Base64decode(asContents)
'將Base64編碼字符串轉換成Ansi編碼的字符串
'asContents應當也是ANSI編碼的字符串（二進制的字符串也可以）
Dim lsResult
Dim lnPosition
Dim lsGroup64, lsGroupBinary
Dim Char1, Char2, Char3, Char4
Dim Byte1, Byte2, Byte3
Dim M4,len1,len2
len1= Lenb(asContents)
M4 = len1 Mod 4
if len1 < 1 or M4 > 0 then
'字符串長度應當是4的倍數
Base64decode = ""
exit Function
end if
'判斷最後一位是不是 = 號
'判斷倒數第二位是不是 = 號
'這裡m4表示最後剩餘的需要單獨處理的字符個數
if midb(asContents, len1, 1) = chrb(61) then m4=3
if midb(asContents, len1-1, 1) = chrb(61) then m4=2
if m4 = 0 then
len2=len1
else
len2=len1-4
end if
For lnPosition = 1 To Len2 Step 4
lsGroupBinary = ""
lsGroup64 = Midb(asContents, lnPosition, 4)
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
lsGroupBinary = Byte1 & Byte2 & Byte3
lsResult = lsResult & lsGroupBinary
Next
'處理最後剩餘的幾個字符
if M4 > 0 then
lsGroupBinary = ""
lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) 'chr(65)=A，轉換成值為0
if M4=2 then '補足4位，是為了便於計算
lsGroup64 = lsGroup64 & chrB(65)
end if
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
if M4=2 then
lsGroupBinary = Byte1
elseif M4=3 then
lsGroupBinary = Byte1 & Byte2
end if
lsResult = lsResult & lsGroupBinary
end if
Base64decode = lsResult
End Function
%>
<%
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
Dim Md5OLD
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function str2bin(varstr)
Dim varasc
Dim i
Dim varchar
Dim varlow
Dim varhigh
str2bin=""
For i=1 To Len(varstr)
varchar=mid(varstr,i,1)
varasc = Asc(varchar)
If varasc<0 Then
varasc = varasc + 65535
End If
If varasc>255 Then
varlow = Left(Hex(Asc(varchar)),2)
varhigh = right(Hex(Asc(varchar)),2)
str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
Else
str2bin = str2bin & chrB(AscB(varchar))
End If
Next
End Function
Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function md5_F(x, y, z)
md5_F = (x And y) Or ((Not x) And z)
End Function
Private Function md5_G(x, y, z)
md5_G = (x And z) Or (y And (Not z))
End Function
Private Function md5_H(x, y, z)
md5_H = (x Xor y Xor z)
End Function
Private Function md5_I(x, y, z)
md5_I = (y Xor (x Or (Not z)))
End Function
Private Sub md5_FF(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_GG(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_HH(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_II(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
If Md5OLD = 1 Then
lMessageLength = Len(sMessage)
Else
lMessageLength = LenB(sMessage)
End If
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
If Md5OLD = 1 Then
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
Else
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(AscB(MidB(sMessage, lByteCount + 1, 1)), lBytePosition)
End If
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Private Function WordToHex(lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
Public Function MD5(sMessage,stype)
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)
m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)
Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d
Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21
If Md5OLD = 1 Then
x = ConvertToWordArray(sMessage)
Else
x = ConvertToWordArray(str2bin(sMessage))
End If
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476
For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d
md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
md5_FF b, c, d, a, x(k + 15), S14, &H49B40821
md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
md5_GG d, a, b, c, x(k + 10), S22, &H2441453
md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665
md5_II a, b, c, d, x(k + 0), S41, &HF4292244
md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
md5_II c, d, a, b, x(k + 6), S43, &HA3014314
md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
md5_II b, c, d, a, x(k + 9), S44, &HEB86D391
a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
if stype=32 then
MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
else
MD5=LCase(WordToHex(b) & WordToHex(c))'I crop this to fit 16byte database password :D
end if
End Function
%>
<%
'-----------------------------------------------------------------------
'--- EMAIL郵件處理類模塊
'--- Copyright (c) 2004 Aspsky, Inc.
'--- Mail: Sunwin@artbbs.net http://www.aspsky.net
'--- 2004-12-18
'-----------------------------------------------------------------------
'--- 設置項
'-----------------------------------------------------------------------
'--- ServerLoginName 設置您的郵件服務器登錄名
'--- ServerLoginPass 設置登錄密碼
'--- SendSMTP 設置SMTP郵件服務器地址
'--- SendFromEmail 設置發件人的E-MAIL地址
'--- SendFromName 設置發送人名稱
'--- ContentType 設置郵件類型 默認：text/html
'--- CharsetType 設置編碼類型 默認：gb2312
'--- SendObject 設置選取組件 1=Jmail,2=Cdonts,3=Aspemail
'-----------------------------------------------------------------------
'--- 屬性
'-----------------------------------------------------------------------
'--- SendMail Email, Topic, MailBody 收件人地址，標題，郵件內容
'-----------------------------------------------------------------------
'--- 獲取信息
'-----------------------------------------------------------------------
'--- ErrCode 信息編號 0=正常
'--- Description 相應操作信息
'--- Count 發送郵件數
'-----------------------------------------------------------------------
Class Dv_SendMail
Public Count,ErrCode,ErrMsg
Private LoginName,LoginPass,SMTP,FromEmail,FromName,Object,Content_Type,Charset_Type
Private Obj,cdoConfig
Private Sub Class_Initialize()
Object = 0
Count = 0
ErrCode = 0
Content_Type = "text/html"
Charset_Type = "gb2312"
End Sub
Private Sub Class_Terminate()
If Isobject(Obj) Then
Set Obj = Nothing
End If
If IsObject(cdoConfig) Then
Set cdoConfig = Nothing
End If
End Sub
'設置您的郵件服務器登錄名
Public Property Let ServerLoginName(Byval Value)
LoginName = Value
End Property
'設置登錄密碼
Public Property Let ServerLoginPass(Byval Value)
LoginPass = Value
End Property
'設置SMTP郵件服務器地址
Public Property Let SendSMTP(Byval Value)
SMTP = Value
End Property
'設置發件人的E-MAIL地址
Public Property Let SendFromEmail(Byval Value)
FromEmail = Value
End Property
'設置發送人名稱
Public Property Let SendFromName(Byval Value)
FromName = Value
End Property
'設置郵件類型
Public Property Let ContentType(Byval Value)
Content_Type = Value
End Property
'設置編碼類型
Public Property Let CharsetType(Byval Value)
Charset_Type = Cstr(Value)
End Property
'獲取錯誤信息
Public Property Get Description()
Description = ErrMsg
End Property
'設置選取組件 SendObject 0=Jmail,1=Cdonts,2=Aspemail
Public Property Let SendObject(Byval Value)
Object = Value
On Error Resume Next
Select Case Object
Case 1
Set Obj = Server.CreateObject("JMail.Message")
Case 2
Set Obj = Server.CreateObject("CDONTS.NewMail")
Case 3
Set Obj = Server.CreateObject("Persits.MailSender")
Case 4
Set Obj = Server.CreateObject("CDO.Message") 'window 2003 new SendMailCom Object
Case Else
ErrNumber = 2
End Select
If Err<>0 Then
ErrNumber = 3
End If
End Property
Private Property Let ErrNumber(Byval Value)
ErrCode = Value
ErrMsg = ErrMsg & Msg
End Property
Private Function Msg()
Dim MsgValue
Select Case ErrCode
Case 1
MsgValue = "未選取郵件組件或服務器不支持該組件！"
Case 2
MsgValue = "所選的組件不存在！"
Case 3
MsgValue = "錯誤：服務器不支持該組件!"
Case 4
MsgValue = "發送失敗!"
Case Else
MsgValue = "正常。"
End Select
Msg = MsgValue
End Function
Public Sub SendMail(Byval Email,Byval Topic,Byval MailBody)
If ErrCode <> 0 Then
Exit Sub
End If
If Email="" or ISNull(Email) Then Exit Sub
If Object>0 Then
Select Case Object
Case 1
Jmail Email,Topic,MailBody
Case 2
Cdonts Email,Topic,Mailbody
Case 3
Aspemail Email,Topic,Mailbody
Case 4
CDOMessage Email,Topic,Mailbody
Case Else
ErrNumber = 2
End Select
Else
ErrNumber = 1
End If
End Sub
Private Sub Jmail(Email,Topic,Mailbody)
On Error Resume Next
Obj.Silent = True
Obj.Logging = True
Obj.Charset = Charset_Type
If Not(LoginName = "" Or LoginPass = "") Then
Obj.MailServerUserName = LoginName '您的郵件服務器登錄名
Obj.MailServerPassword = LoginPass '登錄密碼
End If
Obj.ContentType = Content_Type
Obj.Priority = 1
Obj.From = FromEmail
Obj.FromName = FromName
Obj.AddRecipient Email
Obj.Subject = Topic
Obj.Body = Mailbody
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Obj.Send (SMTP)
Obj.ClearRecipients()
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Count = Count + 1
ErrMsg = ErrMsg & "發送成功!"
End If
End If
End Sub
Private Sub Cdonts(Email,Topic,Mailbody)
On Error Resume Next
Obj.From = FromEmail
Obj.To = Email
Obj.Subject = Topic
Obj.BodyFormat = 0
Obj.MailFormat = 0
Obj.Body = Mailbody
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Obj.Send
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Count = Count + 1
ErrMsg = ErrMsg & "發送成功!"
End If
End If
End Sub
Private Sub Aspemail(Email,Topic,Mailbody)
On Error Resume Next
Obj.Charset = Charset_Type
Obj.IsHTML = True
Obj.username = LoginName '服務器上有效的用戶名
Obj.password = LoginPass '服務器上有效的密碼
Obj.Priority = 1
Obj.Host = SMTP
'Obj.Port = 25 ' 該項可選.端口25是默認值
Obj.From = FromEmail
Obj.FromName = FromName ' 該項可選
Obj.AddAddress Email,Email
Obj.Subject = Topic
Obj.Body = Mailbody
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Obj.Send
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Count = Count + 1
ErrMsg = ErrMsg & "發送成功!"
End If
End If
End Sub
Private Sub CDOMessage(Email,Topic,Mailbody)
On Error Resume Next
If Not IsObject(cdoConfig) Then
Call CreatCDOConfig()
End If
Set Obj = Server.CreateObject("CDO.Message")
With Obj
Set .Configuration = cdoConfig
'.From = FromEmail
.To = Email
.Subject = Topic
.TextBody = Mailbody
.Send
End With
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
Else
Count = Count + 1
ErrMsg = ErrMsg & "發送成功!"
End If
End Sub
Private Sub CreatCDOConfig()
On Error Resume Next
Dim Sch
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set cdoConfig = Server.CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(sch & "smtpserver") = SMTP
'.Item(sch & "smtpserverport") = 25
.Item(sch & "sendusing") = 2 'cdoSendUsingPort CdoSendUsing enum value =2
.Item(sch & "smtpaccountname") = FromName '"My Name"
.Item(sch & "sendemailaddress") = FromEmail '"""MySelf"" <example@example.com>"
.Item(sch & "smtpuserreplyemailaddress") = 25 '"""Another"" <another@example.com>"
'.Item(sch & "smtpauthenticate") = cdoBasic
.Item(sch & "sendusername") = LoginName
.Item(sch & "sendpassword") = LoginPass
.update
End With
If Err<>0 Then
ErrMsg = ErrMsg & "發送失敗!原因：" & Err.Description
ErrNumber = 4
End If
End Sub
End Class
%>
var dv_ajax_debug_mode = false;
function dvajax_debug(text) {
if (dv_ajax_debug_mode)
alert("RSD: " + text);
}
function dvajax_init_object() {
dvajax_debug("dvajax_init_object() called..");
var RetValue;
try {
RetValue = new ActiveXObject("Msxml2.XMLHTTP");
} catch (e) {
try {
RetValue = new ActiveXObject("Microsoft.XMLHTTP");
} catch (oc) {
RetValue = null;
}
}
if(!RetValue && typeof XMLHttpRequest != "undefined")
RetValue = new XMLHttpRequest();
if (!RetValue)
dvajax_debug("Could not create connection object.");
return RetValue;
}
function dvajax_run(func_name,func_obj, args) {
var i, x, n;
var uri;
var post_data;
uri = "ajax_check.asp";
if (dvajax_request_type == "GET") {
if (uri.indexOf("?") == -1)
uri = uri + "?rs=" + func_name;
else
uri = uri + "&rs=" + func_name;
for (i = 0; i < args.length-1; i++)
uri = uri + "&rsargs[]=" + args;
uri = uri + "&rsrnd=" + new Date().getTime();
post_data = null;
} else {
post_data = "rs=" + func_name;
for (i = 0; i < args.length-1; i++)
post_data = post_data + "&rsargs[]=" + urlencode(args);
}
x = dvajax_init_object();
x.open(dvajax_request_type, uri, true);
if (dvajax_request_type == "POST") {
x.setRequestHeader("Method", "POST " + uri + " HTTP/1.1");
x.setRequestHeader("Content-Type", "application/x-www-form-urlencoded");
}
x.onreadystatechange = function() {
if (x.readyState != 4)
return;
dvajax_debug("received " + x.responseText);
var status;
var data;
status = x.responseText.charAt(0);
datacache = x.responseText.substring(0);
data = unescape(datacache);
if (status == "-")
alert("Error: " + data);
else
args(func_obj,data);
}
x.send(post_data);
dvajax_debug(func_name + " uri = " + uri + "/post = " + post_data);
dvajax_debug(func_name + " waiting..");
delete x;
}
function obj_getbyid(id) {
itm = null;
if (document.getElementById) {
itm = document.getElementById(id);
} else if (document.all) {
itm = document.all;
} else if (document.layers) {
itm = document.layers;
}
return itm;
}
function dv_ajaxcheck(seltype,objid){
var objname = obj_getbyid(objid).value;
if (objname){
x_checkdata(seltype,objid,objname,checkuser_cb);
}
}
function checkuser_cb(c_type,data){
var isok_username = obj_getbyid("isok_"+c_type);
if (isok_username)
{
isok_username.innerHTML = " "+data;
}
}
function x_checkdata(x_seltype,x_obj) {
dvajax_run(x_seltype,x_obj,x_checkdata.arguments);
}
function urlencode(text){
text = text.toString();
var matches = text.match(/[\x90-\xFF]/g);
if (matches)
{
for (var matchid = 0; matchid < matches.length; matchid++)
{
var char_code = matches.charCodeAt(0);
text = text.replace(matches, '%u00' + (char_code & 0xFF).toString(16).toUpperCase());
}
}
return escape(text).replace(/\+/g, "%2B");
}
var RegCheck = {
passValue : new Array(),
pass : function(v,Objid,t){
var isok_pass = obj_getbyid("isok_"+Objid);
RegCheck.passValue = v;
if (v.length<6||v.length>10){
isok_pass.innerHTML = err_msg("密碼不能少於6位或多於10位");
return false;
}else{
isok_pass.innerHTML = suc_msg("符合要求");
}
if (t==0){
SetPwdStrengthEx(v);
}else{
if (RegCheck.passValue.length==2){
if (RegCheck.passValue==RegCheck.passValue){
isok_pass.innerHTML = suc_msg("符合要求");
}else{
isok_pass.innerHTML = err_msg("重復輸入密碼不符");
return false;
}
}else
{
isok_pass.innerHTML = err_msg("重復輸入密碼不符");
return false;
}
}
return true;
},
Value : function(v,Objid){
var isok_pass = obj_getbyid("isok_"+Objid);
if (v==''){
isok_pass.innerHTML = err_msg("必填內容，不能為空");
return false;
}else{
return true;
}
}
}
//錯誤提示信息
function err_msg(msg){
return "<img src='"+forum_picurl+"/note_error.gif' border='0'/> <span class='redfont'>"+msg+"</span>";
}
//成功提示信息
function suc_msg(msg){
return "<img src='"+forum_picurl+"/note_ok.gif' border='0'/> <span class='bluefont'>"+msg+"</span>";
}
//檢查密碼強弱
function pse_a1(j,b){
this.j=j;this.b=b;
};
function pse_a7(c,j){
var b=false;
switch(j){
case 0:
if((c>='A')&&(c<='Z')){
b=true;
};
break;
case 1:
if((c>='a')&&(c<='z')){
b=true;
};
break;
case 2:
if((c>='0')&&(c<='9')){
b=true;
};
break;
case 3:
if("!@#$%^&*()_+-='\";:[{]}\|.>,</?`~".indexOf(c)>=0){
b=true;
};
break;
case 4:
if(pse_a7(c,0)||pse_a7(c,1)){
b=true;
};
break;
default:break;
};
return b;
};
function pse_a8(e,g){
if((e==null)||isNaN(g)){
return false;
}else if(e.length<g){
return false;
};
return true;
};
function pse_a10(e,f){
var i=0;
var jj=new Array(new pse_a1(0,false),new pse_a1(1,false),new pse_a1(2,false),new pse_a1(3,false));
if((e==null)||isNaN(f)){
return false;
};
for(var k=0;k<e.length;k++){
for(var d=0;d<jj.length;d++){
if(!jj.b&&pse_a7(e.charAt(k),jj.j)){
jj.b=true;break;
};
};
};
for(var d=0;d<jj.length;d++){if(jj.b){i++;};};if(i<f){return false;};return true;};function pse_a3(h){return(pse_a8(h,"7")&&pse_a10(h,"3"));};function pse_a2(h){return(pse_a8(h,"7")&&pse_a10(h,"2"));};function pse_a4(h){return(pse_a8(h,"5")||(!pse_a8(h,"0")));};function pse_a6(q){return document.getElementById(q);};
function SetPwdStrengthEx(o){
if(pse_a3(o)){
pse_a5(3,'pse04');
}
else if(pse_a2(o)){
pse_a5(2,'pse03');
}else if(pse_a4(o)){pse_a5(1,'pse02');
}else{
pse_a5(0,'pse01');
};
};
function pse_a5(m,p){if(m>3){m=3;};for(var n=0;n<4;n++){var l="pse01";if(n<=m){l=p;};if(n>0){pse_a6("idSM"+n).className=l;};pse_a6("idSMT"+n).style.display=((n==m)?"inline":"none");};};
页:
[1]