MountVol

[Droopy]

Ces procédures permettent de visualiser les nom des volumes associés à une lettre de lecteur / réaffecter ces lettres .

Code : Tout sélectionner

;/ Droopy 25/10/05
; PureBasic 3.94

; MountVolName : Return VolumeName as String or "" if volume is not mounted
; UnMountVolume : Return 1 if success / 0 if fail
; MountVol : Return 1 if success / 0 if fail
; MountVolChange : Change Drive letter : Return if success : 1
; if Fail : 0 Cannot Mount Destination / 2 Cannot Unmount Source / 3 Destination already Mounted / 4 Source not mounted

Procedure.s MountVolName(Drive.s)
  If Right(Drive,1)<>"\" : Drive+"\":EndIf
  VolumeName.s=Space(255)
  VolumeMountPoint.s=Drive
  OpenLibrary(0,"Kernel32.dll")
  Retour=CallFunction(0,"GetVolumeNameForVolumeMountPointA",@VolumeMountPoint,@VolumeName,255)
  CloseLibrary(0)
  If Retour 
    ProcedureReturn VolumeName
  EndIf
EndProcedure

Procedure UnMountVolume(Drive.s)
  If Right(Drive,1)<>"\" : Drive+"\":EndIf
  VolumeMountPoint.s=Drive
  OpenLibrary(0,"Kernel32.dll")
  Retour=CallFunction(0,"DeleteVolumeMountPointA",@VolumeMountPoint)
  CloseLibrary(0)
  If Retour<>0 : Retour=1 : EndIf
  ProcedureReturn Retour
EndProcedure

Procedure MountVol(Drive.s,MountPoint.s)
  If Right(Drive,1)<>"\" : Drive+"\":EndIf
  VolumeMountPoint.s=Drive
  OpenLibrary(0,"Kernel32.dll")
  Retour=CallFunction(0,"SetVolumeMountPointA",@VolumeMountPoint,@MountPoint)
  CloseLibrary(0)
  If Retour<>0 : Retour=1 : EndIf
  ProcedureReturn Retour
EndProcedure

Procedure MountVolChange(Source.s,Destination.s)
  If Right(Source,1)<>"\" : Source+"\":EndIf
  If Right(Destination,1)<>"\" : Destination+"\":EndIf
   
  VolId.s=MountVolName(Source)
  If VolId<>"" ;/ Source existe
    If MountVolName(Destination)="" ;/ Destination non montée
      If UnMountVolume(Source) ;/ Le suppression s'est bien passé
        Retour=MountVol(Destination,VolId) ;/ Le montage s'est bien passé
      Else
        Retour=2 ;/ Suppression mal passée
      EndIf
    Else ;/ Destination déjà montée
      Retour=3
    EndIf
  Else ;/ Pas de montage dans le lecteur Source
    Retour=4
  EndIf
  
  ProcedureReturn Retour
EndProcedure


;/ Test1 : List All Mounted Volumes
For n=65 To 90
  Lecteur.s=Chr(n)+":\"
  Temp.s=MountVolName(Lecteur)
  If Temp<>""
    Message.s+Lecteur+"         "+Temp+#CRLF$
  EndIf
Next
MessageRequester("Volume Information",Message,#MB_ICONINFORMATION)


;/ Test2 : Change Drive letter of my USB Key
If MessageRequester("Change Drive Letter ?","Do you want to change drive letter ?",#PB_MessageRequester_YesNo)=6
  
  Select MountVolChange("Z:","U:")
    Case 0
      MessageRequester("Changing Drive Letter","Cannot Mount Destination",#MB_ICONERROR )
    Case 1
      MessageRequester("Changing Drive Letter","Success",#MB_ICONINFORMATION )
    Case 2
      MessageRequester("Changing Drive Letter","Cannot Unmount Source",#MB_ICONERROR )
    Case 3
      MessageRequester("Changing Drive Letter","Destination already Mounted",#MB_ICONERROR )
    Case 4
      MessageRequester("Changing Drive Letter","Source not mounted",#MB_ICONERROR )
  EndSelect
  
EndIf

[Droopy]

Dans le même Style :

Code : Tout sélectionner

Procedure MountListInit()
  Static Flag
  
  If Flag=0
    NewList LLMPoint.s()
    Beep(400,250)
    Flag=1
  Else
    ClearList(LLMPoint())
  EndIf
  
  VolumeName.s=Space(255)
  OpenLibrary(0,"Kernel32.dll")
  Handle=CallFunction(0,"FindFirstVolumeA",VolumeName,255)
  
  If Handle<>-1 ;/ Trouvé
    AddElement(LLMPoint())
    LLMPoint()=VolumeName
    
    Repeat
      VolumeName=Space(255)
      Retour=CallFunction(0,"FindNextVolumeA",Handle,VolumeName,255)
      If Retour =0 : Break : EndIf ;/ Erreur ou Plus de volumes à lister
      AddElement(LLMPoint())
      LLMPoint()=VolumeName
      
    ForEver
    
    CallFunction(0,"FindVolumeCloseA") ;/ Fermeture Propre
    CloseLibrary(0)
  EndIf
  
  ResetList(LLMPoint())
  ProcedureReturn CountList(LLMPoint())
  
EndProcedure

Procedure.s MountList()
  
  If NextElement(LLMPoint())
    ProcedureReturn LLMPoint()
  Else
    ResetList(LLMPoint())
  EndIf
EndProcedure

Procedure.s GetMountVolName(MountPoint.s)
  VolName.s=Space(1000)
  OpenLibrary(0,"Kernel32.dll")
  Handle=CallFunction(0,"GetVolumePathNamesForVolumeNameA",MountPoint,VolName,1000,val2)
  CloseLibrary(0)
  ProcedureReturn VolName
EndProcedure

;/ Test3
Message.s=Str(MountListInit())+ " MountPoint Found"+#CRLF$+#CRLF$
Repeat
  MountPoint.s=MountList()
  If MountPoint="": Break:EndIf
  Message+ GetMountVolName(MountPoint)+" --> "+MountPoint+#CRLF$
ForEver
  
MessageRequester("MountPoint Info",Message)

[Gillou]

Merci, un nouveau code pour ta lib

[Droopy]

Oui j'en avais besoin pour détecter / réparer des conflits entre des clé usb et des mappages réseaux.

Avec ces fonctions c'est réglé en quelques commandes .

[lionel_om]

Code : Tout sélectionner

  Select MountVolChange("Z:","U:")
    Case 0
      MessageRequester("Changing Drive Letter","Cannot Mount Destination",#MB_ICONERROR )
    Case 1
      MessageRequester("Changing Drive Letter","Success",#MB_ICONINFORMATION )
    Case 2
      MessageRequester("Changing Drive Letter","Cannot Unmount Source",#MB_ICONERROR )
    Case 3
      MessageRequester("Changing Drive Letter","Destination already Mounted",#MB_ICONERROR )
    Case 4
      MessageRequester("Changing Drive Letter","Source not mounted",#MB_ICONERROR )
  EndSelect 

Ca aurait était bien des constantes...

[Droopy]

Tu as raison pour les Constantes, mais je pense ne plus inclure cette fonction car elle s'appuie sur MountVolName qui n'es pas foutue de renvoyer le nom de volume si la lettre est recouverte pas un mappage réseau, bref pas top !