DES 算法对字符串加、解密算法的源码

Question

如提

Answer 1

直接加密和解密算法:{*******************************************************}
{                                                       }
{  Decrypt                                              }
{                                                       }
{  bitwise compare of each characters XOR 27            }
{                                                       }
{  Return string which after bitwise compare            }
{                                                       }
{*******************************************************}
function Decrypt(s: string; Key: Integer = 27): string;
var
  i: Integer;
begin
  Result := s;
  for i := 1 to Length(s) do
    Result[i] := Chr(Ord(s[i]) xor Key);
end;{*******************************************************}
{                                                       }
{  Encrypt                                              }
{                                                       }
{  Call again Decrypt to back to origin                 }
{                                                       }
{  Return string which after bitwise compare            }
{                                                       }
{*******************************************************}
function Encrypt(s: string; Key : Integer =27): string;
begin
  Result := Decrypt(s, Key);
end;

Answer 2

TO:  Wally_wu(韦利),喂喂..要的可是DES算法.我这儿倒有C的DES算法,网上一搜索也有一堆,但大多重用性不好..

Answer 3

http://members.lycos.co.uk/netvideo/download/src/crypto.htm
那里有c语言的

Answer 4

halfdream(哈欠) 
你知不什么是DES，DES就是直接加密算法，它有复杂的，也有简单的，不是写到看不明白的就是DES呀！！！！
另外一个是RSA，这种通常是用在公钥机制上。

Answer 5

你去网上找吧,很多的!
你先看看DES算法是怎么来实现的,然后自己写,很简单的,我这有VC的,要吗?

Answer 6

////////Begin Source
function EditVisibleText(mEdit: TEdit): string;
var
  X, Y, L: Integer;
  S: string;
begin
  Result := '';
  if not Assigned(mEdit) then Exit;
  with mEdit do try
    S := Text;
    L := Length(S);
    X := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(2, 2));
    X := X and $0000FFFF;
    Y := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(ClientWidth - 4, 2));
    Y := Y and $0000FFFF;
    for X := X to Y - 1 do if (Y >= 0) and (X < L) then
      Result := Result + S[X + 1];
  except
    Result := '';
  end;
end; { EditVisibleText }function MemoVisibleText(mMemo: TMemo; mStrings: TStrings): Boolean;
var
  I, X, Y: Integer;
  L, H, W: Integer;
  S: string;
  T: string;
begin
  Result := False;
  if (not Assigned(mMemo)) or (not Assigned(mStrings)) then Exit;
  with TControlCanvas.Create do try
    Control := mMemo;
    H := TextHeight('|');
  finally
    Free;
  end;
  mStrings.Clear;
  with mMemo do try
    S := Text;
    L := Length(S);
    W := ClientWidth;
    for I := 0 to (ClientHeight div H) - 1 do begin
      X := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(3, I * H + 2));
      X := X and $0000FFFF;
      Y := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(5, I * H + 2));
      Y := Y and $0000FFFF;
      if Abs(Y - X) > 1 then Inc(X);
      if not ((X = 0) or ((X < L) and (S[X - 1] in [#13, #10]))) then Inc(X);
      Y := SendMessage(Handle, EM_CHARFROMPOS, 0, MAKELPARAM(W - 2, I * H + 2));
      Y := Y and $0000FFFF;
      T := '';
      for X := X to Y - 1 do if (Y >= 0) and (X < L) then
        T := T + S[X + 1];
      mStrings.Add(T);
    end;
  except
    Exit;
  end;
  Result := True;
end; { MemoVisibleText }
////////End Source////////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  MemoVisibleText(Memo1, Memo2.Lines);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  Caption := EditVisibleText(Edit1);
end;
////////End Demo
(*//
标题:字符串加密;pascal字符表示
说明:应用于文件加密
设计:Zswang
日期:2002-02-19
支持:[email protected]
//*)///////Begin Source
function StringToDisplay(mString: string): string;
var
  I: Integer;
  S: string;
begin
  Result := '';
  S := '';
  for I := 1 to Length(mString) do
    if mString[I] in [#32..#127] then
      S := S + mString[I]
    else begin
      if S <> '' then begin
        Result := Result + QuotedStr(S);
        S := '';
      end;
      Result := Result + Format('#$%x', [Ord(mString[I])]);
    end;
  if S <> '' then Result := Result + QuotedStr(S);
end; { StringToDisplay }function DisplayToString(mDisplay: string): string;
var
  I: Integer;
  S: string;
  B: Boolean;
begin
  Result := '';
  B := False;
  mDisplay := mDisplay;
  for I := 1 to Length(mDisplay) do
    if B then case mDisplay[I] of
      '''': begin
        if S <> '' then Result := Result + StringReplace(S, '''''', '''', [rfReplaceAll]);
          if Copy(mDisplay, I + 1, 1) = '''' then Result := Result + '''';
          S := '';
          B := False;
        end;
      else S := S + mDisplay[I];
      end
    else case mDisplay[I] of
      '#', '''': begin
        if S <> '' then Result := Result + Chr(StrToIntDef(S, 0));
        S := '';
        B := mDisplay[I] = '''';
      end;
      '$', '0'..'9', 'a'..'f', 'A'..'F': S := S + mDisplay[I];
    end;
  if (not B) and (S <> '') then Result := Result + Chr(StrToIntDef(S, 0));
end; { DisplayToString }function StringEncrypt(mStr: string; mKey: string): string;
var
  I, J: Integer;
begin
  J := 1;
  Result := '';
  for I := 1 to Length(mStr) do begin
    Result := Result + Char(Ord(mStr[I]) xor Ord(mKey[J]));
    if J + 1 <= Length(mKey) then
      Inc(J)
    else J := 1;
  end;
  { 自己加步骤 }
end; { StringEncrypt }function StringDecrypt(mStr: string; mKey: string): string;
var
  I, J: Integer;
begin
  J := 1;
  Result := '';
  { 自己加步骤 }
  for I := 1 to Length(mStr) do begin
    Result := Result + Char(Ord(mStr[I]) xor Ord(mKey[J]));
    if J + 1 <= Length(mKey) then
      Inc(J)
    else J := 1;
  end;
end; { StringDecrypt }
///////End Source///////Begin Demo
const
  cKey = '给你这一把钥匙,只能打开这一把锁';procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.Text := StringToDisplay(StringEncrypt(Memo1.Text, cKey));
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Text := StringDecrypt(DisplayToString(Memo2.Text), cKey);
end;
///////End Demo

Answer 7

我这有一段完整代码，加密是用vbscript写的（用在ASP上），解密是用Delphi写的,虽然简单，
但适用于任何字符串的加密与解密。
加密：
function Add(S1,S2) ''''''''''''''S1为传入参数，S2为传出参数      
PassWords="abcd1234"
if len(S1)>=len(PassWords) then
  Flag=True
else Flag=False
end if
Select Case Flag
  case True
    For i = 0 To Len(S1) - 1
    If j >= Len(PassWords) - 1 Then
      j = 0
    End If
    If (Asc(Mid(S1,i+1,1)) Xor Asc(Mid(PassWords,j+1,1))) = 0 Then 
      S2 = S2 & Chr(255)
    else  
      S2 = S2 & Chr(Asc(Mid(S1,i+1,1)) Xor Asc(Mid(PassWords,j+1,1)))  
    end if
    j = j + 1
  Next  
  case False
  for i=0 to len(S1)-1
    
    If (Asc(Mid(S1,i+1,1)) Xor Asc(Mid(PassWords,i+1,1))) = 0 Then 
      S2 = S2 & Chr(255)
    else
      S2=S2 & Chr(Asc(Mid(PassWords,i+1,1)) xor Asc(Mid(S1,i+1,1)))
    end if  
  next 
End Select  
End function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
解密：
///////////////解密过程
procedure Tstartbrowser.JM(S1:string;var S2:string);  //////S1为传入参数，S2为传出参数
var
  Flag:Boolean;
  PassWord:string;
  i,j:integer;
begin
  PassWord:='abcd1234';
  S2:='';
  If Length(S1)>=Length(PassWord) Then
   Flag:=True
  Else
   Flag:=False;
  j:=0;                                 
  Case Flag of
  True:
  For i:=0 To Length(S1)-1 do
  begin
    If j>=Length(PassWord)-1 Then
      j:=0;
    If Ord(S1[i+1])=255 Then S1[i+1]:=Chr(0);
    S2:=S2+Chr(Ord(S1[i+1])Xor Ord(PassWord[j+1]));
    j:=j+1;
  end;
  False:
  For i:=0 To Length(S1)-1 do
  begin
  If Ord(S1[i+1])=255 Then S1[i+1]:=Chr(0);
    S2:=S2+Chr(Ord(S1[i+1])Xor Ord(PassWord[i+1]));
  end;  End;
end;
////////////////////////////////////////////////////////////////
用在BS结构上，完全没问题。