PureBasic Forums - English

Code: Select all

;
; small CheckDrives - 20021011
;
; F.Weil
;
; small CheckDrives is a refined program from CheckDrives for getting available drives on the local machine, eventually remote drives.
;

#FORMAT_MESSAGE_FROM_SYSTEM = $1000

Dim DrivesTable.s(100, 10)

Global DrivesTable

; sFormatMessage handles a Windows API MessageID and calls FormatMessage_() with
; standard parameters.
;
; This function takes the message text system response as return value
;
Procedure.s sFormatMessage(MessageID.l)
*Message = AllocateMemory(0, 255, 0)
Result.l
sMessage.s
  Result = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, MessageID, LANG_NEUTRAL, *Message, 200, 0) - 2
  sMessage = PeekS(*Message, Result)
  ProcedureReturn sMessage
EndProcedure

;
; FormatUnits converts a Bytes quantity in KB, MB, GB or TB according to argument value
; Range of values is 1024. Finally the returned result is a formatted string with
; 2 decimal digits float.
;
Procedure.s FormatUnits(n.f)
Limit.f
Result.s
Units.s
  Units = " B"
  If n > 1024
      n = n / 1024
      Units = " KB"
  EndIf
  If n > 1024
      n = n / 1024
      Units = " MB"
  EndIf
  If n > 1024
      n = n / 1024
      Units = " GB"
  EndIf
  If n > 1024
      n = n / 1024
      Units = " TB"
  EndIf
  ;
  ; The following line should be enough to limit two decimal digits but it seems
  ; necessary to look at the exact result (maybe a bug somewhere in float handling).
  ; The 2 while / wend loops check for exact format I wished.
  ; This makes this procedure corresponding to a regular ###.## $ number formatting
  ; where $ represents a string set to unit label.
  ;
  Result = StrF(Int(n * 100) / 100)                     ; add a . if the number is an integer result
  If FindString(Result, ".", 1) = 0
      Result = Result + "."
  EndIf
  While FindString(Result, ".", 1) > Len(Result) - 2    ; Add trailing 0s if necessary
    Result = Result + "0"
  Wend
  While FindString(Result, ".", 1)  0
      Quit = #FALSE
    Else
      Quit = #TRUE
  EndIf
  ;
  ; A repeat / forever loop allows to scan drives all the time
  ;
  Repeat
    ;
    ; Erase the list of items
    ;
    ClearGadgetItemList(10)
    ;
    ; Initialize the items counter to 1
    ;
    ipt = 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).
    ;
    Tmp = ""
    For i = 0 To GetLogicalDriveStrings_(255, *Buffer)
      C = PeekB(*Buffer + i)
      If C  0
          Tmp = Tmp + Chr(c)
        Else
          If DrivesTable(ipt, 1)  Tmp
              DrivesTable(ipt, 1) = Tmp
              If Tmp = "A:\" Or Tmp = "B:\"
                  DrivesTable(ipt, 6) = "Off"
                Else
                  DrivesTable(ipt, 6) = "On"
              EndIf
          EndIf
          ipt = ipt + 1
          Tmp = ""
      EndIf
    Next
    ;
    ; Decrease the last entry number until no null item is found
    ;
    While DrivesTable(ipt, 1) = ""
      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
      DrivesTable(i, 2) = sGetDriveType(DrivesTable(i, 1))
      ;
      ; Items are displayed using found parameters or filling status for not available drives
      ;
      If DrivesTable(i, 6) = "On"
          DrivesTable(i, 3) = Space(255)
          DrivesTable(i, 5) = Space(255)
          If GetVolumeInformation_(DrivesTable(i, 1), @DrivesTable(i, 3), 255, @Serial, 0, 0, @DrivesTable(i, 5), 255)
              DrivesTable(i, 4) = Str(Serial)
              Text = DrivesTable(i, 1) + Chr(10) + DrivesTable(i, 3) + Chr(10) + Hex(Serial) + Chr(10) + DrivesTable(i, 5) + Chr(10) + DrivesTable(i, 2) + Chr(10) + Chr(10) + DrivesTable(i, 6)
              If GetDiskFreeSpace_(DrivesTable(i, 1), @SectorsPerCluster, @BytesPerSector, @NumberOfFreeClusters, @TotalNumberOfClusters)
                  TotalSpace = TotalNumberOfClusters * SectorsPerCluster * BytesPerSector
                  TotalFreeSpace = NumberOfFreeClusters * SectorsPerCluster * BytesPerSector
                  TotalUsedSpace = TotalSpace - TotalFreeSpace
                  Text = Text + Chr(10) + Str(SectorsPerCluster) + Chr(10) + Str(BytesPerSector) + Chr(10) + Str(NumberOfFreeClusters) + Chr(10) + Str(TotalNumberOfClusters) + Chr(10) + FormatUnits(TotalSpace) + Chr(10) + FormatUnits(TotalFreeSpace) + Chr(10) + FormatUnits(TotalUsedSpace)
              EndIf
            Else
              Text = DrivesTable(i, 1) + Chr(10) + Chr(10) + Chr(10) + Chr(10) + DrivesTable(i, 2) + Chr(10) + sFormatMessage(GetLastError_()) + Chr(10) + DrivesTable(i, 6)
          EndIf
        Else
          Text = DrivesTable(i, 1) + Chr(10) + "" + Chr(10) + "" + Chr(10) + "" + Chr(10) + DrivesTable(i, 2) + Chr(10) + "" + Chr(10) + DrivesTable(i, 6)
      EndIf
      AddGadgetItem(10, -1, Text)
    Next
    Delay(Delay)
  Until Quit
EndProcedure

;
; Get drives
;
; Got this API code from freaks post to PureBasic forum and just transformed it to a function.
; Not used in this application sample
;
Procedure.s GetDrives()
  bitmask.l = GetLogicalDrives_()
  drives.s = ""
  one.l = 1
  For i = 0 To 31
    If bitmask  & one  WindowWidth() Or WindowHeight  WindowHeight()
            WindowWidth = WindowWidth()
            WindowHeight = WindowHeight()
            ResizeGadget(10, 5, 5, WindowWidth - 10, WindowHeight - 10)
        EndIf
      Until Quit
  EndIf

End

Code: Select all

; -----------------------------
;  DriveType Procedure
;
;   Useage: DriveType("C:\") 
; -----------------------------
Procedure.s DriveType(DriveLetter.s)
  
   Number.l = GetDriveType_(DriveLetter)
   
   If Number = #DRIVE_UNKNOWN            ; 0  -  UNDETERMINED
      Result.s = "Unknown  "
   ElseIf Number = #DRIVE_NO_ROOT_DIR    ; 1  - ROOT DIR DOESN'T EXIST	
      Result = "NoRootDir"
   ElseIf Number = #DRIVE_REMOVABLE      ; 2  - DRIVE_REMOVABLE	
       Result = "Removable"
   ElseIf Number = #DRIVE_FIXED          ; 3  - DRIVE_FIXED
      Result = "Fixed    "
   ElseIf Number = #DRIVE_REMOTE         ; 4  - REMOTE DRIVE (NETWORK)
      Result =  "Remote   "
   ElseIf Number = #DRIVE_CDROM          ; 5  - CDROM (DVD)
      Result  = "CDROM    "
   ElseIf Number = #DRIVE_RAMDISK        ; 6  - RAM DRIVE (MEMORY)
      Result  = "RAM Disk "
   EndIf
 ProcedureReturn Result.s
EndProcedure
; ========================================= 
;
;
; Test Program
;

ans.s = DriveType("A:\")
messagerequester("", ans, 0)  

End