USBEventThread.pas

unit USBEventThread;

interface

uses
  Windows, Classes;

type
  TUsbDrive = record
    DriveLetter: Char;
    Serial: string;
    VolumeName: string;
    VolumeCaption: string;
  end;
  PUsbDrive = ^TUsbDrive;

  TUSBEventCallBack = procedure(const UsbDriveInfo: TUsbDrive; EventType: Byte) of object;

  TUSBChangeEventThread = class(TThread)
  private
    Success      : HResult;
    FSWbemLocator: OleVariant;
    FWMIService  : OleVariant;
    FEventSource : OleVariant;
    FWbemObject  : OleVariant;
    FCallBack    : TUSBEventCallBack;

    procedure DoCallBack;
  public
    Constructor Create(CallBack : TUSBEventCallBack); overload;
    destructor Destroy; override;
    procedure Execute; override;
  end;

  //GetUsbDriveByLetter'ı çalıştırmak için ayrı bir thread gerekli
  TGetUSBInfoThread = class(TThread)
  private
    fUsbInfo: TUsbDrive;
    FCallBack: TUSBEventCallBack;

    procedure DoCallBack;
  public
    constructor Create(DL: Char; CB: TUSBEventCallBack); overload;
    procedure Execute; override;

    property UsbDriveInfo: TUsbDrive read fUsbInfo;
  end;

  procedure GetUsbDriveByLetter(var USB: TUsbDrive);
  procedure GetUsbList(var Liste: TList);

implementation

uses
 SysUtils,
 ComObj,
 ActiveX,
 Variants;

function GetWMIObject(const objectName: String): IDispatch;
  var
    chEaten: Integer;
    BindCtx: IBindCtx;
    Moniker: IMoniker;
  begin
    OleCheck(CreateBindCtx(0, bindCtx));
    OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
    OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
  end;

function VarStrNull(const V:OleVariant): string;
begin
  Result:='';
  if not VarIsNull(V) then
    Result := VarToStr(V);
end;

procedure GetUsbDriveByLetter(var USB: TUsbDrive);
var
  objWMIService  : OleVariant;
  colDiskDrives  : OLEVariant;
  colLogicalDisks: OLEVariant;
  colPartitions  : OLEVariant;
  objDiskDrive   : OLEVariant;
  objPartition   : OLEVariant;
  objLogicalDisk : OLEVariant;
  oEnumDiskDrive : IEnumvariant;
  oEnumPartition : IEnumvariant;
  oEnumLogical   : IEnumvariant;
  iValue         : LongWord;
  devID, Serial, DriveLetter, VolumeName, DevName: string;
begin
  try
    objWMIService := GetWMIObject('winmgmts:\\localhost\root\CIMV2');
    colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive WHERE InterfaceType="USB"','WQL',0);
    oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;
    while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do
    begin
       devID := StringReplace(VarStrNull(objDiskDrive.DeviceID),'\','\\',[rfReplaceAll]);
       colPartitions   := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[devID]));
       oEnumPartition  := IUnknown(colPartitions._NewEnum) as IEnumVariant;
        while oEnumPartition.Next(1, objPartition, iValue) = 0 do
         begin
           colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+VarStrNull(objPartition.DeviceID)+'"} WHERE AssocClass = Win32_LogicalDiskToPartition');
           oEnumLogical  := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;
           while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
           begin
             Serial := VarToStr(objDiskDrive.PNPDeviceID);
             if Serial <> '' then
             begin
               Serial := Copy(Serial, LastDelimiter('\', Serial)+1, Length(Serial));
               Serial := StringReplace(Serial, '&0', '', [rfReplaceAll]);
               DriveLetter := VarToStr(objLogicalDisk.DeviceID);
               if Length(DriveLetter) > 0 then
                 DriveLetter := DriveLetter[1];
               VolumeName := VarToStr(objLogicalDisk.VolumeName);
               if VolumeName = '' then
                 VolumeName := VarToStr(objDiskDrive.Description);
               DevName := VarToStr(objDiskDrive.Caption);

               if DriveLetter = USB.DriveLetter then
               begin
                 USB.Serial := Serial;
                 USB.VolumeCaption := DevName;
                 USB.VolumeName := VolumeName;
               end;
             end;

             objLogicalDisk := Unassigned;
           end;
           objPartition := Unassigned;
         end;
         objDiskDrive := Unassigned;
    end;
  except        
  end;
end;

procedure GetUsbList(var Liste: TList);
var
  objWMIService  : OleVariant;
  colDiskDrives  : OLEVariant;
  colLogicalDisks: OLEVariant;
  colPartitions  : OLEVariant;
  objDiskDrive   : OLEVariant;
  objPartition   : OLEVariant;
  objLogicalDisk : OLEVariant;
  oEnumDiskDrive : IEnumvariant;
  oEnumPartition : IEnumvariant;
  oEnumLogical   : IEnumvariant;
  iValue         : LongWord;
  devID, S       : string;
  UsbDisk        : PUsbDrive;
begin
  CoInitialize(nil);
  try
    Liste.Clear;
    try
      objWMIService := GetWMIObject('winmgmts:\\localhost\root\CIMV2');
      colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive WHERE InterfaceType="USB"','WQL',0);
      oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;
      while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do
      begin
         devID := StringReplace(VarStrNull(objDiskDrive.DeviceID),'\','\\',[rfReplaceAll]); 
         colPartitions   := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[devID]));
         oEnumPartition  := IUnknown(colPartitions._NewEnum) as IEnumVariant;
          while oEnumPartition.Next(1, objPartition, iValue) = 0 do
           begin
             colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+VarStrNull(objPartition.DeviceID)+'"} WHERE AssocClass = Win32_LogicalDiskToPartition'); 
             oEnumLogical  := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;
             New(UsbDisk);
             while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
               with UsbDisk^ do
               begin
                 Serial := VarToStr(objDiskDrive.PNPDeviceID);
                 if Serial <> '' then
                 begin
                   Serial := Copy(Serial, LastDelimiter('\', Serial)+1, Length(Serial));
                   Serial := StringReplace(Serial, '&0', '', [rfReplaceAll]);
                   S := VarToStr(objLogicalDisk.DeviceID);
                   if Length(S) > 0 then
                     DriveLetter := S[1];
                   VolumeName := VarToStr(objLogicalDisk.VolumeName);
                   if VolumeName = '' then
                     VolumeName := VarToStr(objDiskDrive.Description);

                   VolumeCaption := VarToStr(objDiskDrive.Caption);
                   Liste.Add(UsbDisk);
                 end;

               objLogicalDisk := Unassigned;
             end;
             objPartition := Unassigned;
           end;
           objDiskDrive := Unassigned;
      end;
    except        
    end;
  finally
    CoUninitialize;
  end;
end;


{TUSBChangeEventThread}

constructor TUSBChangeEventThread.Create(CallBack : TUSBEventCallBack);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FCallBack       := CallBack;
end;

destructor TUSBChangeEventThread.Destroy;
begin
  FCallBack     := nil;
  FSWbemLocator := Unassigned;
  FWMIService   := Unassigned;
  FEventSource  := Unassigned;
  FWbemObject   := Unassigned;
  inherited;
end;                      

procedure TUSBChangeEventThread.Execute;
const
  wbemErrTimedout = $80043001;
begin
  Success := CoInitialize(nil);
  try
    FWMIService := GetWMIObject('winmgmts:\\localhost\root\CIMV2');
    FEventSource  := FWMIService.ExecNotificationQuery('Select * From Win32_VolumeChangeEvent WHERE (EventType=2) OR (EventType=3)');
    while not Terminated do
    begin
      try
        FWbemObject := FEventSource.NextEvent(100);
      except
        on E:EOleException do
          if EOleException(E).ErrorCode = HRESULT(wbemErrTimedout) then
            FWbemObject := Null
          else
            raise;
      end;

      if FindVarData(FWbemObject)^.VType <> varNull then
        Synchronize(DoCallBack);

      FWbemObject :=Unassigned; 
    end;
  finally
    case Success of
      0, 1: CoUninitialize; //S_OK, S_FALSE
    end;
  end;
end;

procedure TUSBChangeEventThread.DoCallBack;
var
  EventType, DriveLetter : string;
  aUSB: TUsbDrive;
begin
  if not Assigned(FCallBack) then
    Exit;
  EventType := VarStrNull(FWbemObject.Properties_.Item('EventType').Value);
  DriveLetter := VarStrNull(FWbemObject.Properties_.Item('DriveName').Value);
  if (EventType <> '') and (DriveLetter <> '') then
    if (EventType = '2') or (EventType = '3') then//aygıt takıldı, çıkarıldı
    begin
      aUSB.Serial := '';
      aUSB.DriveLetter := DriveLetter[1];
      if EventType = '3' then //USB sürücü çıkarıldıysa hemen gönder
        FCallBack(aUSB, 0) // 0 = USB çıkarıldı 
      else //USB sürücü takıldıysa bilgileri almak gerekir
        TGetUSBInfoThread.Create(aUSB.DriveLetter, FCallBack); 
    end;
end;

{ TGetUSBInfoThread }

constructor TGetUSBInfoThread.Create(DL: Char; CB: TUSBEventCallBack);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FCallBack := CB;
  with fUsbInfo do
  begin
    Serial := '';
    DriveLetter := DL;
    VolumeName := '';
    VolumeCaption := '';
  end;
end;

procedure TGetUSBInfoThread.Execute;
begin
  CoInitialize(nil);
  try
    GetUsbDriveByLetter(fUsbInfo);
    Synchronize(DoCallBack);
  finally
    CoUninitialize;
  end;
end;

procedure TGetUSBInfoThread.DoCallBack;
begin
  if Assigned(FCallBack) then
    FCallBack(fUsbInfo, 1);// 1 = USB takıldı
end;

end.

Usage:

procedure TfrmMain.CallBackForUsbChangeThread(const DrvInfo: TUsbDrive; EventType: Byte);
begin
  case EventType of
    0:  // USB removed
    1:   // USB plugged
  end;
end;

//...

TUSBChangeEventThread.Create(CallBackForUsbChangeThread);