delphi检查U口,如果有U盘插入则调用杀毒软件进行查杀

这个程序是我为XX税务局在办公大厅做的一个小程序，当用户拿U盘来进行报表时，要求用户先在一个

触摸式的计算机前进行查杀，然后再允许用户将U盘插入到办公电脑上

unit fuMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Registry,iniFiles, FuAncestor, ImgList, Menus, ExtCtrls, StdCtrls,
  jpeg, Buttons,RunDos;

type
  TFrmMain = class(TFrmAncestor)
    pmMenu: TPopupMenu;
    N2: TMenuItem;
    mnuAutoRun: TMenuItem;
    mnuExit: TMenuItem;
    ilImage: TImageList;
    N1: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    MemoMessage: TMemo;
    Panel2: TPanel;
    Image8: TImage;
    Image9: TImage;
    Image10: TImage;
    procedure mnuAutoRunClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Image8Click(Sender: TObject);
    procedure Image9Click(Sender: TObject);
    procedure Image10Click(Sender: TObject);
  private
    { Private declarations }

    procedure SetTrayIcon(Sender: TObject);
    procedure TrayOnClick(Sender: TObject);
    procedure SetAuto;
    procedure GetAuto;
    procedure WMDeviceChange(var   Msg:   TMessage);   message   WM_DEVICECHANGE;
  public
    { Public declarations }
  end;
  TKillU = class(TThread)
  protected
  procedure Execute; override;
  function GetDriveName:String;
  end;
var
  FrmMain: TFrmMain;

implementation
uses TrayIcon,FuEnvironment;
var
  TmpTray: TTrayNotifyIcon;
{$R *.dfm}

 

procedure TFrmMain.mnuAutoRunClick(Sender: TObject);
var
  Reg: TRegistry;
begin
  inherited;
  SetAuto;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True) then
    begin
      if mnuAutoRun.Checked then
        Reg.WriteString('vkillKey', Application.ExeName)
      else Reg.DeleteValue('vkillKey');
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

procedure TFrmMain.SetAuto;
var
  inifile : TInifile;
  FileDir : String;
  iIfAuto : integer;
begin
  try
    FileDir := Extractfilepath(application.ExeName);
    inifile := TiniFile.Create(FileDir + 'Config\config.ini');
    with inifile do
    begin
      iIfAuto := ReadInteger('AUTO','IFAUTO',0);
      if iIfAuto =0 then
      begin
        WriteInteger('AUTO' , 'IFAUTO', 1);
        mnuAutoRun.Checked := true;
      end
      else
      begin
        WriteInteger('AUTO' , 'IFAUTO', 0) ;
        mnuAutoRun.Checked := false;
      end;
    end;
    inifile.Free;
  except
    showmessage('打开*.ini文件出错,请与软件开发商联系');
    exit;
  end;
end;

procedure TFrmMain.SetTrayIcon(Sender: TObject);
begin
  tmpTray := TTrayNotifyIcon.Create(Self);
  with tmpTray do
  begin
    ilImage.GetIcon(0, Icon);
    IconVisible := True;
    PopupMenu := pmMenu;
    Hint := frmMain.Caption;
    HideTask := true;
    OnClick := TrayOnClick;
  end;
end;

procedure TFrmMain.TrayOnClick(Sender: TObject);
begin
 inherited;
 if (not Visible) and (Application.Tag = 0) then begin
    Show;
  end else begin
    Hide;
  end;
  if Application.Tag = 1 then
  begin
    Application.ShowMainForm := True;
    Application.Tag := 0;
  end;
end;

procedure TFrmMain.mnuExitClick(Sender: TObject);
begin
  inherited;
  application.Terminate;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  inherited;
  SetTrayIcon(Self);
end;
procedure TFrmMain.GetAuto;
var
  inifile : TInifile;
  FileDir : String;
  iIfAuto : integer;
begin
  try
    FileDir := Extractfilepath(application.ExeName);
    inifile := TiniFile.Create(FileDir + 'Config\config.ini');
    with inifile do
    begin
      iIfAuto := ReadInteger('AUTO','IFAUTO',0);
      if iIfAuto =0 then
        mnuAutoRun.Checked := false
      else
        mnuAutoRun.Checked := true;
    end;
    inifile.Free;
  except
    showmessage('打开*.ini文件出错,请与软件开发商联系');
    exit;
  end;

end;
procedure TFrmMain.N1Click(Sender: TObject);
begin
  inherited;
  FrmEnvironment := TFrmEnvironment.create(nil);
  FrmEnvironment.showmodal;
  FrmEnvironment.free;
end;

procedure TFrmMain.Button1Click(Sender: TObject);
var
  VRunDos:TRunDos;
begin
  inherited;
  VRunDos := TRunDos.Create();
  VRunDos.RunDOS('control hotplug.dll');
end;

procedure TFrmMain.Button2Click(Sender: TObject);
var
  VRunDos:TRunDos;
  Kavpath:String;
  inifile : TInifile;
  FileDir : String;
begin
  inherited;
  VRunDos := TRunDos.Create();
  FileDir := Extractfilepath(application.ExeName);
  inifile := TiniFile.Create(FileDir + 'Config\config.ini');
  Kavpath   :=   ExtractFileDir(inifile.ReadString('KavPath','KavPath',''))+'\';
  VRunDos.RunDOS(Kavpath+'kav32.exe') ;
end;

{ TKillU }

procedure TKillU.Execute;
var
      hReadPipe,   hWritePipe:   THandle;  
      si:   STARTUPINFO;  
      lsa:   SECURITY_ATTRIBUTES;  
      pi:   PROCESS_INFORMATION;  
      mDosScreen:   string;
      cchReadBuffer:   DWORD;
      ph:   PChar;  
      fname:   PChar;  
      i,   j:   integer;
      inifile : TInifile;
      FileDir : String;
      Kavpath : String;
      upath : String;
  begin
      inherited;
      Frmmain.MemoMessage.Text:='';
      FileDir := Extractfilepath(application.ExeName);
      inifile := TiniFile.Create(FileDir + 'Config\config.ini');
      Kavpath   :=   ExtractFileDir(inifile.ReadString('KavPath','KavPath',''))+'\';
      upath := GetDriveName;
      if(upath='')then
      begin
         Application.MessageBox('没有U盘,插入U盘可以进行自动杀毒','阳光杀毒', 0 + 64);
         exit;
      end;
      Frmmain.MemoMessage.Text :='开始查杀U盘:'+ upath+'....请等待,这可能会花几分钟的时间.................';
      fname   :=   allocmem(255);  
      ph   :=   AllocMem(5000);  
      lsa.nLength   :=   sizeof(SECURITY_ATTRIBUTES);  
      lsa.lpSecurityDescriptor   :=   nil;  
      lsa.bInheritHandle   :=   True;
      if   CreatePipe(hReadPipe,   hWritePipe,   @lsa,   0)   =   false   then  
      begin  
          Application.MessageBox('不能创建管道!','阳光杀毒', 0 + 64);
          exit;  
      end;  
      fillchar(si,   sizeof(STARTUPINFO),   0);  
      si.cb   :=   sizeof(STARTUPINFO);  
      si.dwFlags   :=   (STARTF_USESTDHANDLES   or   STARTF_USESHOWWINDOW);  
      si.wShowWindow   :=   SW_HIDE;  
      si.hStdOutput   :=   hWritePipe;
      //Application.MessageBox(pchar(Kavpath+'\KAVDX /AC '+upath),'阳光杀毒', 0 + 64);
      StrPCopy(fname,Kavpath+'\KAVDX /AC '+upath);
      if   CreateProcess(nil,   fname,   nil,   nil,   true,   0,   nil,   nil,   si,   pi)   =   False   then
      begin  
          Application.MessageBox('不能创建进程,请重新设置杀毒软件环境','阳光杀毒', 0 + 64);
          FreeMem(ph);  
          FreeMem(fname);  
          Exit;  
      end;
      while   (true)   do  
      begin  
          if   not   PeekNamedPipe(hReadPipe,   ph,   1,   @cchReadBuffer,   nil,   nil)   then   break;  
          if   cchReadBuffer   <>   0   then  
          begin  
              if   ReadFile(hReadPipe,   ph^,   4096,   cchReadBuffer,   nil)   =   false   then   break;  
              ph[cchReadbuffer]   :=   chr(0);
              Frmmain.MemoMessage.Lines.Add(ph);  
          end
          else   if   (WaitForSingleObject(pi.hProcess,   0)   =   WAIT_OBJECT_0)   then   break;  
          Sleep(100);  
      end;  
   
      ph[cchReadBuffer]   :=   chr(0);
      Frmmain.MemoMessage.Lines.Add(ph);  
      CloseHandle(hReadPipe);  
      CloseHandle(pi.hThread);  
      CloseHandle(pi.hProcess);  
      CloseHandle(hWritePipe);  
      FreeMem(ph);  
      FreeMem(fname);
      Application.MessageBox('查杀病毒结束,请点击删除U盘按钮,然后拔出U盘','阳光杀毒', 0 + 64);
end;

function TKillU.GetDriveName: String;
var
    buf:array [0..MAX_PATH-1] of char;
    m_Result:Integer;
    i:Integer;
    str_temp:string;
    driveName:string;
begin
   m_Result:=GetLogicalDriveStrings(MAX_PATH,buf);
    for i:=0 to (m_Result div 4) do
    begin
        str_temp:=string(buf[i*4]+buf[i*4+1]+buf[i*4+2]);
        if GetDriveType(pchar(str_temp)) = DRIVE_REMOVABLE then
        begin
           driveName := str_temp;
        end;
    end;
  
    Result := driveName;
end;

procedure TFrmMain.Button3Click(Sender: TObject);
var
  killu :TKillU;
begin
  inherited;
  killu := TKillU.Create(false);
end;

procedure TFrmMain.WMDeviceChange(var Msg: TMessage);
var
   myMsg   :   String;
   killu :TKillU;
begin
      Case   Msg.WParam   of  
      32768:  
          begin  
              myMsg   :='U盘插入';
              FrmMain.MemoMessage.Text :='';
              FrmMain.MemoMessage.Lines.Add(myMsg);
              killu := TKillU.Create(false);
          end;  
      32772:  
          begin  
              myMsg   :='U盘拔出';
              FrmMain.MemoMessage.Lines.Add(myMsg);
          end;  
      end;
end;

procedure TFrmMain.Image8Click(Sender: TObject);
var
  killu :TKillU;
begin
  inherited;
  killu := TKillU.Create(false);
end;

procedure TFrmMain.Image9Click(Sender: TObject);
var
  VRunDos:TRunDos;
  Kavpath:String;
  inifile : TInifile;
  FileDir : String;
begin
  inherited;
  VRunDos := TRunDos.Create();
  FileDir := Extractfilepath(application.ExeName);
  inifile := TiniFile.Create(FileDir + 'Config\config.ini');
  Kavpath   :=   ExtractFileDir(inifile.ReadString('KavPath','KavPath',''))+'\';
  VRunDos.RunDOS(Kavpath+'kav32.exe') ;

end;

procedure TFrmMain.Image10Click(Sender: TObject);
var
  VRunDos:TRunDos;
begin
  inherited;
  VRunDos := TRunDos.Create();
  VRunDos.RunDOS('control hotplug.dll');

end;

end.