Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Proyecto AjpdSoft: Foros

AjpdSoft :: Ver tema - Cerrar con seguridad dispositivos USB con Delphi
Foros de discusión Buscar Perfil FAQ Iniciar sesión
Information Cerrar con seguridad dispositivos USB con Delphi

Publicar nuevo tema Responder al tema
Foros de discusión » Borland Delphi, Codegear Delphi .Net   
Ver tema anterior :: Ver tema siguiente
AutorMensaje
varios
Magnífico usuario


Registrado: Oct 10, 2006
Mensajes: 2092

Asunto: Cerrar con seguridad dispositivos USB con Delphi Responder citando

Estoy desarrollando una aplicación de gestión, facturación y contabilidad, he implementado una opción de copia de seguridad a lápiz de memoria (pendrive) y quisiera saber si desde mi aplicación Delphi puedo extraer con seguridad el dispositivo, simulando la opción de Windows de "Quitar hardware de forma segura".

Utilizo Microsoft Windows 7 como sistema operativo y Borland Delphi 6 como lenguaje de programación.
MensajePublicado:
Sab May 22, 2010 7:13 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Cerrar con seguridad dispositivos USB con Delphi Responder citando



Anuncios



varios escribió:
Estoy desarrollando una aplicación de gestión, facturación y contabilidad, he implementado una opción de copia de seguridad a lápiz de memoria (pendrive) y quisiera saber si desde mi aplicación Delphi puedo extraer con seguridad el dispositivo, simulando la opción de Windows de "Quitar hardware de forma segura".

Utilizo Microsoft Windows 7 como sistema operativo y Borland Delphi 6 como lenguaje de programación.


Sí que es posible, a continuación te mostramos el código fuente de una de nuestras aplicaciones, que realiza justamente lo que nos indicas. Además, esta aplicación muestra los dispositivos conectados, incluso aunque ya esté abierta (mediante interrupciones):

Código:

unit UnidadMenuPrincipal;

{$R WinXP.res}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms,
  Dialogs, StdCtrls, ShlObj, Controls, CheckLst, ExtCtrls, Buttons,
  shellapi, ThemeMgr;

type
  TformMenuPrincipal = class(TForm)
    lsListaDispositivos: TCheckListBox;
    Label1: TLabel;
    LWEB: TLabel;
    ThemeManager1: TThemeManager;
    btRetirarUSB: TBitBtn;
    btSalir: TBitBtn;
    procedure FormActivate(Sender: TObject);
    procedure btRetirarUSBClick(Sender: TObject);
    procedure LWEBClick(Sender: TObject);
    procedure btSalirClick(Sender: TObject);
  private
    Procedure estadoConexionDispositivo (var Msg: TMessage); Message $0219;
  public
  end;

var
  vRetirarDispositivo : TformMenuPrincipal;
  letraVolumen, volumen : string;

implementation

{$R *.dfm}

Procedure TformMenuPrincipal.estadoConexionDispositivo (var Msg: TMessage);
//Dbt.h
Type
  DEV_BROADCAST_HDR     = ^PDEV_BROADCAST_HDR;
    PDEV_BROADCAST_HDR  = packed record
      dbch_size         : DWORD;
      dbch_devicetype   : DWORD;
      dbch_reserved     : DWORD;
  end;

  DEV_BROADCAST_VOLUME    = ^PDEV_BROADCAST_VOLUME;
    PDEV_BROADCAST_VOLUME = packed record
      dbcv_size           : DWORD;
      dbcv_devicetype     : DWORD;
      dbcv_reserved       : DWORD;
      dbcv_unitmask       : DWORD;
      dbcv_flags          : WORD;
  end;
var
  C : Integer;
begin
  //desconexión física
  if Msg.wParam = $8004 then
  begin
    if DEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype = 2 then
    begin
      if DEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_flags = 0 then
      begin
        Str(Ln(DEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_unitmask) / Ln(2) +
            Ord('A'):2:0, letraVolumen);
        letraVolumen := Char(StrToInt(letraVolumen));
        for c := 0 to lsListaDispositivos.Count - 1 do
        begin
          //quitar dispositivo de la lista
          volumen := lsListaDispositivos.Items.Strings[c];
          if volumen[1] = letraVolumen then
          begin
            lsListaDispositivos.Items.Delete(c);
            Break;
          end;
        end;
      end;
    end;
  end;

  //conexión física
  if Msg.wParam = $8000 then
  begin
    if DEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype = 2 then
    begin
      if DEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_flags = 0 then
      begin
        //añadir nuevo volumen a la lista
        Str(Ln(DEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_unitmask) / Ln(2) +
            Ord('A'):2:0, letraVolumen);
        letraVolumen := Char(StrToInt(letraVolumen));
        lsListaDispositivos.Items.Add(letraVolumen + ':\ -> Conectado');
      end;
    end;
  end;
end;

function extraerDispositivoUSB (letraDispositivo : String;
    intervaloTiempo : Integer = 0; numeroIntentos : Integer = 1) : Boolean;
const
  //parámetros de WinIoCtl.h
  FSCTL_LOCK_VOLUME           = ($00000009 shl 16) or ($0000 shl 14) or (00006 shl 2) or 0;
  FSCTL_DISMOUNT_VOLUME       = ($00000009 shl 16) or ($0000 shl 14) or (00008 shl 2) or 0;
  IOCTL_STORAGE_MEDIA_REMOVAL = ($0000002d shl 16) or ($0001 shl 14) or ($0201 shl 2) or 0;
  IOCTL_STORAGE_EJECT_MEDIA   = ($0000002d shl 16) or ($0001 shl 14) or ($0202 shl 2) or 0;
  FSCTL_UNLOCK_VOLUME         = ($00000009 shl 16) or ($0000 shl 14) or (00007 shl 2) or 0;
Type
  TPREVENT_MEDIA_REMOVAL  = record
  PreventMediaRemoval : ByteBool;
end;
var
  HandleVolume : THandle;
  formatoLetraDispositivo : string;
  lpBytesReturned : DWORD;
  PreventRemoval : TPREVENT_MEDIA_REMOVAL;
  T : Integer;
begin
  letraDispositivo := Uppercase(letraDispositivo);
  formatoLetraDispositivo := Format('%s:', [letraDispositivo]);
  Result := False;
  case GetDriveType(PChar(formatoLetraDispositivo)) of
    DRIVE_REMOVABLE:
    begin
      //configurar el formato deseado
      formatoLetraDispositivo := Format('\\.\%s:', [letraDispositivo]);
      PreventRemoval.PreventMediaRemoval := False;
      //creación del volumen
      HandleVolume := CreateFile(PChar(formatoLetraDispositivo),
          GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
          nil, OPEN_EXISTING, 0, 0);
      //cierre del volumen
      for T := 0 to numeroIntentos do
      begin
        if DeviceIoControl(HandleVolume, FSCTL_LOCK_VOLUME,
            nil, 0, nil, 0, lpBytesReturned, nil) then
        begin
          //desmontar volumen
          DeviceIoControl(HandleVolume, FSCTL_DISMOUNT_VOLUME,
              nil, 0, nil, 0, lpBytesReturned, nil);
          //control del volumen
          DeviceIoControl(HandleVolume, IOCTL_STORAGE_MEDIA_REMOVAL,
              @PreventRemoval, SizeOf(TPREVENT_MEDIA_REMOVAL),
              nil, 0, lpBytesReturned, nil);
          //retirar volumen
          DeviceIoControl(HandleVolume, IOCTL_STORAGE_EJECT_MEDIA, nil,
              0, nil, 0, lpBytesReturned, nil);
          //liberar el volumen
          Result := DeviceIoControl(HandleVolume, FSCTL_UNLOCK_VOLUME, nil,
              0, nil, 0, lpBytesReturned, nil);
          formatoLetraDispositivo := Format('%s:\',[letraDispositivo]);
          //enviar al sistema aviso de que desmonte el dispositivo
          ShChangeNotify(SHCNE_MEDIAREMOVED, SHCNF_PATH,
              PChar(formatoLetraDispositivo), Nil);
          Break;
        end
        else
        begin
          Result := False;
          Sleep(intervaloTiempo);
        end;
      end;
      //liberar volumen
      CloseHandle(HandleVolume);
    end
    else
      Result := False;
  end;
end;

Procedure listaDispositivos (dispositivos : TStrings; tipos : Integer);
var
  i   : integer;
  bits  : set of 0..25;
  disco : String;
begin
  //obtener nombre de los discos lógicos
  integer(bits):= GetLogicalDrives;

  //obtener letras si el dispositivo es removible DRIVE_REMOVABLE
  for i := 0 to 25 do
  begin
    if i in bits then
    begin
      disco := Char(i + Ord('A')) + ':';
      if tipos = GetDriveType(PChar(disco)) then
        dispositivos.Append(Char(i + Ord('A')) + ':\ -> Conectado');
    end;
  end;
end;

procedure TformMenuPrincipal.FormActivate(Sender: TObject);
begin
  lsListaDispositivos.Clear;
  listaDispositivos(lsListaDispositivos.Items, DRIVE_REMOVABLE);
end;

procedure TformMenuPrincipal.btRetirarUSBClick(Sender: TObject);
var
  i : Integer;
begin
  volumen := '';
  for i := 0 to lsListaDispositivos.Count - 1 do
  begin
    if lsListaDispositivos.Checked[i] then
    begin
      volumen := lsListaDispositivos.Items.Strings[i];
      //retirar volúmenes seleccionados, con tres intentos
      //con un intervalo de de 2000 ms cada uno
      if extraerDispositivoUSB (volumen[1], 2000, 3) then
      begin
        MessageDlg('El dispositivo ' + volumen[1] +
            ' ya se puede retirar con seguridad.', mtInformation, [mbOk], 0);
        lsListaDispositivos.Items.Strings[i] := volumen[1] +
            ':\ -> esperando ser extraído físicamente '
      end
      else
        MessageDlg('El dispositivo ' + volumen[1] + ' no puede ser retirado.' +
                    chr(13) + chr(13) + 'Posible causa:' + chr(13) +
                   '- El dispositivo ' + volumen[1] + ' está siendo utilizado.' +
                    chr(13) +
                   '- El dispositivo ' + volumen[1] + ' ya no existe.' + chr(13) +
                   '- El dispositivo ' + volumen[1] + ' tiene algún problema.',
                   mtWarning, [mbOk], 0);
    end;
  end;
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar('http://www.ajpdsoft.com'),
      Nil, Nil, SW_SHOWNORMAL);
end;

procedure TformMenuPrincipal.btSalirClick(Sender: TObject);
begin
  close;
end;

end.
MensajePublicado:
Sab May 22, 2010 7:15 pm
Top of PageVer perfil de usuario
varios
Magnífico usuario


Registrado: Oct 10, 2006
Mensajes: 2092

Asunto: Re: Cerrar con seguridad dispositivos USB con Delphi Responder citando



Anuncios



¿Está disponible esta aplicación en vuestra web?
MensajePublicado:
Sab May 22, 2010 7:16 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Cerrar con seguridad dispositivos USB con Delphi Responder citando



Anuncios



varios escribió:
¿Está disponible esta aplicación en vuestra web?


Acabamos de publicar la descarga de AjpdSoft Quitar dispositivos USB de forma segura:

http://www.ajpdsoft.com/modules.php?name=Downloads&d_op=viewdownloaddetails&lid=267
MensajePublicado:
Sab May 22, 2010 9:03 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Cerrar con seguridad dispositivos USB con Delphi Responder citando



Anuncios



El artículo que explica cómo funciona la aplicación AjpdSoft Quitar dispositivos USB de forma segura:

http://www.ajpdsoft.com/modules.php?name=News&file=article&sid=463
MensajePublicado:
Mar May 25, 2010 5:22 am
Top of PageVer perfil de usuario
Mostrar mensajes de anteriores:   
Todas las horas son GMT - 1 Horas
Publicar nuevo tema Responder al tema
Foros de discusión » Borland Delphi, Codegear Delphi .Net  

Cambiar a:  
Key
  Puede publicar nuevos temas en este foro
No puede responder a temas en este foro
No puede editar sus mensajes en este foro
No puede borrar sus mensajes en este foro
No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A