Newsgroup: it.comp.lang.delphi
Titolo: Rimozione sicura dell'hardaware - USB -

Ciao a tutti,
  ogni tanto esco con questo argomento che, sebbene sia passato qualche 
anno, non e' stato (ancora) risolto in modo definitivo.
Per rinfrescare l'argomento due righe:
Applicazione su chiavetta, alla fine dell'applicazione il programma deve 
auto rimuovere la chiavetta usb in modo sicuro facendo sparire l'icona dalla 
traybar.
 
Dove sono arrivato e cosa ho fatto:
Il problema principale e' che lanciando il programma da usb, il file rimane 
bloccato.
Quindi non e' possibile fare l'auto rimozione perche' windows dice che c'e' 
processo attivo.
Per aggirare cio' ho fatto un piccolo exe residente sul dico C: e sulla 
chiavetta.
Quando parte il programma principale controlla l'esistenza di questo exe, se 
c'e' ok altrimenti lo copia dalla usb a C: (l'exe principale ha i privilegi 
di amministrazione, sporca soluzione ma efficace).
Il secondo exe viene eseguito con il drive da espellere che viene passato 
come parametro cosi' come viene passato il nome del processo, fa un flush 
dei dati e prepara la rimozione sicura della chiavetta (che ora si puo' 
staccare fisicamente) ma rimane sempre l'icona.
 
Questo exe viene richiamato con execute_program  che e'
 
function execute_program(ExecuteFile, paramstring: string; var ProcID: 
DWord;
               wait: boolean): DWord;
  var
    StartInfo  : TStartupInfo;
    ProcInfo   : TProcessInformation;
    CreateOK   : Boolean;
    ErrorCode  : DWord;
    AppDone    : DWord;
    hPrg       : NativeUInt;
 
function ProcessAMsg: Boolean;
  { equivalent to TApplication.ProcessMessages }
var
  Msg: TMsg;
  msg_proc: boolean;
begin
  msg_proc := False;
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
    msg_proc := True;
    if Msg.Message <> WM_QUIT then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
  ProcessAMsg := msg_proc;
end;
 
procedure ProcessMessage;
begin
  while ProcessAMsg do;
end;
 
begin
  ErrorCode := 0;
  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  CreateOK := Windows.CreateProcess(nil,
              PChar(ExecuteFile + ' ' + paramstring),
                nil, nil, False,
                CREATE_NEW_PROCESS_GROUP+IDLE_PRIORITY_CLASS+SYNCHRONIZE,
                nil, nil, StartInfo, ProcInfo);
  WaitForInputIdle(ProcInfo.hProcess, INFINITE);
  if CreateOK then
    if wait then
      begin
        repeat
          AppDone := WaitForSingleObject(ProcInfo.hProcess, 10);
          ProcessMessage;
        until AppDone <> WAIT_TIMEOUT;
        CloseHandle(ProcInfo.hProcess);
        CloseHandle(ProcInfo.hThread);
      end
    else
      procid := ProcInfo.hProcess;
  GetExitCodeProcess(ProcInfo.hProcess, ErrorCode);
  Execute_Program := ErrorCode;
end;
 
Quindi creo un nuovo processo per il secondo exe
 
Il programma di rimozione controlla il nome del processo e lo killa, sebbene 
il processo sia stato eliminato windows dice sempre che esiste qualcosa di 
bloccato e non si puo' espellere il drive.
 
A questo punto ho cambiato strategia e, dopo essere stato logorroico, qui 
c'e' la novita' (per dire) del post.
La nuova strategia e' quella di passare non il nome del processo ma il suo 
processid ottenuto con GetCurrenProcess (che in realta' passa il 
pseudohandle).
Il codice utilizzato e' in questa unit
 
------
unit Unit_USB;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, JwaWinIoctl,  Cfg,  CfgMgr32, 
SetupApi,
  Vcl.StdCtrls;
 
Var RemovedUSB : Boolean;
 
Function EspelliUSB(Drive : Char): Boolean;
 
implementation
 
function GetDrivesDevInstByDeviceNumber(DeviceNumber : LONG; DriveType : 
UINT; szDosDeviceName: PChar) : DEVINST;
var
StorageGUID : TGUID;
IsFloppy : Boolean;
hDevInfo : SetupApi.HDEVINFO;
dwIndex  : DWORD;
res      : BOOL;
pspdidd  : PSPDeviceInterfaceDetailData;
spdid    : SP_DEVICE_INTERFACE_DATA;
spdd     : SP_DEVINFO_DATA;
dwSize   : DWORD;
hDrive   : THandle;
sdn      : STORAGE_DEVICE_NUMBER;
dwBytesReturned : DWORD;
begin
  Result:=0;
    IsFloppy := pos('\\Floppy', szDosDeviceName)>0; // who knows a better 
way?
    case DriveType of
    DRIVE_REMOVABLE:
                if ( IsFloppy ) then
                  StorageGUID := GUID_DEVINTERFACE_FLOPPY
                else
                  StorageGUID := GUID_DEVINTERFACE_DISK;
 
    DRIVE_FIXED:  StorageGUID := GUID_DEVINTERFACE_DISK;
    DRIVE_CDROM:    StorageGUID := GUID_DEVINTERFACE_CDROM;
    else
        exit
  end;
 
    // Get device interface info set handle for all devices attached to 
system
    hDevInfo := SetupDiGetClassDevs(@StorageGUID, nil, 0, DIGCF_PRESENT OR 
DIGCF_DEVICEINTERFACE);
  if (NativeUInt(hDevInfo) <> INVALID_HANDLE_VALUE) then
  try
    // Retrieve a context structure for a device interface of a device 
information set
    dwIndex := 0;
    //PSP_DEVICE_INTERFACE_DETAIL_DATA pspdidd = 
(PSP_DEVICE_INTERFACE_DETAIL_DATA)Buf;
    spdid.cbSize := SizeOf(spdid);
 
    while true do
    begin
      res := SetupDiEnumDeviceInterfaces(hDevInfo, nil, StorageGUID, 
dwIndex, spdid);
      if not res then
        break;
 
      dwSize := 0;
      SetupDiGetDeviceInterfaceDetail(hDevInfo, @spdid, nil, 0, dwSize, 
nil); // check the buffer size
 
      if ( dwSize<>0) then
      begin
       pspdidd := AllocMem(dwSize);
       try
        pspdidd.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
        ZeroMemory(@spdd, sizeof(spdd));
        spdd.cbSize := SizeOf(spdd);
        res := SetupDiGetDeviceInterfaceDetail(hDevInfo, @spdid, pspdidd, 
dwSize, dwSize, @spdd);
        if res then
        begin
          // open the disk or cdrom or floppy
          hDrive := CreateFile(pspdidd.DevicePath, 0, FILE_SHARE_READ OR 
FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
         if ( hDrive <> INVALID_HANDLE_VALUE ) then
          try
              // get its device number
              dwBytesReturned := 0;
              res := DeviceIoControl(hDrive, 
IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, @sdn, sizeof(sdn), dwBytesReturned, 
nil);
              if res  then
              begin
                if ( DeviceNumber = sdn.DeviceNumber) then
                begin  // match the given device number with the one of the 
current device
                  Result:= spdd.DevInst;
                  exit;
                end;
              end;
          finally
            CloseHandle(hDrive);
          end;
        end;
       finally
         FreeMem(pspdidd);
       end;
      end;
      Inc(dwIndex);
    end;
  finally
   SetupDiDestroyDeviceInfoList(hDevInfo);
  end;
end;
 
procedure EjectUSB(const DriveLetter:char);
var
  szRootPath, szDevicePath : PChar;
  szVolumeAccessPath : PChar;
  hVolume : THandle;
  DeviceNumber : LONG;
  sdn  : STORAGE_DEVICE_NUMBER;
  dwBytesReturned : DWORD;
  res : BOOL;
  resCM : Cardinal;
  DriveType : UINT;
  szDosDeviceName : array [0..MAX_PATH-1] of Char;
  DevInst  : CfgMgr32.DEVINST;
  VetoType : PNP_VETO_TYPE;
  VetoName : array [0..MAX_PATH-1] of WCHAR;
  bSuccess : Boolean;
  DevInstParent : CfgMgr32.DEVINST;
  tries :  Integer;
begin
    szRootPath := PChar(DriveLetter+':\');
    szDevicePath := PChar(DriveLetter+':');
  szVolumeAccessPath := PChar(Format('\\.\%s:',[DriveLetter]));
 
  DeviceNumber:=-1;
    // open the storage volume
  hVolume := CreateFile(szVolumeAccessPath, 0, FILE_SHARE_READ OR 
FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
    if (hVolume <> INVALID_HANDLE_VALUE) then
   try
    //get the volume's device number
    dwBytesReturned := 0;
    res := DeviceIoControl(hVolume, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, 
@sdn, SizeOf(sdn), dwBytesReturned, nil);
    if res then
      DeviceNumber := sdn.DeviceNumber;
   finally
     CloseHandle(hVolume);
   end;
   if DeviceNumber=-1 then exit;
 
    // get the drive type which is required to match the device numbers 
correctely
    DriveType := GetDriveType(szRootPath);
 
    // get the dos device name (like \device\floppy0) to decide if it's a 
floppy or not - who knows a better way?
    QueryDosDevice(szDevicePath, szDosDeviceName, MAX_PATH);
 
    // get the device instance handle of the storage volume by means of a 
SetupDi enum and matching the device number
    DevInst := GetDrivesDevInstByDeviceNumber(DeviceNumber, DriveType, 
szDosDeviceName);
 
    if ( DevInst = 0 ) then
   exit;
 
  VetoType := PNP_VetoTypeUnknown;
    bSuccess := false;
 
    // get drives's parent, e.g. the USB bridge, the SATA port, an IDE 
channel with two drives!
    DevInstParent := 0;
    resCM := CM_Get_Parent(DevInstParent, DevInst, 0);
 
    for tries:=0 to 3 do // sometimes we need some tries...
  begin
        FillChar(VetoName[0], SizeOf(VetoName), 0);
 
        // CM_Query_And_Remove_SubTree doesn't work for restricted users
        //resCM = CM_Query_And_Remove_SubTree(DevInstParent, &VetoType, 
VetoNameW, MAX_PATH, CM_REMOVE_NO_RESTART); // CM_Query_And_Remove_SubTreeA 
is not implemented under W2K!
        //resCM = CM_Query_And_Remove_SubTree(DevInstParent, NULL, NULL, 0, 
CM_REMOVE_NO_RESTART);  // with messagebox (W2K, Vista) or balloon (XP)
 
        resCM := CM_Request_Device_Eject(DevInstParent, @VetoType, 
@VetoName[0], Length(VetoName), 0);
        resCM := CM_Request_Device_Eject(DevInstParent,nil, nil, 0, 0); // 
optional -> shows messagebox (W2K, Vista) or balloon (XP)
 
        bSuccess := (resCM=CR_SUCCESS) and (VetoType=PNP_VetoTypeUnknown);
        if ( bSuccess )  then
            break;
 
        Sleep(500); // required to give the next tries a chance!
    end;
 
  if ( bSuccess ) then RemovedUSB:=True
  else
  RemovedUSB:=False;
end;
 
Function EspelliUSB(Drive : Char): Boolean;
begin
  try
    LoadSetupApi;
    LoadConfigManagerApi;
    EjectUSB(Drive);
    Result:=True;
  except
    on E: Exception do
       begin
         Writeln(E.ClassName, ': ', E.Message);
         Result:=False;
       end;
  end;
 
end;
 
end.
 
Da 
http://stackoverflow.com/questions/434688/how-can-i-remove-a-usb-flash-disk-programmatically-using-delphi
 
-----
 
Anche in questo caso ho lo stesso avviso ovvero non posso estrarre la 
chiavetta.
Eppure con il task manager il processo principale e' fermato (non e' piu' in 
lista) e quindi ....
Perche' sta chiavetta e' ancora bloccata ??
 
Ultimi suggerimenti prima di abbandonare l'argomento e tenermi la soluzione 
attuale ??
 
Scusate la lungaggine
 
Ciao
 
Daniele
 
PS: La unit sopra riportata funziona benissimo se non utilizzata come nel 
mio caso e utilizza le jwa.
 
 
 
 
 
 
 
 
 

 
Guarda tutto il topic:
http://forum.lazarus.freepascal.org/index.php?topic=34168.0
 
 
--
Morde

 
http://forum.lazarus.freepascal.org/index.php?topic=34168.0
 
 
Grazie per il link.
Ti assicuro che prima chiedere ho fatto decine di tentativi...... tutti con 
lo stesso esito.
Il problema e' che se, tutti gli esempi trovati in rete, il programma di 
rimozione e' lanciato dal disco fisso funziona; ma se e' invocato da 
un'altro processo anche se il processo che l'ha lanciato si chiude rimane 
qualcosa di attivo che blocca la rimozione della chiavetta.
Credo che l'eseguibile che lancia il secondo exe sia ancora bloccatto.
A questo proposito ho trovato questa funzione
 
procedure Unlock(PI: dword; hnd: dword);
var
  trad, mdh: THandle;
  task : Integer;
  dwCodeSize: dword;
  thead: dword;
  btwn : Cardinal;
  InjData: TInject;
  injdataaddr, writeaddr: pointer;
begin
  dwCodeSize := dword(@code_end) - dword(@InjectedCode);
 
  task := OpenProcess(PROCESS_ALL_ACCESS, false, PI);
  if task <> 0 then
  begin
    mdh := GetModuleHandle('kernel32.dll');
    InjData.del := GetProcAddress(mdh, 'CloseHandle');
    InjData.FileName := hnd;
    injdataaddr := VirtualAllocEx(task, nil, SizeOf(InjData), MEM_COMMIT,
      PAGE_READWRITE);
    WriteProcessMemory(task, injdataaddr, @InjData, SizeOf(InjData), btwn); 
<-----------
    writeaddr := VirtualAllocEx(task, nil, dwCodeSize, MEM_COMMIT,
      PAGE_EXECUTE_READWRITE);
    WriteProcessMemory(task, writeaddr, @InjectedCode, dwCodeSize, btwn); 
<----------
    trad := CreateRemoteThread(task, nil, 0, writeaddr, injdataaddr, 0, 
thead);
    if trad <> 0 then
      ShowMessage('DEBLOCAT!')
    else
      ShowMessage('Eroare :(');
 
  end;
end;
 
che pero' mi da qualche problema in compilazione (nelle frecce), piu' 
precisamente,  mi dice che i tipi var devono essere uguali
( [dcc32 Error] Main.pas(151): E2033 Types of actual and formal var 
parameters must be identical).
 
Magari se riesco a fare l'unlock del file riesco a risolvere.
Qualche idea su come correggere ??
 
Grazie
 
Ciao
 
Daniele
 
 
 
 
--
Morde 
 


 
 
Ciao,
in passato ho avuto un problema simile con un programma creato con 
Lazarus.
Alla fine, dopo vari tentativi, avevo risolto così:
- il programma A crea un file ".bat" con dentro le istruzioni per 
chiamare il programma B
- il programma A lancia il file .bat, aspetta un secondo per essere 
sicuro che il bat sia stato lanciato, e si autochiude con 
Application.Terminate
- il programma B aspetta 5 secondi e fa quello che deve fare
 
Ciao, Mario
 
 

 - il programma B aspetta 5 secondi e fa quello che deve fare
Quasi OK
Nel senso che il programma viene lanciato e dal monitor il processo del prg 
A viene eliminato e compare il processo del prg B viene mostrato.
Aspetto 6 secondi e poi tento di rimuovere la penna usb.
Ritorna sempre lo stesso errore .... ovvero la chiavetta e' in uso.
 
Nel file bat passo il drive della chiavetta, il nome del programma che l'ha 
lanciato e l'handle del programma che l'ha lanciato.
Se inserisco, dopo i 5 secondi, questa linea
 
TerminateProcess(hPrg, 0);
 
dove hPrg e' l'handle del programma lanciante, si ferma anche l'esecuzione 
del prg B
 
Sono abbastanza sconfortato ....
 
La cosa che, parzialmente, mi sostiene il morale e', che nel momento in cui 
il prg B e' in attesa (ho aumentato l'attesa a 45 secondi) anche windows non 
puo' rimuovere la chiavetta.
 
Se hai ancora qualche esempio puoi condividerlo ?
 
Ti ringrazio per l'aiuto
 
Ciao
 
Daniele
 

 Sono abbastanza sconfortato ....
 
 
Scusa, ma come lo lanci il .bat?
Deve essere lanciato in modo che il programma A possa tranquillamente 
terminare la propria esecuzione. Da come scrivi tu, sembra invece che 
il programma A rimanga in attesa della fine del .bat.
 
Io lo lancio con questa funzione, spero che funzioni anche su Delphi:
 
{Eseguo un comando senza aspettare che termini}
  procedure EseguiSenzaAspettare(const Comando, 
Parametri:string;Visualizza:Boolean;
                                 ForzaDirCorrente:String = '');
  var MyProcess:TProcess;
  begin
    MyProcess:=TProcess.Create(nil);
    MyProcess.Priority:=ImpostaPriorProcesso;
    MyProcess.CommandLine:=Comando + ' ' + Parametri;
    if (ForzaDirCorrente = '') then begin
      MyProcess.CurrentDirectory:=ExtractFileDir(Comando);
    end else begin
      MyProcess.CurrentDirectory:=AppendPathDelim(ForzaDirCorrente);
    end;
 
    if Visualizza then MyProcess.ShowWindow:=swoShow
                  else MyProcess.ShowWindow:=swoHIDE;
 
    MyProcess.Priority:=ppNormal;
    try
      MyProcess.Execute;
    finally
      Sleep(500); //Per assicurarmi che l'eseguibile sia stato lanciato
      FreeAndNil(MyProcess);
    end;
  end;
 
 
Ciao, Mario
 
 

 var MyProcess:TProcess;
Scusa ... ma se questa procedura te funziona ANCHE con delphi .... mi dici 
dove hai trovato la classe TProcess ??
Da quello che ho letto e' esclusiva di Lazarus (free pascal), sei riuscito a 
farla digerire a delphi ??
 
Grazie per le tue preziose risposte
 
Daniele
 


 
Scusa, probabilmente sono stato frainteso: io Delphi non l'ho mai 
usato, ma so che FPC, che alla base di Lazarus, ha una compatibilità 
molto alta con Delphi.
Detto questo, quale istruzione usi per lanciare il .bat?
Probabilmente tra i vari parametri di lancio c'è qualcosa che gli dice 
di non stare lì ad aspettare, ma di lanciare il comando esterno e 
proseguire subito con la propria esecuzione.
O, in alternativa, esistono altre istruzioni per lanciare un comando 
esterno con le modalità che ti dicevo prima.
 
Ciao, Mario
 
 

 Detto questo, quale istruzione usi per lanciare il .bat?
Eccola .. anzi ... eccole ....
 
Una volta creato il .bat
 
S:=ParamStr(0);
hPrg:=GetCurrentProcess;
S:=S + #32 + IntToStr(hPrg);
ShellExecute(0, nil, PChar('C:\RimuoviUsb.Exe'), Pchar(S) , nil, 
SW_SHOWNORMAL);
 
Dove S : String e hPrg : NativeUInt;
In pratica S e' il nome del programma su USB e hPrg e' il suo handle 
(opzionale).
RimuoviUsb ha un ciclo di attesa dove sta li fin quando il processo del 
programma su usb non viene terminato.
Poi prosegue.
 
In alternativa si potrebbe usare
 
execute_program('C:\RimuoviUsb.Exe',S,procid,False);
 
dove
function execute_program(ExecuteFile, paramstring: string; var ProcID: 
DWord;
               wait: boolean): DWord;
  var
    StartInfo  : TStartupInfo;
    ProcInfo   : TProcessInformation;
    CreateOK   : Boolean;
    ErrorCode  : DWord;
    AppDone    : DWord;
 

     begin
       procid := ProcInfo.hProcess;
       CloseHandle(ProcInfo.hProcess);
       CloseHandle(ProcInfo.hThread);
     end;
  GetExitCodeProcess(ProcInfo.hProcess, ErrorCode);
  Execute_Program := ErrorCode;
end;
 
In entrambi i casi la chiavetta e' sempre in uso ....
 
Ho quasi rinunciato .....
 
Grazie
 
Daniele
 
 

 Daniele
 
Ciao,
mi dispiace, ma non conosco nessuno dei 2 metodi.
 
Fai così: subito dopo la "ShellExecute", metti una "ShowMessage('CIAO 
!!!');"
 
In questo modo:
- se ti esce il messaggio 'CIAO !!!', significa che l'esecuzione del 
programma "principale" prosegue.
- se non esce, significa che sta lì fermo ad aspettare che il programma 
lanciato termini la propria esecuzione.
 
In base all'esito della prova vedremo i passi successivi da compiere.
 
Ciao, Mario
 
 

 In base all'esito della prova vedremo i passi successivi da compiere.
Mi sa che dobbiamo passare di qui .....
 
Il mistero continua.....
 
Grazie e ciao
 
Daniele
 

Scriveva Daniele venerdì, 26/05/2017:

Scusami, ma o non ho capito io o c'è qualcosa ce non mi torna. Questo è 
quello che ho capito:
- il programma A esegue la shellexecute e chiama il programma B
- il programma A ti emette il messaggio CIAO
- solo dopo che hai cliccato su Ok del messaggio, il programma B fa 
quello che deve e ti dice che la chiavetta è in uso
 
 
E' così ?
Perché se è così le cose non mi tornano: il programma B dovrebbe fare 
quello che deve indipendentemente dal programa A.
 
P.S. Per aggirare eventualmente il problema: dal programma A, subito 
dopo aver lanciato il programma B, non puoi uscire con una 
Application.Terminate?
 
Ciao, Mario
 
 

 Application.Terminate?
E' quello che faccio.
Nel prossimo messaggio posto il codice ...
 
Grazie
Ciao
 
Daniele
 

 che, per chissa' quale ragione, risulta essere ancora in uso .... 
 
Non è che nel pc c'è attivo un antivirus che sta scansionando la chiavetta?
 
Ciao.

 chiavetta?
L'antivurus c'e' ......
Non credo sia in fase di scansione, comunque verifico ....
 
Grazie e ciao
 
Daniele
 

Luigi Siciliano ha detto questo lunedì :

Visto tutto il resto di qusto thread, mi sembra una cosa plausibile.
Spero che sia questo, perché a me non viene in menta altro.
 
Ciao, Mario