const
  C1=52845; //字符串加密算法的公匙
  C2=22719; //字符串加密算法的公匙function TransChar(AChar: Char): Integer;
begin
   if AChar in ['0'..'9'] then
      Result := Ord(AChar) - Ord('0')
   else
      Result := 10 + Ord(AChar) - Ord('A');
end;function HexToStr(AStr: string): string;
var
   I : Integer;
   CharValue: Word;
   begin
   Result := '';
   for I := 1 to Trunc(Length(Astr)/2) do
   begin
      Result := Result + ' ';
      CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);
      Result[I] := Char(CharValue);
   end;
end;function Decrypt(const S: String; Key: Word): String;
var
   I: Integer;
   S1: string;
begin
   S1 := HexToStr(S);
   Result := S1;
   for I := 1 to Length(S1) do
   begin
      if char(byte(S1[I]) xor (Key shr 8)) = Chr(0) then
         begin
            Result[I] := S1[I];
            Key := (byte(Chr(0)) + Key) * C1 + C2; //保证Key的正确性  
         end
      else
         begin
            Result[I] := char(byte(S1[I]) xor (Key shr 8));
            Key := (byte(S1[I]) + Key) * C1 + C2;
         end;
   end;
end;

解决方案 »

  1.   

    要下班了,没翻译完,只翻译了两个函数,LZ参考使用吧<%Const C1=52845 '//字符串加密算法的公匙
    Const C2=22719 '//字符串加密算法的公匙
      
    Function TransChar(AChar)
    If Asc(AChar) >= &h30 And Asc(AChar <= &h39) Then
    TransChar = Asc(AChar) - Asc("0")
    Else
    TransChar = 10 + Asc(AChar) - Asc("A")
    End If
    End FunctionFunction HexToStr(AStr)
    Dim I, CharValue, Result, ss1, ss2
      Result = ""
      For I = 1 To Len(Astr) \ 2
       ss1 = Mid(AStr, 2 * I -1, 1)
       ss2 = Mid(AStr, 2 * I, 1)
       CharValue = TransChar(ss1) * 16 + TransChar(ss2)
       Result = Result & Chr(CharValue)
    Next
    HexToStr = Result
    End Function
    Function Decrypt(S, Key)End Function
    %>
      

  2.   

    上面两个函数修改如下:
    <%Const C1=52845 '//字符串加密算法的公匙
    Const C2=22719 '//字符串加密算法的公匙
      
    Function TransChar(AChar)
    If (AscW(AChar) >= &h30) And (AscW(AChar) <= &h39) Then
    TransChar = AscW(AChar) - AscW("0")
    Else
    TransChar = 10 + AscW(AChar) - AscW("A")
    End If
    End Function
    Function HexToStr(AStr)
    Dim I, CharValue, Result, ss1, ss2
      Result = ""
      For I = 1 To Len(Astr) \ 2
       ss1 = Mid(AStr, 2 * I -1, 1)
       ss2 = Mid(AStr, 2 * I, 1)
       CharValue = TransChar(ss1) * 16 + TransChar(ss2)
       Result = Result & ChrW(CharValue)
    Next
    HexToStr = Result
    End Function
    %>
    最后一个函数没找到翻译的方法,在Delphi中Word溢出后会自动截断,在ASP中没法截断(没找到方法)
      

  3.   

    <%
    C1=52845'字符串加密算法的公匙
    C2=22719'字符串加密算法的公匙function TransChar(AChar)
       if AChar >= "0" and AChar <="9" then
          TransChar = Asc(AChar) - Asc("0")
       else
          TransChar = 10+Asc(AChar) - Asc("A")
    end functionfunction HexToStr(AStr)
       Result = ""
       for I = 1 to Len(Astr)\2
          CharValue = TransChar(Mid(AStr,2*I-1,1))*16 + TransChar(Mid(AStr,2*I,1))
          Result = Result + Chr(CharValue)
       next
       HexToStr=Result
    end functionfunction Decrypt(S,Key)
       S1 = HexToStr(S)
       Result = ""
       for I = 1 to Len(S1) 
          if Chr(Asc(Mid(S1,I,1)) xor (Key \256 )) = Chr(0) then
                Result = Result+Mid(S1,I,1)
                Key = Key * C1 + C2 '保证Key的正确性  
          else
                Result =  Result+Chr(Asc(Mid(S1,I,1)) xor (Key \256))
                Key = (Asc(Mid(S1,I,1)) + Key) * C1 + C2
          end if
       next
       Decrypt=Result
    end function
    %>
      

  4.   

    wizardqi(男巫) 晕,代码有测试吗?
      

  5.   

    //以下代码通过MS VBScript Complier 5.6测试通过
    function TransChar(AChar)
       if AChar >= "0" and AChar <="9" then
          TransChar = Asc(AChar) - Asc("0")
       else
          TransChar = 10+Asc(AChar) - Asc("A")
       end if
    end functionfunction HexToStr(AStr)
       Result = ""
       for I = 1 to Len(Astr)\2
          CharValue = TransChar(Mid(AStr,2*I-1,1))*16 + TransChar(Mid(AStr,2*I,1))
          Result = Result + Chr(CharValue)
       next
       HexToStr=Result
    end functionfunction Decrypt(S,Key)
       S1 = HexToStr(S)
       Result = ""
       for I = 1 to Len(S1) 
          if Chr(Asc(Mid(S1,I,1)) xor (Key \256 )) = Chr(0) then
                Result = Result+Mid(S1,I,1)
                Key = Key * C1 + C2 '保证Key的正确性  
          else
                Result =  Result+Chr(Asc(Mid(S1,I,1)) xor (Key \256))
                Key = (Asc(Mid(S1,I,1)) + Key) * C1 + C2
          end if
       next
       Decrypt=Result
    end function