标 题: 代码变异加密工具
作 者: 东方蜘蛛

思路：将程序中关键代码强行变异，让它执行不下去，出错。。。
逆向调试也将无法进行，以达到保护作用。

加密工具代码：
代码:unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
Button2: TButton;
OpenDialog: TOpenDialog;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
XPManifest: TXPManifest;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function hextoint(s: string): Integer;
begin //$代表16进制
Result:=StrToInt('$'+s);
end;

function Stream_SearchString( // 在流中搜索字符串
mStream: TStream; // 目标流
mStr: string; // 字符串
mStartAddress: Integer = 0; // 起始地址
mEndAddress: Integer = MaxInt; // 终止地址
mIgnoreCase: Boolean = False // 是否忽略大小写
): Integer; // 返回字符串所在的位置
const
cBufferSize = $1000;
var
S: string;
T: string;
I: Integer;
J: Integer;
L: Integer;
begin
Result := -1;
if not Assigned(mStream) then Exit;
if mStr = '' then Exit;
L := Length(mStr);
mStream.Position := mStartAddress;
if mIgnoreCase then mStr := UpperCase(mStr);
T := '';
J := mStartAddress;
while mStream.Position <= mEndAddress do
begin
SetLength(S, cBufferSize);
I := mStream.Read(S[1], cBufferSize);
SetLength(S, I);
if S = '' then Exit;
if mIgnoreCase then S := UpperCase(S);
Result := Pos(mStr, T + S) - 1;
if Result >= 0 then
begin
Result := Result + J - Length(T);
Exit;
end;
T := Copy(S, cBufferSize - L, MaxInt);
Inc(J, I);
end;
end; { Stream_SearchString }

function File_SearchString( // 在文件中搜索字符串
mFileName: string; // 文件名
mStr: string; // 字符串
mStartAddress: Integer = 0; // 起始地址
mEndAddress: Integer = MaxInt; // 终止地址
mIgnoreCase: Boolean =true // 是否忽略大小写
): Integer; // 返回字符串所在的位置
var
vFileStream: TFileStream;
vFileHandle: THandle;
begin
Result := -1;
if not FileExists(mFileName) then Exit;
vFileHandle := _lopen(PChar(mFileName), OF_READ or OF_SHARE_DENY_NONE); //06-09-25 No.1 ZswangY37
if Integer(vFileHandle) <= 0 then Exit;
vFileStream := TFileStream.Create(vFileHandle);
try
Result := Stream_SearchString(vFileStream, mStr,
mStartAddress, mEndAddress, mIgnoreCase);
finally
vFileStream.Free;
end;
end; { File_SearchString }

Procedure XorData(vFileName:string; vStart, vEnd: Integer); //===数据加密
var
vMemoryStream: TMemoryStream;
vBuffer: string;
I: Integer;
begin
if not FileExists(vFileName) then
begin
application.MessageBox('指定的来原文件不存在！','提示',MB_ok+MB_Iconinformation);
Exit;
end;
SetLength(vBuffer, vEnd - vStart + 1);
vMemoryStream := TMemoryStream.Create;
try
vMemoryStream.LoadFromFile(vFileName);
vMemoryStream.Seek(vStart, soFromBeginning);
vMemoryStream.Read(vBuffer[1], Length(vBuffer));
for I := 1 to Length(vBuffer) do
vBuffer[i] := Chr(Ord(vBuffer[i]) xor $51DE003A);
vMemoryStream.Seek(vStart, soFromBeginning);
vMemoryStream.Write(vBuffer[1], Length(vBuffer));
vMemoryStream.SaveToFile(vFileName);
finally
vMemoryStream.Free;
showmessage('处理成功！');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog.Execute then
Edit1.Text:=OpenDialog.FileName;
end;

procedure TForm1.Button3Click(Sender: TObject); //自动定位，地址可能有所偏差
begin
Edit2.Text:= IntToHex(File_SearchString(Edit1.text,'xor_begin')-212,8);
Edit3.Text:= IntToHex(File_SearchString(Edit1.text,'xor_end')-117,8);
end;

procedure TForm1.Button2Click(Sender: TObject);
var i1,i2:integer;
begin
i1:=hextoint(Edit2.Text);
i2:=hextoint(Edit3.Text);
XorData(Edit1.Text,i1,i2); //Xor
end;

end.
程序注册演示：
代码:unit UnitM;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Label3: TLabel;
XPManifest1: TXPManifest;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
//随便写一个算法演示 当然也可以把标位放在这函数里
function StrToASCII16(s: string): string; //字符串转换ascii码16进制，
var i:integer; // 如：东方蜘蛛＝$B6,$AB,$B7,$BD,$D6,$A9,$D6,$EB
begin
for i:=1 to length(s) do
begin
result := result+ '$'+ IntToHex(ord(s[i]),2)+',';
end;
Result:=copy(Result,0,Length(result)-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var x1,x2:string;
begin
try
x1:='xor_begin'; //标位
if (Edit2.Text=StrToASCII16(Edit1.Text)) and (Length(edit2.Text)>0) then //明码
begin
showmessage('注册成功了，呵呵！');
end;
x2:='xor_end'; //标位
except
end;
end;

end.
OD载入调试：
代码:
004539CE |. 55 push ebp
004539CF |. 68 A83A4500 push 00453AA8 ; 0x453AA8进栈 (字符串:"椋 ")
004539D4 |. 64:FF30 push dword ptr fs:[eax] ; SEH异常处理
004539D7 |. 64:8920 mov dword ptr fs:[eax], esp ; FS段[0]=0x12F608 (字符串:"h")
004539DA |. 33C0 xor eax, eax ; EAX=0,CF=0 //自身xor运算结果为0,CF=0
004539DC |. 55 push ebp ; 0x12F638进栈 (字符串:"x")
004539DD |. 68 663A4500 push 00453A66 ; 0x453A66进栈
004539E2 |. 64:FF30 push dword ptr fs:[eax] ; SEH异常处理
004539E5 |. 64:8920 mov dword ptr fs:[eax], esp ; FS段[0]=0x12F5FC
004539E8 |. 8D45 FC lea eax, dword ptr [ebp-4]
004539EB |. 80FA 00 cmp dl, 0 ; ZF=0 //DL=0x88
004539EE |? 7F 3A jg short 00453A2A
004539F0 |. |D2D5 rcl ch, cl
004539F2 |? |3E:C1C5 B7 rol ebp, 0B7
004539F6 |? |6F outs dx, dword ptr es:[edi]
004539F7 |? |CE into
004539F8 |. |B1 B9 mov cl, 0B9
004539FA |? |3E:393A cmp dword ptr [edx], edi
004539FD |? |3AD2 cmp dl, dl
004539FF |?^|73 CA jnb short 004539CB
00453A01 |? |C7C5 B17FCE6A mov ebp, 6ACE7FB1

7C92EAF0 8B1C24 mov ebx, dword ptr [esp] ; 就在这里来回跳动A
7C92EAF3 51 push ecx
7C92EAF4 53 push ebx
7C92EAF5 E8 C78C0200 call 7C9577C1 ; 就在这里来回跳动B