<%
  ''微软Encoder加密解密
  ''暂时只支持中文，英文，其他语言未测试
  ''Author:amuie@126.com

Private Ary, En, SB, StrStartFlag, StrEndFlag

Private Sub Class_Initialize()
    Set En = Server.CreateObject("Scripting.Encoder")
    Set SB = App.Str.StringBuilder()
StrStartFlag = App.Str.RegexpEncode("#@~^")
  StrEndFlag = App.Str.RegexpEncode("==^#~@")
Ary = Array( _
    &h00, &h00, &h00, &h01, &h01, &h01, &h02, &h02, &h02, &h03, &h03, &h03, &h04, &h04, &h04, &h05, &h05, &h05, &h06, &h06, _
      &h06, &h07, &h07, &h07, &h08, &h08, &h08, &h57, &h6E, &h7B, &h00, &h00, &h00, &h0B, &h0B, &h0B, &h0C, &h0C, &h0C, &h00, _
    &h00, &h00, &h0E, &h0E, &h0E, &h0F, &h0F, &h0F, &h10, &h10, &h10, &h11, &h11, &h11, &h12, &h12, &h12, &h13, &h13, &h13, _
    &h14, &h14, &h14, &h15, &h15, &h15, &h16, &h16, &h16, &h17, &h17, &h17, &h18, &h18, &h18, &h19, &h19, &h19, &h1A, &h1A, _
    &h1A, &h1B, &h1B, &h1B, &h1C, &h1C, &h1C, &h1D, &h1D, &h1D, &h1E, &h1E, &h1E, &h1F, &h1F, &h1F, &h2E, &h2D, &h32, &h47, _
      &h75, &h30, &h7A, &h52, &h21, &h56, &h60, &h29, &h42, &h71, &h5B, &h6A, &h5E, &h38, &h2F, &h49, &h33, &h26, &h5C, &h3D, _
  &h49, &h62, &h58, &h41, &h7D, &h3A, &h34, &h29, &h35, &h32, &h36, &h65, &h5B, &h20, &h39, &h76, &h7C, &h5C, &h72, &h7A, _
      &h56, &h43, &h7F, &h73, &h38, &h6B, &h66, &h39, &h63, &h4E, &h70, &h33, &h45, &h45, &h2B, &h6B, &h68, &h68, &h62, &h71, _
  &h51, &h59, &h4F, &h66, &h78, &h09, &h76, &h5E, &h62, &h31, &h7D, &h44, &h64, &h4A, &h23, &h54, &h6D, &h75, &h43, &h71, _
      &h00, &h00, &h00, &h7E, &h3A, &h60, &h00, &h00, &h00, &h5E, &h7E, &h53, &h40, &h00, &h40, &h77, &h45, &h42, &h4A, &h2C, _
      &h27, &h61, &h2A, &h48, &h5D, &h74, &h72, &h22, &h27, &h75, &h4B, &h37, &h31, &h6F, &h44, &h37, &h4E, &h79, &h4D, &h3B, _
      &h59, &h52, &h4C, &h2F, &h22, &h50, &h6F, &h54, &h67, &h26, &h6A, &h2A, &h72, &h47, &h7D, &h6A, &h64, &h74, &h39, &h2D, _
      &h54, &h7B, &h20, &h2B, &h3F, &h7F, &h2D, &h38, &h2E, &h2C, &h77, &h4C, &h30, &h67, &h5D, &h6E, &h53, &h7E, &h6B, &h47, _
      &h6C, &h66, &h34, &h6F, &h35, &h78, &h79, &h25, &h5D, &h74, &h21, &h30, &h43, &h64, &h23, &h26, &h4D, &h5A, &h76, &h52, _
      &h5B, &h25, &h63, &h6C, &h24, &h3F, &h48, &h2B, &h7B, &h55, &h28, &h78, &h70, &h23, &h29, &h69, &h41, &h28, &h2E, &h34, _
      &h73, &h4C, &h09, &h59, &h21, &h2A, &h33, &h24, &h44, &h7F, &h4E, &h3F, &h6D, &h50, &h77, &h55, &h09, &h3B, &h53, &h56, _
    &h55, &h7C, &h73, &h69, &h3A, &h35, &h61, &h5F, &h61, &h63, &h65, &h4B, &h50, &h46, &h58, &h67, &h58, &h3B, &h51, &h31, _
    &h57, &h49, &h69, &h22, &h4F, &h6C, &h6D, &h46, &h5A, &h4D, &h68, &h48, &h25, &h7C, &h27, &h28, &h36, &h5C, &h46, &h70, _
  &h3D, &h4A, &h6E, &h24, &h32, &h7A, &h79, &h41, &h2F, &h37, &h3D, &h5F, &h60, &h5F, &h4B, &h51, &h4F, &h5A, &h20, &h42, _
      &h2C, &h36, &h65, &h57, &h80, &h80, &h80, &h81, &h81, &h81, &h82, &h82, &h82, &h83, &h83, &h83, &h84, &h84, &h84, &h85, _
      &h85, &h85, &h86, &h86, &h86, &h87, &h87, &h87, &h88, &h88, &h88, &h89, &h89, &h89, &h8A, &h8A, &h8A, &h8B, &h8B, &h8B, _
      &h8C, &h8C, &h8C, &h8D, &h8D, &h8D, &h8E, &h8E, &h8E, &h8F, &h8F, &h8F, &h90, &h90, &h90, &h91, &h91, &h91, &h92, &h92, _
      &h92, &h93, &h93, &h93, &h94, &h94, &h94, &h95, &h95, &h95, &h96, &h96, &h96, &h97, &h97, &h97, &h98, &h98, &h98, &h99, _
      &h99, &h99, &h9A, &h9A, &h9A, &h9B, &h9B, &h9B, &h9C, &h9C, &h9C, &h9D, &h9D, &h9D, &h9E, &h9E, &h9E, &h9F, &h9F, &h9F, _
      &hA0, &hA0, &hA0, &hA1, &hA1, &hA1, &hA2, &hA2, &hA2, &hA3, &hA3, &hA3, &hA4, &hA4, &hA4, &hA5, &hA5, &hA5, &hA6, &hA6, _
      &hA6, &hA7, &hA7, &hA7, &hA8, &hA8, &hA8, &hA9, &hA9, &hA9, &hAA, &hAA, &hAA, &hAB, &hAB, &hAB, &hAC, &hAC, &hAC, &hAD, _
      &hAD, &hAD, &hAE, &hAE, &hAE, &hAF, &hAF, &hAF, &hB0, &hB0, &hB0, &hB1, &hB1, &hB1, &hB2, &hB2, &hB2, &hB3, &hB3, &hB3, _
      &hB4, &hB4, &hB4, &hB5, &hB5, &hB5, &hB6, &hB6, &hB6, &hB7, &hB7, &hB7, &hB8, &hB8, &hB8, &hB9, &hB9, &hB9, &hBA, &hBA, _
      &hBA, &hBB, &hBB, &hBB, &hBC, &hBC, &hBC, &hBD, &hBD, &hBD, &hBE, &hBE, &hBE, &hBF, &hBF, &hBF, &hC0, &hC0, &hC0, &hC1, _
    &hC1, &hC1, &hC2, &hC2, &hC2, &hC3, &hC3, &hC3, &hC4, &hC4, &hC4, &hC5, &hC5, &hC5, &hC6, &hC6, &hC6, &hC7, &hC7, &hC7, _
      &hC8, &hC8, &hC8, &hC9, &hC9, &hC9, &hCA, &hCA, &hCA, &hCB, &hCB, &hCB, &hCC, &hCC, &hCC, &hCD, &hCD, &hCD, &hCE, &hCE, _
      &hCE, &hCF, &hCF, &hCF, &hD0, &hD0, &hD0, &hD1, &hD1, &hD1, &hD2, &hD2, &hD2, &hD3, &hD3, &hD3, &hD4, &hD4, &hD4, &hD5, _
      &hD5, &hD5, &hD6, &hD6, &hD6, &hD7, &hD7, &hD7, &hD8, &hD8, &hD8, &hD9, &hD9, &hD9, &hDA, &hDA, &hDA, &hDB, &hDB, &hDB, _
      &hDC, &hDC, &hDC, &hDD, &hDD, &hDD, &hDE, &hDE, &hDE, &hDF, &hDF, &hDF, &hE0, &hE0, &hE0, &hE1, &hE1, &hE1, &hE2, &hE2, _
      &hE2, &hE3, &hE3, &hE3, &hE4, &hE4, &hE4, &hE5, &hE5, &hE5, &hE6, &hE6, &hE6, &hE7, &hE7, &hE7, &hE8, &hE8, &hE8, &hE9, _
      &hE9, &hE9, &hEA, &hEA, &hEA, &hEB, &hEB, &hEB, &hEC, &hEC, &hEC, &hED, &hED, &hED, &hEE, &hEE, &hEE, &hEF, &hEF, &hEF, _
      &hF0, &hF0, &hF0, &hF1, &hF1, &hF1, &hF2, &hF2, &hF2, &hF3, &hF3, &hF3, &hF4, &hF4, &hF4, &hF5, &hF5, &hF5, &hF6, &hF6, _
      &hF6, &hF7, &hF7, &hF7, &hF8, &hF8, &hF8, &hF9, &hF9, &hF9, &hFA, &hFA, &hFA, &hFB, &hFB, &hFB, &hFC, &hFC, &hFC, &hFD, _
      &hFD, &hFD, &hFE, &hFE, &hFE, &hFF, &hFF, &hFF _
    )
End sub

Private Sub Class_Terminate
   Set En = Nothing
    Set SB = Nothing
  End Sub

''微软Encoder加密
  Public Default Function Encoder(ByVal Str)
    If App.Str.EndsWith(Str, ".asp") Then Str = App.Router.Read(Str)
  ''去除结尾占位符nul
  Encoder = App.Str.Nul(En.EncodeScriptFile(".vbs", Str, 0, "VBScript"))
  End Function

  ''微软Encoder解密
  Public Function Decoder(ByVal Str)
    Dim Match, Matches, Rule
  If App.Str.EndsWith(Str, ".asp") Then Str = App.Fso.Read(Str)
  Rule = StrStartFlag & ".+?[^" & StrStartFlag & "]" & StrEndFlag
    If App.Str.Test(Str, Rule) Then
    Set Matches = App.Str.Match(Str, Rule)
    For Each Match In Matches
    Str = Replace(Str, Match.Value, DECR(Match.Value))
    Next
  Set Matches = Nothing
    Else
    Str = "Invalid Encoder Encryption"
  End If
  Decoder = App.Str.HtmlEncode(Str)
  End Function

  ''解码
  Private Function DECR(ByVal Str)
    Dim i, x : x = 0
    Dim LAddition, Ascii, LAscii, Index, LIndex
    ''去除前后参数
    Str = Mid(Left(Str, Len(Str) - 12), 13)
    For i = 1 To Len(Str)
      Ascii = Mid(Str, i, 1)
      ''判断中文以及全角符号直接显示
      If Abs(Ascw(Ascii)) > 127 Then
        SB.Append Ascii
      Else
        ''转换解码特殊字符，前进一位
        ''@# \r, @& \n, @! <, @* >, @$ @
        If Ascii = "@" Then
          Index = InStr(1, "!*$#&", Mid(Str, i + 1, 1))
          ''对比无特殊字符外直接显示
          If Index = 0 Then
            LAscii = Asc(Ascii)
            LAddition = Addition(i)
            LIndex = (LAscii * 3) + LAddition
            SB.Append Chr(Ary(LIndex))
          Else
            SB.Append Mid("<>@" & vbCrLf, Index, 1)
            i = i + 1
          End If
        Else
          LAscii = Asc(Ascii)
          LAddition = Addition(x)
          LIndex = (LAscii * 3) + LAddition
          SB.Append Chr(Ary(LIndex))
        End If
        x = x + 1
      End If
    Next
    DECR = SB.ToString
    SB.Clear
  End Function

  Private Function Addition(ByRef pLngPosition)
    Addition = CInt(Mid("0120121221210212021200122102122100212120200120210212001220012021", (pLngPosition Mod 64) + 1, 1))
  End Function

%>