Solved

Removal Media with threat

Posted on 2011-09-30
1
422 Views
Last Modified: 2016-09-30
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
Comment
Question by:prasiddutta
1 Comment
 
LVL 25

Accepted Solution

by:
epasquier earned 500 total points
ID: 36892546
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Delphi 2010 Export to pdf 2 287
How to fill array with TArray.Create? 14 79
FMX enumerated colours 2 84
Delphi...Split view - idea? 1 42
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Migrating to Microsoft Office 365 is becoming increasingly popular for organizations both large and small. If you have made the leap to Microsoft’s cloud platform, you know that you will need to create a corporate email signature for your Office 365…
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now