Listage de lecteurs disponible

Fortix · Message par **Fortix** » mar. 17/juil./2007 13:48

Bonjours, exist il un moyen de lister touts les lecteurs disponibles dans un system et pourquoi pas déterminer son type???

j'ai une solution mais malheureusement elle n'est pas universel !!!!

et je me suis basé sur une technique plutôt mesquinne :

(lettres d'alphabets +":" dans "SectionData" lecture de cette liste dans "ExamineDirectory", bref c'est très mesquin et pas du tout efficace !!!

)

, je suis convaincu qu'il existe une fonction prévue à cette éffet mais laquel,??,

Merci à tous

Progi1984 · Message par **Progi1984** » mar. 17/juil./2007 14:20

Code : Tout sélectionner

;Author: M.Kollenaar
;Date: 26 january 2003
;Version: 1.0
;Purpose: Get a list of drives present in this system.
;I got the idea from Freak. He used GetLogicalDrives to get a list of drives present in the system.
;I use in this code GetLogicalDriveStrings().
; URL : http://www.purebasic.fr/english/viewtopic.php?t=4915&highlight=list+drives

;Use Win32Api function.
;DWORD GetLogicalDriveStrings(
; DWORD nBufferLength, // size of buffer
; LPTSTR lpBuffer // address of buffer For drive strings
; );

;The returned drive string has the following format A:\<null>C:\<null>...Z:\<null><null> also 4 bytes for
;each drive and at the end two <null> terminating string characters. If there are 26 possible drive letters
;allocate a buffer of 105 bytes (4*26)+1.
;

;Calculate memory buffer.
nBufferLength = (4*26)+1

;Get the buffer and startaddress.
*npBuffer = AllocateMemory(nBufferLength)

;Check if memory allocation succeeded.
If *npBuffer <> 0
;Get drives and put the returned stringlength on a var.
stringlength = GetLogicalDriveStrings_(nBufferLength,*npBuffer)

;The number of drives in this system.
NumberOfDrives = stringlength/4

;Step through the drive string.
For i = 0 To NumberOfDrives - 1
;Get the drives names on intervals of 4 bytes.
Drive.s = PeekS(*npBuffer+(i*4))

;Show the drive names.
MessageRequester("DRIVES",Drive,0)
Next i
Else
;Something went wrong.
MessageRequester("Memory","No memory allocated",0)
EndIf
End

brossden · Message par **brossden** » mar. 17/juil./2007 15:38

Bonjour à tous
Un autre bout de prog avec le Type de lecteur

Code : Tout sélectionner

Tab.s=Chr(9)
Lecteurs.s = Space(255)
res = GetLogicalDriveStrings_(255, Lecteurs)
Repeat
  Lect.s = PeekS(@Lecteurs+offset,4)
  Type = GetDriveType_(Lect)
  If Type =2
    Genre.s= Tab +"DRIVE_REMOVABLE" + Tab + " Lecteur de disque amovible (Disquette,USB,zip,...)."
  ElseIf Type =3
    Genre.s= Tab +"DRIVE_FIXED" + Tab +" Lecteur de disque fixe."
  ElseIf Type =4
    Genre.s= Tab +"DRIVE_REMOTE" + Tab +" Lecteur de disque distant (réseau,...)."
  ElseIf Type =5
    Genre.s= Tab +"DRIVE_CDROM" + Tab +" Lecteur de CD-ROM (DVD aussi surement)."
  ElseIf Type =6
    Genre.s= Tab +"DRIVE_RAMDISK" + Tab +" Lecteur de disque en RAM (mémoire)."
  ElseIf Type >6
    Genre.s= Tab +"DRIVE_UNKNOW" + Tab +" Lecteur inconnu."
    
  EndIf
  tx.s +Lect+Genre+ Chr(13)
  offset+4
Until PeekS(@Lecteurs+offset,4)=""
MessageRequester("Liste des lecteurs",tx)

Pour chaque lecteur il est possible d'avoir la taille, le nom ....

Merci les API Windows !

Jacobus · Message par **Jacobus** » mar. 17/juil./2007 17:08

Une appli assez complète avec affichage des infos locales
Je me suis servi de procédures trouvées sur CodeArchiv

Code : Tout sélectionner

;Code en PB 4.02
;non testé en PB 4.10
Enumeration
#Windrives
#BtnRefreshListDrives
#BtnHelpListDrives
#TextListDrives
#ListDrives
EndEnumeration

;Images format icones 16x16 à décommenter en ajoutant vos propres icones
; DataSection
; Image42 : IncludeBinary "\Disque dur 04.ico";Disque dur
; Image43 : IncludeBinary "\CD-Rom.ico"; Lecteur CD Rom
; Image44 : IncludeBinary "\Lecteur externe.ico"; Disque amovible
; Image45 : IncludeBinary "\Réseau.ico"; lecteur réseau
; Image46 : IncludeBinary "\Memory1.ico"; barre mémoire
; Image47 : IncludeBinary "\Disquette.ico"; inconnu
; EndDataSection
; Global Image42, Image43, Image44, Image45, Image46, Image47
; Image42  = CatchImage(42, ?Image42)
; Image43  = CatchImage(43, ?Image43)
; Image44  = CatchImage(44, ?Image44)
; Image45  = CatchImage(45, ?Image45)
; Image46  = CatchImage(46, ?Image46)
; Image47  = CatchImage(47, ?Image47)

Global Free$ 
Global Total$ 
Global DriveIcon

Structure HiLow 
  lowlow.w 
  lowhi.w 
  hilow.w 
  hihi.w 
EndStructure 

Procedure.s GetFreeSpace(p$) 
  #div=10 
  #mask=(1<<#div)-1 
  #mul=16-#div 
  If Left(p$,2)="\\" 
    a=FindString(p$,"\",3) 
  Else 
    a=FindString(p$,"\",1) 
  EndIf 
  If a=0 : a=Len(p$) : EndIf 
  p$=Left(p$,a) 
  If GetDiskFreeSpaceEx_(@p$,@free.HiLow,@Total.HiLow,@TotalFree.HiLow) 
    hilow=free\hilow&$FFFF 
    hihi=free\hihi&$FFFF 
    lowlow=free\lowlow&$FFFF 
    lowhi=free\lowhi&$FFFF 
    
    p=1 
    While hihi>0 Or hilow>0 Or lowhi>0 
      lowlow=(lowlow>>#div)+((lowhi&#mask)<<#mul) 
      lowhi =(lowhi >>#div)+((hilow&#mask)<<#mul) 
      hilow =(hilow >>#div)+((hihi&#mask)<<#mul) 
      hihi  =(hihi>>#div) 
      p+1 
    Wend 
    
    If lowlow>1024 
      Free$= StrF(lowlow/1024,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p+1,",") 
    Else 
      Free$= StrF(lowlow,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p,",") 
    EndIf 
  Else 
    Free$="---" 
  EndIf 
  ProcedureReturn Free$ 
  
EndProcedure 

Procedure.s GetTotalSpace(p$) 
  #div=10 
  #mask=(1<<#div)-1 
  #mul=16-#div 
  If Left(p$,2)="\\" 
    a=FindString(p$,"\",3) 
  Else 
    a=FindString(p$,"\",1) 
  EndIf 
  If a=0 : a=Len(p$) : EndIf 
  p$=Left(p$,a) 
  If GetDiskFreeSpaceEx_(@p$,@free.HiLow,@Total.HiLow,@TotalFree.HiLow) 
    hilow=Total\hilow&$FFFF 
    hihi=Total\hihi&$FFFF 
    lowlow=Total\lowlow&$FFFF 
    lowhi=Total\lowhi&$FFFF 
    
    p=1 
    While hihi>0 Or hilow>0 Or lowhi>0 
      lowlow=(lowlow>>#div)+((lowhi&#mask)<<#mul) 
      lowhi =(lowhi >>#div)+((hilow&#mask)<<#mul) 
      hilow =(hilow >>#div)+((hihi&#mask)<<#mul) 
      hihi  =(hihi>>#div) 
      p+1 
    Wend 
    
    If lowlow>1024 
      Total$= StrF(lowlow/1024,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p+1,",") 
    Else 
      Total$= StrF(lowlow,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p,",") 
    EndIf 
  Else 
    Total$="---" 
  EndIf 
  ProcedureReturn Total$ 
  
EndProcedure 

Procedure DisplayHelp() 
  Help$ = "" 
  Help$ +"Informations affichées." + Chr(10) 
  Help$ +"" + Chr(10) 
  Help$ +"Drive = Identification du lecteur (lettre)" + Chr(10) 
  Help$ +"Label = Nom de lecteur (label)" + Chr(10) 
  Help$ +"N° = Numéro de série (si disponible)" + Chr(10) 
  Help$ +"Part = Partition - Système de fichiers" + Chr(10) 
  Help$ +"Type = Type de lecteur" + Chr(10) 
  Help$ +"Etat = Statut actuel du lecteur" + Chr(10) 
  Help$ +"Taille = Capacité totale du lecteur" + Chr(10) 
  Help$ +"Libre = Espace disque disponible" + Chr(10) 
  MessageRequester("Lecteurs disponibles",Help$,#MB_ICONINFORMATION) 
EndProcedure 

Procedure.s sGetDriveType(Parameter.s) 
  Result.s 
  Select GetDriveType_(Parameter) 
  Case 2 
    Result = "Lecteur amovible";"Removable Drive" 
   ; DriveIcon = Image44  ;<<---- affiche l'icône correspondante
  Case 3 
    Result = "Disque dur";"Fixed Drive" 
   ; DriveIcon = Image42
  Case 4 
    Result = "Réseau";"Remote (Network)" 
   ; DriveIcon = Image45
  Case 5 
    Result = "Lecteur CD-ROM";"CDRom Drive" 
   ; DriveIcon = Image43
  Case 6 
    Result = "Mémoire physique";"RAM Drive" 
   ; DriveIcon = Image46
    Default 
    Result = "Inconnu";"Unknown" 
   ; DriveIcon = Image47
  EndSelect 
  ProcedureReturn Result 
EndProcedure 

Procedure UpdateDrives(Delay.l) 
  *Buffer = AllocateMemory(255) 
  ipt.l 
  C.l 
  Serial.l 
  LogicalDriveType.s 
  VName.s 
  FSName.s 
  Text.s 
  EOL.s 
  VName  = Space(255) 
  FSName = Space(255) 
  Global Dim LogicalDrives.s(16) ; Allow room for up to 16 drives 

  LogicalDrives(1) = ""     ; Set the first table entry to null 
  ipt = 1                   ; Initialize the items counter to 1 
  ; Get the drives names in *Buffer and split it into a table 
  ; 
  ; GetLogicalDriveStrings writes the list of drives names 
  ; in a buffer, each name being Chr(0) separated. 
  ; The end of the buffer contains a double Chr(0). 
  For i = 0 To GetLogicalDriveStrings_(255, *Buffer) 
    C = PeekB(*Buffer + i) 
    If C <> 0 
      LogicalDrives(ipt) = UCase(LogicalDrives(ipt) + Chr(C)) 
    Else 
      ipt = ipt + 1 
      LogicalDrives(ipt) = "" 
    EndIf 
  Next 
  
  ; Decrease the last entry number until no null item is found 
  While LogicalDrives(ipt) = "" 
    ipt = ipt - 1 
  Wend 
  
  ; Loop to give further information about found drives 
  ; Values I found in different documents are not so clear. This has to be checked. 
  For i = 1 To ipt 
    LogicalDriveType = sGetDriveType(LogicalDrives(i)) 
    
    ; Items are displayed using found parameters or filling status for not available drives 
    If GetVolumeInformation_(LogicalDrives(i), VName, 255, Serial, 0, 0, FSName, 255) 
      GetFreeSpace(LogicalDrives(i)) 
      GetTotalSpace(LogicalDrives(i)) 
      Text = LogicalDrives(i) + Chr(10) + VName + Chr(10) + Str(Serial) + Chr(10) + FSName + Chr(10) + LogicalDriveType + Chr(10) + " " + Chr(10) + Total$ + Chr(10) + Free$ 
      
    Else 
      Text = LogicalDrives(i) + Chr(10) + Chr(10) + Chr(10) + Chr(10) + LogicalDriveType 
      If GetLastError_() = 21 
        Text = Text + Chr(10) + "Périphérique inaccessible"
      Else 
        Text = Text + Chr(10) + "LastError: " + Str(GetLastError_()) 
      EndIf 
    EndIf 
   ; AddGadgetItem(#ListDrives, -1, Text,DriveIcon) ;<<---- affiche l'icône correspondante
    AddGadgetItem(#ListDrives, -1, Text)
  Next 
EndProcedure 

Serial.l 
Delay.l 
Parameter.s 
LogicalDriveType.s 
VName.s 
FSName.s 
Text.s 
errmode = SetErrorMode_(#SEM_FAILCRITICALERRORS) 


If OpenWindow(#Windrives,0,0,600,260,"Lecteurs",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar) And CreateGadgetList(WindowID(#Windrives))=0
  End 
Else
   
   TextGadget(#TextListDrives, 0, 0, 600, 20, "", #PB_Text_Center)
   SetGadgetColor(#TextListDrives, #PB_Gadget_BackColor, RGB(175, 201, 226))
   SetGadgetColor(#TextListDrives, #PB_Gadget_FrontColor, RGB(255, 255, 255))
   SetGadgetFont(#TextListDrives, Font0)
   
   ListIconGadget(#ListDrives, 0, 20, 600, 200, "Drive", 50, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_HeaderDragDrop) 
    AddGadgetColumn(#ListDrives, 1, "Label", 50) 
    AddGadgetColumn(#ListDrives, 2, "N°", 50) 
    AddGadgetColumn(#ListDrives, 3, "Part", 50) 
    AddGadgetColumn(#ListDrives, 4, "Type", 110) 
    AddGadgetColumn(#ListDrives, 5, "Etat", 140) 
    AddGadgetColumn(#ListDrives, 6, "Taille", 70) 
    AddGadgetColumn(#ListDrives, 7, "Libre", 70)    
    SetGadgetColor(#ListDrives, #PB_Gadget_LineColor, RGB(92, 99, 232))
    
   ButtonGadget(#BtnRefreshListDrives,10,230,100,20,"Actualiser")
   GadgetToolTip(#BtnRefreshListDrives,"Actualiser les données affichées")
   SetGadgetFont(#BtnRefreshListDrives, Font0)
   
   ButtonGadget(#BtnHelpListDrives,560,230,30,20,"?")
   GadgetToolTip(#BtnHelpListDrives,"Qu'est-ce-que c'est?")
   SetGadgetFont(#BtnHelpListDrives, Font0)

;Recherche et affichage des infos trouvées
While WindowEvent():Wend 
  HideGadget(#ListDrives,1)
  UpdateDrives(0) 
  SetGadgetText(#TextListDrives,"Statut des lecteurs et disques disponibles") 
  HideGadget(#ListDrives,0)
EndIf 
     
Repeat 
  Select WaitWindowEvent() 
    Case #PB_Event_Gadget 
      Select EventGadget() 
        
      Case #BtnRefreshListDrives
        HideGadget(#ListDrives,1) 
        ClearGadgetItemList(#ListDrives)   
         SetGadgetText(#TextListDrives,"Analyse en cours...patientez");analyse très rapide 
         UpdateDrives(0) 
         SetGadgetText(#TextListDrives,"Statut des lecteurs et disques disponibles") 
        HideGadget(#ListDrives,0)
          
      Case #BtnHelpListDrives : DisplayHelp()
      
      EndSelect 
    Case #PB_Event_CloseWindow :Quit=1 
  EndSelect 
Until Quit=1 
End

Fortix · Message par **Fortix** » mar. 17/juil./2007 18:23

Un très Grand merci pour :

@_Progi1984
@_Jacobus
@_brossden

@_et les autres

Vos codes sont impécables

mais comment fêtes vous pour manipuler avec facilité les API de Windows

???

Dans ma version de PB (v4), l'aide contextuelle n'est pas disponible quand
il sagit d'une fonction API, et du coup j'ai un handicape très sévère ;

en tous cas merci à tous

brossden · Message par **brossden** » mar. 17/juil./2007 19:35

Les API ne sont pas renseignées sous PureBasic mais un petit lien pour commencer qui te donneras peut être des idées !

http://docvb.free.fr/api.php

Fortix · Message par **Fortix** » mar. 17/juil./2007 20:06

Merci Brossden

Droopy · Message par **Droopy** » mar. 17/juil./2007 20:52

Fortix a écrit :Dans ma version de PB (v4), l'aide contextuelle n'est pas disponible quand
il sagit d'une fonction API, et du coup j'ai un handicape très sévère ;

Télécharge le fichier Win32.hlp et met le dans le répertoire help de PureBasic. (ftp://ftp.borland.com/pub/delphi/techpu ... /win32.zip)

Fortix · Message par **Fortix** » mer. 18/juil./2007 11:56

Merci Droopy