動網中用到的幾個Function和一個JS[base64encode,base64decode,md5,sendmail,js]

cmfr

<%
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 > 127  then
         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 > 0  then
    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[args.length-1](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[id];
    } else if (document.layers) {
        itm = document.layers[id];
    }
    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 = "&nbsp;"+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[matchid].charCodeAt(0);
            text = text.replace(matches[matchid], '%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[t] = 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[0]==RegCheck.passValue[1]){
                    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[d].b&&pse_a7(e.charAt(k),jj[d].j)){
                jj[d].b=true;break;
            };
        };
    };
    for(var d=0;d<jj.length;d++){if(jj[d].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");};};