IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

API, COM et SDKs Delphi Discussion :

[USB] Ejection d'un disque [FAQ]


Sujet :

API, COM et SDKs Delphi

  1. #21
    dem
    dem est déconnecté
    Membre habitué

    Inscrit en
    Juillet 2003
    Messages
    110
    Détails du profil
    Informations personnelles :
    Âge : 55

    Informations forums :
    Inscription : Juillet 2003
    Messages : 110
    Points : 137
    Points
    137
    Par défaut
    Voilà un truc super intéressant !

    Déjà que Windows tout seul n'arrive pas une fois sur deux à me déconnecter mes périphériques USB correctement tout seul... Je m'étais dit qu'il faudrait un jour trouver une appli qui force Windows à libérer ses #u?%@n$ de lecteurs...

    Pour vous je ne sais pas, mais trop souvent, alors qu'il ne se passe rien du tout sur mon lecteur ou ma clé USB, en cliquant sur "Retirer le périphérique en toute sécurité", Windows me signale que c'est impossible ... Même en y allant brutalement je n'ai (je crois) jamais perdu de données, mais bon....

  2. #22
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut Une autre piste interressante Hotplug.dll
    HotPlug.dll contient les fonctions suivantes :

    CPlApplet
    HotPlugChildWithInvalidIdW
    HotPlugDriverBlockedW
    HotPlugEjectDevice
    HotPlugEjectVetoedW
    HotPlugHibernateVetoedW
    HotPlugRemovalVetoedW
    HotPlugSafeRemovalNotificationW
    HotPlugStandbyVetoedW
    HotPlugWarmEjectVetoedW

    Helas je ne connais pas les paramètres et Microsoft n'est pas prolixe sur ce sujet , c'est le moins que l'on puisse dire
    Un shellExecute se ferait de la manière suivante (non testé, attention à la casse du texte )
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    shellExecute(Handle,nil,'rundll32.exe','Sell32.dll,Control_RunDLL hotplug.dll',nil,SW_SHOW)
    à suivre
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  3. #23
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut un petit pas en avant
    en cherchant beaucoup sur le net, j'ai trouvé ceci
    Callers of CM_Request_Device_Eject sometimes require SeUndockPrivilege or SeLoadDriverPrivilege, as follows:

    * If the device's CM_DEVCAP_DOCKDEVICE capability is set (the device is a "dock" device), callers must have SeUndockPrivilege. (SeLoadDriverPrivilege is not required.)
    * If the device's CM_DEVCAP_DOCKDEVICE capability is not set (the device is not a "dock" device), and if the calling process is either not interactive or is running in a multi-user environment in a session not attached to the physical console (such as a remote Terminal Services session), callers of this function must have SeLoadDriverPrivilege.
    qui expliquerait peut-être le pourquoi du refus OBSTINE de vista

    j'ai également trouvé
    Code C : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    typedef BOOL (WINAPI* pfnHotPlugEjectDevice)(HWND hwndParent, PTCHAR DeviceInstanceId);
     
    pfnHotPlugEjectDevice HotPlugEjectDevice = NULL;
     
    HMODULE hHotPlug = LoadLibrary("HotPlug.dll");
    if(hHotPlug == NULL) 
    {
    printf("LoadLibrary(HotPlug.dll) Error:%d\n", GetLastError());
    return FALSE;
    }
     
    //get functions
    HotPlugEjectDevice = (pfnHotPlugEjectDevice)GetProcAddress(hHotPlug, "HotPlugEjectDevice");
     
    BOOL bResult = HotPlugEjectDevice(NULL, "USB\\Vid_xxxx&Pid_xxxx\\4D3B190303C0");
    DEVNODE DevNode;
        CONFIGRET ConfigRet;
     
        if ((ConfigRet = CM_Locate_DevNode(&DevNode,
    /*"USB\\Vid_0d7d&Pid_0150&Rev_0100"*//*"USB\\Class08&SubClass06&Port50"*/NULL,
    0)) == CR_SUCCESS) {
     
            ConfigRet = CM_Request_Device_Eject_Ex(DevNode,
    NULL,
    NULL,
    0,
    0,
    NULL);
        }

    les explications étant en japonnais je ne les joints pas d'ailleurs je ne lis pas les ideogrammes

    Quelqu'un pourrait-il se pencher sur une traduction de C vers DELPHI ?

    c'est quoi ces constantes : (j'ai une sainte horreur des constantes )

    "USB\\Vid_xxxx&Pid_xxxx\\4D3B190303C0"
    /*"USB\\Vid_0d7d&Pid_0150&Rev_0100"*//*"USB\\Class08&SubClass06&Port50"*/NULL


    un autre lien utile
    http://www.codeproject.com/system/Re...veByLetter.asp
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  4. #24
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut RESOLU
    j'ai réussi mon ejection sous VISTA
    Je remet résolu sur ce post , je teste sous XP , j'en fait une nouvelle fonction ...

    bref
    le résultat dans quelques heures ... jours
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  5. #25
    Membre éprouvé
    Avatar de goldkey
    Profil pro
    Inscrit en
    Mars 2003
    Messages
    802
    Détails du profil
    Informations personnelles :
    Âge : 43
    Localisation : France

    Informations forums :
    Inscription : Mars 2003
    Messages : 802
    Points : 1 084
    Points
    1 084
    Par défaut


    Félicitation SergioMaster

    Je commencais a peine à redevelopper la fonction après m'etre battu avec la JVCL !!

    En tout cas j'ai hate de voir ca...
    Yes We Can

  6. #26
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    premier jus :

    y'a encore un problème , en theorie c'est valable également pour les CD mais le programme me renvoi une erreur je vais regarder de plus près le composant d'EroSenin

    le tout est encore en vrac , ne pas désespérer un bon coup de balai est en cours

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    unit Unit1;
     
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, Buttons, Cfg, CfgMgr32, JwaWinBase, JwaWinIoCtl, SetupApi ;
     
     
    type
      TForm1 = class(TForm)
        BitBtn1: TBitBtn;
        Dr: TEdit;                                             // 'F:'
        procedure BitBtn1Click(Sender: TObject);
      private
        { Déclarations privées }
      public
        { Déclarations publiques }
        procedure DisplaySystemError;
        function GetDeviceNumber(Drive : String) : Cardinal;
        function NomDos(Drive : String) : String;
        function GetDrivesDevInstByDeviceNumber(DeviceNom,DriveType : Cardinal; DriveName : String) : DEVINST;
      end;
     
    var
      Form1: TForm1;
     
    implementation
     
    {$R *.dfm}
     
    {
    Obtention du numéro réel? de volume à ejecter
    }
    function TForm1.GetDrivesDevInstByDeviceNumber(DeviceNom,DriveType : Cardinal; DriveName : String) : DEVINST;
    var isFloppy : Boolean;
        StorageGUID : TGUID;
        PnPHandle: HDEVINFO;
        DevData: TSPDevInfoData;
        DeviceInterfaceData: TSPDeviceInterfaceData;
        FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
        Success: LongBool;
        Devn : Integer;
        BytesReturned: Cardinal;
        Hdrive : THandle;
        sdn : STORAGE_DEVICE_NUMBER;
    begin
      result:=0;
      isFloppy:=(Pos('\\Floppy',DriveName)>0);
      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;
      Result := 0;
      PnPHandle := SetupDiGetClassDevs(@StorageGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
      if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
        begin
         ShowMessage('erreur');
         exit;
        end;
        Devn := 0;
        repeat
          DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
          Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, StorageGUID, Devn, DeviceInterfaceData);
        if Success then
        begin
          DevData.cbSize := SizeOf(DevData);
          BytesReturned := 0;
          SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
          if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
          begin
            FunctionClassDeviceData := AllocMem(BytesReturned);
            try
              FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
              if SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
                          FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) then
              begin
           			// open the disk or cdrom or floppy
    				    HDrive:=CreateFile(FunctionClassDeviceData.DevicePath, 0, FILE_SHARE_READ OR FILE_SHARE_WRITE,nil, OPEN_EXISTING, 0, 0);
    				    if (HDrive<>INVALID_HANDLE_VALUE ) then
                 begin
    				   	  // get its device number
    					     Success := DeviceIoControl(HDrive, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, @sdn, sizeof(sdn), @BytesReturned, nil);
    					     if (Success) AND (DeviceNom=sdn.DeviceNumber) then
                     begin
                      // match the given device number with the one of the current device
                  	  CloseHandle(HDrive);
    							    SetupDiDestroyDeviceInfoList(PnpHandle);
    							    Result:=DevData.DevInst;
                     end;
                    CloseHandle(HDrive);
    	            end;
              end;
            finally
              FreeMem(FunctionClassDeviceData);
            end;
           end;
          end;
          Inc(Devn);
        until not Success;
        SetupDiDestroyDeviceInfoList(PnPHandle);
    end;
     
    {
    Nom Dos du Volume (par exemple  \device\floppy0)
    apparement ce serait le seul moyen de savoir si c'est un floppy  ou USB
    }
    function TForm1.NomDos(Drive: string) : String;
    var Nom : String[60];
    begin
      Nom:='';
      QueryDosDevice(Pchar(Drive),@Nom,60);
      result:=Copy(nom,0,pos(#0,nom)-1);
    end;
     
     
    {
    ACTION
    }
    procedure TForm1.BitBtn1Click(Sender: TObject);
    var dtype,dnumber,retf : Cardinal ; // drivetype , drivenumber , retour de fonction
        i : Word;               // essais 1 à 3
        nd : String;            // nom dos du drive (permet de distinguer un floppy d'un USB)
        DIParent : DEVINST;     // identifient du parent
        ejecte : Boolean;
    begin
    dtype := GetDriveType(PChar(Dr.Text+'\'));
    dnumber := GetDeviceNumber(Dr.Text);
    nd:=NomDos(dr.text);
    LoadSetupApi;
    LoadConfigManagerApi;
    dnumber:=GetDrivesDevInstByDeviceNumber(Dnumber,Dtype,nd);
    if dnumber>0 then
     begin
      //****** ici il doit certainement y avoir un test manquant
      //****** car pour un CD pas de parent ???
    	// Obtenir le parent, i.e.  USB bridge, port SATA, Canal IDE avec 2 lecteurs!
    	DIParent:= 0;
    	CM_Get_Parent(DIParent,Dnumber, 0);
    	for i:=1 to 3  do // au cas où cela ne marche pas du premier coup.
        begin
     		 retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0); // avec  message (W2K, Vista) ou bulle (XP)
    		 ejecte:=(retf=CR_SUCCESS) ;
    	   if (ejecte) then break else Sleep(500); // Attendre avant de retenter!
        end;
     end;
    UnloadConfigManagerApi;
    UnloadSetupApi;
    end;
     
    {
    Obtention du Numéro du Volume
    }
    function TForm1.GetDeviceNumber(Drive : String) : Cardinal;
    var R : LongBool;                  // retour de fonction
        HVolume : THandle;             // Hande du volume
        sdn : STORAGE_DEVICE_NUMBER;   // n° du volume
        dw : DWORD;
     
       {Obtention du Handle du volume}
       function GetHVolume(Drive : String) : THandle;
       var CheminVolume : String;
       begin
        CheminVolume:='\\.\'+Drive;
        Result:=CreateFile(Pchar(CheminVolume), 0,
                         FILE_SHARE_READ OR FILE_SHARE_WRITE,
                         Nil, OPEN_EXISTING, 0, 0);
        end;
    begin
     HVolume:=GetHVolume(Drive);
     R := DeviceIoControl(hVolume,
                         IOCTL_STORAGE_GET_DEVICE_NUMBER,
                         Nil, 0, @sdn, sizeof(sdn),
                         @dw, nil);
     if R then Result := sdn.DeviceNumber
          else begin
           result:=0;
           DisplaySystemError;
          end;
     CloseHandle(HVolume);
    end;
     
     
    {
    Affichage de l'erreur
    }
    Procedure TForm1.DisplaySystemError; // merci à Eric Boisvert (DupDisk)
    Var
      ErrorCode: Integer;
      Buf: Array[0..1023] Of Char;
      ErrMsg: String;
      result: DWord;
    Begin
      //== Obtient un message lisible de l'erreur... ==
      ErrorCode := GetLastError;
      FillChar(Buf, SizeOf(Buf), #0);
      result := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, Nil, ErrorCode
        , 0, Buf, sizeof(Buf), Nil);
      If result <> 0 Then
      Begin
        ErrMsg := Trim(Buf);
        Raise Exception.Create(buf);
      End;
    End;
     
    end.
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  7. #27
    Rédacteur/Modérateur
    Avatar de ero-sennin
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2005
    Messages
    2 965
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2005
    Messages : 2 965
    Points : 4 935
    Points
    4 935
    Par défaut
    Salut Maître Sergio

    Pour avoir trouvé sous Vista !!!!
    Reste une chose à faire je pense ... c'est de l'intégrer au compo mais comme tu dis, faudrait résoudre ce problème d'éjection de CD...

    En tout cas, grand

    PS: C'est Ero-Sennin

    EDIT:
    Sauf erreur de ma part, je pense que C++ lorsqu'il rencontre un return, il sort directement de la fonction et donc ne teste pas le CloseHandle(HDrive); et tout ce qui s'en suit ...
    Je modifie le code en conséquence et le reposte dès qu'il est fonctionnel ...

    [EDIT 2]

    En regardant plus attentivement ton code, tu respectais bien ce que j'ai cité dans le premier EDIT

    Cependant, lorsque je compare le code C++ donnée sur le site et le tient, il y a une différence et que j'ai du mal à saisir :

    Code du site :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    res = CM_Request_Device_EjectW(DevInstParent,
              &VetoType, VetoNameW, MAX_PATH, 0);
     
      bSuccess = (res==CR_SUCCESS &&
                        VetoType==PNP_VetoTypeUnknown);
    Ton code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0); // avec message (W2K, Vista) ou bulle (XP)
    ejecte:=(retf=CR_SUCCESS) ;
    Enfin voilà, ça tombe dans la transposition de C++ vers Delphi c'est correct... Je ne suis pas calé du tout, c'est juste une remarque ...

    Par contre, en remplaçant :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0);
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    retf:= CM_Request_Device_EjectW(DIParent,nil, nil, MAX_PATH, 0);
    Pour Preuve :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    function CM_Request_Device_EjectW(dnDevInst: DEVINST;
      pVetoType: PPNP_VETO_TYPE;     // OPTIONAL
      pszVetoName: PWideChar;        // OPTIONAL
      ulNameLength: ULONG; ulFlags: ULONG): CONFIGRET; stdcall;
    On a plus d'erreur, mais c'est pas pour autant que le CD sort ... et retf renvoie CR_INVALID_POINTER

    [EDIT 3]

    J'ai modifié le code de SergioMaster en ce qui concerne l'appelle pour déconnecter le périphérique ... Je ne sais pas si ça fonctionne sous Vista ... à voir :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    function OpenCD(Drive: Char): Boolean;
    var
      Error: MciError;
      OpenParm: TMCI_Open_Parms;
      Flags: DWORD;
      DeviceLetter: string;
      DeviceID: Word;
    begin
      Result := False;
      DeviceLetter := Drive + ':';
      Flags  := MCI_OPEN_TYPE or MCI_OPEN_ELEMENT;
      with OpenParm do
      begin
        dwCallback := 0;
        lpstrDeviceType := 'CDAudio';
        lpstrElementName := PChar(DeviceLetter);
      end;
      Error := mciSendCommand(0, MCI_OPEN, Flags, Longint(@OpenParm));
      if Error <> 0 then Exit;
      DeviceID := OpenParm.wDeviceID;
      try
        Error := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
        if Error <> 0 then Exit;
        Result := True;
      finally
        mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm));
      end;
    end;
     
    procedure TForm1.Button1Click(Sender: TObject);
    var dtype,dnumber,retf : Cardinal ; // drivetype , drivenumber , retour de fonction
        i : Word;               // essais 1 à 3
        nd : String;            // nom dos du drive (permet de distinguer un floppy d'un USB)
        DIParent : DEVINST;     // identifient du parent
        ejecte : Boolean;
        LettreMedia:char;
    begin
    LettreMedia:=Media.Text[1];
    dtype := GetDriveType(PChar(Media.Text+'\'));
    dnumber := GetDeviceNumber(Media.Text);
    nd:=NomDos(Media.text);
    LoadSetupApi;
    LoadConfigManagerApi;
    dnumber:=GetDrivesDevInstByDeviceNumber(Dnumber,Dtype,nd);
    if dnumber>0 then
     begin
      //****** ici il doit certainement y avoir un test manquant
      //****** car pour un CD pas de parent ???
    	// Obtenir le parent, i.e.  USB bridge, port SATA, Canal IDE avec 2 lecteurs!
    	DIParent:= 0;
    	CM_Get_Parent(DIParent,Dnumber, 0);
     
      if GetDriveType(Pchar(Media.Text+'\')) = DRIVE_REMOVABLE then
      begin
        for i:=1 to 3  do // au cas où cela ne marche pas du premier coup.
        begin
          retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0); // avec  message (W2K, Vista) ou bulle (XP)
          ejecte:=(retf=CR_SUCCESS) ;
         if (ejecte) then
           break
         else
           Sleep(500); // Attendre avant de retenter!
        end;
      end
      else
      begin
        if GetDriveType(Pchar(Media.Text+'\')) = DRIVE_CDROM then
        begin
          if OpenCD(LettreMedia) then
           ShowMessage('Réussi');
        end;
      end;
     end;
    UnloadConfigManagerApi;
    UnloadSetupApi;
    end;
    C'est surement du bricolage mais bon, j'ai pas trouvé mieux pour le moment

  8. #28
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    Code du site :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    res = CM_Request_Device_EjectW(DevInstParent,
              &VetoType, VetoNameW, MAX_PATH, 0);
     
      bSuccess = (res==CR_SUCCESS &&
                        VetoType==PNP_VetoTypeUnknown);
    Ton code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0); // avec message (W2K, Vista) ou bulle (XP)
    ejecte:=(retf=CR_SUCCESS) ;
    Dans le code du site Uwe utilise CM_Request_Device_EjectW avec recupération de Vetotype et Vetoname pour pouvoir géré le 'message' , moi je voulais le message standard windows d'où le nil,nil donc logiquement il ne devrait pas y avoir besoin de MAX_PATH mais je me trompe peut-être ?

    Rien non plus ne permets d'affirmer que le code du site est complet

    pour moi il s'agirait plutôt de cette partie

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    CM_Get_Parent(DIParent,Dnumber, 0);
    qui ne devrait peut être se faire que pour les clés usb . En fait je reformule , il faut peut-être verifier que le 'parent' recu est éjectable ,en effet , je n'ai pas encore essayé mais j'ai une imprimante qui à un lecteur de cartes mémoires est-ce que parent va pointer sur l'imprimante ou bien faire ce qu'on lui demande .

    Pour l'instant j'ai :

    avec un lecteur de disquette usb
    Citation Envoyé par Windows
    ---------------------------
    Problème lors de l'éjection de Intel(R) 82801HEM/HBM SATA AHCI Controller
    ---------------------------
    Le périphérique Intel(R) 82801HEM/HBM SATA AHCI Controller n'est pas amovible et ne peut pas être déconnecté.
    Avec le lecteur CD/DVD
    Citation Envoyé par Windows
    ---------------------------
    Problème lors de l'éjection de Canal IDE
    ---------------------------
    Le périphérique Canal IDE n'est pas amovible et ne peut pas être déconnecté.
    Avec un disque dur interne là c'est logique , j'ai pas verifié le type de disque
    Citation Envoyé par Windows
    ---------------------------
    Problème lors de l'éjection de Intel(R) 82801HEM/HBM SATA AHCI Controller
    ---------------------------
    Le périphérique Intel(R) 82801HEM/HBM SATA AHCI Controller n'est pas amovible et ne peut pas être déconnecté.
    correction :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
      case DriveType of
        DRIVE_REMOVABLE :
          if isFloppy then StorageGuid:=GUID_DEVINTERFACE_FLOPPY
                      else StorageGuid:=GUID_DEVINTERFACE_DISK;
    // ----ici ----->    DRIVE_FIXED : StorageGuid:=GUID_DEVINTERFACE_DISK;
        DRIVE_CDROM : StorageGuid:=GUID_DEVINTERFACE_CDROM;
        else exit;
      end;
    il me reste à tester avec un disque dur USB

    pour la carte mémoire sur l'imprimante
    Citation Envoyé par windows
    ---------------------------
    Problème lors de l'éjection de Périphérique de stockage de masse USB
    ---------------------------
    Le périphérique Périphérique de stockage de masse USB n'est pas amovible et ne peut pas être déconnecté.
    mais l'icone d'ejection disparait
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  9. #29
    Membre éprouvé
    Avatar de goldkey
    Profil pro
    Inscrit en
    Mars 2003
    Messages
    802
    Détails du profil
    Informations personnelles :
    Âge : 43
    Localisation : France

    Informations forums :
    Inscription : Mars 2003
    Messages : 802
    Points : 1 084
    Points
    1 084
    Par défaut
    Bonjour à tous,

    Je ne voudrais pas poluer ce fantastisque topic, mais j'ai besoin d'aide suite à l'installation de Delphi 7 sur mon PC perso.

    Voulant testé ton code SergioMaster
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, Buttons, Cfg, CfgMgr32, JwaWinBase, JwaWinIoCtl, SetupApi ;
     
     
    type
      TForm1 = class(TForm)
        BitBtn1: TBitBtn;
        Dr: TEdit;                                             // 'F:'
        procedure BitBtn1Click(Sender: TObject);
      private
        { Déclarations privées }
      public
        { Déclarations publiques }
        procedure DisplaySystemError;
        function GetDeviceNumber(Drive : String) : Cardinal;
        function NomDos(Drive : String) : String;
        function GetDrivesDevInstByDeviceNumber(DeviceNom,DriveType : Cardinal; DriveName : String) : DEVINST;
      end;
     
    var
      Form1: TForm1;
     
    implementation
     
    {$R *.dfm}
     
    {
    Obtention du numéro réel? de volume à ejecter
    }
    function TForm1.GetDrivesDevInstByDeviceNumber(DeviceNom,DriveType : Cardinal; DriveName : String) : DEVINST;
    var isFloppy : Boolean;
        StorageGUID : TGUID;
        PnPHandle: HDEVINFO;
        DevData: TSPDevInfoData;
        DeviceInterfaceData: TSPDeviceInterfaceData;
        FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
        Success: LongBool;
        Devn : Integer;
        BytesReturned: Cardinal;
        Hdrive : THandle;
        sdn : STORAGE_DEVICE_NUMBER;
    begin
      result:=0;
      isFloppy:=(Pos('\\Floppy',DriveName)>0);
      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;
      Result := 0;
      PnPHandle := SetupDiGetClassDevs(@StorageGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
      if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
        begin
         ShowMessage('erreur');
         exit;
        end;
        Devn := 0;
        repeat
          DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
          Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, StorageGUID, Devn, DeviceInterfaceData);
        if Success then
        begin
          DevData.cbSize := SizeOf(DevData);
          BytesReturned := 0;
          SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
          if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
          begin
            FunctionClassDeviceData := AllocMem(BytesReturned);
            try
              FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
              if SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
                          FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) then
              begin
           			// open the disk or cdrom or floppy
    				    HDrive:=CreateFile(FunctionClassDeviceData.DevicePath, 0, FILE_SHARE_READ OR FILE_SHARE_WRITE,nil, OPEN_EXISTING, 0, 0);
    				    if (HDrive<>INVALID_HANDLE_VALUE ) then
                 begin
    				   	  // get its device number
    					     Success := DeviceIoControl(HDrive, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, @sdn, sizeof(sdn), @BytesReturned, nil);
    					     if (Success) AND (DeviceNom=sdn.DeviceNumber) then
                     begin
                      // match the given device number with the one of the current device
                  	  CloseHandle(HDrive);
    							    SetupDiDestroyDeviceInfoList(PnpHandle);
    							    Result:=DevData.DevInst;
                     end;
                    CloseHandle(HDrive);
    	            end;
              end;
            finally
              FreeMem(FunctionClassDeviceData);
            end;
           end;
          end;
          Inc(Devn);
        until not Success;
        SetupDiDestroyDeviceInfoList(PnPHandle);
    end;
     
    {
    Nom Dos du Volume (par exemple  \device\floppy0)
    apparement ce serait le seul moyen de savoir si c'est un floppy  ou USB
    }
    function TForm1.NomDos(Drive: string) : String;
    var Nom : String[60];
    begin
      Nom:='';
      QueryDosDevice(Pchar(Drive),@Nom,60);
      result:=Copy(nom,0,pos(#0,nom)-1);
    end;
     
     
    {
    ACTION
    }
    procedure TForm1.BitBtn1Click(Sender: TObject);
    var dtype,dnumber,retf : Cardinal ; // drivetype , drivenumber , retour de fonction
        i : Word;               // essais 1 à 3
        nd : String;            // nom dos du drive (permet de distinguer un floppy d'un USB)
        DIParent : DEVINST;     // identifient du parent
        ejecte : Boolean;
    begin
    dtype := GetDriveType(PChar(Dr.Text+'\'));
    dnumber := GetDeviceNumber(Dr.Text);
    nd:=NomDos(dr.text);
    LoadSetupApi;
    LoadConfigManagerApi;
    dnumber:=GetDrivesDevInstByDeviceNumber(Dnumber,Dtype,nd);
    if dnumber>0 then
     begin
      //****** ici il doit certainement y avoir un test manquant
      //****** car pour un CD pas de parent ???
    	// Obtenir le parent, i.e.  USB bridge, port SATA, Canal IDE avec 2 lecteurs!
    	DIParent:= 0;
    	CM_Get_Parent(DIParent,Dnumber, 0);
    	for i:=1 to 3  do // au cas où cela ne marche pas du premier coup.
        begin
     		 retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0); // avec  message (W2K, Vista) ou bulle (XP)
    		 ejecte:=(retf=CR_SUCCESS) ;
    	   if (ejecte) then break else Sleep(500); // Attendre avant de retenter!
        end;
     end;
    UnloadConfigManagerApi;
    UnloadSetupApi;
    end;
     
    {
    Obtention du Numéro du Volume
    }
    function TForm1.GetDeviceNumber(Drive : String) : Cardinal;
    var R : LongBool;                  // retour de fonction
        HVolume : THandle;             // Hande du volume
        sdn : STORAGE_DEVICE_NUMBER;   // n° du volume
        dw : DWORD;
     
       {Obtention du Handle du volume}
       function GetHVolume(Drive : String) : THandle;
       var CheminVolume : String;
       begin
        CheminVolume:='\\.\'+Drive;
        Result:=CreateFile(Pchar(CheminVolume), 0,
                         FILE_SHARE_READ OR FILE_SHARE_WRITE,
                         Nil, OPEN_EXISTING, 0, 0);
        end;
    begin
     HVolume:=GetHVolume(Drive);
     R := DeviceIoControl(hVolume,
                         IOCTL_STORAGE_GET_DEVICE_NUMBER,
                         Nil, 0, @sdn, sizeof(sdn),
                         @dw, nil);
     if R then Result := sdn.DeviceNumber
          else begin
           result:=0;
           DisplaySystemError;
          end;
     CloseHandle(HVolume);
    end;
     
     
    {
    Affichage de l'erreur
    }
    Procedure TForm1.DisplaySystemError; // merci à Eric Boisvert (DupDisk)
    Var
      ErrorCode: Integer;
      Buf: Array[0..1023] Of Char;
      ErrMsg: String;
      result: DWord;
    Begin
      //== Obtient un message lisible de l'erreur... ==
      ErrorCode := GetLastError;
      FillChar(Buf, SizeOf(Buf), #0);
      result := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, Nil, ErrorCode
        , 0, Buf, sizeof(Buf), Nil);
      If result <> 0 Then
      Begin
        ErrMsg := Trim(Buf);
        Raise Exception.Create(buf);
      End;
    End;
     
    end.
    j'ai installé JCL et JVCL 3.3 et ajouté au projet les win32api.

    Je compile est la j'obtiens une belle erreur
    [erreur] Unit1.pas(146): Identificateur non déclaré: 'CM_Request_Device_EjectW'
    Meme erreur si j'ajoute manuellement les .pas au projet.

    Franchement je suis sec, je n'avais pas eu ce soucis sur ma config au boulot
    Quelqu'un aurait-il une idée ??

    [EDIT]
    J'avais bien oublié CfgMgr32.pas
    Désolé pour le dérangement.
    Yes We Can

  10. #30
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    super d'avoir installé JCL et JVCL (j'adore ) mais dans ce topic ce n'est pas les composants de la JVCL qui sont utilisés

    c'est bien du JEDI (comme le disait luke skywalker pendant la guerre des etoiles)
    mais c'est JEDI WINDOWS API ici

    PS : ecrit sous D10 (BDS2006PRO) (tests sous VISTA et XP)

    Bon allez Hop , j'y retourne avec d'autres idées
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  11. #31
    Membre éprouvé
    Avatar de goldkey
    Profil pro
    Inscrit en
    Mars 2003
    Messages
    802
    Détails du profil
    Informations personnelles :
    Âge : 43
    Localisation : France

    Informations forums :
    Inscription : Mars 2003
    Messages : 802
    Points : 1 084
    Points
    1 084
    Par défaut
    Citation Envoyé par SergioMaster Voir le message
    super d'avoir installé JCL et JVCL (j'adore ) mais dans ce topic ce n'est pas les composants de la JVCL qui sont utilisés

    c'est bien du JEDI (comme le disait luke skywalker pendant la guerre des etoiles)
    mais c'est JEDI WINDOWS API ici

    PS : ecrit sous D10 (BDS2006PRO) (tests sous VISTA et XP)

    Bon allez Hop , j'y retourne avec d'autres idées
    Je me suis effectivement un peu mélanger les pinceaux (j'ai besoin de JVCL pour autre chose)

    Sinon j'ai modifié ton code en ajoutant le type TPnpVetoType afin de pouvoir remonter la cause de non éjection du périphérique USB.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    unit Unit1;
     
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, Buttons, Cfg, CfgMgr32, JwaWinBase, JwaWinIoCtl, SetupApi ;
     
    type
      TForm1 = class(TForm)
        BitBtn1: TBitBtn;
        testt: TLabel;
        Dr: TEdit;                                             // 'F:'
     
     
        procedure BitBtn1Click(Sender: TObject);
      private
        { Déclarations privées }
      public
        { Déclarations publiques }
        procedure DisplaySystemError;
        function GetDeviceNumber(Drive : String) : Cardinal;
        function NomDos(Drive : String) : String;
        function GetDrivesDevInstByDeviceNumber(DeviceNom,DriveType : Cardinal; DriveName : String) : DEVINST;
      end;
     
    type
      _PNP_VETO_TYPE = (
        PNP_VetoTypeUnknown,
        PNP_VetoLegacyDevice,
        PNP_VetoPendingClose,
        PNP_VetoWindowsApp,
        PNP_VetoWindowsService,
        PNP_VetoOutstandingOpen,
        PNP_VetoDevice,
        PNP_VetoDriver,
        PNP_VetoIllegalDeviceRequest,
        PNP_VetoInsufficientPower,
        PNP_VetoNonDisableable,
        PNP_VetoLegacyDriver);
      PNP_VETO_TYPE = _PNP_VETO_TYPE;
      PPNP_VETO_TYPE = ^PNP_VETO_TYPE;
      TPnpVetoType = _PNP_VETO_TYPE;
      PPnpVetoType = PPNP_VETO_TYPE;
     
    var
      Form1: TForm1;
     
    implementation
     
    {$R *.dfm}
     
    {
    Obtention du numéro réel? de volume à ejecter
    }
    function TForm1.GetDrivesDevInstByDeviceNumber(DeviceNom,DriveType : Cardinal; DriveName : String) : DEVINST;
    var isFloppy : Boolean;
        StorageGUID : TGUID;
        PnPHandle: HDEVINFO;
        DevData: TSPDevInfoData;
        DeviceInterfaceData: TSPDeviceInterfaceData;
        FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
        Success: LongBool;
        Devn : Integer;
        BytesReturned: Cardinal;
        Hdrive : THandle;
        sdn : STORAGE_DEVICE_NUMBER;
    begin
      result:=0;
      isFloppy:=(Pos('\\Floppy',DriveName)>0);
      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;
      Result := 0;
      PnPHandle := SetupDiGetClassDevs(@StorageGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
      if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
        begin
         ShowMessage('erreur');
         exit;
        end;
        Devn := 0;
        repeat
          DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
          Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, StorageGUID, Devn, DeviceInterfaceData);
        if Success then
        begin
          DevData.cbSize := SizeOf(DevData);
          BytesReturned := 0;
          SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
          if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
          begin
            FunctionClassDeviceData := AllocMem(BytesReturned);
            try
              FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
              if SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
                          FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) then
              begin
           			// open the disk or cdrom or floppy
    				    HDrive:=CreateFile(FunctionClassDeviceData.DevicePath, 0, FILE_SHARE_READ OR FILE_SHARE_WRITE,nil, OPEN_EXISTING, 0, 0);
     
    				    if (HDrive<>INVALID_HANDLE_VALUE ) then
                 begin
    				   	  // get its device number
    					     Success := DeviceIoControl(HDrive, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, @sdn, sizeof(sdn), @BytesReturned, nil);
    					     if (Success) AND (DeviceNom=sdn.DeviceNumber) then
                     begin
                      // match the given device number with the one of the current device
                  	  CloseHandle(HDrive);
    							    SetupDiDestroyDeviceInfoList(PnpHandle);
    							    Result:=DevData.DevInst;
                     end;
                    CloseHandle(HDrive);
    	            end;
              end;
            finally
              FreeMem(FunctionClassDeviceData);
            end;
           end;
          end;
          Inc(Devn);
        until not Success;
        SetupDiDestroyDeviceInfoList(PnPHandle);
    end;
     
    {
    Nom Dos du Volume (par exemple  \device\floppy0)
    apparement ce serait le seul moyen de savoir si c'est un floppy  ou USB
    }
    function TForm1.NomDos(Drive: string) : String;
    var Nom : String[60];
    begin
      Nom:='';
      QueryDosDevice(Pchar(Drive),@Nom,60);
      result:=Copy(nom,0,pos(#0,nom)-1);
    end;
     
     
    {
    ACTION
    }
    procedure TForm1.BitBtn1Click(Sender: TObject);
    var dtype,dnumber,retf : Cardinal ; // drivetype , drivenumber , retour de fonction
        i : Word;               // essais 1 à 3
        nd : String;            // nom dos du drive (permet de distinguer un floppy d'un USB)
        DIParent : DEVINST;     // identifiant du parent
        ejecte : Boolean;
        VetoName : array[0..256] of Char;
        VetoType : TPnpVetoType;
    begin
    VetoType := PNP_VetoTypeUnknown;
    dtype := GetDriveType(PChar(Dr.Text+'\'));
    dnumber := GetDeviceNumber(Dr.Text);
    nd:=NomDos(dr.text);
    LoadSetupApi;
    LoadConfigManagerApi;
    dnumber:=GetDrivesDevInstByDeviceNumber(Dnumber,Dtype,nd);
    if dnumber>0 then
     begin
      //****** ici il doit certainement y avoir un test manquant
      //****** car pour un CD pas de parent ???
    	// Obtenir le parent, i.e.  USB bridge, port SATA, Canal IDE avec 2 lecteurs!
    	DIParent:= 0;
      CM_Get_Parent(DIParent,dnumber, 0);
    	for i:=1 to 3  do // au cas où cela ne marche pas du premier coup.
        begin
     
          VetoName[0] := '0';
     		 //retf:= CM_Request_Device_EjectW(DIParent,nil, nil, 0, 0); // avec  message (W2K, Vista) ou bulle (XP)
         retf:= CM_Request_Device_EjectW(DIParent,@VetoType,@VetoName, MAX_PATH, 0); // sans  message (W2K, Vista) ou bulle (XP) et indique type de veto a l'ejection
     		 ejecte:=(retf=CR_SUCCESS) ;
    	   if (ejecte) then break else Sleep(500); // Attendre avant de retenter!
        end;
     end;
    UnloadConfigManagerApi;
    UnloadSetupApi;
    end;
     
     
    {
    Obtention du Numéro du Volume
    }
    function TForm1.GetDeviceNumber(Drive : String) : Cardinal;
    var R : LongBool;                  // retour de fonction
        HVolume : THandle;             // Hande du volume
        sdn : STORAGE_DEVICE_NUMBER;   // n° du volume
        dw : DWORD;
     
       {Obtention du Handle du volume}
       function GetHVolume(Drive : String) : THandle;
       var CheminVolume : String;
       begin
        CheminVolume:='\\.\'+Drive;
        Result:=CreateFile(Pchar(CheminVolume), 0,
                         FILE_SHARE_READ OR FILE_SHARE_WRITE,
                         Nil, OPEN_EXISTING, 0, 0);
        end;
    begin
     HVolume:=GetHVolume(Drive);
     R := DeviceIoControl(hVolume,
                         IOCTL_STORAGE_GET_DEVICE_NUMBER,
                         Nil, 0, @sdn, sizeof(sdn),
                         @dw, nil);
     if R then Result := sdn.DeviceNumber
          else begin
           result:=0;
           DisplaySystemError;
          end;
     CloseHandle(HVolume);
    end;
     
     
    {
    Affichage de l'erreur
    }
    Procedure TForm1.DisplaySystemError; // merci à Eric Boisvert (DupDisk)
    Var
      ErrorCode: Integer;
      Buf: Array[0..1023] Of Char;
      ErrMsg: String;
      result: DWord;
    Begin
      //== Obtient un message lisible de l'erreur... ==
      ErrorCode := GetLastError;
      FillChar(Buf, SizeOf(Buf), #0);
      result := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, Nil, ErrorCode
        , 0, Buf, sizeof(Buf), Nil);
      If result <> 0 Then
      Begin
        ErrMsg := Trim(Buf);
        Raise Exception.Create(buf);
      End;
    End;
     
    end.
    Citation Envoyé par Ero-sennin
    On a plus d'erreur, mais c'est pas pour autant que le CD sort ...
    Je ne pense pas que cela soit faisable avec CM_Request_Device_EjectW.

    En testant avec la version compilé du soft de Uwe sur mon lecteur de CD, celui-ci a été carrement démonté (disparu du panneau de config et donc rendu inacessible mais pas d'éjection de disque)
    Yes We Can

  12. #32
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    je ne pense pas que cela soit faisable avec CM_Request_Device_EjectW.
    c'est la conclusion à laquelle je suis arrivé , voilà par contre un code d'ejection de CD qui par contre fonctionne trés bien et dans le même "style"
    (je le préfère à MCISendCommand , @ero-sennin ce n'est qu'une question de goût )

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Procedure TForm1.EjecteCD(Drive : String);
    var
      cd: THandle;
      ret: Cardinal;
    begin
      cd := CreateFile(PChar('\\.\'+Drive), GENERIC_READ, 0, nil, OPEN_EXISTING, 0,0);
      if CD <> INVALID_HANDLE_VALUE then begin
        // eject
        if not DeviceIoControl(cd,IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0,@ret, nil) then DisplaySystemError;
        CloseHandle(cd);
      end;
    end;
    reste maintenant les problèmes suivants
    • la disquette USB
    • la carte mémoire 'enfichée' dans une imprimante multifonction
    • un disque dur USB 1 partition, n partitions
    • une clé USB 'enfichée' dans un hub
    • un appareil photo etc ........


    Enfin au départ je voulais juste éjecter une clé USB sans réinventer la roue

    Va falloir aussi restructurer tout ça ce que j'ai envoyé depuis la détection du 'Problème VISTA' c'est plutôt mon programme de test qu'une ou plusieurs fonctions "indépendantes"
    je vois bien quelque chose du genre
    • Ejecter(lecteur)
    • EjecterCD(lecteur)
    • EjecterUSB(lecteur)
    • EjecterFloppy(lecteur)
    • etc...
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  13. #33
    Rédacteur/Modérateur
    Avatar de ero-sennin
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2005
    Messages
    2 965
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2005
    Messages : 2 965
    Points : 4 935
    Points
    4 935
    Par défaut
    Salut,

    Citation Envoyé par SergioMaster Voir le message
    c'est la conclusion à laquelle je suis arrivé , voilà par contre un code d'ejection de CD qui par contre fonctionne trés bien et dans le même "style"
    (je le préfère à MCISendCommand , @ero-sennin ce n'est qu'une question de goût )

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Procedure TForm1.EjecteCD(Drive : String);
    var
      cd: THandle;
      ret: Cardinal;
    begin
      cd := CreateFile(PChar('\\.\'+Drive), GENERIC_READ, 0, nil, OPEN_EXISTING, 0,0);
      if CD <> INVALID_HANDLE_VALUE then begin
        // eject
        if not DeviceIoControl(cd,IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0,@ret, nil) then DisplaySystemError;
        CloseHandle(cd);
      end;
    end;
    reste maintenant les problèmes suivants
    • la disquette USB
    • la carte mémoire 'enfichée' dans une imprimante multifonction
    • un disque dur USB 1 partition, n partitions
    • une clé USB 'enfichée' dans un hub
    • un appareil photo etc ........


    Enfin au départ je voulais juste éjecter une clé USB sans réinventer la roue

    Va falloir aussi restructurer tout ça ce que j'ai envoyé depuis la détection du 'Problème VISTA' c'est plutôt mon programme de test qu'une ou plusieurs fonctions "indépendantes"
    je vois bien quelque chose du genre
    • Ejecter(lecteur)
    • EjecterCD(lecteur)
    • EjecterUSB(lecteur)
    • EjecterFloppy(lecteur)
    • etc...
    Pour la question d'éjection d'un CD, oui, ce n'est qu'une question de goût et je vais peut-être utiliser ta méthode en mettant en commentaire la mienne

    Pour la mise en forme pour l'éjection, dans mon composant, j'ai fait uniquement la première fonction qui prend n'importe quel lecteur ...
    C'est par la suite que je détermine si c'est un CD-ROM, clé USB etc etc ...
    Est ce que c'est ce que tu veux dire avec la première fonction que tu as citée ?
    Si oui, alors on cette fonction appellera les autres fonctions une fois le type du média défini ...

    En tout cas, je peux déjà incorporer les modifs pour que le compo fonctionne sous XP et Vista

    Toutes propositions pour la mise en forme du code ou pour l'ajout de nouvelles fonctionnalités sont les bienvenues

  14. #34
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    En tout cas, je peux déjà incorporer les modifs pour que le compo fonctionne sous XP et Vista
    Et tes examens .....

    Pour la mise en forme pour l'éjection, dans mon composant, j'ai fait uniquement la première fonction qui prend n'importe quel lecteur ...
    C'est par la suite que je détermine si c'est un CD-ROM, clé USB etc etc ...
    Est ce que c'est ce que tu veux dire avec la première fonction que tu as citée ?
    Si oui, alors on cette fonction appellera les autres fonctions une fois le type du média défini ...
    En fait ce que je veux faire, vais faire (mañana dirait les Venézueliens, cad un de ces jours ) c'est plutôt une unité, pas un composant, avec la liste de fonctions d'ejection , bien sûr la première , générique, faisant appel aux autres
    et des spécifiques (testant ou non que c'est le bon type de lecteur) pour chaque type . En effet , par exemple, si mon application n'utilise que le lecteur USB et que je ne veux que faire l'ejection (ce qui est mon cas) pas besoin d'installer de compo, pas besoin de faire d'appels inutiles
    par exemple :
    EjecteUSB('H:',false) ; (l'ajout de false pour dire "ne fait pas de test, ejecte point barre")

    Enfin voilà mon état d'esprit aujourd'hui , ce n'est pas pour remplacer ton composant, mais plutôt ajouter une unité à un programme


    vous allez rire

    j'ai essayer de déconnecter un disque dur USB (1 partition)
    avec la routine USB actuelle pas de surprise ça ne marche pas (peripherique occupé)
    avec la routine d'ejection d'un CD pas de surprise ça ne marche pas mais pas d'erreur
    par contre après avoir demandé l'ejection comme un CD puis comme un clé USB pas de problème , déconnecté correctement
    QUE FAIT DONC DeviceIoControl
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  15. #35
    Rédacteur/Modérateur
    Avatar de ero-sennin
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2005
    Messages
    2 965
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2005
    Messages : 2 965
    Points : 4 935
    Points
    4 935
    Par défaut
    Citation Envoyé par SergioMaster Voir le message
    Et tes examens .....
    Oh, il ne me reste que deux oraux ! Je n'avais qu'un écrit à passer du fait que je possède déjà un BTS (Développeur D'applications). Je ferai l'intégration à mon compo sur mon temps libre (hors révisions)

    Citation Envoyé par SergioMaster Voir le message
    En fait ce que je veux faire, vais faire (mañana dirait les Venézueliens, cad un de ces jours ) c'est plutôt une unité, pas un composant, avec la liste de fonctions d'ejection , bien sûr la première , générique, faisant appel aux autres
    et des spécifiques (testant ou non que c'est le bon type de lecteur) pour chaque type . En effet , par exemple, si mon application n'utilise que le lecteur USB et que je ne veux que faire l'ejection (ce qui est mon cas) pas besoin d'installer de compo, pas besoin de faire d'appels inutiles
    par exemple :
    EjecteUSB('H:',false) ; (l'ajout de false pour dire "ne fait pas de test, ejecte point barre")
    D'accord, je vois ce que tu veux faire

    Citation Envoyé par SergioMaster Voir le message
    Enfin voilà mon état d'esprit aujourd'hui , ce n'est pas pour remplacer ton composant, mais plutôt ajouter une unité à un programme
    Mon composant était avant tout un petit défi que je m'étais lancé sans vraiment penser que ça allait attirer autant de monde. Personnellement, je ne l'ai pas encore utilisé dans mes applications ... c'était juste histoire de voir un peu de nouvelles choses et d'approfondir mes connaissances. L'utilisation du composant facilite certaines choses si l'on veut vraiment avoir plus de fonctionnalité sans se casser la tête à tout recoder

    Voilà voilà! En tout cas, je te remercie pour ton aide précieuse

    [EDIT]
    Citation Envoyé par SergioMaster

    vous allez rire

    j'ai essayer de déconnecter un disque dur USB (1 partition)
    avec la routine USB actuelle pas de surprise ça ne marche pas (peripherique occupé)
    avec la routine d'ejection d'un CD pas de surprise ça ne marche pas mais pas d'erreur
    par contre après avoir demandé l'ejection comme un CD puis comme un clé USB pas de problème , déconnecté correctement
    QUE FAIT DONC DeviceIoControl
    Mdrrr !!! Va comprendre comment Windows gère la chose
    Tiens, je ne sais pas si ça peut t'intéresser Sergio ...
    http://msdn.microsoft.com/en-us/library/ms803687.aspx

  16. #36
    Membre régulier Avatar de fs999
    Profil pro
    Inscrit en
    Avril 2004
    Messages
    99
    Détails du profil
    Informations personnelles :
    Âge : 62
    Localisation : Luxembourg

    Informations forums :
    Inscription : Avril 2004
    Messages : 99
    Points : 111
    Points
    111
    Par défaut
    Bonjour,

    Merci à tous pour votre superbe (encore) travail !

    Je me suis permis de regrouper un peu tout ça dans une unit avec une fonction EjectDrive qui prend comme paramètre le caractère du lecteur et en option si le message d'éjection doit être affiché par Windows.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    unit Eject;
     
    interface
     
    uses Windows, Messages, SysUtils, Classes, Dialogs;
     
    function EjectDrive(DriveLetter: Char; Inform: Boolean = True): Boolean;
     
    implementation
     
    uses variants, jwawinioctl, SetupApi, JwaWinBase, Cfg, CfgMgr32;
     
    {
    Affichage de l'erreur
    }
     
    procedure DisplaySystemError; // merci à Eric Boisvert (DupDisk)
    var
      ErrorCode: Integer;
      Buf: array[0..1023] of Char;
      ErrMsg: string;
      result: DWord;
    begin
      //== Obtient un message lisible de l'erreur... ==
      ErrorCode := GetLastError;
      FillChar(Buf, SizeOf(Buf), #0);
      result := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, 0, Buf, sizeof(Buf), nil);
      if result <> 0 then
      begin
        ErrMsg := Trim(Buf);
        raise Exception.Create(buf);
      end;
    end;
     
    {
    Obtention du numéro réel? de volume à ejecter
    }
     
    function GetDrivesDevInstByDeviceNumber(DeviceNom, DriveType: Cardinal; DriveName: string): DEVINST;
    var
      isFloppy: Boolean;
      StorageGUID: TGUID;
      PnPHandle: HDEVINFO;
      DevData: TSPDevInfoData;
      DeviceInterfaceData: TSPDeviceInterfaceData;
      FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
      Success: LongBool;
      Devn: Integer;
      BytesReturned: Cardinal;
      Hdrive: THandle;
      sdn: STORAGE_DEVICE_NUMBER;
    begin
      result := 0;
      isFloppy := (Pos('\\Floppy', DriveName) > 0);
      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;
      Result := 0;
      PnPHandle := SetupDiGetClassDevs(@StorageGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
      if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
      begin
        ShowMessage('erreur');
        exit;
      end;
      Devn := 0;
      repeat
        DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
        Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, StorageGUID, Devn, DeviceInterfaceData);
        if Success then
        begin
          DevData.cbSize := SizeOf(DevData);
          BytesReturned := 0;
          SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
          if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
          begin
            FunctionClassDeviceData := AllocMem(BytesReturned);
            try
              FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
              if SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
                FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) then
              begin
              // open the disk or cdrom or floppy
                HDrive := CreateFile(FunctionClassDeviceData.DevicePath, 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
                if (HDrive <> INVALID_HANDLE_VALUE) then
                begin
              // get its device number
                  Success := DeviceIoControl(HDrive, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, @sdn, sizeof(sdn), @BytesReturned, nil);
                  if Success and (DeviceNom = sdn.DeviceNumber) then
                  begin
                      // match the given device number with the one of the current device
                    //CloseHandle(HDrive);
                    //SetupDiDestroyDeviceInfoList(PnpHandle);
                    Result := DevData.DevInst;
                  end;
                  CloseHandle(HDrive);
                end;
              end;
            finally
              FreeMem(FunctionClassDeviceData);
            end;
          end;
        end;
        Inc(Devn);
      until not Success;
      SetupDiDestroyDeviceInfoList(PnPHandle);
    end;
     
    {
    Nom Dos du Volume (par exemple  \device\floppy0)
    apparement ce serait le seul moyen de savoir si c'est un floppy  ou USB
    }
     
    function NomDos(Drive: string): string;
    var
      Nom: string[60];
    begin
      Nom := '';
      QueryDosDevice(Pchar(Drive), @Nom, 60);
      result := Copy(nom, 0, pos(#0, nom) - 1);
    end;
     
    {
    Obtention du Numéro du Volume
    }
     
    function GetDeviceNumber(Drive: string): Cardinal;
    var
      R: LongBool; // retour de fonction
      HVolume: THandle; // Hande du volume
      sdn: STORAGE_DEVICE_NUMBER; // n° du volume
      dw: DWORD;
     
       {Obtention du Handle du volume}
      function GetHVolume(Drive: string): THandle;
      var
        CheminVolume: string;
      begin
        CheminVolume := '\\.\' + Drive;
        Result := CreateFile(Pchar(CheminVolume), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
      end;
     
    begin
      HVolume := GetHVolume(Drive);
      R := DeviceIoControl(hVolume, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0, @sdn, sizeof(sdn), @dw, nil);
      if R then
        Result := sdn.DeviceNumber
      else
      begin
        result := 0;
        DisplaySystemError;
      end;
      CloseHandle(HVolume);
    end;
     
     
    {
    ACTION
    }
     
    function EjectDrive(DriveLetter: Char; Inform: Boolean = True): Boolean;
    var
      dtype, dnumber, retf: Cardinal; // drivetype , drivenumber , retour de fonction
      i: Word; // essais 1 à 3
      nd: string; // nom dos du drive (permet de distinguer un floppy d'un USB)
      DIParent: DEVINST; // identifient du parent
      cd: THandle;
      ret: Integer;
      VetoType: PNP_VETO_TYPE;
    	VetoNamew: Array[0..MAX_PATH] of wChar;
    begin
      Result := False;
      dtype := GetDriveType(PChar(DriveLetter + ':\'));
      if dtype = DRIVE_CDROM then
      begin
        cd := CreateFile(PChar('\\.\'+DriveLetter+':'), GENERIC_READ, 0, nil, OPEN_EXISTING, 0,0);
        if cd <> INVALID_HANDLE_VALUE then
        begin
          // eject
          Result := DeviceIoControl(cd, IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0,@ret, nil);
          CloseHandle(cd);
          if not Result then DisplaySystemError;
          exit;
        end;
      end;
      dnumber := GetDeviceNumber(DriveLetter + ':');
      nd := NomDos(DriveLetter + ':');
      LoadSetupApi;
      LoadConfigManagerApi;
      dnumber := GetDrivesDevInstByDeviceNumber(Dnumber, Dtype, nd);
      if dnumber > 0 then
      begin
        //****** ici il doit certainement y avoir un test manquant
        //****** car pour un CD pas de parent ???
        // Obtenir le parent, i.e.  USB bridge, port SATA, Canal IDE avec 2 lecteurs!
        DIParent := 0;
        CM_Get_Parent(DIParent, Dnumber, 0);
        for i := 1 to 3 do // au cas où cela ne marche pas du premier coup.
        begin
        	VetoType := PNP_VetoTypeUnknown;
        	VetoNamew[0] := #0;
          if Inform then
            retf := CM_Request_Device_EjectW(DIParent, nil, nil, 0, 0) // avec  message (W2K, Vista) ou bulle (XP)
          else
            retf := CM_Request_Device_EjectW(DIParent, @VetoType, @VetoNamew[0], MAX_PATH, 0); // sans  message (W2K, Vista) ou bulle (XP)
          Result := (retf = CR_SUCCESS);
          if Result then break else Sleep(500); // Attendre avant de retenter!
        end;
      end;
      UnloadConfigManagerApi;
      UnloadSetupApi;
    end;
     
    end.
    Frédéric
    On ne me la fait pas à moi !

  17. #37
    Rédacteur/Modérateur
    Avatar de ero-sennin
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2005
    Messages
    2 965
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2005
    Messages : 2 965
    Points : 4 935
    Points
    4 935
    Par défaut
    Salut et Merci d'avoir fait cette unit

    J'apporterai une modification dans le code (si c'est un CD-ROM, alors on ne traite que la première partie du code, sinon on essaie de l'extraire avec le retrait en toute sécurité) :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    function EjectDrive(DriveLetter: Char; Inform: Boolean = True): Boolean;
    var
      dtype, dnumber, retf: Cardinal; // drivetype , drivenumber , retour de fonction
      i: Word; // essais 1 à 3
      nd: string; // nom dos du drive (permet de distinguer un floppy d'un USB)
      DIParent: DEVINST; // identifient du parent
      cd: THandle;
      ret: Integer;
      VetoType: PNP_VETO_TYPE;
    	VetoNamew: Array[0..MAX_PATH] of wChar;
    begin
      Result := False;
      dtype := GetDriveType(PChar(DriveLetter + ':\'));
      if dtype = DRIVE_CDROM then
      begin
        cd := CreateFile(PChar('\\.\'+DriveLetter+':'), GENERIC_READ, 0, nil, OPEN_EXISTING, 0,0);
        if cd <> INVALID_HANDLE_VALUE then
        begin
          // eject
          Result := DeviceIoControl(cd, IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0,@ret, nil);
          CloseHandle(cd);
          if not Result then DisplaySystemError;
          exit;
        end;
      end
      else // <- On ne traite que cette partie si ce n'est pas un CD ;)
      begin
        dnumber := GetDeviceNumber(DriveLetter + ':');
        nd := NomDos(DriveLetter + ':');
        LoadSetupApi;
        LoadConfigManagerApi;
        dnumber := GetDrivesDevInstByDeviceNumber(Dnumber, Dtype, nd);
        if dnumber > 0 then
        begin
          //****** ici il doit certainement y avoir un test manquant
          //****** car pour un CD pas de parent ???
          // Obtenir le parent, i.e.  USB bridge, port SATA, Canal IDE avec 2 lecteurs!
          DIParent := 0;
          CM_Get_Parent(DIParent, Dnumber, 0);
          for i := 1 to 3 do // au cas où cela ne marche pas du premier coup.
          begin
          	VetoType := PNP_VetoTypeUnknown;
          	VetoNamew[0] := #0;
            if Inform then
              retf := CM_Request_Device_EjectW(DIParent, nil, nil, 0, 0) // avec  message (W2K, Vista) ou bulle (XP)
            else
              retf := CM_Request_Device_EjectW(DIParent, @VetoType, @VetoNamew[0], MAX_PATH, 0); // sans  message (W2K, Vista) ou bulle (XP)
            Result := (retf = CR_SUCCESS);
            if Result then break else Sleep(500); // Attendre avant de retenter!
          end;
        end;
        UnloadConfigManagerApi;
        UnloadSetupApi;
      end;
    end;

  18. #38
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    Citation Envoyé par fs999 Voir le message

    Merci à tous pour votre superbe (encore) travail !

    Je me suis permis de regrouper un peu tout ça dans une unit avec une fonction EjectDrive qui prend comme paramètre le caractère du lecteur et en option si le message d'éjection doit être affiché par Windows.
    Frérédic
    ben voilà , plus ou moins ce que j'avais en tête
    maintenant reste les bémols (floppy,hd USB, autres ...) et ATTENTION ne fonctionne pas sous W95,W98,NT 4.0 et en fait ce qui serait sous XP
    frederic c'est le mañana qui t'as fait peur

    @ero-sennin
    ben oui , j'etais suis sur ce coup (IOCTL_STORAGE_GET_MEDIA_TYPES) mais qui pour l'instant me ramenait que floppy, je vais voir avec ce _EX(tended) ce que ça donne (pour l'instant je suis bloqué vista est en cours de mise à jour (SP1 ?) depuis au moins 1/2 heure )
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  19. #39
    Membre régulier Avatar de fs999
    Profil pro
    Inscrit en
    Avril 2004
    Messages
    99
    Détails du profil
    Informations personnelles :
    Âge : 62
    Localisation : Luxembourg

    Informations forums :
    Inscription : Avril 2004
    Messages : 99
    Points : 111
    Points
    111
    Par défaut
    Salut,

    ça marche impec' sous XP !

    Sauf si il s'agit d'un floppy (sous XP et Vista). C'est dans GetDeviceNumber, la fonction DeviceIoControl renvois False... avec le message "Fonction Incorrecte".

    Je suppose que l'on ne peut pas éjecter une disquette, on est pas des mac-istes tout de même

    Frédéric
    On ne me la fait pas à moi !

  20. #40
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 045
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 045
    Points : 40 963
    Points
    40 963
    Billets dans le blog
    62
    Par défaut
    Citation Envoyé par fs999 Voir le message
    Sauf si il s'agit d'un floppy (sous XP et Vista). C'est dans GetDeviceNumber, la fonction DeviceIoControl renvois False... avec le message "Fonction Incorrecte".

    Je suppose que l'on ne peut pas éjecter une disquette, on est pas des mac-istes tout de même
    On n'est pas des mac-istes mais des perfection-istes

    non sérieux ça doit pouvoir se deconnecter puisqu'on peut le faire en cliquant sur l'icone d'ejection.

    j'ai trouvé une piste C avec ioctl , pas fraiche c'est sûr (1995)
    ioctl(fd,FDIOCEJECT,0) pour floppy
    CDIOEJECT pour CD
    MTIOCTP pour Tape

    ici

    affaire à suivre
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

+ Répondre à la discussion
Cette discussion est résolue.
Page 2 sur 4 PremièrePremière 1234 DernièreDernière

Discussions similaires

  1. Réponses: 1
    Dernier message: 01/09/2009, 16h31
  2. Ejecter disque dur usb
    Par maloups dans le forum Composants
    Réponses: 4
    Dernier message: 27/08/2007, 13h52
  3. Réponses: 2
    Dernier message: 29/03/2007, 15h45
  4. Quel est le nom des dIsques dur usb dans /dev
    Par MrEddy dans le forum Administration système
    Réponses: 5
    Dernier message: 19/10/2004, 21h06
  5. Monter un disque dur USB
    Par Iced Earth dans le forum Matériel
    Réponses: 5
    Dernier message: 13/01/2003, 22h02

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo