'加密函数
Function Encrypt(ByVal PlainStr As String, ByVal Key As String) As String
On Error Resume Next
Dim Char As String, KeyChar As String, NewStr As String
Dim Pos As Integer
Dim I As Integer, Side1 As String, Side2 As String
Pos = 1
For I = 1 To Len(PlainStr)
Char = Mid(PlainStr, I, 1)
KeyChar = Mid(Key, Pos, 1)
NewStr = NewStr & Chr(Asc(Char) Xor Asc(KeyChar))
If Pos = Len(Key) Then Pos = 0
Pos = Pos + 1
Next I
If Len(NewStr) Mod 2 = 0 Then
Side1 = StrReverse(Left(NewStr, (Len(NewStr) / 2)))
Side2 = StrReverse(Right(NewStr, (Len(NewStr) / 2)))
NewStr = Side1 & Side2
End If
Encrypt = NewStr
End Function'解密函数
Function Decrypt(PlainStr As String, Key As String)
Dim Char As String, KeyChar As String, NewStr As String
Dim Pos As Integer
Dim I As Integer, Side1 As String, Side2 As String
Pos = 1
If Len(PlainStr) Mod 2 = 0 Then
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2)))
PlainStr = Side1 & Side2
End If
For I = 1 To Len(PlainStr)
Char = Mid(PlainStr, I, 1)
KeyChar = Mid(Key, Pos, 1)
NewStr = NewStr & Chr(Asc(Char) Xor Asc(KeyChar))
If Pos = Len(Key) Then Pos = 0
Pos = Pos + 1
Next I
Decrypt = NewStr
End Function
Function Encrypt(ByVal PlainStr As String, ByVal Key As String) As String
On Error Resume Next
Dim Char As String, KeyChar As String, NewStr As String
Dim Pos As Integer
Dim I As Integer, Side1 As String, Side2 As String
Pos = 1
For I = 1 To Len(PlainStr)
Char = Mid(PlainStr, I, 1)
KeyChar = Mid(Key, Pos, 1)
NewStr = NewStr & Chr(Asc(Char) Xor Asc(KeyChar))
If Pos = Len(Key) Then Pos = 0
Pos = Pos + 1
Next I
If Len(NewStr) Mod 2 = 0 Then
Side1 = StrReverse(Left(NewStr, (Len(NewStr) / 2)))
Side2 = StrReverse(Right(NewStr, (Len(NewStr) / 2)))
NewStr = Side1 & Side2
End If
Encrypt = NewStr
End Function'解密函数
Function Decrypt(PlainStr As String, Key As String)
Dim Char As String, KeyChar As String, NewStr As String
Dim Pos As Integer
Dim I As Integer, Side1 As String, Side2 As String
Pos = 1
If Len(PlainStr) Mod 2 = 0 Then
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2)))
PlainStr = Side1 & Side2
End If
For I = 1 To Len(PlainStr)
Char = Mid(PlainStr, I, 1)
KeyChar = Mid(Key, Pos, 1)
NewStr = NewStr & Chr(Asc(Char) Xor Asc(KeyChar))
If Pos = Len(Key) Then Pos = 0
Pos = Pos + 1
Next I
Decrypt = NewStr
End Function
unit crypt;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation
uses StrUtils;
{$R *.dfm}Function Encrypt(PlainStr :String; Key :String) :String;
var
dchar,keychar:char;
newstr:string;
pos:integer;
i:integer;
Side1 , Side2 : String;
begin
// On Error Resume Next
Pos := 1;
For I := 1 To Length(PlainStr) do
begin
dChar := PlainStr[I];
KeyChar := Key[Pos] ;
NewStr := NewStr + Chr( ord(dChar) Xor ord(KeyChar)) ;
If Pos = Length(Key) Then
Pos := 0;
inc(Pos);
end;
If Length(NewStr) Mod 2 = 0 Then
begin
Side1 := ReverseString(LeftStr(NewStr, (Length(NewStr) div 2)));
Side2 := ReverseString(RightStr(NewStr, (Length(NewStr) div 2)));
NewStr := Side1 + Side2;
end;
Encrypt := NewStr;
end;
Function Decrypt(PlainStr: String; Key : String):string;
var
dChar :char;
KeyChar :char;
NewStr : String;
Pos : Integer;
I : Integer;
Side1 :String;
Side2 : String;
begin
Pos := 1;
If Length(PlainStr) Mod 2 = 0 Then
begin
Side1 := ReverseString(LeftStr(PlainStr, (Length(PlainStr) div 2)));
Side2 := ReverseString(RightStr(PlainStr, (Length(PlainStr) div 2)));
PlainStr := Side1 + Side2;
end;
For I := 1 To Length(PlainStr) do
begin
dChar := PlainStr[I];
KeyChar :=Key[Pos];
NewStr := NewStr + Chr(ord(dChar) Xor ord(KeyChar));
If Pos = Length(Key)
Then Pos := 0;
inc(Pos);
end;
Decrypt := NewStr;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
begin
s:=Encrypt('aaabbbccc','1234');
Edit1.Text:=s;
Edit2.Text:=Decrypt(s,'1234');
end;end.