• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 446
  • Last Modified:

Removal Media with threat

Suppose I insert a USB stick and autorun.inf is found with virus. I want to block instantly and remove inf file. Possible.

That means a search fiction always work in background which detect removal media.

I make few function and finally I saw it uses CPU in high. Need help. Thanks
0
prasiddutta
Asked:
prasiddutta
1 Solution
 
epasquierCommented:
There is an annoying thing with Geert's unit, the event is returning 'Drive X:' instead of just 'X:'
I fixed that, and put it in a global DiskUtils unit
This works well with XE

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Log: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    procedure Usb(Sender: TObject; Drive: string; Attached: boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Uses StrUtils,DiskUtils;

procedure TForm1.FormCreate(Sender: TObject);
begin
 StartUsbDetector(Usb);
end;

procedure TForm1.Usb(Sender: TObject; Drive: string; Attached: boolean);
Var
 L:TStringList;
 Msg:String;
Const
 Autorun='\Autorun.inf';
begin
 if Attached then
  begin
   Msg:='>> '+Drive+' attached ';
   if FileExists(Drive+Autorun) Then
    begin
     Log.Lines.Add(Msg+Autorun+ ' exists :');
     L:=TStringList.Create;
     L.LoadFromFile(Drive+'\Autorun.inf');
     Log.Lines.AddStrings(L);
     L.Free;
    end Else Log.Lines.Add(Msg+Autorun+ ' doesn''t exist.');
  end Else Log.Lines.Add("<< '+Drive + ' disconnected');
end;

end.

Open in new window

unit DiskUtils;
 
interface
 
uses Classes;
 
type
 TDriveType=(dtUnknown,dtNotMounted,dtRemovable,dtFixed,dtRemote,dtCDRom,dtRAMDisk);
 TDriveTypeSet=set of TDriveType;
 TUsbDriveChanged = procedure (Sender: TObject; Drive: string; Attached: boolean) of object;
 
 procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
 procedure StopUsbDetector;
 function DriveType(Drive: ANSIChar): TDriveType;
 function DiskInDrive(Drive: ANSIChar): Boolean;
 function GetDriveList(DriveTypes:TDriveTypeSet;MountedOnly:Boolean=False):ANSIString;
 procedure FileResize(const FilePath: String; Size:int64 );
 
implementation
 
uses Windows, Messages, Forms, SysUtils;
 
type
  TUSBDetector = class(TObject)
  private
    fUsbDriveChanged: TUsbDriveChanged;
  protected
    procedure DeviceChanged(Msg: UINT; wParam, lParam: Longint);
    procedure DoUsbDriveChanged(Drive: string; Attached: Boolean); dynamic;
  public
    constructor Create(NotifyProc: TUsbDriveChanged);
    destructor Destroy; override;
    property OnUsbDriveChanged: TUsbDriveChanged read fUsbDriveChanged;
  end;
 
var mUSBDetector: TUSBDetector;
 
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
begin
  if not Assigned(mUsbDetector) then
    mUsbDetector := TUsbDetector.Create(NotifyProc);
end;
 
procedure StopUsbDetector;
begin
  FreeAndNil(mUsbDetector);
end;

function DriveType(Drive: ANSIChar): TDriveType;
Var
 DriveStr:String;
begin
 Result:=dtNotMounted;
 Drive:=UpCase(Drive);
 if Not (Drive in ['A'..'Z']) Then Exit;
 DriveStr:=Drive+':\';
 Result:=TDriveType(GetDriveType(PChar(DriveStr)));
end;

function DiskInDrive(Drive: ANSIChar): Boolean;
var EMode: Word;
begin
 Result := False;
 Drive:=UpCase(Drive);
 if Not (Drive in ['A'..'Z']) Then Exit;
 EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
 try
  Result:=DiskSize(Ord(Drive)-$40)>=0;
 finally
  SetErrorMode(EMode);
 end;
end;

function GetDriveList(DriveTypes:TDriveTypeSet;MountedOnly:Boolean=False):ANSIString;
var
 D:ANSIChar;
begin
 Result:='';
 for D:='A' to 'Z' do
  if DriveType(D) In DriveTypes Then
   if (Not MountedOnly) Or DiskInDrive(D) Then
    Result:=Result+D;
end;
 
procedure FileResize(const FilePath: String; Size:int64 );
Var
 hTmpFile:THandle;
const
 dwFlagsAndAttr = FILE_FLAG_RANDOM_ACCESS;
begin
 hTmpFile := CreateFile( PChar( FilePath ),
  GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
  FILE_ATTRIBUTE_TEMPORARY or dwFlagsAndAttr, 0 );
 try
  if Size>=$80000000
   Then SetFilePointer( hTmpFile, Size {And $FFFFFFFF}, Pointer(Cardinal(@Size)+4), FILE_BEGIN )
   Else SetFilePointer( hTmpFile, Size, nil, FILE_BEGIN );
  SetEndOfFile( hTmpFile );
 finally
  CloseHandle( hTmpFile );
 end;
end;
 
{----------------------------------------------------------------------------}
// Device constants
const
  DBT_DEVICEARRIVAL          =  $00008000;
  DBT_DEVICEREMOVECOMPLETE   =  $00008004;
  DBT_DEVTYP_VOLUME          =  $00000002;
 
// Device structs
type
  _DEV_BROADCAST_HDR         =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
  end;
  DEV_BROADCAST_HDR          =  _DEV_BROADCAST_HDR;
  TDevBroadcastHeader        =  DEV_BROADCAST_HDR;
  PDevBroadcastHeader        =  ^TDevBroadcastHeader;
 
type
  _DEV_BROADCAST_VOLUME      =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
     dbcv_unitmask:          DWORD;
     dbcv_flags:             WORD;
  end;
  DEV_BROADCAST_VOLUME       =  _DEV_BROADCAST_VOLUME;
  TDevBroadcastVolume        =  DEV_BROADCAST_VOLUME;
  PDevBroadcastVolume        =  ^TDevBroadcastVolume;
 
var
  fPrevWndProc: TFNWndProc = nil;
 
function UsbWndProc(hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := CallWindowProc(fPrevWndProc, hWnd, Msg, wParam, lParam);
  if (Msg = WM_DEVICECHANGE) and (mUsbDetector <> nil) then
    mUsbDetector.DeviceChanged(Msg, wParam, lParam);
end;
 
constructor TUSBDetector.Create(NotifyProc: TUsbDriveChanged);
begin
  inherited Create;
  fUsbDriveChanged := NotifyProc;
  if not Assigned(fPrevWndProc) then 
  begin
    fPrevWndProc := TFNWndProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@UsbWndProc));
  end;
end;
 
destructor TUSBDetector.Destroy;
begin
  //SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@fPrevWndProc));
  inherited Destroy;
end;
 
procedure TUSBDetector.DeviceChanged(Msg: UINT; wParam, lParam: LongInt);
var
  lpdbhHeader: PDevBroadcastHeader;
  lpdbvData: PDevBroadcastVolume;
  dwIndex: Integer;
  lpszDrive: string;
begin
  // Get the device notification header
  lpdbhHeader := PDevBroadcastHeader(lParam);
  // Handle the message
  case WParam of
    DBT_DEVICEARRIVAL:    {a USB drive was connected}
    begin
      if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      begin
        lpdbvData := PDevBroadcastVolume(lParam);
        for dwIndex := 0 to 25 do
        begin
          if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
          begin
            lpszDrive := Chr(65 + dwIndex) + ':';
            DoUsbDriveChanged(lpszDrive, True);
          end;
        end;
      end;
    end;
    DBT_DEVICEREMOVECOMPLETE:    {a USB drive was removed}
    begin
      if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      begin
        lpdbvData := PDevBroadcastVolume(lParam);
        for dwIndex := 0 to 25 do
        begin
          if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
          begin
            lpszDrive := Chr(65 + dwIndex) + ':';
            DoUsbDriveChanged(lpszDrive, False);
          end;
        end;
      end;
    end;
  end;
end;
 
procedure TUSBDetector.DoUsbDriveChanged(Drive: string; Attached: Boolean);
begin
  if Assigned(fUsbDriveChanged) then
    fUsbDriveChanged(Self, Drive, Attached);
end;
 
end.

Open in new window

0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now