`
lengyue
  • 浏览: 144517 次
  • 性别: Icon_minigender_1
  • 来自: 长春
社区版块
存档分类
最新评论

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.

 

 

分享到：
| delphi调用dos命令
评论
发表评论

您还没有登录,请您登录后再发表评论

相关推荐

    delphi U盘管理 拷贝 复制

    标题中的“delphi U盘管理 拷贝 复制”指的是使用Delphi编程语言来实现对U盘的管理和文件拷贝复制功能。Delphi是一款强大的面向对象的集成开发环境（IDE），它基于Pascal语言，特别适合于快速开发Windows应用程序。...

    Delphi监视U盘源码

    在实际应用中，你需要在设备插入事件中检查U盘，并根据需要调用`LockUnlockDisk`函数来锁定或解锁U盘。同时，为了防止恶意软件绕过控制，你可能还需要在应用程序启动时注册热键或服务，以便在后台持续监控U盘状态。 ...

    通过delphi取U盘系列号,其实很简单的

    本篇文章将深入探讨如何通过Delphi获取U盘的系列号，这个过程实际上并不复杂，只需理解基本的Windows API调用和设备枚举原理。 首先，我们需要了解Windows操作系统是如何管理硬件设备的。在Windows中，每一个硬件...

    delphi源码U盘自动识别盘符id状态

    2. **Windows API调用**：为了获取U盘的状态和盘符，Delphi程序通常需要调用Windows操作系统提供的API函数，如`FindFirstVolume`, `FindNextVolume`, `GetVolumeInformation`等，来遍历和查询磁盘信息。 3. **设备...

    简易Delphi杀毒软件源码

    【简易Delphi杀毒软件源码】是一款基于Delphi编程语言开发的轻量级杀毒软件，虽然体积小巧，但其内部蕴含了多种反病毒技术的实现。在深入理解这款软件之前，首先需要对Delphi编程环境有所了解。Delphi是Borland公司...

    DELPHI 取得U盘唯一码

    在IT行业中，尤其是在软件开发领域，获取硬件设备的唯一标识符常常是必要的，例如U盘的唯一码。这个过程可以帮助开发者实现特定的功能，比如验证U盘授权、追踪U盘使用等。标题“DELPHI 取得U盘唯一码”指的是使用...

    两种办法实现安全删除(断开)U盘的DELPHI源码

    这里我们将深入探讨两种使用DELPHI编程语言实现安全删除U盘的方法，这两种方法都涉及到调用Windows系统接口。 首先，我们来看第一种方法。在“弹出U盘方法一.txt”中，可能包含的是较为复杂的实现方式。这通常涉及...

    Delphi 读取 网卡U盘序列号

    在IT领域，有时候我们需要获取设备的一些特定信息，例如网卡和U盘的序列号，这些信息对于设备管理和软件授权等方面非常有用。在Delphi编程环境中，可以利用Windows API函数来实现这一目标。以下是对如何使用Delphi...

    禁止U盘插入运行软件

    运行该软件，Ｕ盘插入被识别后即刻删除。 用法：下载该文件到本地机器，双击即可。 有问题站内联系

    DELPHI 7 调用 JAVA 接口

    Delphi 7是一款历史悠久且功能强大的Windows应用程序开发工具，而Java则是一种广泛应用于服务器端和跨平台开发的编程语言。本文将深入探讨如何在Delphi 7中调用Java接口，实现两者之间的数据传递和结果返回。 首先...

    delphi动态调用Dll

    在Delphi编程中，动态调用DLL（Dynamic Link Library）是一种常见的技术，它允许你在运行时加载和使用库函数，而无需在编译时硬编码这些依赖。这为程序提供了更大的灵活性，因为你可以根据需要加载特定的DLL，或者在...

    U盘检测工具 Delphi代码

    本文将深入探讨使用Delphi编程语言来实现这样的功能，主要关注如何监测U盘的插入和拔出，并获取U盘的盘符。 Delphi是一款强大的面向对象的集成开发环境（IDE），它基于Pascal语言，提供了丰富的组件库和Windows API...

    Delphi编程实现U盘锁

    本项目“Delphi编程实现U盘锁”旨在利用Delphi的强大功能创建一个软件，该软件能够锁定U盘，防止未经授权的访问或拷贝U盘内的数据。 首先，我们要理解U盘锁的基本工作原理。U盘锁通常是一个系统级的程序，它通过...

    delphi调用C# DLL

    ### Delphi调用C# DLL的关键知识点 #### 一、环境配置与理解.NET与Delphi交互的基本原理 在深入探讨如何让Delphi调用C#编写的DLL之前，我们需要了解几个基本概念，以及如何配置相应的开发环境。 1. **环境配置**...

    Delphi调用c++ DLL技术文档

    因此，在调用DLL之前进行适当的错误检查是非常必要的。 ### 四、总结 通过上述介绍，我们可以看出Delphi调用C++ DLL涉及到多个方面，包括DLL的准备、函数声明、调用约定的选择、数据类型转换以及错误处理等。正确...

    Delphi2010大漠免注册调用，和注册调用

    这需要开发者了解DLL中的接口定义，并通过PInvoke或CreateDLLInstance等方法进行调用。 2. **注册调用**：注册调用则是传统的DLL使用方式，需要在安装程序时将DLL信息写入系统注册表。Windows系统通过注册表来查找...

    delphi调用wps实例

    Delphi是一款强大的RAD（快速应用程序开发）工具，而WPS Office则是一款广受欢迎的办公软件套件，包括文字处理、电子表格和演示文稿组件。本文将详细讲解如何通过Delphi进行WPS的二次开发，实现对WPS的调用、关闭...

    突破Autorun.inf的U盘传播代码 Delphi 附源码

    标题中的“突破Autorun.inf的U盘传播代码 Delphi 附源码”指的是利用Delphi编程语言编写的一段代码，这段代码旨在绕过或突破Windows系统中的Autorun.inf机制，以便在U盘插入电脑时自动运行。Autorun.inf通常被病毒、...

    DELPHI 调用SAP RFC 文档

    "DELPHI 调用 SAP RFC 文档" DELPHI 调用 SAP RFC 文档是指使用 Delphi 编程语言调用 SAP RFC（Remote Function Call）函数，以实现与 SAP 系统的集成。下面是相关知识点的详细说明： 一、安装 SAP 客户端 要使用...

    Delphi调用Java类和包源代码

    6. **异常处理**：在Java和Delphi之间进行跨语言调用时，异常处理是关键。Java的异常可以被转换为Delphi的错误代码或异常对象，反之亦然。确保在Delphi中正确处理可能出现的Java异常，并在Java端捕获可能由Delphi...

Magicbox
Global site tag (gtag.js) - Google Analytics