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.
?
?