From de99a5556e28d8413ecb569f8e5b7edd4201da4c Mon Sep 17 00:00:00 2001 From: jam Date: Thu, 21 Jul 2016 13:24:32 +0800 Subject: [PATCH] =?UTF-8?q?=E6=B7=BB=E5=8A=A0=E4=B8=80=E4=BA=9B=E5=B8=B8?= =?UTF-8?q?=E7=94=A8=E6=8F=92=E4=BB=B6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- easyasp/plugin/easp.aes.asp | 834 ++++++++++++++++++++++++++++++++ easyasp/plugin/easp.alidayu.asp | 153 ++++++ easyasp/plugin/easp.aspjpeg.asp | 715 +++++++++++++++++++++++++++ easyasp/plugin/easp.bs.asp | 259 ++++++++++ easyasp/plugin/easp.fun.asp | 51 ++ easyasp/plugin/easp.ipinfo.asp | 308 ++++++++++++ easyasp/plugin/easp.jmail.asp | 111 +++++ easyasp/plugin/easp.mail.asp | 564 +++++++++++++++++++++ easyasp/plugin/easp.md5utf8.asp | 417 ++++++++++++++++ easyasp/plugin/easp.pr.asp | 307 ++++++++++++ easyasp/plugin/easp.pyo.asp | 98 ++++ easyasp/plugin/easp.wx.asp | 551 +++++++++++++++++++++ 12 files changed, 4368 insertions(+) create mode 100644 easyasp/plugin/easp.aes.asp create mode 100644 easyasp/plugin/easp.alidayu.asp create mode 100644 easyasp/plugin/easp.aspjpeg.asp create mode 100644 easyasp/plugin/easp.bs.asp create mode 100644 easyasp/plugin/easp.fun.asp create mode 100644 easyasp/plugin/easp.ipinfo.asp create mode 100644 easyasp/plugin/easp.jmail.asp create mode 100644 easyasp/plugin/easp.mail.asp create mode 100644 easyasp/plugin/easp.md5utf8.asp create mode 100644 easyasp/plugin/easp.pr.asp create mode 100644 easyasp/plugin/easp.pyo.asp create mode 100644 easyasp/plugin/easp.wx.asp diff --git a/easyasp/plugin/easp.aes.asp b/easyasp/plugin/easp.aes.asp new file mode 100644 index 0000000..a6102b4 --- /dev/null +++ b/easyasp/plugin/easp.aes.asp @@ -0,0 +1,834 @@ +<% +'###################################################################### +'## easp.aes.asp +'## ------------------------------------------------------------------- +'## Feature : AES Encryption +'## Version : v2.2 alpha +'## Author : Roderick Divilbiss +'## Update : Coldstone(coldstone[at]qq.com) +'## Update Date : 2010/10/20 23:57:56 +'## Description : Encrypt strings with AES in EasyASP +'## +'###################################################################### +Class EasyAsp_AES + Private m_lOnBits(30) + Private m_l2Power(30) + Private m_bytOnBits(7) + Private m_byt2Power(7) + + Private m_InCo(3) + + Private m_fbsub(255) + Private m_rbsub(255) + Private m_ptab(255) + Private m_ltab(255) + Private m_ftable(255) + Private m_rtable(255) + Private m_rco(29) + + Private m_Nk + Private m_Nb + Private m_Nr + Private m_fi(23) + Private m_ri(23) + Private m_fkey(119) + Private m_rkey(119) + + Private s_pass + + Private Sub Class_Initialize() + m_InCo(0) = &HB + m_InCo(1) = &HD + m_InCo(2) = &H9 + m_InCo(3) = &HE + + m_bytOnBits(0) = 1 + m_bytOnBits(1) = 3 + m_bytOnBits(2) = 7 + m_bytOnBits(3) = 15 + m_bytOnBits(4) = 31 + m_bytOnBits(5) = 63 + m_bytOnBits(6) = 127 + m_bytOnBits(7) = 255 + + m_byt2Power(0) = 1 + m_byt2Power(1) = 2 + m_byt2Power(2) = 4 + m_byt2Power(3) = 8 + m_byt2Power(4) = 16 + m_byt2Power(5) = 32 + m_byt2Power(6) = 64 + m_byt2Power(7) = 128 + + m_lOnBits(0) = 1 + m_lOnBits(1) = 3 + m_lOnBits(2) = 7 + m_lOnBits(3) = 15 + m_lOnBits(4) = 31 + m_lOnBits(5) = 63 + m_lOnBits(6) = 127 + m_lOnBits(7) = 255 + m_lOnBits(8) = 511 + m_lOnBits(9) = 1023 + m_lOnBits(10) = 2047 + m_lOnBits(11) = 4095 + m_lOnBits(12) = 8191 + m_lOnBits(13) = 16383 + m_lOnBits(14) = 32767 + m_lOnBits(15) = 65535 + m_lOnBits(16) = 131071 + m_lOnBits(17) = 262143 + m_lOnBits(18) = 524287 + m_lOnBits(19) = 1048575 + m_lOnBits(20) = 2097151 + m_lOnBits(21) = 4194303 + m_lOnBits(22) = 8388607 + m_lOnBits(23) = 16777215 + m_lOnBits(24) = 33554431 + m_lOnBits(25) = 67108863 + m_lOnBits(26) = 134217727 + m_lOnBits(27) = 268435455 + m_lOnBits(28) = 536870911 + m_lOnBits(29) = 1073741823 + m_lOnBits(30) = 2147483647 + + m_l2Power(0) = 1 + m_l2Power(1) = 2 + m_l2Power(2) = 4 + m_l2Power(3) = 8 + m_l2Power(4) = 16 + m_l2Power(5) = 32 + m_l2Power(6) = 64 + m_l2Power(7) = 128 + m_l2Power(8) = 256 + m_l2Power(9) = 512 + m_l2Power(10) = 1024 + m_l2Power(11) = 2048 + m_l2Power(12) = 4096 + m_l2Power(13) = 8192 + m_l2Power(14) = 16384 + m_l2Power(15) = 32768 + m_l2Power(16) = 65536 + m_l2Power(17) = 131072 + m_l2Power(18) = 262144 + m_l2Power(19) = 524288 + m_l2Power(20) = 1048576 + m_l2Power(21) = 2097152 + m_l2Power(22) = 4194304 + m_l2Power(23) = 8388608 + m_l2Power(24) = 16777216 + m_l2Power(25) = 33554432 + m_l2Power(26) = 67108864 + m_l2Power(27) = 134217728 + m_l2Power(28) = 268435456 + m_l2Power(29) = 536870912 + m_l2Power(30) = 1073741824 + + s_pass = "EasyAspAES" + End Sub + Private Sub Class_Terminate() + + End Sub + + Public Property Let Password(ByVal p) + s_pass = p + End Property + Public Property Get Password() + Password = s_pass + End Property + + 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 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 LShiftByte(bytValue, bytShiftBits) + If bytShiftBits = 0 Then + LShiftByte = bytValue + Exit Function + ElseIf bytShiftBits = 7 Then + If bytValue And 1 Then + LShiftByte = &H80 + Else + LShiftByte = 0 + End If + Exit Function + ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then + Err.Raise 6 + End If + + LShiftByte = ((bytValue And m_bytOnBits(7 - bytShiftBits)) * m_byt2Power(bytShiftBits)) + End Function + + Private Function RShiftByte(bytValue, bytShiftBits) + If bytShiftBits = 0 Then + RShiftByte = bytValue + Exit Function + ElseIf bytShiftBits = 7 Then + If bytValue And &H80 Then + RShiftByte = 1 + Else + RShiftByte = 0 + End If + Exit Function + ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then + Err.Raise 6 + End If + + RShiftByte = bytValue \ m_byt2Power(bytShiftBits) + End Function + + Private Function RotateLeft(lValue, iShiftBits) + RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) + End Function + + Private Function RotateLeftByte(bytValue, bytShiftBits) + RotateLeftByte = LShiftByte(bytValue, bytShiftBits) Or RShiftByte(bytValue, (8 - bytShiftBits)) + End Function + + Private Function Pack(b()) + Dim lCount + Dim lTemp + + For lCount = 0 To 3 + lTemp = b(lCount) + Pack = Pack Or LShift(lTemp, (lCount * 8)) + Next + End Function + + Private Function PackFrom(b(), k) + Dim lCount + Dim lTemp + + For lCount = 0 To 3 + lTemp = b(lCount + k) + PackFrom = PackFrom Or LShift(lTemp, (lCount * 8)) + Next + End Function + + Private Sub Unpack(a, b()) + b(0) = a And m_lOnBits(7) + b(1) = RShift(a, 8) And m_lOnBits(7) + b(2) = RShift(a, 16) And m_lOnBits(7) + b(3) = RShift(a, 24) And m_lOnBits(7) + End Sub + + Private Sub UnpackFrom(a, b(), k) + b(0 + k) = a And m_lOnBits(7) + b(1 + k) = RShift(a, 8) And m_lOnBits(7) + b(2 + k) = RShift(a, 16) And m_lOnBits(7) + b(3 + k) = RShift(a, 24) And m_lOnBits(7) + End Sub + + Private Function xtime(a) + Dim b + + If (a And &H80) Then + b = &H1B + Else + b = 0 + End If + + xtime = LShiftByte(a, 1) + xtime = xtime Xor b + End Function + + Private Function bmul(x, y) + If x <> 0 And y <> 0 Then + bmul = m_ptab((CLng(m_ltab(x)) + CLng(m_ltab(y))) Mod 255) + Else + bmul = 0 + End If + End Function + + Private Function SubByte(a) + Dim b(3) + + Unpack a, b + b(0) = m_fbsub(b(0)) + b(1) = m_fbsub(b(1)) + b(2) = m_fbsub(b(2)) + b(3) = m_fbsub(b(3)) + + SubByte = Pack(b) + End Function + + Private Function product(x, y) + Dim xb(3) + Dim yb(3) + + Unpack x, xb + Unpack y, yb + product = bmul(xb(0), yb(0)) Xor bmul(xb(1), yb(1)) Xor bmul(xb(2), yb(2)) Xor bmul(xb(3), yb(3)) + End Function + + Private Function InvMixCol(x) + Dim y + Dim m + Dim b(3) + + m = Pack(m_InCo) + b(3) = product(m, x) + m = RotateLeft(m, 24) + b(2) = product(m, x) + m = RotateLeft(m, 24) + b(1) = product(m, x) + m = RotateLeft(m, 24) + b(0) = product(m, x) + y = Pack(b) + + InvMixCol = y + End Function + + Private Function ByteSub(x) + Dim y + Dim z + + z = x + y = m_ptab(255 - m_ltab(z)) + z = y + z = RotateLeftByte(z, 1) + y = y Xor z + z = RotateLeftByte(z, 1) + y = y Xor z + z = RotateLeftByte(z, 1) + y = y Xor z + z = RotateLeftByte(z, 1) + y = y Xor z + y = y Xor &H63 + + ByteSub = y + End Function + + Public Sub gentables() + Dim i + Dim y + Dim b(3) + Dim ib + + m_ltab(0) = 0 + m_ptab(0) = 1 + m_ltab(1) = 0 + m_ptab(1) = 3 + m_ltab(3) = 1 + + For i = 2 To 255 + m_ptab(i) = m_ptab(i - 1) Xor xtime(m_ptab(i - 1)) + m_ltab(m_ptab(i)) = i + Next + + m_fbsub(0) = &H63 + m_rbsub(&H63) = 0 + + For i = 1 To 255 + ib = i + y = ByteSub(ib) + m_fbsub(i) = y + m_rbsub(y) = i + Next + + y = 1 + For i = 0 To 29 + m_rco(i) = y + y = xtime(y) + Next + + For i = 0 To 255 + y = m_fbsub(i) + b(3) = y Xor xtime(y) + b(2) = y + b(1) = y + b(0) = xtime(y) + m_ftable(i) = Pack(b) + + y = m_rbsub(i) + b(3) = bmul(m_InCo(0), y) + b(2) = bmul(m_InCo(1), y) + b(1) = bmul(m_InCo(2), y) + b(0) = bmul(m_InCo(3), y) + m_rtable(i) = Pack(b) + Next + End Sub + + Public Sub gkey(nb, nk, key()) + Dim i + Dim j + Dim k + Dim m + Dim N + Dim C1 + Dim C2 + Dim C3 + Dim CipherKey(7) + + m_Nb = nb + m_Nk = nk + + If m_Nb >= m_Nk Then + m_Nr = 6 + m_Nb + Else + m_Nr = 6 + m_Nk + End If + + C1 = 1 + If m_Nb < 8 Then + C2 = 2 + C3 = 3 + Else + C2 = 3 + C3 = 4 + End If + + For j = 0 To nb - 1 + m = j * 3 + + m_fi(m) = (j + C1) Mod nb + m_fi(m + 1) = (j + C2) Mod nb + m_fi(m + 2) = (j + C3) Mod nb + m_ri(m) = (nb + j - C1) Mod nb + m_ri(m + 1) = (nb + j - C2) Mod nb + m_ri(m + 2) = (nb + j - C3) Mod nb + Next + + N = m_Nb * (m_Nr + 1) + + For i = 0 To m_Nk - 1 + j = i * 4 + CipherKey(i) = PackFrom(key, j) + Next + + For i = 0 To m_Nk - 1 + m_fkey(i) = CipherKey(i) + Next + + j = m_Nk + k = 0 + Do While j < N + m_fkey(j) = m_fkey(j - m_Nk) Xor _ + SubByte(RotateLeft(m_fkey(j - 1), 24)) Xor m_rco(k) + If m_Nk <= 6 Then + i = 1 + Do While i < m_Nk And (i + j) < N + m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _ + m_fkey(i + j - 1) + i = i + 1 + Loop + Else + i = 1 + Do While i < 4 And (i + j) < N + m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _ + m_fkey(i + j - 1) + i = i + 1 + Loop + If j + 4 < N Then + m_fkey(j + 4) = m_fkey(j + 4 - m_Nk) Xor _ + SubByte(m_fkey(j + 3)) + End If + i = 5 + Do While i < m_Nk And (i + j) < N + m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _ + m_fkey(i + j - 1) + i = i + 1 + Loop + End If + + j = j + m_Nk + k = k + 1 + Loop + + For j = 0 To m_Nb - 1 + m_rkey(j + N - nb) = m_fkey(j) + Next + + i = m_Nb + Do While i < N - m_Nb + k = N - m_Nb - i + For j = 0 To m_Nb - 1 + m_rkey(k + j) = InvMixCol(m_fkey(i + j)) + Next + i = i + m_Nb + Loop + + j = N - m_Nb + Do While j < N + m_rkey(j - N + m_Nb) = m_fkey(j) + j = j + 1 + Loop + End Sub + + Public Sub encrypt(buff()) + Dim i + Dim j + Dim k + Dim m + Dim a(7) + Dim b(7) + Dim x + Dim y + Dim t + + For i = 0 To m_Nb - 1 + j = i * 4 + + a(i) = PackFrom(buff, j) + a(i) = a(i) Xor m_fkey(i) + Next + + k = m_Nb + x = a + y = b + + For i = 1 To m_Nr - 1 + For j = 0 To m_Nb - 1 + m = j * 3 + y(j) = m_fkey(k) Xor m_ftable(x(j) And m_lOnBits(7)) Xor _ + RotateLeft(m_ftable(RShift(x(m_fi(m)), 8) And m_lOnBits(7)), 8) Xor _ + RotateLeft(m_ftable(RShift(x(m_fi(m + 1)), 16) And m_lOnBits(7)), 16) Xor _ + RotateLeft(m_ftable(RShift(x(m_fi(m + 2)), 24) And m_lOnBits(7)), 24) + k = k + 1 + Next + t = x + x = y + y = t + Next + + For j = 0 To m_Nb - 1 + m = j * 3 + y(j) = m_fkey(k) Xor m_fbsub(x(j) And m_lOnBits(7)) Xor _ + RotateLeft(m_fbsub(RShift(x(m_fi(m)), 8) And m_lOnBits(7)), 8) Xor _ + RotateLeft(m_fbsub(RShift(x(m_fi(m + 1)), 16) And m_lOnBits(7)), 16) Xor _ + RotateLeft(m_fbsub(RShift(x(m_fi(m + 2)), 24) And m_lOnBits(7)), 24) + k = k + 1 + Next + + For i = 0 To m_Nb - 1 + j = i * 4 + UnpackFrom y(i), buff, j + x(i) = 0 + y(i) = 0 + Next + End Sub + + Public Sub decrypt(buff()) + Dim i + Dim j + Dim k + Dim m + Dim a(7) + Dim b(7) + Dim x + Dim y + Dim t + + For i = 0 To m_Nb - 1 + j = i * 4 + a(i) = PackFrom(buff, j) + a(i) = a(i) Xor m_rkey(i) + Next + + k = m_Nb + x = a + y = b + + For i = 1 To m_Nr - 1 + For j = 0 To m_Nb - 1 + m = j * 3 + y(j) = m_rkey(k) Xor m_rtable(x(j) And m_lOnBits(7)) Xor _ + RotateLeft(m_rtable(RShift(x(m_ri(m)), 8) And m_lOnBits(7)), 8) Xor _ + RotateLeft(m_rtable(RShift(x(m_ri(m + 1)), 16) And m_lOnBits(7)), 16) Xor _ + RotateLeft(m_rtable(RShift(x(m_ri(m + 2)), 24) And m_lOnBits(7)), 24) + k = k + 1 + Next + t = x + x = y + y = t + Next + + For j = 0 To m_Nb - 1 + m = j * 3 + + y(j) = m_rkey(k) Xor m_rbsub(x(j) And m_lOnBits(7)) Xor _ + RotateLeft(m_rbsub(RShift(x(m_ri(m)), 8) And m_lOnBits(7)), 8) Xor _ + RotateLeft(m_rbsub(RShift(x(m_ri(m + 1)), 16) And m_lOnBits(7)), 16) Xor _ + RotateLeft(m_rbsub(RShift(x(m_ri(m + 2)), 24) And m_lOnBits(7)), 24) + k = k + 1 + Next + + For i = 0 To m_Nb - 1 + j = i * 4 + + UnpackFrom y(i), buff, j + x(i) = 0 + y(i) = 0 + Next + End Sub + + Private Function IsInitialized(vArray) + On Error Resume Next + IsInitialized = IsNumeric(UBound(vArray)) + End Function + + Private Sub CopyBytesASP(bytDest, lDestStart, bytSource(), lSourceStart, lLength) + Dim lCount + lCount = 0 + Do + bytDest(lDestStart + lCount) = bytSource(lSourceStart + lCount) + lCount = lCount + 1 + Loop Until lCount = lLength + End Sub + + Public Function EncryptData(bytMessage, bytPassword) + Dim bytKey(31) + Dim bytIn() + Dim bytOut() + Dim bytTemp(31) + Dim lCount + Dim lLength + Dim lEncodedLength + Dim bytLen(3) + Dim lPosition + + If Not IsInitialized(bytMessage) Then + Exit Function + End If + If Not IsInitialized(bytPassword) Then + Exit Function + End If + + For lCount = 0 To UBound(bytPassword) + bytKey(lCount) = bytPassword(lCount) + If lCount = 31 Then + Exit For + End If + Next + + gentables + gkey 8, 8, bytKey + + lLength = UBound(bytMessage) + 1 + lEncodedLength = lLength + 4 + + If lEncodedLength Mod 32 <> 0 Then + lEncodedLength = lEncodedLength + 32 - (lEncodedLength Mod 32) + End If + ReDim bytIn(lEncodedLength - 1) + ReDim bytOut(lEncodedLength - 1) + + Unpack lLength, bytIn + CopyBytesASP bytIn, 4, bytMessage, 0, lLength + + For lCount = 0 To lEncodedLength - 1 Step 32 + CopyBytesASP bytTemp, 0, bytIn, lCount, 32 + Encrypt bytTemp + CopyBytesASP bytOut, lCount, bytTemp, 0, 32 + Next + + EncryptData = bytOut + End Function + + Public Function DecryptData(bytIn, bytPassword) + Dim bytMessage() + Dim bytKey(31) + Dim bytOut() + Dim bytTemp(31) + Dim lCount + Dim lLength + Dim lEncodedLength + Dim bytLen(3) + Dim lPosition + + If Not IsInitialized(bytIn) Then + Exit Function + End If + If Not IsInitialized(bytPassword) Then + Exit Function + End If + + lEncodedLength = UBound(bytIn) + 1 + + If lEncodedLength Mod 32 <> 0 Then + Exit Function + End If + + For lCount = 0 To UBound(bytPassword) + bytKey(lCount) = bytPassword(lCount) + If lCount = 31 Then + Exit For + End If + Next + + gentables + gkey 8, 8, bytKey + + ReDim bytOut(lEncodedLength - 1) + + For lCount = 0 To lEncodedLength - 1 Step 32 + CopyBytesASP bytTemp, 0, bytIn, lCount, 32 + Decrypt bytTemp + CopyBytesASP bytOut, lCount, bytTemp, 0, 32 + Next + + lLength = Pack(bytOut) + If lLength<0 Then + Exit Function + End If + If lLength > lEncodedLength - 4 Then + Exit Function + End If + + ReDim bytMessage(lLength - 1) + CopyBytesASP bytMessage, 0, bytOut, 4, lLength + + DecryptData = bytMessage + End Function + + Function AESEncrypt(sPlain,sPassword) + Dim bytIn() + Dim bytOut + Dim bytPassword() + Dim lCount + Dim lLength + Dim sTemp + + lLength = Len(sPlain) + ReDim bytIn(lLength-1) + For lCount = 1 To lLength + bytIn(lCount-1) = CByte(AscB(Mid(sPlain,lCount,1))) + Next + lLength = Len(sPassword) + ReDim bytPassword(lLength-1) + For lCount = 1 To lLength + bytPassword(lCount-1) = CByte(AscB(Mid(sPassword,lCount,1))) + Next + + bytOut = EncryptData(bytIn, bytPassword) + + sTemp = "" + For lCount = 0 To UBound(bytOut) + sTemp = sTemp & Right("0" & Hex(bytOut(lCount)), 2) + Next + + AESEncrypt = sTemp + End Function + + Function AESDecrypt(sCypher, sPassword) + Dim bytIn() + Dim bytOut + Dim bytPassword() + Dim lCount + Dim lLength + Dim sTemp + + lLength = Len(sCypher) + ReDim bytIn(lLength/2-1) + For lCount = 0 To lLength/2-1 + bytIn(lCount) = CByte("&H" & Mid(sCypher,lCount*2+1,2)) + Next + lLength = Len(sPassword) + ReDim bytPassword(lLength-1) + For lCount = 1 To lLength + bytPassword(lCount-1) = CByte(AscB(Mid(sPassword,lCount,1))) + Next + + bytOut = DecryptData(bytIn, bytPassword) + If Easp.isN(bytOut) Then + AESDecrypt = "false" + Else + lLength = UBound(bytOut) + 1 + sTemp = "" + For lCount = 0 To lLength - 1 + sTemp = sTemp & Chr(bytOut(lCount)) + Next + AESDecrypt = sTemp + End If + End Function + Public Function Encode(ByVal s) + Dim p + s = Escape(s) + p = Escape(s_pass) + Encode = AESEncrypt(s,p) + End Function + Public Function Decode(ByVal s) + Dim p + p = Escape(s_pass) + Decode = UnEscape(AESDecrypt(s,p)) + End Function + Function Escape(ByVal ss) + If Easp.isN(ss) Then Escape = "" : Exit Function + Dim i,c,a,s : s = "" + For i = 1 To Len(ss) + c = Mid(ss,i,1) + a = ASCW(c) + If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then + s = s & c + ElseIf InStr("@*_+-./",c)>0 Then + s = s & c + ElseIf a>0 and a<16 Then + s = s & "%0" & Hex(a) + ElseIf a>=16 and a<256 Then + s = s & "%" & Hex(a) + Else + s = s & "%u" & Hex(a) + End If + Next + Escape = s + End Function + Function UnEscape(ByVal ss) + If Easp.isN(ss) Then UnEscape = "" : Exit Function + Dim x, s + x = InStr(ss,"%") + s = "" + Do While x>0 + s = s & Mid(ss,1,x-1) + If LCase(Mid(ss,x+1,1))="u" Then + s = s & ChrW(CLng("&H"&Mid(ss,x+2,4))) + ss = Mid(ss,x+6) + Else + s = s & Chr(CLng("&H"&Mid(ss,x+1,2))) + ss = Mid(ss,x+3) + End If + x=InStr(ss,"%") + Loop + UnEscape = s & ss + End Function +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.alidayu.asp b/easyasp/plugin/easp.alidayu.asp new file mode 100644 index 0000000..b3d7ea5 --- /dev/null +++ b/easyasp/plugin/easp.alidayu.asp @@ -0,0 +1,153 @@ +<% +'################################################################################# +'## easp.alidayu.asp +'## ------------------------------------------------------------------------------ +'## Feature : EasyASP 阿里大鱼短信发送插件 +'## Version : v1.0 +'## For EasyASP : 3.0+ +'## Author : Jam(2239559[at]qq.com) +'## Update Date : 2016年7月1日 星期五 +'## Description : +'## 此插件用于阿里大鱼短信发送，具体API接口信息见https://api.alidayu.com/doc2/apiDetail?apiId=25450 +'## 使用方法如下： +'## Easp("alidayu") - 根据属性值发送短信，成功返回True，错误返回错误信息 +'## 在使用方法前必须设置如下属性值： +'## Easp("alidayu").AppKey = "12345678" - 阿里大鱼分配给你的AppKey +'## Easp("alidayu").Secret = "1acde2335689748a377654503d" - AppKey对应的Secret +'## Easp("alidayu").SignName = "Jam轻博客" - 在阿里大鱼管理后台中通过审批的短信签名 +'## Easp("alidayu").RecNum = "13911111111" - 要接收短信的手机号码 +'## Easp("alidayu").TplCode = "SMS_11370053" - 在阿里大鱼管理后台中通过审批的短信模板ID +'## 以上是必要的属性，下面还有两个非必须属性： +'## Easp("alidayu").Extend = "2356" - 公共回传参数 +'## Easp("alidayu").SMSParam = "{""number"":""1234""}" - 短信模板变量，传参规则{"key":"value"} +'################################################################################# +Class EasyASP_alidayu + Private s_author,s_version,a_list,b_list,s_method,s_v,s_format,s_simplify,s_secret,s_app_key,s_sign_method + Private s_sms_type,s_sms_free_sign_name,s_rec_num,s_sms_template_code,s_extend,s_sms_param + Private Sub Class_Initialize() + s_author = "jam" + s_version = "0.1" + s_method = "alibaba.aliqin.fc.sms.num.send" 'API接口名称，这里是短信发送的接口 + s_v = "2.0" 'API协议版本 + s_format = "json" '响应格式 + s_simplify = false '是否采用精简JSON返回格式，仅当format=json时有效，默认值为：false + s_sign_method = "md5" '签名的摘要算法 + s_sms_type = "normal" '短信类型，传入值请填写normal + s_secret = "" 'APP的Secret，加密时用 + s_app_key = "" '应用的AppKey + s_sms_free_sign_name = "" '短信签名，传入的短信签名必须是在阿里大鱼“管理中心-短信签名管理”中的可用签名 + s_rec_num = "" '短信接收号码。支持单个或多个手机号码，传入号码为11位手机号码，不能加0或+86。群发短信需传入多个号码，以英文逗号分隔，一次调用最多传入200个号码。示例：18600000000,13911111111,13322222222 + s_sms_template_code = "" '短信模板ID，传入的模板必须是在阿里大鱼“管理中心-短信模板管理”中的可用模板 + s_extend = "" '公共回传参数，在“消息返回”中会透传回该参数；举例：用户可以传入自己下级的会员ID，在消息返回时，该会员ID会包含在内，用户可以根据该会员ID识别是哪位会员使用了你的应用 + s_sms_param = "" '短信模板变量，传参规则{"key":"value"}，key的名字须和申请模板中的变量名一致，多个变量之间以逗号隔开。示例：针对模板“验证码${code}，您正在进行${product}身份验证，打死不要告诉别人哦！”，传参时需传入{"code":"1234","product":"alidayu"} + Easp.Error("error-SMS-AppKey") = "AppKey属性为空。|无法读取AppKey属性，这是个必要属性。|请在代码中用属性 Easp(""alidayu"").AppKey 进行设置。" + Easp.Error("error-SMS-Secret") = "Secret属性为空。|无法读取Secret属性，这是个必要属性。|请在代码中用属性 Easp(""alidayu"").Secret 进行设置。" + Easp.Error("error-SMS-SignName") = "SignName属性为空。|无法读取短信签名SignName属性，这是个必要属性。|请在代码中用属性 Easp(""alidayu"").SignName 进行设置。" + Easp.Error("error-SMS-RecNum") = "RecNum属性为空。|无法读取短信接收号码RecNum属性，这是个必要属性。|请在代码中用属性 Easp(""alidayu"").RecNum 进行设置。" + Easp.Error("error-SMS-TplCode") = "TplCode属性为空。|无法读取短信模板IDTplCode属性，这是个必要属性。|请在代码中用属性 Easp(""alidayu"").TplCode 进行设置。" + End Sub + Private Sub Class_Terminate() + + End Sub + '应用的AppKey属性 + Public Property Let AppKey(ByVal String) + s_app_key = String + End Property + 'APP的Secret，加密时用 + Public Property Let Secret(ByVal String) + s_secret = String + End Property + '短信签名 + Public Property Let SignName(ByVal String) + s_sms_free_sign_name = String + End Property + '短信接收号码 + Public Property Let RecNum(ByVal String) + s_rec_num = String + End Property + '短信模板ID + Public Property Let TplCode(ByVal String) + s_sms_template_code = String + End Property + '公共回传参数 + Public Property Let Extend(ByVal String) + s_extend = String + End Property + '短信模板变量 + Public Property Let SMSParam(ByVal String) + s_sms_param = String + End Property + + '发送短信，成功返回True，错误返回错误信息 + Public Default Function SendSMS() + If Easp.isN(s_app_key) Then :If Easp.Debug Then Easp.Error.Raise "error-SMS-AppKey":Exit Function:End If + If Easp.isN(s_secret) Then :If Easp.Debug Then Easp.Error.Raise "error-SMS-Secret":Exit Function:End If + If Easp.isN(s_sms_free_sign_name) Then :If Easp.Debug Then Easp.Error.Raise "error-SMS-SignName":Exit Function:End If + If Easp.isN(s_rec_num) Then :If Easp.Debug Then Easp.Error.Raise "error-SMS-RecNum":Exit Function:End If + If Easp.isN(s_sms_template_code) Then :If Easp.Debug Then Easp.Error.Raise "error-SMS-TplCode":Exit Function:End If + '生成参数的键数组，原始字典对象 + Dim a,b,d,k,u,l,j + Set d = Server.CreateObject("Scripting.Dictionary") + '公用参数 + d.Add "method",s_method + d.Add "app_key",s_app_key + d.Add "timestamp",Easp.Date.Format(Now(),"yyyy-mm-dd hh:mm:ss") + d.Add "format",s_format + d.Add "v",s_v + d.Add "sms_type",s_sms_type + d.Add "simplify",s_simplify + d.Add "sign_method",s_sign_method + '接口参数 + d.Add "sms_free_sign_name",s_sms_free_sign_name + d.Add "rec_num",s_rec_num + d.Add "sms_template_code",s_sms_template_code + d.Add "extend",s_extend + d.Add "sms_param",s_sms_param + Sort d + For Each k In d + u = u&k&d(k) + l = l & "&" & k & "=" & Server.URLEncode(d(k)) + Next + Set d = Nothing + '将HASH数组去掉无用内容并加上Secret，然后MD5返回字符串 + u = UCase(Easp("md5utf8")(s_secret&u&s_secret)) + '加上sign签名参数 + l = "sign="&u&l + Easp.Http.Data = l + Set j = Easp.Json.Parse(Easp.Http.Get("http://gw.api.taobao.com/router/rest")) + If j.Has("alibaba_aliqin_fc_sms_num_send_response") Then + SendSMS = True + ElseIf j.Has("error_response") Then + SendSMS = j("error_response")("sub_msg") + End If + End Function + + '字典按Key排序 + Private Function Sort(dict) + Dim i,j, temp + Dim keys,items + Dim t + Set t = Server.CreateObject("Scripting.Dictionary") + keys = dict.Keys + items = dict.Items + For i = 0 To dict.Count - 1 + t.Add keys(i),items(i) + Next + For i = 0 To dict.Count - 1 + For j = i + 1 To dict.Count - 1 + If Easp.Str.Compare(keys(i), ">", keys(j)) Then + temp = keys(i) + keys(i) = keys(j) + keys(j) = temp + End If + Next + Next + dict.RemoveAll + For i = 0 To UBound(keys) + dict.Add keys(i), t.Item(keys(i)) + Next + t.RemoveAll + Set t = Nothing + End Function +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.aspjpeg.asp b/easyasp/plugin/easp.aspjpeg.asp new file mode 100644 index 0000000..8dc4c7d --- /dev/null +++ b/easyasp/plugin/easp.aspjpeg.asp @@ -0,0 +1,715 @@ +<% +'################################################################################# +'## easp.aspjpeg.asp +'## ------------------------------------------------------------------------------ +'## Feature : EasyAsp AspJpeg Class +'## Version : v0.2 +'## Author : xuhuan(zhongjingjing[at]gmail.com) +'## Update Date : 2010/12/4 15:22:12 +'## Description : 基于AspJpeg 2 的easp插件 +'################################################################################# +Class EasyAsp_AspJpeg + + '=================================================== + '定义变量 + '=================================================== + Private s_author + Private s_SourcePath, s_ToPath + Private s_AspJpeg, s_Width, s_Height, s_Quality, s_Opacity, s_Force, s_BackGroundColor + Private s_PenColor, s_PenWidth, s_BrushSolid, s_Font + Private s_WaterMarkPath, s_Position + Private s_Binary + Private t_PNGOutput + Private s_RegKey + + '=================================================== + '类初始化 + '=================================================== + Private Sub Class_Initialize() + s_author = "xuhuan" + + Easp.Use "Fso" + + Set s_AspJpeg = [New]() '创建AspJpeg对象 + + s_Quality = 100 '生成图片质量 + s_Opacity = 100 '生成图片透明度 + s_Width = 200 '默认图片宽度 + s_Height = 200 '默认图片高度 + s_Force = False '是否强制生成固定大小图片 + s_BackGroundColor = &HFFFFFF '背景色 + s_PenColor = &H000000 '画笔颜色 + s_PenWidth = 1 '画笔宽度 + s_BrushSolid = False '是否加粗处理 + + s_WaterMarkPath = "" + + s_Font = "" '文字水印使用的字体路径 + + t_PNGOutput = False '是否PNG输出 + + s_Binary = Null '图片的二进制数据 + + s_RegKey = "" + + Easp.Error(10001) = "服务器没有安装AspJpeg组件." + Easp.Error(10002) = "来源路径错误或文件不存在." + Easp.Error(10003) = "存储路径错误或路径不存在." + Easp.Error(10004) = "水印图片路径错误或水印图片不存在." + Easp.Error(10005) = "参数不能为空." + Easp.Error(10006) = "不是Gif格式的图片." + End Sub + + '=================================================== + '清理工作 + '=================================================== + Private Sub Class_Terminate() + s_AspJpeg.Close + Set s_AspJpeg = Nothing + End Sub + + '=================================================== + '属性设置 + '=================================================== + '--------------------------------------------------- + ' 返回作者，只读 + '--------------------------------------------------- + Public Property Get Author() + Author = s_author + End Property + '--------------------------------------------------- + ' 返回AspJpeg版本，只读 + '--------------------------------------------------- + Public Property Get Version() + Version = s_AspJpeg.Version + End Property + '--------------------------------------------------- + ' 返回当前操作的AspJpeg对象，只读 + '--------------------------------------------------- + Public Property Get AspJpeg() + set AspJpeg = s_AspJpeg + End Property + '--------------------------------------------------- + ' 返回AspJpeg组件过期日期，只读 + '--------------------------------------------------- + Public Property Get [Expires]() + [Expires] = s_AspJpeg.Expires + End Property + + + '--------------------------------------------------- + ' 设置AspJpeg组件的注册码，只写 + '--------------------------------------------------- + Public Property Let RegKey(ByVal k) + s_AspJpeg.RegKey = k + s_RegKey = k + End Property + + '--------------------------------------------------- + ' 设置和返回图片生成质量全局参数，读写 + '--------------------------------------------------- + Public Property Let Quality(ByVal q) + s_Quality = q + End Property + Public Property Get Quality() + Quality = s_Quality + End Property + '--------------------------------------------------- + ' 设置和返回图片生成质量全局参数，读写 + '--------------------------------------------------- + Public Property Let Opacity(ByVal o) + s_Opacity = o + End Property + Public Property Get Opacity() + Opacity = s_Opacity + End Property + + '--------------------------------------------------- + ' 设置和返回批量处理来源文件夹，读写 + '--------------------------------------------------- + Public Property Let SourcePath(ByVal s) + s_SourcePath = Easp.Fso.MapPath(s) + if not Easp.Fso.IsExists(s_SourcePath) then + Easp.Error.Raise 10002 + end if + End Property + Public Property Get SourcePath() + SourcePath = s_SourcePath + End Property + '--------------------------------------------------- + ' 设置和返回批量处理保存文件夹，读写 + '--------------------------------------------------- + Public Property Let ToPath(ByVal s) + s_ToPath = Easp.Fso.MapPath(s) + if not Easp.Fso.IsExists(s_ToPath) then + Easp.Error.Raise 10002 + end if + End Property + Public Property Get ToPath() + ToPath = s_ToPath + End Property + + '--------------------------------------------------- + ' 设置和返回图片默认宽度，全局参数，读写 + '--------------------------------------------------- + Public Property Let Width(ByVal w) + s_Width = w + End Property + Public Property Get Width() + Width = s_Width + End Property + '--------------------------------------------------- + ' 设置和返回图片默认高度，全局参数，读写 + '--------------------------------------------------- + Public Property Let Height(ByVal h) + s_Height = h + End Property + Public Property Get Height() + Height = s_Height + End Property + '--------------------------------------------------- + ' 设置和返回默认强制生成指定尺寸图片，全局参数，读写 + '--------------------------------------------------- + Public Property Let Force(ByVal f) + s_Force = f + End Property + Public Property Get Force() + Force = s_Force + End Property + + '--------------------------------------------------- + ' 设置和返回默认图片背景颜色，全局参数，读写 + '--------------------------------------------------- + Public Property Let BackGroundColor(ByVal bc) + s_BackGroundColor = bc + End Property + Public Property Get BackGroundColor() + BackGroundColor = s_BackGroundColor + End Property + '--------------------------------------------------- + ' 设置和返回默认画笔颜色，全局参数，读写 + '--------------------------------------------------- + Public Property Let PenColor(ByVal p) + s_PenColor = p + End Property + Public Property Get PenColor() + PenColor = s_PenColor + End Property + + '--------------------------------------------------- + ' 设置和返回默认画笔宽度，全局参数，读写 + '--------------------------------------------------- + Public Property Let PenWidth(ByVal p) + s_PenWidth = p + End Property + Public Property Get PenWidth() + PenWidth = s_PenWidth + End Property + + '--------------------------------------------------- + ' 设置和返回默认是否加粗，全局参数，读写 + '--------------------------------------------------- + Public Property Let BrushSolid(ByVal b) + s_BrushSolid = b + End Property + Public Property Get BrushSolid() + BrushSolid = s_BrushSolid + End Property + '--------------------------------------------------- + ' 设置和返回默认字体路径，全局参数，读写 + '--------------------------------------------------- + Public Property Let Font(ByVal f) + s_Font = f + End Property + Public Property Get Font() + Font = s_Font + End Property + '--------------------------------------------------- + ' 设置和返回默认水印图片路径，全局参数，读写 + '--------------------------------------------------- + Public Property Let WaterMarkPath(ByVal w) + s_WaterMarkPath = w + End Property + Public Property Get WaterMarkPath() + WaterMarkPath = s_WaterMarkPath + End Property + + + + '=================================================== + ' 创建一个新的AspJpeg对象 + '=================================================== + Public Function [New]() + if Easp.IsInstall("Persits.Jpeg") then + Set [New] = Server.CreateObject("Persits.Jpeg") + if Easp.Has(s_RegKey) then + [New].RegKey = s_RegKey + end if + else + Easp.Error.Raise 10001 + end if + End Function + + '=================================================== + ' 根据参数自动调用相应方式打开图片， + ' 可以是图片路径，二进制数据 + '=================================================== + Public Function [Open](ByVal s) + if not Easp.Has(s) then + Easp.Error.Raise 10005 + end if + + set t_AspJpeg = [New]() + + select case typename(s) + case "String" + t_SourcePath = Easp.Fso.MapPath(s) + t_AspJpeg.Open t_SourcePath + case "Byte()" + t_AspJpeg.OpenBinary s + case "IASPJpeg" + set t_AspJpeg = s + case else + Easp.Error.Raise 10005 + end select + + set [Open] = t_AspJpeg + End Function + + '=================================================== + ' 判断是否输出PNG格式图片，如果保存文件扩展名为PNG + ' 则按照PNG格式输出保存 + '=================================================== + Private Sub SetPNGOutput(ByVal s) + if Easp.Fso.ExtOf(s) = ".png" then + t_PNGOutput = True + else + t_PNGOutput = False + end if + End Sub + + '=================================================== + ' 验证码函数，需要一个背景图片 + '=================================================== + Public Function RandCode(ByVal r, ByVal s, ByVal t) + if Easp.Has(r) then + t_RandCode = r + else + t_RandCode = Easp.RandStr("4:0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") + end if + Session("RandCode") = t_RandCode + + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(t) + + if not Easp.Fso.IsExists(t_SourcePath) then + Easp.Error.Raise 10002 + end if + + set s_AspJpeg = [Open](t_SourcePath) + + Randomize + for i = 1 to len(t_RandCode) + s_AspJpeg.Canvas.Font.Rotation = (Rnd*25-5) '倾斜度 + s_AspJpeg.Canvas.Font.Color = (Rnd*255)*255*255+(Rnd*255)*255*255+(Rnd*255)*255*255 '颜色 + s_AspJpeg.Canvas.Font.Family = "Arial Black" '字体 宋体/黑体/楷体/隶书/ + s_AspJpeg.Canvas.Font.Bold = Easp.ifHas(s_BrushSolid,False) '是否加粗 true/false + s_AspJpeg.Canvas.Font.Size = 30 '字体大小 + s_AspJpeg.Canvas.Font.ShadowColor = &HFFFFFF + s_AspJpeg.Canvas.Font.Quality = 100 + if Easp.Has(s_Font) then + s_AspJpeg.Canvas.PrintText 20 * (i-1)+5, 0, Mid(t_RandCode,i,1) , s_Font + else + s_AspJpeg.Canvas.PrintText 20 * (i-1)+5, 0, Mid(t_RandCode,i,1) + end if + next + + + s_AspJpeg.Quality=Easp.ifHas(s_Quality,100) '设置加水印后图片的质量 + + s_Binary = s_AspJpeg.Binary + SetPNGOutput(t_ToPath) + if t_PNGOutput then + s_AspJpeg.PNGOutput = t_PNGOutput + end if + if Easp.Has(t) then + s_AspJpeg.save t_ToPath '保存 + end if + + RandCode = Easp.ifHas(t_ToPath,t_SourcePath) + End Function + + '=================================================== + ' 输出图片 + '=================================================== + Public Sub [Flush]() + Response.Expires = -9999 + Response.AddHeader "pragma", "no-cache" + Response.AddHeader "cache-ctrol", "no-cache" + Response.ContentType = "image/jpeg" + Response.BinaryWrite s_Binary + End Sub + + '========================================================== + ' 生成缩略图 + ' Thumbnail(原图片路径, 生成图片路径, 高度, 宽度, 品质, 是否强制宽高) + '========================================================== + Public Function Thumbnail(ByVal s, ByVal t, ByVal w, ByVal h, ByVal q, ByVal f) + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(t) + + if not Easp.Fso.IsExists(t_SourcePath) then + Easp.Error.Raise 10002 + end if + + t_Quality = Easp.ifHas(q,s_Quality) + t_Width = Easp.ifHas(w,s_Width) + t_Height = Easp.ifHas(h,s_Height) + t_Force = Easp.ifHas(f,s_Force) + + Dim OriginalWidth, OriginalHeight '原图片宽度、高度 + Dim CurrentWidth, CurrentHeight '缩略图宽度、高度 + + set s_AspJpeg = [Open](t_SourcePath) + + OriginalWidth = s_AspJpeg.Width + OriginalHeight = s_AspJpeg.Height + + + CurrentWidth = OriginalWidth + CurrentHeight = OriginalHeight + + if OriginalWidth > t_Width or OriginalHeight > t_Height then + if OriginalWidth >= t_Width then + CurrentWidth = t_Width + CurrentHeight = (t_Width * OriginalHeight) / OriginalWidth + end if + if CurrentHeight >= t_Height then + CurrentHeight = t_Height + CurrentWidth = (t_Height * CurrentWidth) / CurrentHeight + end if + end if + + s_AspJpeg.Width = CurrentWidth + s_AspJpeg.Height = CurrentHeight + s_AspJpeg.Quality = Easp.ifHas(t_Quality , Easp.ifHas(s_Quality,100)) + s_AspJpeg.Sharpen 1,250 + + if t_Force then + t_NewImage_Size = Easp.IIF(CurrentWidth > CurrentHeight, CurrentWidth, CurrentHeight) + set t_AspJpeg = [New]() + t_AspJpeg.New t_NewImage_Size , t_NewImage_Size , s_BackGroundColor + t_AspJpeg.Canvas.DrawImage (t_NewImage_Size - CurrentWidth)/2 ,(t_NewImage_Size - CurrentHeight)/2 ,s_AspJpeg + s_Binary = t_AspJpeg.Binary + SetPNGOutput(t_ToPath) + if t_PNGOutput then + t_AspJpeg.PNGOutput = t_PNGOutput + end if + t_AspJpeg.Save t_ToPath + t_AspJpeg.Close + set t_AspJpeg = Nothing + else + s_Binary = s_AspJpeg.Binary + SetPNGOutput(t_ToPath) + if t_PNGOutput then + s_AspJpeg.PNGOutput = t_PNGOutput + end if + s_AspJpeg.Save t_ToPath + end if + + Thumbnail = t_ToPath + End Function + + '=================================================== + ' 合并图片 + '=================================================== + Public Function Merge(ByVal s,ByVal t,ByVal r, ByVal x, ByVal y) + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(t) + + if not Easp.Fso.IsExists(t_SourcePath) then + Easp.Error.Raise 10002 + end if + if not Easp.Fso.IsExists(t_ToPath) then + Easp.Error.Raise 10003 + end if + + if not Easp.Has(r) then + t_ResultPath = Easp.Fso.MapPath(r) + else + t_ResultPath = t_ToPath + end if + + set t_Source_AspJpeg = [Open](t_SourcePath) + set t_To_AspJpeg = [Open](t_ToPath) + + t_x = Easp.ifHas(x,(t_To_AspJpeg.Width - t_Source_AspJpeg.Width) / 2) + t_y = Easp.ifHas(y,(t_To_AspJpeg.Height - t_Source_AspJpeg.Height) / 2) + + t_To_AspJpeg.Canvas.DrawImage t_x,t_y,t_Source_AspJpeg + + SetPNGOutput(t_ResultPath) + if t_PNGOutput then + t_To_AspJpeg.PNGOutput = t_PNGOutput + end if + t_To_AspJpeg.Save t_ResultPath + + s_Binary = t_To_AspJpeg.Binary + + t_Source_AspJpeg.Close + t_To_AspJpeg.Close + set t_Source_AspJpeg = Nothing + set t_To_AspJpeg = Nothing + + Merge = t_ResultPath + + End Function + + '=================================================== + ' 根据参数返回水印坐标位置的数组 + '=================================================== + Public Function WaterMarkPosition(ByVal source_w,ByVal source_h,ByVal width,ByVal height,ByVal pos) + Dim t_Position(2) + + select case pos '水印位置 + case 1 '顶部居左 + t_Position(0) = 0 + t_Position(1) = 0 + case 2 '顶部居中 + t_Position(0) = (source_w - width) / 2 + t_Position(1) = 0 + case 3 '顶部居右 + t_Position(0) = source_w - width + t_Position(1) = 0 + case 4 '中心位置 + t_Position(0) = (source_w - width) / 2 + t_Position(1) = (source_h - height) / 2 + case 5 '底部居左 + t_Position(0) = 0 + t_Position(1) = source_h - height - 10 + case 6 '底部居中 + t_Position(0) = (source_w - width) / 2 + t_Position(1) = source_h - height - 10 + case 7 '底部居右 + t_Position(0) = source_w - width + t_Position(1) = source_h - height - 10 + case else '随机位置 + Randomize + t_Position(0) = Easp.Rand(0,(source_w - width)) + Randomize + t_Position(1) = Int(source_h - height + 1) * Rnd + end select + WaterMarkPosition = t_Position + + End Function + + '=================================================== + ' 添加文字水印 + ' WaterMarkFont(文字,背景图片路径,水印位置,水印质量, + ' 水印透明度,水印文字角度,文字颜色,文字字体,是否加粗,文字尺寸) + '=================================================== + Public Function WaterMarkFont(ByVal Str,ByVal BackgroundImage,ByVal Pos,ByVal Quality,ByVal Opacity,ByVal Rotation,ByVal Color,ByVal Family,ByVal Bold,ByVal FontSize) + t_SourcePath = Easp.Fso.MapPath(BackgroundImage) + + if not Easp.Fso.IsExists(t_SourcePath) then + Easp.Error.Raise 10002 + end if + + set t_AspJpeg = [Open](t_SourcePath) + + set b_AspJpeg = [New]() + b_AspJpeg.New t_AspJpeg.Width , t_AspJpeg.Height , s_BackGroundColor + + if Easp.Has(Rotation) then + b_AspJpeg.Canvas.Font.Rotation = Rotation '倾斜度 + end if + + b_AspJpeg.Canvas.Font.Color = Easp.ifHas(Color,s_PenColor) '颜色 + + b_AspJpeg.Canvas.Font.Family = Easp.ifHas(Family,"Arial") '字体 宋体/黑体/楷体/隶书/ + + b_AspJpeg.Canvas.Font.Bold = Easp.ifHas(Bold,Easp.ifHas(s_BrushSolid,False)) '是否加骈 true/ + + b_AspJpeg.Canvas.Font.Size = Easp.ifHas(FontSize,30) + + b_AspJpeg.Canvas.Font.Opacity = 1 + + b_AspJpeg.Canvas.Font.Quality = Easp.ifHas(Quality,s_Quality) + + + FontHeight = Round( ( Easp.ifHas(FontSize,30) / 2 )) + FontWidth = Round( FontHeight * Len(Str)) +' FontHeight = Easp.ifHas(FontSize,30) +' FontWidth = FontHeight * Len(Str) + + t_WaterMarkPosition = WaterMarkPosition(t_AspJpeg.Width , t_AspJpeg.Height , FontWidth , FontHeight , Pos) + + if Easp.Has(s_Font) and not Easp.Has(Family) then + b_AspJpeg.Canvas.PrintText t_WaterMarkPosition(0), t_WaterMarkPosition(1), Str , s_Font + else + b_AspJpeg.Canvas.PrintText t_WaterMarkPosition(0), t_WaterMarkPosition(1), Str + end if + + t_AspJpeg.Canvas.DrawImage 0, 0, b_AspJpeg , Easp.ifHas(Opacity ,Easp.ifHas(s_Opacity,100) ) / 100 , s_BackGroundColor + + s_Binary = t_AspJpeg.Binary + + SetPNGOutput(t_SourcePath) + if t_PNGOutput then + t_AspJpeg.PNGOutput = t_PNGOutput + end if + t_AspJpeg.Save t_SourcePath + + b_AspJpeg.Close + set b_AspJpeg = Nothing + t_AspJpeg.Close + set t_AspJpeg = Nothing + WaterMarkFont = t_SourcePath + End Function + + '=================================================== + ' 添加图片水印 + ' WaterMarkJpeg(水印图片路径,背景图片路径,水印位置,水印质量,水印透明度) + '=================================================== + Public Function WaterMarkJpeg(ByVal s,ByVal t,ByVal Pos,ByVal Quality,ByVal Opacity) + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(t) + + if not Easp.Fso.IsExists(t_SourcePath) then + if not Easp.Fso.IsExists(s_WaterMarkPath) then + Easp.Error.Raise 10004 + else + t_SourcePath = s_WaterMarkPath + end if + end if + if not Easp.Fso.IsExists(t_ToPath) then + Easp.Error.Raise 10003 + end if + + set t_Source_AspJpeg = [Open](t_SourcePath) + + set t_To_AspJpeg = [Open](t_ToPath) + + t_WaterMarkPosition = WaterMarkPosition(t_To_AspJpeg.Width , t_To_AspJpeg.Height , t_Source_AspJpeg.Width , t_Source_AspJpeg.Height , Pos) + + t_To_AspJpeg.Quality = Easp.ifHas(Quality , s_Quality) + + + if t_PNGOutput then + t_To_AspJpeg.Canvas.DrawPNG t_WaterMarkPosition(0), t_WaterMarkPosition(1) , t_Source_AspJpeg , Easp.ifHas(Opacity ,Easp.ifHas(s_Opacity,100)) / 100,s_BackGroundColor + else + t_To_AspJpeg.Canvas.DrawImage t_WaterMarkPosition(0), t_WaterMarkPosition(1) , t_Source_AspJpeg , Easp.ifHas(Opacity ,Easp.ifHas(s_Opacity,100)) / 100,s_BackGroundColor + end if + + s_Binary = t_To_AspJpeg.Binary + + SetPNGOutput(t_ToPath) + if t_PNGOutput then + t_To_AspJpeg.PNGOutput = t_PNGOutput + end if + + t_To_AspJpeg.Save t_ToPath + + + t_Source_AspJpeg.Close + t_To_AspJpeg.Close + set t_Source_AspJpeg = Nothing + set t_To_AspJpeg = Nothing + WaterMarkJpeg = t_ToPath + End Function + + '=================================================== + ' 简化的添加水印函数，根据参数自动判断是文字水印还是图片水印 + ' WaterMark(水印图片路径或文字,背景图片路径,水印位置,水印质量,水印透明度) + '=================================================== + Public Function WaterMark(ByVal s,ByVal t,ByVal Pos,ByVal Quality,ByVal Opacity) + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(t) + + if not Easp.Fso.IsExists(t_ToPath) then + Easp.Error.Raise 10003 + end if + if Easp.Fso.IsFile(t_SourcePath) then + WaterMark = WaterMarkJpeg( s, t, Pos, Quality, Opacity) + else + WaterMark = WaterMarkFont( s, t, Pos, Quality, Opacity, "", "", "", "", "") + end if + End Function + + Public Function W(ByVal s,ByVal t,ByVal Pos,ByVal Quality,ByVal Opacity) + W = WaterMark( s, t, Pos, Quality, Opacity) + End Function + + '=================================================== + ' 图片切割，按照提供的左上角和右下角坐标切割图片 + ' Crop(原图片路径,图片存储路径[可以为空],左上角X坐标,左上角y坐标,右下角x坐标,右下角y坐标) + '=================================================== + Public Function Crop(ByVal s,ByVal t,ByVal tx,ByVal ty,ByVal bx,ByVal by) + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(Easp.ifHas(t,s)) + if not Easp.Fso.IsExists(t_SourcePath) then + Easp.Error.Raise 10002 + end if + + set t_Source_AspJpeg = [Open](t_SourcePath) + + t_Source_AspJpeg.Crop tx,ty,bx,by + s_Binary = t_Source_AspJpeg.Binary + SetPNGOutput(t_ToPath) + if t_PNGOutput then + t_Source_AspJpeg.PNGOutput = t_PNGOutput + end if + t_Source_AspJpeg.Save t_ToPath + t_Source_AspJpeg.Close + set t_Source_AspJpeg = Nothing + Crop = t_ToPath + End Function + + '=================================================== + ' Gif动画图片缩放，保留原动画属性 + ' GifResize(原Gif图片路径,图片存储路径[可以为空],图片宽度,图片高度[可以为空],图片算法) + '=================================================== + Public Function GifResize(ByVal s,ByVal t,ByVal w,ByVal h,ByVal a) + t_SourcePath = Easp.Fso.MapPath(s) + t_ToPath = Easp.Fso.MapPath(Easp.ifHas(t,s)) + if not Easp.Fso.IsExists(t_SourcePath) then + Easp.Error.Raise 10002 + end if + if Lcase(Easp.Fso.Extof(t_SourcePath)) <> ".gif" then + Easp.Error.Raise 10006 + end if + set t_AspJpeg = [New]() + set t_Gif = t_AspJpeg.Gif + t_Gif.Open t_SourcePath + if not Easp.Has(h) then + t_Gif.Resize w + else + t_Gif.Resize w , h , Easp.ifHas(a,0) + end if + + t_Gif.Save t_ToPath + s_Binary = t_Gif.Binary + t_AspJpeg.Close + set t_Gif = Nothing + set t_AspJpeg = Nothing + GifResize = t_ToPath + End Function + + '=================================================== + ' Gif动画图片缩放函数简化函数，保留原动画属性 + ' G(原Gif图片路径,图片存储路径[可以为空],图片宽度) + '=================================================== + Public Function G(ByVal s,ByVal t,ByVal w) + G = GifResize(s,t,w,"","") + End Function + + '=================================================== + ' 默认函数，感觉缩略图用的会比较多，就把生成缩略图作为了默认函数 + ' 缩略图函数简化函数 + '=================================================== + Public Default Function T(ByVal s, ByVal tp, ByVal w, ByVal h, ByVal q, ByVal f) + T = Thumbnail(s,tp,w,h,q,f) + End Function + +End Class +%> diff --git a/easyasp/plugin/easp.bs.asp b/easyasp/plugin/easp.bs.asp new file mode 100644 index 0000000..33d7620 --- /dev/null +++ b/easyasp/plugin/easp.bs.asp @@ -0,0 +1,259 @@ +<% +'################################################################################# +'## easp.bs.asp +'## ------------------------------------------------------------------------------ +'## Feature : EasyAsp Bootstrap 代码片段生成插件 +'## Version : 1.0 +'## For EasyASP : 3.0+ +'## Author : Jam(2239559[at]qq.com) +'## Update Date : 2016年7月5日 星期二 +'################################################################################# +Class EasyASP_Bs + '定义内部变量 + Private s_ver, s_source, s_val + '构造方法 + Private Sub Class_Initialize() + s_ver = 3 + End Sub + '设置或获取BS版本，可选值为：3或4，默认为3 + Public Property Get Ver() + Ver = s_ver + End Property + Public Property Let Ver(ByVal String) + s_ver = String + End Property + Public Function [New]() + Set [New] = New EasyASP_Bs + End Function + '设置代码片段源文本 + Public Default Function Str(ByVal String) + Set Str = New EasyASP_BsCode + If Easp.Str.IsInList("btn,btna,dropdown,btnGroup,FormInline,Form",Easp.Str.GetName(String,":")) Then + Str.Code = Str.Tag(String,Easp.Str.GetValue(String, ":")) + Else + Str.Code = String + End If + End Function +End Class + + +Class EasyASP_BsCode + Private s_source + '设置源 + Public Property Let Code(ByRef String) + s_source = String + End Property + '读取处理后的源 + Public Default Property Get Code() + s_source = Easp.Str.iReplace(s_source,"{col-l}","col-sm-3") + s_source = Easp.Str.iReplace(s_source,"{col-r}","col-sm-9") + Dim Match,Matches + Set Matches = Easp.Str.Match(s_source, "{(.+?)}") + For Each Match In Matches + s_source = Replace(s_source, Match.Value, "") + Next + Code = s_source + End Property + '根据参数取得对应代码片段 + Public Function Tag(ByVal t, ByVal l) + listType = l + Dim q : Set q = New EasyASP_Str_StringBuilder + Select Case Easp.Str.GetName(t, ":") + Case "btn" + q.Append "" + Case "btna" + q.Append "{str}" + Case "dropdown" + q.Append "
" + q.Append "" + q.Append "
" + Case "btnGroup" + q.Append "
" + q.Append "" + q.Append "" + q.Append "
" + Case "FormInline" + Select Case Easp.Str.GetValue(t, ":") + Case "text" + q.Append "
" + q.Append " " + q.Append "" + q.Append "
" + Case "textarea" + q.Append "
" + q.Append " " + q.Append "" + q.Append "
" + Case "checkbox" + q.Append "
{loop}
" + Case "radio" + q.Append "
{loop}
" + Case "select" + q.Append "
" + q.Append " " + q.Append "" + q.Append "
" + Case "static" + q.Append "
" + q.Append " " + q.Append "

{val}

" + q.Append "
" + End Select + Case "Form" + Select Case Easp.Str.GetValue(t, ":") + Case "text" + q.Append "
" + q.Append "" + q.Append "
" + q.Append "" + q.Append "
" + Case "textarea" + q.Append "
" + q.Append "" + q.Append "
" + q.Append "" + q.Append "
" + Case "checkbox" + q.Append "
" + q.Append "" + q.Append "
" + q.Append "{loop}" + q.Append "
" + Case "radio" + q.Append "
" + q.Append "" + q.Append "
" + q.Append "{loop}" + q.Append "
" + Case "select" + q.Append "
" + q.Append "" + q.Append "
" + q.Append "" + q.Append "
" + Case "static" + q.Append "
" + q.Append "" + q.Append "
" + q.Append "

{val}

" + q.Append "
" + End Select + End Select + Tag = q.ToString + End Function + Private Function S(ByRef String) + Set S = New EasyASP_BsCode + S.Code = String + End Function + '替换Str字符串 + Public Function Str(ByVal value) + Set Str = S(Easp.Str.iReplace(s_source,"{str}",value)) + End Function + '替换ID + Public Function Id(ByVal value) + Set Id = S(Easp.Str.iReplace(s_source,"{id}",value)) + End Function + '替换Name + Public Function Name(ByVal value) + Set Name = S(Easp.Str.iReplace(s_source,"{name}",value)) + End Function + '替换CSS + Public Function Css(ByVal value) + Set Css = S(Easp.Str.iReplace(s_source,"{css}",value)) + End Function + '替换Type + Public Function [Type](ByVal value) + Set [Type] = S(Easp.Str.iReplace(s_source,"{type}",value)) + End Function + '替换Label + Public Function Label(ByVal value) + Set Label = S(Easp.Str.iReplace(s_source,"{label}",value)) + End Function + '替换Url + Public Function Url(ByVal value) + 'If InStr(Value,"http") = 0 Then Value = "http://" & Value + Set Url = S(Easp.Str.iReplace(s_source,"{url}",value)) + End Function + '替换Val + Public Function Val(ByVal value) + Set Val = S(Easp.Str.iReplace(s_source,"{val}",value)) + End Function + '替换Disabled + Public Function Disabled() + Set Disabled = S(Easp.Str.iReplace(s_source,"{disabled}","disabled")) + End Function + '替换HideLabel + Public Function HideLabel() + Set HideLabel = S(Easp.Str.iReplace(s_source,"{labelhide}","class=""sr-only""")) + End Function + '替换PlaceHolder + Public Function PlaceHolder(ByVal value) + Set PlaceHolder = S(Easp.Str.iReplace(s_source,"{ph}",value)) + End Function + '替换Row + Public Function Row(ByVal value) + Set Row = S(Easp.Str.iReplace(s_source,"{row}",value)) + End Function + '替换Size + Public Function Size(ByVal value) + Set Size = S(Easp.Str.iReplace(s_source,"{size}",value)) + End Function + '替换Multiple + Public Function Multiple() + Set Multiple = S(Easp.Str.iReplace(s_source,"{multiple}","multiple")) + End Function + '替换其他 + Public Function F(ByVal value) + Set F = S(Easp.Str.iReplace(s_source,"{"&Easp.Str.GetName(value,":")&"}",Easp.Str.GetValue(value,":"))) + End Function + '替换List + Public Function [Loop](ByVal Data,ByVal t) + Dim d,i,li,b,C,rname : d = "" + If Easp.isN(data) Then data = "[{}]" + If TypeName(data) = "String" Then Set d = Easp.Json.Parse(data) + If TypeName(data) = "EasyASP_Json_Array" Then Set d = Data + Set li = Easp.Str.StringBuilder + Select Case t + Case "li" + For i = 0 To d.Length-1 + Select Case d(i)("type") + Case "li" li.Append "
  • "&d(i)("name")&"
    • " + Case "header" li.Append "
  • "&d(i)("name")&"
    • " + Case "separator" li.Append "
  • " + Case "disabled" li.Append "
  • "&d(i)("name")&"
    • " + Case Else li.Append "
  • "&d(i)("name")&"
    • " + End Select + Next + Case "checkbox" + For i = 0 To d.Length-1 + b="":If Easp.Has(d(i)("disabled")) And d(i)("disabled") Then b="disabled" + c="":If Easp.Has(d(i)("type")) And d(i)("type")="inline" Then c=" checkbox-inline" + li.Append "
    " + li.Append "" + li.Append "
    " + Next + Case "radio" + rname = d(0)("name") + For i = 0 To d.Length-1 + b="":If Easp.Has(d(i)("disabled")) And d(i)("disabled") Then b="disabled" + c="":If Easp.Has(d(i)("type")) And d(i)("type")="inline" Then c=" radio-inline" + li.Append "
    " + li.Append "" + li.Append "
    " + Next + Case "select" + For i = 0 To d.Length-1 + li.Append "" + Next + End Select + Set d = Nothing + d = li.ToString + Set li = Nothing + Set [Loop] = S(Easp.Str.iReplace(s_source,"{loop}",d)) + End Function +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.fun.asp b/easyasp/plugin/easp.fun.asp new file mode 100644 index 0000000..dee4ad1 --- /dev/null +++ b/easyasp/plugin/easp.fun.asp @@ -0,0 +1,51 @@ +<% +Class EasyASP_Fun + Private s_version + Private Sub Class_Initialize() + s_version = "0.1" + End Sub + Private Sub Class_Terminate() + + End Sub + + Public Property Get Version() + Version = s_version + End Property + Public Function [New]() + Set [New] = New EasyASP_Fun + End Function + '身份证15位转18位，只支持2000年之前的，成功返回18位身份证号，失败返回原字符串 + Public Function IdCard(ByVal a) + If Len(a) = 15 Then + '加19就行了，2000年以后应该就没15位了 + a = Left(a,6) & "19" & Right(a,9) + Dim m : m = 0 + Dim b : Set b = Easp.List.NewArray("7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2") + For i = 0 To 16 + m = m + (CLng(Right(Left(a,i+1),1)) * CLng(b(i))) + Next + Dim x : Set x = Easp.List.NewArray("1 0 X 9 8 7 6 5 4 3 2") + IdCard = a & x(m Mod 11) + Else + IdCard = a + End If + End Function + '远程接口加域名限制，感谢 @绝世名伶 + '注意：此方法必须在接口文件最前面运行，否则会报设置头信息错误 + 'null为本地运行的HTML远程访问时的值 + '必须在远程访问接口时有效，当前页测试无效 + '例子：If fun.Header("http://www.jam1.cn,http://easp.cn,null") Then 输出接口内容 + Public Function Header(ByVal arr) + Response.AddHeader "Access-Control-Allow-Origin","*" + Header = False + Dim a : Set a = Easp.List.New + a.Separator = "," + a.Data = Replace(arr," ","") + If a.Has(Request.ServerVariables("HTTP_ORIGIN")) Then Header = True + End Function + + 'Public Default Function Fun(ByVal num) + ' Fun = num + 'End Function +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.ipinfo.asp b/easyasp/plugin/easp.ipinfo.asp new file mode 100644 index 0000000..a6ab4e2 --- /dev/null +++ b/easyasp/plugin/easp.ipinfo.asp @@ -0,0 +1,308 @@ +<% +'###################################################################### +'## easp.ipinfo.asp +'## ------------------------------------------------------------------- +'## Feature : EasyAsp IpInfo Class +'## Version : v1.1 Alpha +'## Author : Easp.智者(Liaoyizhi[at]gmail.com) +'## Update Date : 2010/03/23 15:35 +'## Description : EasyAsp IP信息查询类（插件） +'## 本类修改自互联网流传代码 +'## 利用QQWry.DAT文件，查询指定IP所在位置 +'## 本类在ASP环境中使用纯真版QQWry.dat通过完美测试 +'## 如果您的服务器环境不支持ADodb.Stream，将无法使用此程序 +'## 推荐使用纯真数据库，更新也方便 +'## 您可以根据 QQWry(IP) 返回值来判断该IP地址在数据库中是否存在， +'## 如果不存在可以执行其他的一些操作，比如您自建一个数据库作为追捕等 +'## +'## .SetQQWryFile ：设置QQWry.DAT文件的路径 +'## .GetIpInfo(ip,type)方法的参数说明： +'## ip：ip地址字符串 +'## type：显示方式 +'## "1"或"ip" ：返回IP地址 +'## "2"或"c" ：返回所在城市，如：广西桂林市 +'## "3"或"l" ：返回所在区域，如：某某网吧 +'## "4"或"cl" ：返回所在城市及区域，如：广西桂林市 某某网吧 +'## "5"或"all" ：返回更详细的信息，如：您来自：124.226.126.121 所在区域：广西桂林市 某某网吧 +'## .GetWryInfo()方法返回一个QQWry.DAT文件信息数组 +'## .GetWryInfo()(0):返回数据库版本信息 +'## .GetWryInfo()(1):返回数据库IP地址数目 +'## +'## Examples : Easp.W Easp.Ext("ipinfo").GetIpInfo("192.168.1.1","cl") '直接使用 +'## With Easp.Ext("ipinfo") +'## .SetQQWryFile = "/Data/QQWry.Dat" '设置QQWry.Dat文件路径 +'## Easp.WN .GetWryInfo()(1) '输出数据库IP地址数目 +'## Easp.WN .GetIpInfo(Easp.GetIp(),5) '输出当前访问者IP信息 +'## End With +'###################################################################### + +Class EasyAsp_IpInfo + ' ============================================ + ' 变量声明 + ' ============================================ + Private QQWryFile, Country, LocalStr + Private StartIP, EndIP, CountryFlag, Buf, OffSet + Private FirstStartIP, LastStartIP, RecordCount + Private Stream, EndIPOff,s_charset + ' ============================================ + ' 类模块初始化 + ' ============================================ + Private Sub Class_Initialize + s_charset = Easp.CharSet + Country = "" + LocalStr = "" + StartIP = 0 + EndIP = 0 + CountryFlag = 0 + FirstStartIP = 0 + LastStartIP = 0 + EndIPOff = 0 + QQWryFile = Server.MapPath("/db/QQWry.Dat") 'QQ IP库路径，要转换成物理路径 + Easp.Error(20001) = "您的服务器不支持 Adodb.Stream 组件." + End Sub + ' ============================================ + ' 类终结 + ' ============================================ + Private Sub Class_Terminate + On ErrOr Resume Next + Stream.Close + If Err Then Err.Clear + Set Stream = Nothing + End Sub + ' ============================================ + ' 设置QQWry.Dat文件路径 + ' ============================================ + Public Property Let SetQQWryFile(ByVal p) + If Instr(p,":") = 0 Then + p = Server.MapPath(p) + End If + If Right(p,1) = "\" Then p = Left(p,Len(p)-1) + QQWryFile = p + End Property + ' ============================================ + ' 返回QQWry信息(公共函数，QQWry.Dat版本以及记录条数) + ' ============================================ + Public Function GetWryInfo() + Dim arrQQWry(1) + Call QQWry("255.255.255.255") + ' 读取数据库版本信息 + arrQQWry(0) = Country & " " & LocalStr + ' 读取数据库IP地址数目 + arrQQWry(1) = RecordCount + 1 + GetWryInfo = arrQQWry + End Function + ' ============================================ + ' 返回IP信息（公共函数） + ' ============================================ + Public Function GetIpInfo(ByVal IP, ByVal sType) + Call QQWry(IP) + Select Case LCase(sType) + Case "1","ip" GetIpInfo = IP + Case "2","c" GetIpInfo = Country + Case "3","l" GetIpInfo = LocalStr + Case "4","cl" GetIpInfo = Country & " " & LocalStr + Case "5","all" GetIpInfo = "您来自：" & IP & " 所在区域：" & Country & " " & LocalStr & "" + End Select + End Function + ' ============================================ + ' IP地址转换成整数 + ' ============================================ + Private Function IPToInt(ByVal IP) + Dim IPArray, i + IPArray = Split(IP, ".", -1) + FOr i = 0 to 3 + If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0 + If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i))) + If CInt(IPArray(i)) > 255 Then IPArray(i) = 255 + Next + IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3)) + End Function + ' ============================================ + ' 整数逆转IP地址 + ' ============================================ + Private Function IntToIP(ByVal IntValue) + p4 = IntValue - Fix(IntValue/256)*256 + IntValue = (IntValue-p4)/256 + p3 = IntValue - Fix(IntValue/256)*256 + IntValue = (IntValue-p3)/256 + p2 = IntValue - Fix(IntValue/256)*256 + IntValue = (IntValue - p2)/256 + p1 = IntValue + IntToIP = Cstr(p1) & "." & Cstr(p2) & "." & Cstr(p3) & "." & Cstr(p4) + End Function + ' ============================================ + ' 获取开始IP位置 + ' ============================================ + Private Function GetStartIP(ByVal RecNo) + OffSet = FirstStartIP + RecNo * 7 + Stream.Position = OffSet + Buf = Stream.Read(7) + + EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256) + StartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256) + GetStartIP = StartIP + End Function + ' ============================================ + ' 获取结束IP位置 + ' ============================================ + Private Function GetEndIP() + Stream.Position = EndIPOff + Buf = Stream.Read(5) + EndIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256) + CountryFlag = AscB(MidB(Buf, 5, 1)) + GetEndIP = EndIP + End Function + ' ============================================ + ' 获取地域信息，包含国家和和省市 + ' ============================================ + Private Sub GetCountry(ByVal IP) + If (CountryFlag = 1 Or CountryFlag = 2) Then + Country = GetFlagStr(EndIPOff + 4) + If CountryFlag = 1 Then + LocalStr = GetFlagStr(Stream.Position) + ' 以下用来获取数据库版本信息 + If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then + LocalStr = GetFlagStr(EndIPOff + 21) + Country = GetFlagStr(EndIPOff + 12) + End If + Else + LocalStr = GetFlagStr(EndIPOff + 8) + End If + Else + Country = GetFlagStr(EndIPOff + 4) + LocalStr = GetFlagStr(Stream.Position) + End If + ' 过滤数据库中的无用信息 + Country = Trim(Country) + LocalStr = Trim(LocalStr) + If InStr(Country, "CZ88.NET") Then Country = "" + If InStr(LocalStr, "CZ88.NET") Then LocalStr = "" + End Sub + ' ============================================ + ' 获取IP地址标识符 + ' ============================================ + Private Function GetFlagStr(ByVal OffSet) + Dim Flag + Flag = 0 + Do While (True) + Stream.Position = OffSet + Flag = AscB(Stream.Read(1)) + If(Flag = 1 Or Flag = 2 ) Then + Buf = Stream.Read(3) + If (Flag = 2 ) Then + CountryFlag = 2 + EndIPOff = OffSet - 4 + End If + OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + Else + Exit Do + End If + Loop + + If (OffSet < 12 ) Then + GetFlagStr = "" + Else + Stream.Position = OffSet + GetFlagStr = GetStr() + End If + End Function + ' ============================================ + ' 获取字串信息 + ' ============================================ + Private Function GetStr() + Dim c + GetStr = "" + If LCase(s_charset) = "utf-8" Then + Dim objstream + Set objstream = Server.CreateObject("Adodb.Stream") + objstream.Type = 1 + objstream.Mode =3 + objstream.Open + c = Stream.Read(1) + Do While (AscB(c)<>0 And Not Stream.EOS) + objstream.write c + c = Stream.Read(1) + Loop + objstream.Position = 0 + objstream.Type = 2 + objstream.Charset = "GB2312" + GetStr = objstream.ReadText + objstream.Close + Set objstream = Nothing + Else + Do While (True) + c = AscB(Stream.Read(1)) + If (c = 0) Then Exit Do + + '如果是双字节，就进行高字节在结合低字节合成一个字符 + If c > 127 Then + If Stream.EOS Then Exit Do + GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C))) + Else + GetStr = GetStr & Chr(c) + End If + Loop + End If + End Function + + ' ============================================ + ' 核心函数，执行IP搜索 + ' ============================================ + Public Function QQWry(ByVal DotIP) + If Not Easp.IsInstall("Adodb.Stream") Then Easp.Error.Raise 20001 + Dim IP, nRet + Dim RangB, RangE, RecNo + + IP = IPToInt (DotIP) + + Set Stream = CreateObject("Adodb.Stream") + Stream.Mode = 3 + Stream.Type = 1 + Stream.Open + Stream.LoadFromFile QQWryFile + Stream.Position = 0 + Buf = Stream.Read(8) + + FirstStartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256) + LastStartIP = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256) + (AscB(MidB(Buf, 8, 1))*256*256*256) + RecordCount = Int((LastStartIP - FirstStartIP)/7) + ' 在数据库中找不到任何IP地址 + If (RecordCount <= 1) Then + Country = "未知" + QQWry = 2 + Exit Function + End If + + RangB = 0 + RangE = RecordCount + + Do While (RangB < (RangE - 1)) + RecNo = Int((RangB + RangE)/2) + Call GetStartIP (RecNo) + If (IP = StartIP) Then + RangB = RecNo + Exit Do + End If + If (IP > StartIP) Then + RangB = RecNo + Else + RangE = RecNo + End If + Loop + + Call GetStartIP(RangB) + Call GetEndIP() + + If (StartIP <= IP) And ( EndIP >= IP) Then + ' 没有找到 + nRet = 0 + Else + ' 正常 + nRet = 3 + End If + Call GetCountry(IP) + + QQWry = nRet + End Function +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.jmail.asp b/easyasp/plugin/easp.jmail.asp new file mode 100644 index 0000000..c43a79d --- /dev/null +++ b/easyasp/plugin/easp.jmail.asp @@ -0,0 +1,111 @@ +<% +'###################################################################### +'## easp.jmail.asp +'## ------------------------------------------------------------------- +'## Feature : EasyAsp Chinese character processing tools +'## Version : 1.0 +'## Author : Jessica(301093752[at]qq.com) +'## Update Date : 2014-08-03 +'## Description : This plugin provides Jmail. +'## +'###################################################################### + +Class EasyASP_Jmail + + Private s_SMTPServer, s_FromMail, s_FromName, s_MailServerUserName, s_MailServerPassword, s_Charset + + Private Sub Class_Initialize() + s_SMTPServer = "smtp.qq.com" + s_FromMail = "301093752@qq.com" + s_FromName = "杰西工作室" + s_MailServerUserName = "301093752" + s_MailServerPassword = "123456" + s_Charset = "GB2312" + End Sub + + + Private Sub Class_Terminate() + + End Sub + + Public Property Let EmailSMTPServer(ByVal value) + s_SMTPServer = value + End Property + + Public Property Let EmailFromMail(ByVal value) + s_FromMail = value + End Property + + Public Property Let EmailFromName(ByVal value) + s_FromName = value + End Property + + Public Property Let EmailUserName(ByVal value) + s_MailServerUserName = value + End Property + + Public Property Let EmailPassword(ByVal value) + s_MailServerPassword = value + End Property + + Public Property Let EmailCharset(ByVal value) + s_Charset = value + End Property + + Public Property Get EmailSMTPServer() + EmailSMTPServer = s_SMTPServer + End Property + + Public Property Get EmailFromMail() + EmailFromMail = s_FromMail + End Property + + Public Property Get EmailFromName() + EmailFromName = s_FromName + End Property + + Public Property Get EmailUserName() + EmailUserName = s_MailServerUserName + End Property + + Public Property Get EmailPassword() + EmailPassword = s_MailServerPassword + End Property + + Public Property Get EmailCharset() + EmailCharset = s_Charset + End Property + + '发送邮件，返回状态1 ， 2 ， 3 状态1为检测不到JMAIL组件 状态2为发送失败 状态3为发送成功！ + '发送带三个参数 ToEmail：收件人地址 Subject：邮件主题 Body：邮件内容，第一版本暂不支持带附件内容 + Public Function SendMail(ByVal ToEmail,ByVal Subject,ByVal Body) + On Error Resume Next + Set jmail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象 + If Err.Number <> 0 Then + SendMail = 1 + Exit Function + End If + jmail.silent = True '屏蔽例外错误，返回FALSE跟TRUE两值 + jmail.logging = False '启用邮件日志 + jmail.Charset = s_Charset '邮件的文字编码GB2312为中文 UTF-8为英文 + jmail.ISOEncodeHeaders = False '防止邮件标题乱码 + jmail.ContentType = "text/html" '邮件的格式为HTML格式 + jmail.AddRecipient ToEmail '邮件收件人的地址 + jmail.From = s_FromMail '发件人的E-MAIL地址 + jmail.FromName = s_FromName '发件人姓名 + jmail.MailServerUserName = s_MailServerUserName '登录邮件服务器所需的用户名 + jmail.MailServerPassword = s_MailServerPassword '登录邮件服务器所需的密码 + jmail.Subject = Subject '邮件的标题 + jmail.Body = Body '邮件的内容 + jmail.Priority = 1 '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值 + jmail.Send(s_SMTPServer) '执行邮件发送（通过邮件服务器地址） + jmail.Close() '关闭对象 + If jmail.ErrorCode <> 0 Then + SendMail = 2 + Else + SendMail = 3 + End If + End Function + +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.mail.asp b/easyasp/plugin/easp.mail.asp new file mode 100644 index 0000000..3641504 --- /dev/null +++ b/easyasp/plugin/easp.mail.asp @@ -0,0 +1,564 @@ +<% +'###################################################################### +'## easp.mail.asp +'## ------------------------------------------------------------------- +'## Feature : EasyAsp Mail Class +'## Version : v0.2 Alpha +'## Author : xuhuan(xu.huan.web.master[at]gmail.com) +'## Update Date : 2010/06/04 +'## Description : EasyAsp Jmail邮件发送（插件） +'## 建议Body 和HTMLBody只设置其中一个，否则邮件将是多部分MIME格式的消息 +'## 本类是基于Jmail组件的类，在Jmail 4.5 版本下测试通过，有兴趣的可以测试下其他版本。 +'## 如果您的服务器环境不支持Jmail，将无法使用此程序。 +'## Examples : +'## '1.快速发送邮件方式，前面需要配置了各项基本参数，适用于邮件参数基本固定，只需要添加收件人和附件的情况 +'## Easp.Ext("mail").Init() '初始化jmail对象，因为下面的设置都需要涉及到jmail对象，为了让下面的参数设置顺序可以随意排列必须先初始化 +'## Easp.Ext("mail").AddRecipient "********@126.com" '增加联系人 +'## Easp.Ext("mail").AddRecipient "********@126.com;********@126.com" '增加多个联系人 +'## Easp.Ext("mail").AddRecipient Array("********@126.com") '数组方式增加联系人，数组也可以不这样设置，只要是数组就可以 +'## Easp.Ext("mail").AddRecipientBCC "********@126.com" '增加密件收件人,非必须 +'## Easp.Ext("mail").AddRecipientCC "********@126.com" '增加邮件抄送者,非必须 +'## Easp.Ext("mail").Smtp="smtp.126.com" '设置SMTP +'## Easp.Ext("mail").From="********@126.com" '发送人的邮箱 +'## Easp.Ext("mail").FromName="虚幻" '发送人姓名 +'## Easp.Ext("mail").MailServerUserName="********@126.com" '发送人邮箱用户名 +'## Easp.Ext("mail").MailServerPassword="********" '发送人邮箱密码 +'## Easp.Ext("mail").Subject="Subjectsmtp.126.com" '邮件主题 +'## Easp.Ext("mail").Body="Bodysmtp.126.com" '邮件body内容 +'## Easp.Ext("mail").AppendText "AppendText.126.com" '增加文本内容 +'## Easp.Ext("mail").AddAttachmentIn("t.rar;t.asp") '增加多个嵌入式附件 +'## t_file=Easp.Ext("mail").File("") '返回附件数组，非必须 +'## Easp.WN t_file(0) '输出第一个附件ID +'## Easp.WN Easp.Ext("mail").File(1) '输出第二个附件ID，如果 +'## Easp.Ext("mail").HTMLBody="HTMLBodysmtp.126.com" '邮件HTMLBODY内容 +'## Easp.Ext("mail").AppendHTML Easp.Ext("mail").File(0) '往邮件内容中添加附件，有附件的邮件将以html格式发送 +'## Easp.Ext("mail").AddAttachment("t.rar") '增加一个普通附件 +'## Easp.WN Easp.Ext("mail").QuickSend() '快速发送，输出发送邮件数 +'## Easp.WN Easp.Ext("mail").RecipientsCount() '输出收件人数量 +'## '2.一般发送邮件方式，不需要上面的设置，只需要一个函数就可以了，邮件和附件参数不符都可以采用字符串或数组形式，字符串形式的话多个数据之间用 ; 进行分隔。 +'## Easp.WN Easp.Ext("mail").Send("smtp.126.com","********@126.com","虚幻","********@126.com","********@126.com","********","Subjectsmtp.126.com","","HTMLBodysmtp.126.com",1,"","","") '发送邮件，输出发送邮件数 + +'## '该函数的参数如下，每个参数的具体含义可以详见该函数头部的注释Easp.Ext("mail").Send(Smtp,From,FromName,Email,MailServerUserName,MailServerPassword,Subject,Body,HTMLBody,Priority,Silent,tCharset,tContentType) +'## 基本的使用主要就是上面的了，其他一些应用可以详见代码，每个函数和方法都有注释了。 +'## 2010/06/11 晚修正了一个问题，更新了下注释 +'###################################################################### + +Class EasyAsp_Mail + ' ============================================ + ' 变量声明 + ' ============================================ + Private s_jmail,s_ISOEncodeHeaders,s_Silent,s_Charset,s_ContentType,s_From,s_FromName,s_MailServerUserName,s_MailServerPassword,s_Priority,s_Logging,s_Smtp + Private t_Subject,t_Body,t_HTMLBody,t_File + ' ============================================ + ' 类模块初始化 + ' ============================================ + Private Sub Class_Initialize + s_ISOEncodeHeaders = True '是否将信头编码成iso-8859-1字符集. 缺省是True + s_Silent = True '设置为true,ErrorCode包含的是错误代码 + s_Charset = "Gb2312" '设置标题和内容编码，如果标题有中文，必须设定编码为gb2312 + s_ContentType = "text/html" '如果发内嵌附件设置为空值 + s_From = "" ' 发送者地址 + s_FromName = "" ' 发送者姓名 + s_MailServerUserName = "" ' 身份验证的用户名 + s_MailServerPassword = "" ' 身份验证的密码 + s_Priority = 1 '设置优先级，范围从1到5，越大的优先级越高，3为普通 + s_Logging = True '是否使用日志 + s_Smtp = "" + t_Subject = "" + t_Body = "" + t_HTMLBody = "" + t_File = "" + Easp.Error(10001) = "您的服务器不支持 Jmail 组件." + Easp.Error(10002) = "发送者地址不能为空." + Easp.Error(10003) = "发送者姓名不能为空." + Easp.Error(10004) = "优先级必须为1-5之间的数字." + Easp.Error(10005) = "Jmail 对象未创建." + Easp.Error(10006) = "邮件地址不正确." + Easp.Error(10007) = "SMTP地址为空或不正确." + Easp.Error(10008) = "没有任何收件人." + Easp.Error(20001) = "身份验证的用户名不能为空." + Easp.Error(20002) = "身份验证的密码不能为空." + Easp.Error(30001) = "邮件发送失败." + End Sub + ' ============================================ + ' 类终结 + ' ============================================ + Private Sub Class_Terminate + On ErrOr Resume Next + s_jmail.Close() + If Err Then Err.Clear + Set s_jmail = Nothing + End Sub + + ' ============================================ + ' 设置ISOEncodeHeaders + ' ============================================ + Public Property Let ISOEncodeHeaders(ByVal p) + s_ISOEncodeHeaders=Easp.IIF(p,p,False) + End Property + + ' ============================================ + ' 返回ISOEncodeHeaders + ' ============================================ + Public Property Get ISOEncodeHeaders() + ISOEncodeHeaders=s_ISOEncodeHeaders + End Property + + ' ============================================ + ' 设置Silent + ' ============================================ + Public Property Let Silent(ByVal p) + s_Silent=Easp.IIF(p,p,False) + End Property + + ' ============================================ + ' 返回Silent + ' ============================================ + Public Property Get Silent() + Silent=s_Silent + End Property + + ' ============================================ + ' 设置Logging + ' ============================================ + Public Property Let Logging(ByVal p) + s_Logging=Easp.IIF(p,p,False) + End Property + + ' ============================================ + ' 返回Logging + ' ============================================ + Public Property Get Logging() + Logging=s_Logging + End Property + + ' ============================================ + ' 设置Charset + ' ============================================ + Public Property Let [Charset](ByVal p) + s_Charset=Easp.Ifhas(p,"GB2312") + End Property + + ' ============================================ + ' 设置ContentType + ' ============================================ + Public Property Let [ContentType](ByVal p) + s_ContentType=Easp.Ifhas(p,"text/html") + End Property + + ' ============================================ + ' 设置From + ' ============================================ + Public Property Let From(ByVal p) + s_From=p + End Property + + ' ============================================ + ' 设置FromName + ' ============================================ + Public Property Let FromName(ByVal p) + s_FromName=p + End Property + + ' ============================================ + ' 设置MailServerUserName + ' ============================================ + Public Property Let MailServerUserName(ByVal p) + s_MailServerUserName=p + End Property + + ' ============================================ + ' 设置MailServerPassword + ' ============================================ + Public Property Let MailServerPassword(ByVal p) + s_MailServerPassword=p + End Property + + ' ============================================ + ' 设置Priority + ' ============================================ + Public Property Let Priority(ByVal p) + If Not Easp.Test(p,"int") or int(p)<1 or int(p)>5 Then + Easp.Error.Raise 10004 + End If + s_Priority=p + End Property + + ' ============================================ + ' 设置Smtp + ' ============================================ + Public Property Let Smtp(ByVal p) + s_Smtp=p + End Property + + ' ============================================ + ' 设置Subject + ' ============================================ + Public Property Let Subject(ByVal p) + t_Subject=p + End Property + + ' ============================================ + ' 设置Body + ' ============================================ + Public Property Let Body(ByVal p) + t_Body=p + End Property + + ' ============================================ + ' 设置HTMLBody + ' ============================================ + Public Property Let HTMLBody(ByVal p) + t_HTMLBody=p + End Property + + ' ============================================ + ' 返回日志 + ' ============================================ + Public Property Get [Log]() + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + [Log]=s_jmail.Log + End Property + + ' ============================================ + ' 返回嵌入式附件列表,如果参数为空或者小于0则返回附件列表数组，否则则返回指定索引值的附件值，如果指定索引值大于最大数组下标则返回最大下标的附件值 + ' ============================================ + Public Property Get [File](ByVal p) + If Not Easp.Has(p) Then + P=-1 + End If + If Not IsNumeric(p) Then + p=Int(p) + End If + If p < 0 Then + [File]=t_File + Else + [File]=t_File(Easp.IIF(p > Ubound(t_File),Ubound(t_File),p)) + End If + End Property + + ' ============================================ + ' 返回所有收件人数量 + ' ============================================ + Public Property Get RecipientsCount() + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + RecipientsCount=s_jmail.Recipients.count + End Property + + ' ============================================ + ' 清除所有收件人 + ' ============================================ + Public Sub RecipientsClear() + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + s_jmail.Recipients.clear() + End Sub + + ' ============================================ + ' 字符串转数组，字符串各值以;分隔，如果参数为数组则直接返回数组 + ' ============================================ + Public Function ToArray(ByVal p) + If Not IsArray(p) then + If InStr(p,";")>0 Then + If InStrRev(p,";")=Len(p) Then + p=Left(p,len(p)-1) + End If + ToArray = Split(p,";") + Else + ToArray = Array(p) + End If + Else + ToArray=p + End If + End Function + ' ============================================ + ' 添加收件人,参数可以为字符串，多个地址之间用;分隔，也可以为数组 + ' ============================================ + Public Sub AddRecipient(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + t_p=ToArray(p) + For i=0 to UBound(t_p) + If Not Easp.Test(t_p(i),"email") Then + Easp.Error.Raise 10006 + End If + s_jmail.AddRecipient(t_p(i)) + Next + End Sub + + ' ============================================ + ' 添加密件收件人的地址 + ' ============================================ + Public Function AddRecipientBCC(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + t_p=ToArray(p) + For i=0 to UBound(t_p) + If Not Easp.Test(t_p(i),"email") Then + Easp.Error.Raise 10006 + End If + s_jmail.AddRecipientBCC(t_p(i)) + Next + End Function + + ' ============================================ + ' 添加邮件抄送者的地址 + ' ============================================ + Public Function AddRecipientCC(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + t_p=ToArray(p) + For i=0 to UBound(t_p) + If Not Easp.Test(t_p(i),"email") Then + Easp.Error.Raise 10006 + End If + s_jmail.AddRecipientCC(t_p(i)) + Next + End Function + + ' ============================================ + ' 增加普通附件,参数可以为相对和绝对地址，可以为字符串，也可以为数组 + ' ============================================ + Public Sub AddAttachment(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + t_p=ToArray(p) + For i=0 to UBound(t_p) + s_jmail.AddAttachment(Server.MapPath(t_p(i))) + Next + End Sub + + ' ============================================ + ' 返回附件数量 + ' ============================================ + Public Function AttachmentsCount() + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + AttachmentsCount=s_jmail.Attachments.Count + End Function + + ' ============================================ + ' 清除所有附件 + ' ============================================ + Public Sub AttachmentsClear() + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + s_jmail.Attachments.Clear + End Sub + + ' ============================================ + ' 增加嵌入式附件,参数可以为相对和绝对地址，可以为字符串，也可以为数组，返回文件列表数组 + ' ============================================ + Public Function AddAttachmentIn(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + t_p=ToArray(p) + Redim t_File(Ubound(t_p)) + For i=0 to UBound(t_p) + t_File(i)=s_jmail.AddAttachment(Server.MapPath(t_p(i))) + Next + AddAttachmentIn=t_File + End Function + + ' ============================================ + ' 追加HTML + ' ============================================ + Public Sub AppendHTML(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + s_jmail.appendHTML p + End Sub + + ' ============================================ + ' 追加文本 + ' ============================================ + Public Sub AppendText(ByVal p) + If Not isobject(s_jmail) Then + Easp.Error.Raise 10005 + End If + s_jmail.appendText p + End Sub + + ' ============================================ + ' 创建Jmail对象,返回一个新的jmail对象,提供需要直接使用jmail对象的情况下使用 + ' ============================================ + Public Function Jmail() + If Not Easp.IsInstall("JMAIL.Message") then + Easp.Error.Raise 10001 + End If + Set Jmail = Server.CreateObject("JMail.Message") + End Function + + ' ============================================ + ' 初始化Jmail对象 + ' ============================================ + Public Sub Init() + If Not Easp.IsInstall("JMAIL.Message") then + Easp.Error.Raise 10001 + End If + If Not IsObject(s_jmail) Then + Set s_jmail = Server.CreateObject("JMail.Message") + End If + End Sub + + ' ============================================ + ' 关闭释放Jmail对象 + ' ============================================ + Public Sub Terminate() + If IsObject(s_jmail) then + s_jmail.close() + Set s_jmail = Nothing + End If + End Sub + + ' ============================================ + ' 快速发送邮件，返回发送邮件数量，配置了各项参数的情况下才能使用，适用于邮件参数基本固定，只需要添加收件人和附件 + ' ============================================ + Public Function QuickSend() + If Not Easp.IsInstall("JMAIL.Message") then + Easp.Error.Raise 10001 + End If + If Not Easp.Has(s_Smtp) then + Easp.Error.Raise 10007 + End If + If Not Easp.Has(s_From) then + Easp.Error.Raise 10002 + End If + If Not Easp.Has(s_FromName) then + Easp.Error.Raise 10003 + End If + If Not Easp.Has(s_MailServerUserName) then + Easp.Error.Raise 20001 + End If + If Not Easp.Has(s_MailServerPassword) then + Easp.Error.Raise 20002 + End If + If Not Easp.Has(t_Subject) Then + t_Subject="无主题." + End If + If RecipientsCount()=0 then + Easp.Error.Raise 10008 + End If + If Not isobject(s_jmail) Then + Set s_jmail = Server.CreateObject("JMail.Message") + End If + s_jmail.silent = s_Silent + s_jmail.Charset = s_Charset + If AttachmentsCount()=0 Then + s_jmail.ContentType = s_ContentType + End If + s_jmail.From = s_From + s_jmail.FromName = s_FromName + s_jmail.MailServerUserName = s_MailServerUserName + s_jmail.MailServerPassword = s_MailServerPassword + s_jmail.Subject = t_Subject + s_jmail.Body =t_Body + s_jmail.HTMLBody =t_HTMLBody + s_jmail.Priority = s_Priority + s_jmail.Send s_Smtp + If Err.Number<>0 then + Easp.Error.Raise 30001 + End If + QuickSend = RecipientsCount() + Terminate() + End Function + + ' ============================================ + ' 根据参数发送邮件，成功返回发送数量,收件人参数可以为字符串，数组 + ' Smtp 'smtp地址 + ' From '发件人邮箱 + ' FromName '发件人姓名 + ' Email '收件人邮箱 + ' MailServerUserName '身份验证的用户名 + ' MailServerPassword '身份验证的密码 + ' Subject '主题 + ' Body '内容 + ' HTMLBody 'HTML格式内容 + ' Priority '优先级 + ' Silent '设置为true,ErrorCode包含的是错误代码 + ' tCharset '设置标题和内容编码 + ' tContentType '如果发内嵌附件设置为空值 + ' ============================================ + Public Function Send(ByVal Smtp,ByVal From,ByVal FromName,ByVal Email,ByVal MailServerUserName,ByVal MailServerPassword,ByVal Subject,ByVal Body,ByVal HTMLBody,ByVal Priority,ByVal Silent,ByVal tCharset,ByVal tContentType) + If Not Easp.IsInstall("JMAIL.Message") then + Easp.Error.Raise 10001 + End If + Set t_jmail = Server.CreateObject("JMail.Message") + If Not Easp.Has(Smtp) then + Easp.Error.Raise 10007 + End If + If Not Easp.Has(From) then + Easp.Error.Raise 10002 + End If + If Not Easp.Has(FromName) then + Easp.Error.Raise 10003 + End If + If Not Easp.Has(Email) then + Easp.Error.Raise 10008 + End If + t_Email=ToArray(Email) + For i=0 to UBound(t_Email) + If Not Easp.Test(t_Email(i),"email") Then + Easp.Error.Raise 10006 + End If + t_jmail.AddRecipient(t_Email(i)) + Next + If t_jmail.Recipients.count=0 then + Easp.Error.Raise 10008 + End If + If Not Easp.Has(MailServerUserName) then + Easp.Error.Raise 20001 + End If + If Not Easp.Has(MailServerPassword) then + Easp.Error.Raise 20002 + End If + If Not Easp.Has(Subject) Then + Subject="无主题." + End If + If Not Easp.Has(Priority) Then + Priority = 1 + End If + If Not Easp.Has(Silent) Then + Silent = True + End If + If Not Easp.Has(tCharset) Then + tCharset = "UTF-8" + End If + If Not Easp.Has(tContentType) Then + tContentType = "text/html" + End If + t_jmail.silent = Silent + t_jmail.Charset = tCharset + t_jmail.ContentType = tContentType + t_jmail.From = From + t_jmail.FromName = FromName + t_jmail.MailServerUserName = MailServerUserName + t_jmail.MailServerPassword = MailServerPassword + t_jmail.Subject = Subject + t_jmail.Body =Body + t_jmail.HTMLBody =HTMLBody + t_jmail.Priority = Priority + t_jmail.Send Smtp + If Err.Number<>0 then + Easp.Error.Raise 30001 + End If + Send = t_jmail.Recipients.count + t_jmail.close() + Set t_jmail = Nothing + End Function + +End Class +%> diff --git a/easyasp/plugin/easp.md5utf8.asp b/easyasp/plugin/easp.md5utf8.asp new file mode 100644 index 0000000..57c72d8 --- /dev/null +++ b/easyasp/plugin/easp.md5utf8.asp @@ -0,0 +1,417 @@ +<% +' MD5签名函数 +' 功能：支付宝MD5签名处理核心文件，不需要修改 +' 版本：3.2 +' 修改日期：2010-10-29 +' 说明： +' 以下代码只是为了方便商户测试而提供的样例代码，商户可以根据自己网站的需要，按照技术文档编写,并非一定要使用该代码。 +' 该代码仅供学习和研究支付宝接口使用，只是提供一个参考。 + + +Private Const BITS_TO_A_BYTE = 8 +Private Const BYTES_TO_A_WORD = 4 +Private Const BITS_TO_A_WORD = 32 +Class EasyASP_md5utf8 + + Private m_lOnBits(30) + Private m_l2Power(30) + + 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 str2bin_utf(varstr) + Dim varchar, code, codearr, j, i + str2bin_utf = "" + For i=1 To Len(varstr) + varchar = Mid(varstr,i,1) + code = Server.UrlEncode(varchar) + If(code="+") Then code="%20" + If Len(code) = 1 Then + str2bin_utf = str2bin_utf & chrB(AscB(code)) + Else + codearr = Split(code,"%") + For j = 1 to UBound(codearr) + str2bin_utf = str2bin_utf & ChrB("&H" & codearr(j)) + Next + 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 + + lMessageLength = LenB(sMessage) + + 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 + lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(AscB(MidB(sMessage, lByteCount + 1, 1)), lBytePosition) + 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 + + Private Function MD5(sMessage,input_charset) + 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 LCase(input_charset) = "utf-8" Then + x = ConvertToWordArray(str2bin_utf(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 + + MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) + End Function + Public Default Function To32(ByVal s) + To32 = MD5(s,"utf-8") + End Function +End Class +%> diff --git a/easyasp/plugin/easp.pr.asp b/easyasp/plugin/easp.pr.asp new file mode 100644 index 0000000..0717a26 --- /dev/null +++ b/easyasp/plugin/easp.pr.asp @@ -0,0 +1,307 @@ +<% +'Option Explicit +'###################################################################### +'## easp.pr.asp +'## ------------------------------------------------------------------- +'## Feature : EasyAsp Google PageRank Class +'## Version : v1.0 +'## Author : Easp.智者(Liaoyizhi[at]gmail.com) +'## Update Date : 2010/03/29 10:59 +'## Description : EasyAsp 谷歌PR值查询类（插件） +'###################################################################### + +Private Const OFFSET_4 = 4294967296 +Private Const MAXINT_4 = 2147483647 +Class EasyAsp_Pr + Private s_iplist + Private b_ranip + + Public Property Let IpList(ByVal s) + s_iplist = s + End Property + + Public Property Let RanIp(ByVal b) + b_ranip = b + End Property + + Private Sub Class_Initialize + s_iplist = "64.233.169.84,64.233.179.93,209.85.135.184,209.85.135.102,64.233.169.115,64.233.169.19,209.85.135.19,64.233.169.184,216.239.59.147,209.85.135.44,209.85.135.100,64.233.189.162,216.239.59.103,64.233.189.19,66.102.9.147,64.233.189.104,66.102.9.184,64.233.169.81,216.239.59.19,66.102.9.99,209.85.135.115,64.233.189.18,66.249.89.83,216.239.59.44" + b_ranip = True + End Sub + Private Sub Class_Terminate + End Sub + + Private Function getIp() + Dim arrIp + arrIp = Split(s_iplist,",") + If b_ranip And UBound(arrIp) > 0 Then + Randomize() + getIp = arrIp(Round(Rnd()*UBound(arrIp))) + Else + getIp = arrIp(0) + End If + End Function + + Private Function zeroFill(ByVal a, ByVal b) + Dim z + z = &H80000000 + If ((z And a) <> 0) Then + a = BitRShift(a, 1) + a = a And Not z + a = a Or &H40000000 + a = BitRShift(a, b - 1) + Else + a = BitRShift(a, b) + End If + zeroFill = a + End Function + + Private Function uw_WordAdd(ByVal wordA, ByVal wordB) + ' Adds words A and B avoiding overflow + Dim myUnsigned + + myUnsigned = LongToUnsigned(wordA) + LongToUnsigned(wordB) + ' Cope with overflow + If myUnsigned > OFFSET_4 Then + myUnsigned = myUnsigned - OFFSET_4 + End If + uw_WordAdd = UnsignedToLong(myUnsigned) + End Function + + Private Function uw_WordSub(ByVal wordA, ByVal wordB) + ' Subtract words A and B avoiding underflow + Dim myUnsigned + + myUnsigned = LongToUnsigned(wordA) - LongToUnsigned(wordB) + ' Cope with underflow + If myUnsigned < 0 Then + myUnsigned = myUnsigned + OFFSET_4 + End If + uw_WordSub = UnsignedToLong(myUnsigned) + End Function + + Private Function UnsignedToLong(value) + If value < 0 Or value >= OFFSET_4 Then Error 6 ' Overflow + If value <= MAXINT_4 Then + UnsignedToLong = value + Else + UnsignedToLong = value - OFFSET_4 + End If + End Function + + Private Function LongToUnsigned(value) + If value < 0 Then + LongToUnsigned = value + OFFSET_4 + Else + LongToUnsigned = value + End If + End Function + + Private Function BitLShift(ByVal x, n) + If n = 0 Then + BitLShift = x + Else + Dim k + k = 2 ^ (32 - n - 1) + Dim d + d = x And (k - 1) + Dim c + c = d * 2 ^ n + If x And k Then + c = c Or &H80000000 + End If + BitLShift = c + End If + End Function + + Private Function BitRShift(ByVal x, n) + If n = 0 Then + BitRShift = x + Else + Dim y + y = x And &H7FFFFFFF + Dim z + If n = 32 - 1 Then + z = 0 + Else + z = y \ 2 ^ n + End If + If y <> x Then + z = z Or 2 ^ (32 - n - 1) + End If + BitRShift = z + End If + End Function + + Private Function mix(ByVal a, ByVal b, ByVal c) + a = uw_WordSub(a, b): a = uw_WordSub(a, c): a = a Xor (zeroFill(c, 13)) + b = uw_WordSub(b, c): b = uw_WordSub(b, a): b = b Xor BitLShift(a, 8) + c = uw_WordSub(c, a): c = uw_WordSub(c, b): c = c Xor zeroFill(b, 13) + a = uw_WordSub(a, b): a = uw_WordSub(a, c): a = a Xor zeroFill(c, 12) + b = uw_WordSub(b, c): b = uw_WordSub(b, a): b = b Xor BitLShift(a, 16) + c = uw_WordSub(c, a): c = uw_WordSub(c, b): c = c Xor zeroFill(b, 5) + a = uw_WordSub(a, b): a = uw_WordSub(a, c): a = a Xor zeroFill(c, 3) + b = uw_WordSub(b, c): b = uw_WordSub(b, a): b = b Xor BitLShift(a, 10) + c = uw_WordSub(c, a): c = uw_WordSub(c, b): c = c Xor zeroFill(b, 15) + + Dim m(2) + m(0) = a + m(1) = b + m(2) = c + mix = m + End Function + + Private Function GoogleCH(url(), length) + Dim init, a, b, c + init = &HE6359A60 + a = &H9E3779B9 + b = &H9E3779B9 + c = &HE6359A60 + + Dim k, l + k = 0 + l = length + + Dim mixo + While (l >= 12) + a = uw_WordAdd(a, url(k + 0)) + a = uw_WordAdd(a, BitLShift(url(k + 1), 8)) + a = uw_WordAdd(a, BitLShift(url(k + 2), 16)) + a = uw_WordAdd(a, BitLShift(url(k + 3), 24)) + b = uw_WordAdd(b, url(k + 4)) + b = uw_WordAdd(b, BitLShift(url(k + 5), 8)) + b = uw_WordAdd(b, BitLShift(url(k + 6), 16)) + b = uw_WordAdd(b, BitLShift(url(k + 7), 24)) + c = uw_WordAdd(c, url(k + 8)) + c = uw_WordAdd(c, BitLShift(url(k + 9), 8)) + c = uw_WordAdd(c, BitLShift(url(k + 10), 16)) + c = uw_WordAdd(c, BitLShift(url(k + 11), 24)) + mixo = mix(a, b, c) + a = mixo(0): b = mixo(1): c = mixo(2) + k = k + 12 + l = l - 12 + Wend + c = c + length + If l >= 11 Then c = uw_WordAdd(c, BitLShift(url(k + 10), 24)) + If l >= 10 Then c = uw_WordAdd(c, BitLShift(url(k + 9), 16)) + If l >= 9 Then c = uw_WordAdd(c, BitLShift(url(k + 8), 8)) + If l >= 8 Then b = uw_WordAdd(b, BitLShift(url(k + 7), 24)) + If l >= 7 Then b = uw_WordAdd(b, BitLShift(url(k + 6), 16)) + If l >= 6 Then b = uw_WordAdd(b, BitLShift(url(k + 5), 8)) + If l >= 5 Then b = uw_WordAdd(b, url(k + 4)) + If l >= 4 Then a = uw_WordAdd(a, BitLShift(url(k + 3), 24)) + If l >= 3 Then a = uw_WordAdd(a, BitLShift(url(k + 2), 16)) + If l >= 2 Then a = uw_WordAdd(a, BitLShift(url(k + 1), 8)) + If l >= 1 Then a = uw_WordAdd(a, url(k + 0)) + + mixo = mix(a, b, c) + If (mixo(2) < 0) Then + GoogleCH = mixo(2) + 2 ^ 32 + Else + GoogleCH = mixo(2) + End If + End Function + + Private Function StrConv(ByVal s) + Dim tmpArr(),i + ReDim tmpArr(Len(s)) + For i = 0 To Len(s) - 1 + tmpArr(i) = Asc(Mid(s,i+1,1)) + Next + StrConv = tmpArr + End Function + + Private Function c32to8bit(arr32()) + Dim arr8() + ReDim arr8(4 * (UBound(arr32) + 1) - 1) + Dim i, bitOrder + For i = 0 To UBound(arr32) + For bitOrder = i * 4 To i * 4 + 3 + arr8(bitOrder) = arr32(i) And 255 + arr32(i) = zeroFill(arr32(i), 8) + Next + Next + c32to8bit = arr8 + End Function + + Private Function GoogleNewCh(ByVal ch) + Dim prbuf(19), i + prbuf(0) = (BitLShift(Fix(ch / 7), 2) Or ((ch - 13 * Fix(ch / 13)) And 7)) + 'prbuf(0) = (BitLShift((ch / 7), 2) Or ((ch Mod 13) And 7)) + For i = 1 To 19 + prbuf(i) = prbuf(i - 1) - 9 + Next + + GoogleNewCh = GoogleCH(c32to8bit(prbuf), 80) + End Function + + Private Function UrlEncode(ByVal urlText) + Dim i + Dim ansi + Dim ascii + Dim encText + + ansi = StrConv(urlText) + + encText = "" + For i = 0 To UBound(ansi) + ascii = ansi(i) + + Select Case ascii + Case 48,49,50,51,52,53,54,55,56,57, 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90, 97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122 + encText = encText & Chr(ascii) + + Case 32 + encText = encText & "+" + + Case Else + If ascii < 16 Then + encText = encText & "%0" & Hex(ascii) + Else + encText = encText & "%" & Hex(ascii) + End If + + End Select + Next + + UrlEncode = encText + End Function + + Public Default Function GetPageRank(url) + Dim reqgr, reqgre + reqgr = "info:" & url + reqgre = "info:" & UrlEncode(url) + + Dim bUrl + bUrl = StrConv(reqgr) + + Dim gch + gch = GoogleCH(bUrl, Len(reqgr)) + gch = GoogleNewCh(gch) + Dim querystring + querystring = "http://" & getIp() & "/search?client=navclient-auto&ch=6" & gch & "&ie=UTF-8&oe=UTF-8&features=Rank:FVN&q=" & reqgre + + Dim xml + Set xml = Server.CreateObject("Microsoft.XMLHTTP") + xml.Open "GET", querystring, False + xml.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; GoogleToolbar 2.0.114-big; Windows XP 5.1)" + xml.send + + GetPageRank = "" + Dim res + res = xml.responseText + Set xml = Nothing + If Len(res) > 2 Then + Dim pos, pos1 + pos = InStr(res, "Rank_") + pos1 = InStr(pos, res, Chr(10)) + If pos > 0 And pos1 > 0 Then + res = Mid(res, pos, pos1 - pos) + Dim x + x = Split(res, ":", 3) + GetPageRank = x(2) + End If + End If + End Function +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.pyo.asp b/easyasp/plugin/easp.pyo.asp new file mode 100644 index 0000000..27e0414 --- /dev/null +++ b/easyasp/plugin/easp.pyo.asp @@ -0,0 +1,98 @@ +<% +'################################################################################# +'## easp.pyo.asp +'## ------------------------------------------------------------------------------ +'## Feature : PinYin Online Transfer for EasyAsp +'## Version : v1.0 +'## Author : Coldstone(coldstone[at]qq.com) +'## Update Date : 2010/12/16 15:56:57 +'## Special Thanks : kdd.cc +'## Description : 这是一个将汉字转换为拼音的插件，支持将UTF-8或GBK编码下的简、繁汉字甚至是生僻 +'## 字转换为汉语拼音，支持多音字的识别，可以输出六种格式的汉语拼音。由于本插件采用 +'## 在线转换，所以需要服务器能访问互联网。 +'## 使用说明： +'## 1、基本用法： Easp.Ext("pyo")("长春市长") +'## 结果：cháng chūn shì zhǎng +'## 2、本插件可以返回6种格式的拼音，用 Type 属性设置，设置方法如下： +'## Easp.Ext("pyo").Type = +'## 的值可以是以下数字 +'## 1 - 带声调的汉语拼音：cháng chūn shì zhǎng +'## 2 - 首字母大写：Cháng Chūn Shì Zhǎng +'## 3 - 不带声调的拼音：chang chun shi zhang +'## 4 - 声调用数字表示的拼音：chang2 chun1 shi4 zhang3 +'## 5 - 汉字注音：ㄔㄤˊ ㄔㄨㄣ ㄕㄧˋ ㄓㄤˇ +'## 6 - 拼音首字母：ccsz +'## 3、也可以用下面的方法而不用设置此属性： +'## Easp.Ext("pyo").PY("长春市长",6) '结果：ccsz +'## 4、可以用Space属性设置是否保留每个拼音之间的空格： +'## Easp.Ext("pyo").Space = +'## +'## 特别说明：此插件发布时编码为utf-8，如果要使用在gbk编码下，请自行转换此文档的编码。 +'################################################################################# +Class EasyAsp_Pyo + + Private s_author, s_version + Private i_type + Private b_space + Private o_http + + Private Sub Class_Initialize() + s_author = "coldstone" + s_version = "1.0" + Easp.Use "Http" + Set o_http = Easp.Http.New + i_type = 1 + b_space = True + End Sub + Private Sub Class_Terminate() + Set o_http = Nothing + End Sub + + Public Property Get Author() + Author = s_author + End Property + Public Property Get Version() + Version = s_version + End Property + Public Property Let [Type](ByVal n) + i_type = n + End Property + Public Property Let [Space](ByVal b) + b_space = b + End Property + + Public Default Function PinYin(ByVal s) + PinYin = PY(s, i_type) + End Function + + Public Function PY(ByVal s, ByVal t) + If Easp.IsN(s) Then Exit Function + Dim p,u,tmp,arr,i + u = "http://py.kdd.cc/Unicode/index.asp" + o_http.Data = "u=" & Easp.IIF(t=6,3,t) & "&wz=" & s + o_http.SetHeader "referer:" & u + o_http.Post u + p = o_http.SubStr("
    ","

    ",0) + p = Easp.RegReplace(p,"]*>","") + arr = Split(p,"
    ") + If Len(s) = 1 Then + tmp = Easp.CLeft(arr(0)," ") + If t = 6 then tmp = Left(tmp,1) + Else + For i = 0 To Ubound(arr) + If i Mod 2 = 0 Then tmp = tmp & arr(i) + Next + End If + If t = 6 Then + arr = Split(tmp," ") + tmp = "" + For i = 0 To Ubound(arr) + tmp = tmp & Left(arr(i),1) + Next + End If + If Not b_space Then tmp = Replace(tmp," ", "") + PY = tmp + End Function + +End Class +%> \ No newline at end of file diff --git a/easyasp/plugin/easp.wx.asp b/easyasp/plugin/easp.wx.asp new file mode 100644 index 0000000..280f366 --- /dev/null +++ b/easyasp/plugin/easp.wx.asp @@ -0,0 +1,551 @@ +<% +'###################################################################### +'## easp.weixin.asp +'## ------------------------------------------------------------------- +'## Feature : EasyAsp weixin Class +'## Version : v1.0 +'## Author : sky +'## Update Date : 2014/01/24 +'## Description : 微信API接口 +'###################################################################### +Class EasyAsp_WX + '变量声明 + Private s_AppID,s_AppSecret,s_Token,s_AdmOpenID,s_redirect_uri + ' ============================================ + ' 类模块初始化 + ' ============================================ + Private Sub Class_Initialize + s_AppID = "" + s_AppSecret = "" + s_Token = "" + s_AdmOpenID = "" + s_redirect_uri = "" + End Sub + ' ============================================ + ' 类终结 + ' ============================================ + Private Sub Class_Terminate + On ErrOr Resume Next + If Err Then Err.Clear + End Sub + + Public Property Let AppID(ByVal p) + s_AppID=p + End Property + + Public Property Get AppID() + AppID=s_AppID + End Property + + Public Property Let AppSecret(ByVal p) + s_AppSecret=p + End Property + + Public Property Get AppSecret() + AppSecret=s_AppSecret + End Property + + Public Property Let Token(ByVal p) + s_Token=p + End Property + + Public Property Get Token() + Token=s_Token + End Property + + Public Property Let AdmOpenID(ByVal p) + s_AdmOpenID=p + End Property + + Public Property Get AdmOpenID() + AdmOpenID=s_AdmOpenID + End Property + + Public Property Let Redirect_uri(ByVal p) + s_redirect_uri=p + End Property + + Public Property Get Redirect_uri() + Redirect_uri=s_redirect_uri + End Property + + '微信设置类 + + '获取微信的Access_Token + Public Function Get_Access_Token() + Get_Access_Token="a" + '将Access_Token进行缓存 + Dim CacheName,s_url,s_result + CacheName="APPID_"&s_AppID + Easp.Cache(CacheName).Expires = 120 + If Not Easp.Cache(CacheName).Ready or Easp.IsN(Get_Access_Token) Then + s_url="https://api.weixin.qq.com/cgi-bin/token?grant_type=client_credential&appid="&s_AppID&"&secret="&s_AppSecret + s_result=HttpSend(s_url,"get","") + '{"access_token":"I8UUyLt5P82Ytfc7PV5OxoqUhPDvfZrvu4UQ1DqyFhP5QWlT0Cow","expires_in":7200} + '{"errcode":40013,"errmsg":"invalid appid"} + IF instr(s_result,"access_token")>0 Then + Get_Access_Token = Easp.Str.GetName(Easp.Str.GetValue(s_result,":"""),""",") + Easp.Cache(CacheName) = Get_Access_Token + Easp.Cache(CacheName).SaveAPP + Else + Get_Access_Token = "" + End IF + Else + Get_Access_Token = Easp.Cache(CacheName) + End IF + IF Easp.IsN(Get_Access_Token) Then Easp.WE "Access_Token Error" + End Function + + '获取jsAPI + Public Function Get_jsapi_ticket() + '缓存时间7200秒，即120分钟 + CacheName = "JsAPI_Ticket_"&s_AppID + Easp.Cache(CacheName).Expires = 120 + If Not Easp.Cache(CacheName).Ready or Easp.IsN(Get_jsapi_ticket) Then + '获取Access_Token + Access_Token = Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/ticket/getticket?access_token="&Access_Token&"&type=jsapi" + '发送请求，返回正确值为： + '{ + ' "errcode":0, + ' "errmsg":"ok", + ' "ticket":"bxLdikRXVbTPdHSM05e5u5sUoXNKd8-41ZO3MhKoyN5OfkWITDGgnr2fwJ0m9E8NYzWKVZvdVtaUgWvsdshFKA", + ' "expires_in":7200 + '} + s_result = HttpSend(s_url,"get","") + IF instr(s_result,"ticket")>0 Then + Get_jsapi_ticket = Easp.Str.GetName(Easp.Str.GetValue(s_result,"ticket"":"""),""",") + Easp.Cache(CacheName) = Get_jsapi_ticket + Easp.Cache(CacheName).SaveAPP + Else + Get_jsapi_ticket = "" + End IF + 'Set Json = Easp.Ext("vbsjson") + 'Set JsonObj = Json.Decode(result) + 'Get_jsapi_ticket = JsonObj("ticket") + 'Set JsonObj = Nothing + 'Set Json = Nothing + Else + Get_jsapi_ticket = Easp.Cache(CacheName) + End IF + End Function + + '获取微信的用户信息 + Public Function GetUserInfo(UserOpenID) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/user/info?access_token="&Access_Token&"&openid="&UserOpenID&"&lang=zh_CN" + '发送请求，返回正确值为：{"errcode":0,"errmsg":"ok"} + GetUserInfo = HttpSend(s_url,"get","") + End Function + + '微信网页授权及相关方法 + + '获取网页授权CODE + Public Function OAuth_Get_Code() + s_url = "https://open.weixin.qq.com/connect/oauth2/authorize?appid="&s_AppID&"&redirect_uri="&Server.URLEncode(s_redirect_uri)&"&response_type=code&scope=snsapi_userinfo&state=Sky#wechat_redirect" + OAuth_Get_Code = s_url + 'Easp.RR s_url + End Function + + '得到Code后再继续获取网页授权Access_Token，与微信的Access_Token不同 + Public Function OAuth_Get_Access_Token(code) + s_url = "https://api.weixin.qq.com/sns/oauth2/access_token?appid="&s_AppID&"&secret="&s_AppSecret&"&code="&code&"&grant_type=authorization_code" + '发送请求 ，错误将返回{"errcode":40029,"errmsg":"invalid code"} + '成功后返回 + '{ + ' "access_token":"ACCESS_TOKEN", + ' "expires_in":7200, + ' "refresh_token":"REFRESH_TOKEN", + ' "openid":"OPENID", + ' "scope":"SCOPE" + '} + OAuth_Get_Access_Token = HttpSend(s_url,"get","") + 'IF instr(OAuth_Get_Access_Token,"errcode")>0 Then Easp.WE "读取信息失败！" + End Function + + '获取网页授权方式的用户信息 + Public Function OAuth_GetUserInfo(OAuth_access_token,UserOpenID) + s_url = "https://api.weixin.qq.com/sns/userinfo?access_token="&OAuth_access_token&"&openid="&UserOpenID&"&lang=zh_CN" + '发送请求 + OAuth_GetUserInfo = HttpSend(s_url,"get","") + '错误时返回{"errcode":40003,"errmsg":" invalid openid "} + 'IF instr(OAuth_Get_Access_Token,"errcode")>0 Then Easp.WE "读取信息失败！" + End Function + + '回复被动响应消息 + + '文本回复，换行：在content中能够换行，微信客户端就支持换行显示 + Public Function Re_Text(s_ToUser,s_FromUser,s_Content) + s_xml = "" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&""&now()&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + Re_Text = s_xml + End Function + + '图片回复，MediaId通过上传多媒体文件，得到的id。 + Public Function Re_Image(s_ToUser,s_FromUser,s_MediaId) + s_xml = "" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&""&now()&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + Re_Image = s_xml + End Function + + '语音回复，通过上传多媒体文件，得到的id。 + Public Function Re_Voice(s_ToUser,s_FromUser,s_MediaId) + s_xml = "" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&""&now()&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + Re_Voice = s_xml + End Function + + '视频回复，通过上传多媒体文件，得到的id。 + Public Function Re_Video(s_ToUser,s_FromUser,s_MediaId,s_Title,s_Description) + s_xml = "" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&""&now()&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + Re_Video = s_xml + End Function + + '音乐回复 + 'Title 否 音乐标题 + 'Description 否 音乐描述 + 'MusicURL 否 音乐链接 + 'HQMusicUrl 否 高质量音乐链接，WIFI环境优先使用该链接播放音乐 + 'ThumbMediaId 是 缩略图的媒体id，通过上传多媒体文件，得到的id + Public Function Re_Music(s_ToUser,s_FromUser,s_Title,s_Description,s_MusicUrl,s_HQMusicUrl,s_ThumbMediaId) + s_xml = "" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&""&now()&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"<![CDATA["&s_Title&"]]>" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + Re_Music = s_xml + End Function + + '图文回复 + 'ArticleCount 是 图文消息个数，限制为10条以内 + 'Articles 是 多条图文消息信息，默认第一个item为大图,注意，如果图文数超过10，则将会无响应 + 'Title 否 图文消息标题 + 'Description 否 图文消息描述 + 'PicUrl 否 图片链接，支持JPG、PNG格式，较好的效果为大图360*200，小图200*200 + 'Url 否 点击图文消息跳转链接 + 's_Array格式： array(array(s_Title,s_Description,s_PicUrl,s_Url),array(s_Title,s_Description,s_PicUrl,s_Url)) + Public Function Re_News(s_ToUser,s_FromUser,s_Array) + IF isArray(s_Array) Then + s_ArticleCount = Ubound(s_Array) + IF s_ArticleCount > 10 Then s_ArticleCount = 10 + s_xml = "" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&""&now()&"" + s_xml = s_xml&"" + s_xml = s_xml&""&s_ArticleCount&"" + s_xml = s_xml&"" + for s_i = 0 to s_ArticleCount - 1 + s_Title = s_Array(s_i,0) + s_Description = s_Array(s_i,1) + s_PicUrl = s_Array(s_i,2) + s_Url = s_Array(s_i,3) + s_xml = s_xml&"" + s_xml = s_xml&"<![CDATA["&s_Title&"]]>" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + s_xml = s_xml&"" + next + s_xml = s_xml&"" + s_xml = s_xml&"" + Else + s_xml = "" + End IF + Re_News = s_xml + End Function + + '主动发送客服消息 + + '发送文本消息 + Public Function Send_Text(UserOpenID,Text) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/message/custom/send?access_token="&Access_Token + '消息内容 + '{"touser":"OPENID","msgtype":"text","text":{"content":"Hello World"}} + s_Data = "{""touser"":"""&UserOpenID&""",""msgtype"":""text"",""text"":{""content"":"""&Text&"""}}" + '发送请求 ，返回正确值为：{"errcode":0,"errmsg":"ok"} + Send_Text = HttpSend(s_url,"post",s_Data) + End Function + + '发送图片消息 + Public Function Send_Image(UserOpenID,s_media_id) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/message/custom/send?access_token="&Access_Token + '消息内容 + '{"touser":"OPENID","msgtype":"image","image":{"media_id":"MEDIA_ID"}} + s_Data = "{""touser"":"""&UserOpenID&""",""msgtype"":""image"",""image"":{""media_id"":"""&s_media_id&"""}}" + '发送请求 ，返回正确值为：{"errcode":0,"errmsg":"ok"} + Send_Image = HttpSend(s_url,"post",s_Data) + End Function + + '发送语音消息 + Public Function Send_Voice(UserOpenID,s_media_id) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/message/custom/send?access_token="&Access_Token + '消息内容 + '{"touser":"OPENID","msgtype":"voice","voice":{"media_id":"MEDIA_ID"}} + s_Data = "{""touser"":"""&UserOpenID&""",""msgtype"":""voice"",""voice"":{""media_id"":"""&s_media_id&"""}}" + '发送请求 ，返回正确值为：{"errcode":0,"errmsg":"ok"} + Send_Voice = HttpSend(s_url,"post",s_Data) + End Function + + '发送视频消息 + Public Function Send_Video(UserOpenID,s_media_id,s_title,s_description) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/message/custom/send?access_token="&Access_Token + '消息内容 + '{"touser":"OPENID","msgtype":"video","video":{"media_id":"MEDIA_ID","title":"TITLE","description":"DESCRIPTION"}} + s_Data = "{""touser"":"""&UserOpenID&""",""msgtype"":""video"",""video"":{""media_id"":"""&s_media_id&""",""title"":"""&s_title&""",""description"":"""&s_description&"""}}" + '发送请求 ，返回正确值为：{"errcode":0,"errmsg":"ok"} + Send_Video = HttpSend(s_url,"post",s_Data) + End Function + + '发送音乐消息 + Public Function Send_Music(UserOpenID,s_title,s_description,s_musicurl,s_hqmusicurl,s_thumb_media_id) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/message/custom/send?access_token="&Access_Token + '消息内容 + '{"touser":"OPENID","msgtype":"music","music":{"title":"MUSIC_TITLE","description":"MUSIC_DESCRIPTION","musicurl":"MUSIC_URL","hqmusicurl":"HQ_MUSIC_URL","thumb_media_id":"THUMB_MEDIA_ID" }} + s_Data = "{""touser"":"""&UserOpenID&""",""msgtype"":""music"",""music"":{""title"":"""&s_title&""",""description"":"""&s_description&""",""musicurl"":"""&s_musicurl&""",""hqmusicurl"":"""&s_hqmusicurl&""",""thumb_media_id"":"""&s_thumb_media_id&"""}}" + '发送请求 ，返回正确值为：{"errcode":0,"errmsg":"ok"} + Send_Music = HttpSend(s_url,"post",s_Data) + End Function + + '发送图文消息 + Public Function Send_News(UserOpenID,s_Array) + IF isArray(s_Array) Then + s_ArticleCount = Ubound(s_Array) + IF s_ArticleCount > 10 Then s_ArticleCount = 10 + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/message/custom/send?access_token="&Access_Token + '消息内容 + s_Data = "{""touser"":"""&UserOpenID&""",""msgtype"":""news"",""news"":{""articles"":[" + for s_i = 0 to s_ArticleCount - 1 + s_title = s_Array(s_i,0) + s_description = s_Array(s_i,1) + s_picurl = s_Array(s_i,2) + s_url = s_Array(s_i,3) + s_Data = s_Data&"{""title"":"""&s_title&""",""description"":"""&s_description&""",""url"":"""&s_url&""",""picurl"":"""&s_picurl&"""}" + if s_i < s_ArticleCount - 1 Then s_Data = s_Data&"," + next + s_Data = s_Data&"]}}" + '发送请求，返回正确值为：{"errcode":0,"errmsg":"ok"} + Send_News = HttpSend(s_url,"post",s_Data) + Else + Send_News = "" + End IF + End Function + + '微信菜单管理 + + '设置菜单，对于已关注的用户24小时才生效 + Public Function SetMenu(MenuData) + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/menu/create?access_token="&Access_Token + '菜单Json + '{"button":[{"type":"click","name":"服务介绍","key":"V101","sub_button":[{"type":"view","name":"搜索","url":"http://www.soso.com/"},……]},……]} + '发送请求，返回正确值为：{"errcode":0,"errmsg":"ok"} + SetMenu = HttpSend(s_url,"post",MenuData) + End Function + + '查寻菜单 + Public Function GetMenu() + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/menu/get?access_token="&Access_Token + '发送请求，返回正确值为：{"errcode":0,"errmsg":"ok"} + GetMenu = HttpSend(s_url,"get","") + End Function + + '删除菜单 + Public Function DelMenu() + '获取Access_Token + Access_Token = Get_Access_Token + s_url = "https://api.weixin.qq.com/cgi-bin/menu/delete?access_token="&Access_Token + '发送请求，返回正确值为：{"errcode":0,"errmsg":"ok"} + GetMenu = HttpSend(s_url,"get","") + End Function + + '用户分组管理 + '========================================================================================================================= + '创建分组 + Public Function AddGroup(s_name) + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/groups/create?access_token="&Access_Token + '{"group":{"name":"test"}} + s_post="{""group"":{""name"":"""&s_name&"""}}" + '发送请求，返回正确值为：{"group": {"id": 107, "name": "test"}}，错误{"errcode":40013,"errmsg":"invalid appid"} + AddGroup=HttpSend(s_url,"post",s_post) + End Function + + '查询所有分组 + Public Function GetGroup() + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/groups/get?access_token="&Access_Token + '发送请求，错误{"errcode":40013,"errmsg":"invalid appid"} + GetGroup=HttpSend(s_url,"get","") + End Function + + '修改分组名 + Public Function EditGroup(s_id,s_name) + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/groups/update?access_token="&Access_Token + '{"group":{"id":108,"name":"test2_modify2"}} + s_post="{""group"":{""id"":"&s_id&",""name"":"""&s_name&"""}}" + '发送请求，返回正确值为：{"errcode": 0, "errmsg": "ok"}，错误{"errcode":40013,"errmsg":"invalid appid"} + EditGroup=HttpSend(s_url,"post",s_post) + End Function + + '查询用户所在分组 + Public Function GetUserGroup(UserOpenID) + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/groups/getid?access_token="&Access_Token + '{"openid":"od8XIjsmk6QdVTETa9jLtGWA6KBc"} + s_post="{""openid"":"""&UserOpenID&"""}" + '发送请求，返回正确值为：{"groupid": 102}，错误{"errcode":40003,"errmsg":"invalid openid"} + GetUserGroup=HttpSend(s_url,"post",s_post) + End Function + + '修改用户分组 + Public Function EditUserGroup(UserOpenID,s_to_groupid) + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/groups/members/update?access_token="&Access_Token + '{"openid":"oDF3iYx0ro3_7jD4HFRDfrjdCM58","to_groupid":108} + s_post="{""openid"":"""&UserOpenID&""",""to_groupid"":"&s_to_groupid&"}" + '发送请求，返回正确值为：{"errcode": 0, "errmsg": "ok"}，错误{"errcode":40013,"errmsg":"invalid appid"} + EditUserGroup=HttpSend(s_url,"post",s_post) + End Function + + '二维码 + '========================================================================================================================= + '获取带参数的二维码的过程包括两步，首先创建二维码ticket，然后凭借ticket到指定URL换取二维码。 + '目前有2种类型的二维码，分别是临时二维码和永久二维码，前者有过期时间，最大为1800秒，但能够生成较多数量，后者无过期时间，数量较少（目前参数只支持1--100000） + '两种二维码分别适用于帐号绑定、用户来源统计等场景。 + + '创建临时二维码ticket + Public Function AddTempTicket(s_scene_id) + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/qrcode/create?access_token="&Access_Token + + '{"expire_seconds": 1800, "action_name": "QR_SCENE", "action_info": {"scene": {"scene_id": 123}}} + 'expire_seconds 该二维码有效时间，以秒为单位。 最大不超过1800。 + 'action_name 二维码类型，QR_SCENE为临时,QR_LIMIT_SCENE为永久 + 'action_info 二维码详细信息 + 'scene_id 场景值ID，临时二维码时为32位非0整型，永久二维码时最大值为100000（目前参数只支持1--100000） + s_post="{""expire_seconds"": 1800, ""action_name"": ""QR_SCENE"", ""action_info"": {""scene"": {""scene_id"": "&s_scene_id&"}}}" + + '发送请求 + AddTempTicket=HttpSend(s_url,"post",s_post) + '正确返回： + '{"ticket":"gQG28DoAAAAAAAAAASxodHRwOi8vd2VpeGluLnFxLmNvbS9xL0FNMRnNRAAIEesLvUQMECAcAAA==","expire_seconds":1800} + '错误返回 + '{"errcode":40013,"errmsg":"invalid appid"} + End Function + + '创建永久二维码ticket + Public Function AddLongTicket(s_scene_id) + '获取Access_Token + Access_Token=Get_Access_Token + s_url="https://api.weixin.qq.com/cgi-bin/qrcode/create?access_token="&Access_Token + + '{"action_name": "QR_LIMIT_SCENE", "action_info": {"scene": {"scene_id": 123}}} + s_post="{""action_name"": ""QR_LIMIT_SCENE"", ""action_info"": {""scene"": {""scene_id"": "&s_scene_id&"}}}" + + '发送请求 + AddLongTicket=HttpSend(s_url,"post",s_post) + End Function + + '通过ticket换取二维码 + Public Function GetQrCode(s_ticket) + '获取二维码ticket后，开发者可用ticket换取二维码图片。 + '请注意，本接口无须登录态即可调用。 + '提醒： TICKET记得进行UrlEncode + s_url="https://mp.weixin.qq.com/cgi-bin/showqrcode?ticket="&Server.URLEncode(s_ticket) + + '发送请求 + GetQrCode=HttpSend(s_url,"get","") + 'ticket正确情况下，http 返回码是200，是一张图片，可以直接展示或者下载。 + 'HTTP头（示例）如下： + 'Accept-Ranges:bytes + 'Cache-control:max-age=604800 + 'Connection:keep-alive + 'Content-Length:28026 + 'Content-Type:image/jpg + 'Date:Wed, 16 Oct 2013 06:37:10 GMT + 'Expires:Wed, 23 Oct 2013 14:37:10 +0800 + 'Server:nginx/1.4.1 + '错误情况下（如ticket非法）返回HTTP错误码404。 + End Function + + + '公共方法 + '========================================================================================================================= + + '提交Http的GET或POST请求，并得到返回的结果 + Private Function HttpSend(url,stype,s_data) + 'Easp.Use "Http" + Dim http + Set Http = Easp.Http.New + IF Easp.Has(s_data) Then Http.Data=s_data + IF lcase(stype)="post" Then + HttpSend = Http.Post(url) + Else + HttpSend = Http.Get(url) + End IF + Set http = Nothing + End Function + +End Class +%> \ No newline at end of file -- Gitee