ANTICHAT — форум по информационной безопасности, OSINT и технологиям

QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);

'\Device\Harddisk1\DP(1)0-0+9'

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,setupapi;
type  
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Button2: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure OnDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

function IsUSBDevice(DevInst: DWORD): boolean;  
var
  IDLen: DWORD;
  ID: PChar;
  s:string;
begin
  {'USBSTOR\DISK&VEN_&PROD_USB_FLASH_DRIVE&REV_34CH\196B09014EC7&0'}
  result := false;
  if (CM_Get_Device_ID_Size(IDLen, DevInst, 0) <> 0) or (IDLen = 0) then
  begin
  // exit;
  end;

  inc(IDLen);
  ID := GetMemory(IDLen);
  if ID = nil then
    exit;
  if (CM_Get_Device_ID(DevInst, PAnsichar(ID), IDLen, 0) <> 0) or (not CompareMem(ID, PChar('USBSTOR'), 7)) then
   begin
   s:=ID;
    form1.memo1.Lines.Add(String(ID));
    FreeMemory(ID);
    exit;
   end;
   s:=ID;
   form1.memo1.Lines.Add(String(ID));
  FreeMemory(ID);
  result := true;
end;

function GetDeviceName(PnPHandle: HDEVINFO; const DevData: TSPDevInfoData): string;
var
  BytesReturned: DWORD;
  RegDataType: DWORD;
  Buffer: array [0..256] of CHAR;
begin
  BytesReturned := 0;
  RegDataType := 0;
  Buffer[0] := #0;
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, SPDRP_FRIENDLYNAME,
RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned);
  Result := Buffer;
  if Result<>'' then exit;
  BytesReturned := 0;
  RegDataType := 0;
  Buffer[0] := #0;
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, SPDRP_DEVICEDESC,
RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned);
  Result:=Buffer;
end;

function DWORDtoDiskNames(val:DWORD):string;
var
  _i: integer;
begin
  Result:='';
  for _i := 0 to 25 do
   begin
    if ((val mod 2)=1) then Result:=result+ chr(_i + 65);
    val:=val shr 1;
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
VAR
  lpQuery: array [0..MAXCHAR - 1] of Char;
  Volume,s:STRING;

begin
   {'\\.\PHYSICALDRIVE1'}
   Volume:=Edit1.text+':';
   Volume[3] := #0;
   QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
   s:=lpQuery;
   Volume:='';
   Edit2.Text:=s;
   {'\Device\Harddisk1\DP(1)0-0+9'}
end;
procedure TForm1.OnDeviceChange(var Msg: TMessage);
var
  MSGSTR:String;
begin
  if Msg.WParam=DBT_DEVICEARRIVAL then
   begin
    case PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype of
    DBT_DEVTYP_VOLUME:
     begin
      MSGSTR:='новый диск'+MSGSTR;
      Edit1.Text:=(MSGSTR+' '+DWORDtoDiskNames(PDEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_unitmask)+':');
     end;
    end;
   end;
if Msg.WParam=DBT_DEVICEREMOVECOMPLETE then
   begin
    case PDEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype of
     DBT_DEVTYP_VOLUME:
      begin
       MSGSTR:='извлечён диск'+MSGSTR;
       Edit1.Text:=(MSGSTR+' '+DWORDtoDiskNames(PDEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_unitmask)+':');
      end;
    end;
   end;
   end;


procedure RemoveDrive(index:integer);
var
  DrivesPnPHandle: HDEVINFO;
  DevInfo: TSPDevInfoData;
  Parent: DWORD;
  s:string;
  VetoName:array[0..MAX_PATH] of char;
begin
  DevInfo.cbSize := sizeof(SP_DEVINFO_DATA);
  DrivesPnPHandle := SetupDiGetClassDevsA(@GUID_DEVCLASS_DISKDRIVE, nil, 0, 2);
  if DrivesPnPHandle = INVALID_HANDLE_VALUE then
    exit;
  if SetupDiEnumDeviceInfo(DrivesPnPHandle, index,DevInfo) then
   begin
    s:=GetDeviceName(DrivesPnPHandle,DevInfo);
    if (IsUSBDevice(DevInfo.DevInst)) and (CM_Get_Parent(Parent, DevInfo.DevInst, 0) = CR_SUCCESS)
     then
      begin
       CM_Request_Device_Eject(Parent, nil, nil{@VetoName}, {MAX_PATH}0, 0);
      end
     else
      ShowMessage('Это не USB устройство');
   end;
  SetupDiDestroyDeviceInfoList(DrivesPnPHandle);
end;


procedure TForm1.Button1Click(Sender: TObject);
VAR
  lpQuery: array [0..MAXCHAR - 1] of Char;
  Volume,s:STRING;
begin
   Volume:=Edit1.text+':';
   Volume[3] := #0;
   QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
   s:=lpQuery;
   Volume:='';
   Memo1.Lines.add(s);
   {'\Device\Harddisk1\DP(1)0-0+9'}
    RemoveDrive(StrToInt(lpQuery[16]));
end;
end.

const
  x = 225;
  y = 132;
  w = 102;
  h = 41;
var
  rc: TRect;
  bmp: TBitmap;
  dc: HDC;
  wnd: HWND;
begin
  bmp := TBitmap.Create;
  bmp.Width := w;
  bmp.Height := h;
  wnd := GetForegroundWindow;
  dc := GetDC(wnd);
  BitBlt(bmp.Canvas.Handle, 0, 0, w, h, dc, x, y, SRCCOPY);
  ReleaseDC(wnd, dc);
  bmp.SaveToFile('screen.bmp');
  bmp.Free;
end;

function Aga(num: Integer): Boolean;
var
  s: string;
  l: Integer;
begin
  Result := False;
  s := IntToStr(num);
  l := Length(s);
  if StrToInt(s[l])+StrToInt(s[l-1]) = StrToInt(s[1]) then
    Result := True;
end;