求一个中文字符串加密函数～～～～

Question

如题，算法不要简单，XOR,BASE64就算了。
多谢！

Answer 1

function EqLenCrypt(const Src: String; Key: Word;Encrypt:Boolean):String;
var
  i:Integer;
  b:Byte;
  mc:Char;
  Map,Map0:array[0..255]of Char;
begin
  for i:=0 to 255 do
    Map[i]:=Char(i);
  for i:=127 downto 2 do //根据Key生成映射表
  begin
    b:=Byte(Key mod (i-1))+1;
    mc:=Map[i];
    Map[i]:=Map[b];
    Map[b]:=mc;    b:=Byte(Key mod (i-1))+128;
    mc:=Map[i+127];
    Map[i+127]:=Map[b];
    Map[b]:=mc;
  end;
  if not Encrypt then
  begin //用于解密的逆映射表
    Move(Map[0],Map0[0],SizeOf(Map));
    for i:=0 to 255 do
      Map[Byte(Map0[i])]:=Char(i);
  end;
  SetLength(Result,Length(Src));
  for i:=1 to Length(Src) do
    Result[i]:=Map[Byte(Src[i])];
end;

Answer 2

to wrl001(我爱爱我) ( )  解密的呢？也在那个程序里？能提取出来一个么
还有么？顶一下再。

Answer 3

{============================================================================
所属：    
主题：    DeCode对加密字符串解密
入口参数：sPWD---待加密的字符串 sKey---密锁（暂时未用）
返回值：   无
核心算法：
作者：    
时间：    2004-10-23
版本：    v1.0.0
更新：    (说明更新人、更新时间和更新后的版本号)
============================================================================}
function DeCode(sPWD:string):string;
var
  i,iLen:Integer;
begin
  Result := sPWD;
  Exit;
 if Trim(sPwd)<>'' then
     begin
        //得到密码长度
        iLen:=Length(sPWD);
        SetLength(Result,iLen);        for i:=1 to iLen do
          Result[i]:=Chr(Ord(sPwd[i])-iLen+15);
      end
   else
     Result :='';
end;

Answer 4

//MD5是个不可逆推的加密函数，解密只需自己自己对应即可：
function MD_dzt(sMessage:WideString):WideString;
  //把十六精制字符串转化为10精制数
  function HexToInt(Hex: String): Int64;
  var
    i, Len: integer;
    B: Byte;
  begin
    Result := 0;
    Len := Length(Hex);    if Len > 15 then Len := 15;    for i := 1 to Len do
      begin
        B := Ord(Hex[i]);
        if B in [48..64] then
          Result := Result * 16 + (B - 48)
        else if B in [97..122] then
          Result := Result * 16 + (B - 87);//Power(16, i);
      end;  end;
  
  //把十六精制字符串转化为0..9和a..z
  function GetABC(const S:string): String;  
  var
    Temp1, Temp2, Temp3: String;
    I64: Int64;
  begin
    Temp1 := '';
    Temp2 := S;
    while Temp2 <> '' do
      begin
        Temp3 := LeftStr(Temp2, 15);
        I64 := HexToInt(Temp3);        Temp3 := '';
        while I64 > 0 do
          begin
            Temp3 := Temp3 + Conss[I64 mod 36 + 1];
            I64 := I64 div 36;
          end;        Temp1 := Temp1 + Temp3;
        Delete(Temp2, 1, 15);
      end;
    Result := Temp1;
  end;  function RotateLeft(lValue, iShiftBits:integer):integer;
  begin
    result := (lValue shl iShiftBits)  or  (lValue shr (32-iShiftBits));
  end;  function AddUnsigned(lX,lY:integer):integer;
  var
    lX4,lY4,lX8,lY8,lResult:integer;
  begin
    lX8 := (lX  and  $80000000);
    lY8 := (lY  and  $80000000);
    lX4 := (lX  and  $40000000);
    lY4 := (lY  and  $40000000);
    lResult := (lX  and  $3FFFFFFF)+(lY  and  $3FFFFFFF);
    if (lX4  and  lY4) <> 0 then begin result := (lResult xor $80000000 xor lX8 xor lY8); Exit; end;
    if (lX4  or  lY4) <> 0 then
    begin
      if (lResult  and  $40000000) <>0 then
        begin result :=  (lResult xor $C0000000 xor lX8 xor lY8); end
      else
        begin result :=  (lResult xor $40000000 xor lX8 xor lY8); end
    end
    else
      begin result :=  (lResult xor lX8 xor lY8); end
  end;  function F(x,y,z:integer):integer; begin  result :=  (x  and  y)  or  (( not x)  and  z); end;
  function G(x,y,z:integer):integer; begin  result :=  (x  and  z)  or  (y  and  ( not z)); end;
  function H(x,y,z:integer):integer; begin  result :=  (x xor y xor z); end;
  function I(x,y,z:integer):integer; begin  result :=  (y xor (x  or  ( not z))); end;  function FF(a,b,c,d,x,s,ac:integer):integer;
  begin
    a := AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac));
    result :=  AddUnsigned(RotateLeft(a, s), b);
  end;
  function GG(a,b,c,d,x,s,ac:integer):integer;
  begin
    a := AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac));
    result :=  AddUnsigned(RotateLeft(a, s), b);
  end;
  function HH(a,b,c,d,x,s,ac:integer):integer;
  begin
    a := AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac));
    result :=  AddUnsigned(RotateLeft(a, s), b);
  end;
  function II(a,b,c,d,x,s,ac:integer):integer;
  begin
    a := AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac));
    result :=  AddUnsigned(RotateLeft(a, s), b);
  end;  type IntArray = array of integer;
  function ConvertToWordArray(sMessage:WideString):IntArray;
  var lWordCount:integer;
  var lMessageLength:integer;
  var lNumberOfWords_temp1:integer;
  var lNumberOfWords_temp2:integer;
  var lNumberOfWords:integer;
  var lWordArray:IntArray;
  var lBytePosition:integer;
  var lByteCount:integer;
  begin
    lMessageLength := length(sMessage);
    lNumberOfWords_temp1:=lMessageLength + 8;
    lNumberOfWords_temp2:=(lNumberOfWords_temp1-(lNumberOfWords_temp1  mod  64)) div 64;
    lNumberOfWords := (lNumberOfWords_temp2+1)*16;
    SetLength(lWordArray,lNumberOfWords);
    lBytePosition := 0;
    lByteCount := 0;
    while ( lByteCount < lMessageLength ) do
    begin
      lWordCount := (lByteCount-(lByteCount  mod  4)) div 4;
      lBytePosition := (lByteCount  mod  4)*8;
      lWordArray[lWordCount] := (lWordArray[lWordCount]  or  (ord(sMessage[lByteCount+1]) shl lBytePosition));
      inc(lByteCount);
    end;
    lWordCount := (lByteCount-(lByteCount  mod  4)) div 4;
    lBytePosition := (lByteCount  mod  4)*8;
    lWordArray[lWordCount] := lWordArray[lWordCount]  or  ($80 shl lBytePosition);
    lWordArray[lNumberOfWords-2] := lMessageLength shl 3;
    lWordArray[lNumberOfWords-1] := lMessageLength shr 29;
    result :=  lWordArray;
  end;  function WordToHex(lValue:integer):WideString;
  var WordToHexValue,WordToHexValue_temp:WideString;
    lByte,lCount:integer;
  begin
    Result := '';
    for lCount := 0 to 3 do
    begin
      lByte := (lValue shr (lCount*8))  and  255;
      result := result + IntToHex(lByte,2);
    end;
  end;var x:IntArray;
  k,AA,BB,CC,DD,a,b,c,d:integer;
const S11:integer=7;
  S12:integer=12;
  S13:integer=17;
  S14:integer=22;  S21:integer=5;
  S22:integer=9 ;
  S23:integer=14;
  S24:integer=20;  S31:integer=4;
  S32:integer=11;
  S33:integer=16;
  S34:integer=23;
  S41:integer=6;
  S42:integer=10;
  S43:integer=15;
  S44:integer=21;

Answer 5

begin
   //  Steps 1 and 2. Append padding bits and length and convert to words
  x := ConvertToWordArray(sMessage);
   //  Step 3. Initialise
  a := $67452301; b := $EFCDAB89; c := $98BADCFE; d := $10325476;
   //  Step 4. Process the message in 16-word blocks
  k :=0 ;
  while k< length(x) do
  //for (k=0;k<x.length;k+=16)
  begin
    AA:=a; BB:=b; CC:=c; DD:=d;
    a:=FF(a,b,c,d,x[k+0], S11,$D76AA478);
    d:=FF(d,a,b,c,x[k+1], S12,$E8C7B756);
    c:=FF(c,d,a,b,x[k+2], S13,$242070DB);
    b:=FF(b,c,d,a,x[k+3], S14,$C1BDCEEE);
    a:=FF(a,b,c,d,x[k+4], S11,$F57C0FAF);
    d:=FF(d,a,b,c,x[k+5], S12,$4787C62A);
    c:=FF(c,d,a,b,x[k+6], S13,$A8304613);
    b:=FF(b,c,d,a,x[k+7], S14,$FD469501);
    a:=FF(a,b,c,d,x[k+8], S11,$698098D8);
    d:=FF(d,a,b,c,x[k+9], S12,$8B44F7AF);
    c:=FF(c,d,a,b,x[k+10],S13,$FFFF5BB1);
    b:=FF(b,c,d,a,x[k+11],S14,$895CD7BE);
    a:=FF(a,b,c,d,x[k+12],S11,$6B901122);
    d:=FF(d,a,b,c,x[k+13],S12,$FD987193);
    c:=FF(c,d,a,b,x[k+14],S13,$A679438E);
    b:=FF(b,c,d,a,x[k+15],S14,$49B40821);
    a:=GG(a,b,c,d,x[k+1], S21,$F61E2562);
    d:=GG(d,a,b,c,x[k+6], S22,$C040B340);
    c:=GG(c,d,a,b,x[k+11],S23,$265E5A51);
    b:=GG(b,c,d,a,x[k+0], S24,$E9B6C7AA);
    a:=GG(a,b,c,d,x[k+5], S21,$D62F105D);
    d:=GG(d,a,b,c,x[k+10],S22,$2441453);
    c:=GG(c,d,a,b,x[k+15],S23,$D8A1E681);
    b:=GG(b,c,d,a,x[k+4], S24,$E7D3FBC8);
    a:=GG(a,b,c,d,x[k+9], S21,$21E1CDE6);
    d:=GG(d,a,b,c,x[k+14],S22,$C33707D6);
    c:=GG(c,d,a,b,x[k+3], S23,$F4D50D87);
    b:=GG(b,c,d,a,x[k+8], S24,$455A14ED);
    a:=GG(a,b,c,d,x[k+13],S21,$A9E3E905);
    d:=GG(d,a,b,c,x[k+2], S22,$FCEFA3F8);
    c:=GG(c,d,a,b,x[k+7], S23,$676F02D9);
    b:=GG(b,c,d,a,x[k+12],S24,$8D2A4C8A);
    a:=HH(a,b,c,d,x[k+5], S31,$FFFA3942);
    d:=HH(d,a,b,c,x[k+8], S32,$8771F681);
    c:=HH(c,d,a,b,x[k+11],S33,$6D9D6122);
    b:=HH(b,c,d,a,x[k+14],S34,$FDE5380C);
    a:=HH(a,b,c,d,x[k+1], S31,$A4BEEA44);
    d:=HH(d,a,b,c,x[k+4], S32,$4BDECFA9);
    c:=HH(c,d,a,b,x[k+7], S33,$F6BB4B60);
    b:=HH(b,c,d,a,x[k+10],S34,$BEBFBC70);
    a:=HH(a,b,c,d,x[k+13],S31,$289B7EC6);
    d:=HH(d,a,b,c,x[k+0], S32,$EAA127FA);
    c:=HH(c,d,a,b,x[k+3], S33,$D4EF3085);
    b:=HH(b,c,d,a,x[k+6], S34,$4881D05);
    a:=HH(a,b,c,d,x[k+9], S31,$D9D4D039);
    d:=HH(d,a,b,c,x[k+12],S32,$E6DB99E5);
    c:=HH(c,d,a,b,x[k+15],S33,$1FA27CF8);
    b:=HH(b,c,d,a,x[k+2], S34,$C4AC5665);
    a:=II(a,b,c,d,x[k+0], S41,$F4292244);
    d:=II(d,a,b,c,x[k+7], S42,$432AFF97);
    c:=II(c,d,a,b,x[k+14],S43,$AB9423A7);
    b:=II(b,c,d,a,x[k+5], S44,$FC93A039);
    a:=II(a,b,c,d,x[k+12],S41,$655B59C3);
    d:=II(d,a,b,c,x[k+3], S42,$8F0CCC92);
    c:=II(c,d,a,b,x[k+10],S43,$FFEFF47D);
    b:=II(b,c,d,a,x[k+1], S44,$85845DD1);
    a:=II(a,b,c,d,x[k+8], S41,$6FA87E4F);
    d:=II(d,a,b,c,x[k+15],S42,$FE2CE6E0);
    c:=II(c,d,a,b,x[k+6], S43,$A3014314);
    b:=II(b,c,d,a,x[k+13],S44,$4E0811A1);
    a:=II(a,b,c,d,x[k+4], S41,$F7537E82);
    d:=II(d,a,b,c,x[k+11],S42,$BD3AF235);
    c:=II(c,d,a,b,x[k+2], S43,$2AD7D2BB);
    b:=II(b,c,d,a,x[k+9], S44,$EB86D391);
    a:=AddUnsigned(a,AA); b:=AddUnsigned(b,BB); c:=AddUnsigned(c,CC); d:=AddUnsigned(d,DD);
    inc (k,16);
  end;
  result := GetABC(LowerCase(WordToHex(a)+WordToHex(b)+WordToHex(c)+WordToHex(d)));
end;