Solved

Removal Media with threat

Posted on 2011-09-30
1
425 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

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

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

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …

777 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