home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / FileSystem206395542007.psc / Drive.cls < prev    next >
Text File  |  2007-04-29  |  13KB  |  303 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Drive"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. ' =======================================================
  15. '
  16. ' Hex Editor VB
  17. ' Coded by violent_ken (Alain Descotes)
  18. '
  19. ' =======================================================
  20. '
  21. ' A complete hexadecimal editor for Windows ⌐
  22. ' (Editeur hexadΘcimal complet pour Windows ⌐)
  23. '
  24. ' Copyright ⌐ 2006-2007 by Alain Descotes.
  25. '
  26. ' This file is part of Hex Editor VB.
  27. '
  28. ' Hex Editor VB is free software; you can redistribute it and/or modify
  29. ' it under the terms of the GNU General Public License as published by
  30. ' the Free Software Foundation; either version 2 of the License, or
  31. ' (at your option) any later version.
  32. '
  33. ' Hex Editor VB is distributed in the hope that it will be useful,
  34. ' but WITHOUT ANY WARRANTY; without even the implied warranty of
  35. ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  36. ' GNU General Public License for more details.
  37. '
  38. ' You should have received a copy of the GNU General Public License
  39. ' along with Hex Editor VB; if not, write to the Free Software
  40. ' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  41. '
  42. ' =======================================================
  43.  
  44.  
  45. Option Explicit
  46.  
  47. Private clsFile As FileSystem
  48. Private MyDrive As ClassDrive
  49.  
  50. '=======================================================
  51. 'Constantes
  52. '=======================================================
  53. Private Const GENERIC_READ                  As Long = &H80000000
  54. Private Const FILE_SHARE_READ               As Long = &H1
  55. Private Const FILE_SHARE_WRITE              As Long = &H2
  56. Private Const OPEN_EXISTING                 As Long = 3
  57. Private Const INVALID_HANDLE_VALUE          As Long = -1
  58. '=======================================================
  59. 'APIs
  60. '=======================================================
  61. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  62. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  63.  
  64.  
  65. '=======================================================
  66. 'Type privΘ contenant les infos sur ce fichier
  67. '=======================================================
  68. Private Type ClassDrive
  69.     Cylinders As Currency
  70.     TracksPerCylinder As Long
  71.     SectorsPerTrack As Long
  72.     PercentageFree As Double
  73.     FreeSpace As Currency
  74.     UsedSpace As Currency
  75.     UsedClusters As Currency
  76.     StartingOffset As Currency
  77.     TotalSpace As Currency
  78.     SectorPerCluster As Long
  79.     BytesPerSector As Long
  80.     FreeClusters As Long
  81.     TotalClusters As Long
  82.     TotalLogicalSectors As Currency
  83.     TotalPhysicalSectors As Currency
  84.     VolumeLetter As String
  85.     BytesPerCluster As Long
  86.     HiddenSectors As Long
  87.     PartitionLength As Currency
  88.     VolumeName As String
  89.     VolumeSerialNumber As Long
  90.     FileSystemName As String
  91.     strMediaType As String
  92.     DriveType As Byte
  93.     strDriveType As String
  94. End Type
  95.  
  96. '=======================================================
  97. 'DΘfinit le path de cet objet
  98. '=======================================================
  99. Friend Function SetVolumeLetter(VolumeLetter As String, Optional ByVal RefreshInformations As Boolean = True)
  100.     'on dΘfinit le path du fichier
  101.     MyDrive.VolumeLetter = VolumeLetter
  102.     If RefreshInformations Then Call RefreshInfos
  103. End Function
  104.  
  105. '=======================================================
  106. '//PropriΘtΘs de l'objet
  107. '=======================================================
  108. Public Property Get Cylinders() As Currency: Cylinders = MyDrive.Cylinders: End Property
  109. Public Property Get TracksPerCylinder() As Long: TracksPerCylinder = MyDrive.TracksPerCylinder: End Property
  110. Public Property Get SectorsPerTrack() As Long: SectorsPerTrack = MyDrive.SectorsPerTrack: End Property
  111. Public Property Get PercentageFree() As Double: PercentageFree = MyDrive.PercentageFree: End Property
  112. Public Property Get FreeSpace() As Currency: FreeSpace = MyDrive.FreeSpace: End Property
  113. Public Property Get UsedSpace() As Currency: UsedSpace = MyDrive.UsedSpace: End Property
  114. Public Property Get UsedClusters() As Currency: UsedClusters = MyDrive.UsedClusters: End Property
  115. Public Property Get StartingOffset() As Currency: StartingOffset = MyDrive.StartingOffset: End Property
  116. Public Property Get TotalSpace() As Currency: TotalSpace = MyDrive.TotalSpace: End Property
  117. Public Property Get SectorPerCluster() As Long: SectorPerCluster = MyDrive.SectorPerCluster: End Property
  118. Public Property Get BytesPerSector() As Long: BytesPerSector = MyDrive.BytesPerSector: End Property
  119. Public Property Get FreeClusters() As Long: FreeClusters = MyDrive.FreeClusters: End Property
  120. Public Property Get TotalClusters() As Long: TotalClusters = MyDrive.TotalClusters: End Property
  121. Public Property Get TotalLogicalSectors() As Currency: TotalLogicalSectors = MyDrive.TotalLogicalSectors: End Property
  122. Public Property Get TotalPhysicalSectors() As Currency: TotalPhysicalSectors = MyDrive.TotalPhysicalSectors: End Property
  123. Public Property Get VolumeLetter() As String: VolumeLetter = MyDrive.VolumeLetter: End Property
  124. Attribute VolumeLetter.VB_UserMemId = 0
  125. Public Property Get BytesPerCluster() As Long: BytesPerCluster = MyDrive.BytesPerCluster: End Property
  126. Public Property Get HiddenSectors() As Long: HiddenSectors = MyDrive.HiddenSectors: End Property
  127. Public Property Get PartitionLength() As Currency: PartitionLength = MyDrive.PartitionLength: End Property
  128. Public Property Get VolumeName() As String: VolumeName = MyDrive.VolumeName: End Property
  129. Public Property Get VolumeSerialNumber() As Long: VolumeSerialNumber = MyDrive.VolumeSerialNumber: End Property
  130. Public Property Get FileSystemName() As String: FileSystemName = MyDrive.FileSystemName: End Property
  131. Public Property Get strMediaType() As String: strMediaType = MyDrive.strMediaType: End Property
  132. Public Property Get DriveType() As Byte: DriveType = MyDrive.DriveType: End Property
  133. Public Property Get strDriveType() As String: strDriveType = MyDrive.strDriveType: End Property
  134.  
  135.  
  136.  
  137. '=======================================================
  138. '//MΘthodes
  139. '=======================================================
  140.  
  141. '=======================================================
  142. 'Rafraichit les infos
  143. '=======================================================
  144. Public Sub RefreshInfos()
  145. Dim tGeom As DiskGeometry
  146. Dim tSizes As DriveSizes
  147. Dim tVol As VolumeInfo
  148. Dim tPart As PartitionInfo
  149. Dim hDevice As Long
  150.  
  151.     'ouvre le drive
  152.     hDevice = CreateFile("\\.\" & UCase$(Me.VolumeLetter) & ":", GENERIC_READ, _
  153.         FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  154.  
  155.     If hDevice = INVALID_HANDLE_VALUE Then Exit Sub
  156.     
  157.     'rΘcupΦre les infos diverses
  158.     With clsFile
  159.         tGeom = .GetDriveGeometry_HANDLE(hDevice)
  160.         If tGeom.BytesPerSector = 0 Then Exit Sub
  161.         tSizes = .GetDriveSizes_HANDLE(hDevice, Me.VolumeLetter)
  162.         tPart = .GetDrivePartitionInfo_HANDLE(hDevice)
  163.         tVol = .GetDriveVolumeInfo(Me.VolumeLetter)
  164.     End With
  165.     
  166.     'referme le handle
  167.     Call CloseHandle(hDevice)
  168.     
  169.     With MyDrive
  170.         .BytesPerCluster = tSizes.BytesPerCluster
  171.         .BytesPerSector = tGeom.BytesPerSector
  172.         .Cylinders = tGeom.Cylinders
  173.         .FileSystemName = tVol.FileSystemName
  174.         .FreeClusters = tSizes.FreeClusters
  175.         .DriveType = clsFile.GetDriveType(Me.VolumeLetter)
  176.         .FreeSpace = tSizes.FreeSpace
  177.         .HiddenSectors = tPart.HiddenSectors
  178.         .PartitionLength = tPart.PartitionLength
  179.         .PercentageFree = (.FreeSpace / tSizes.TotalSpace) * 100
  180.         .SectorPerCluster = tSizes.BytesPerCluster / tSizes.BytesPerSector
  181.         .SectorsPerTrack = tGeom.SectorsPerTrack
  182.         .StartingOffset = tPart.StartingOffset
  183.         .strDriveType = clsFile.GetStringDriveType(.DriveType)
  184.         .strMediaType = tGeom.strMediaType
  185.         .TotalClusters = tSizes.TotalClusters
  186.         .TotalSpace = tSizes.TotalSpace
  187.         If .FileSystemName = "NTFS" Then
  188.             .TotalLogicalSectors = .TotalSpace / .BytesPerSector
  189.             .TotalPhysicalSectors = .TotalLogicalSectors + .HiddenSectors
  190.         Else
  191.             .TotalLogicalSectors = .PartitionLength / .BytesPerSector
  192.             .TotalPhysicalSectors = .TotalLogicalSectors + .HiddenSectors
  193.         End If
  194.         .TracksPerCylinder = tGeom.TracksPerCylinder
  195.         .UsedClusters = tSizes.UsedClusters
  196.         .UsedSpace = tSizes.UsedSpace
  197.         .VolumeName = tVol.VolumeName
  198.         .VolumeSerialNumber = tVol.VolumeSerialNumber
  199.     End With
  200.  
  201. End Sub
  202.  
  203. '=======================================================
  204. 'Renvoie true si accessible
  205. '=======================================================
  206. Public Function IsDriveAvailable() As Boolean
  207.     IsDriveAvailable = clsFile.IsDriveAvailable(Me.VolumeLetter)
  208. End Function
  209.  
  210. '=======================================================
  211. 'Affiche la boite de dialogue propriΘtΘs
  212. '=======================================================
  213. Public Function ShowPropertyBox(ByVal hWnd As Long) As Long
  214.     ShowPropertyBox = clsFile.ShowDriveProperty(Me.VolumeLetter, hWnd)
  215. End Function
  216.  
  217. '=======================================================
  218. 'Lecture dans le disque
  219. '=======================================================
  220. Public Function ReadDriveString(ByVal StartingSector As Currency, ByVal nBytes As _
  221.     Long) As String
  222.     
  223. Dim bpsec As Long
  224.  
  225.     'dΘtermine le nombre de bytes par secteur
  226.     If Me.BytesPerSector = 0 Then bpsec = _
  227.         clsFile.GetDriveSizes(Me.VolumeLetter).BytesPerSector Else _
  228.         bpsec = Me.BytesPerSector
  229.     
  230.     ReadDriveString = clsFile.ReadDriveString(Me.VolumeLetter, StartingSector, _
  231.         nBytes, bpsec)
  232.  
  233. End Function
  234.  
  235. '=======================================================
  236. 'Ecriture dans le disque
  237. '=======================================================
  238. Public Function WriteDriveString(ByVal StartingSector As Currency, ByVal nBytes As _
  239.     Long, ByVal StringToWrite As String) As Long
  240.     
  241. Dim bpsec As Long
  242.  
  243.     'dΘtermine le nombre de bytes par secteur
  244.     If Me.BytesPerSector = 0 Then bpsec = _
  245.         clsFile.GetDriveSizes(Me.VolumeLetter).BytesPerSector Else _
  246.         bpsec = Me.BytesPerSector
  247.     
  248.     WriteDriveString = clsFile.WriteDriveString(Me.VolumeLetter, StartingSector, _
  249.         nBytes, bpsec, StringToWrite)
  250.     
  251. End Function
  252.  
  253. '=======================================================
  254. 'RΘcupΦre l'icone du fichier
  255. '=======================================================
  256. Public Function GetIcon(ByVal Size As IconSize) As IPictureDisp
  257.     Set GetIcon = clsFile.GetIcon(Me.VolumeLetter & ":\", Size)
  258. End Function
  259.  
  260. '=======================================================
  261. 'Lance la sanitization... my god...
  262. '=======================================================
  263. Public Function Sanitize() As Long
  264.     Sanitize = clsFile.SanitizeDrive(Me.VolumeLetter)
  265. End Function
  266.  
  267. '=======================================================
  268. 'Change le label du drive
  269. '=======================================================
  270. Public Function SetVolumeLabel(NewLabel As String) As Long
  271.  
  272.     SetVolumeLabel = clsFile.SetVolumeLabel(Me.VolumeLetter, NewLabel)
  273.     
  274.     'refresh le volumename dans les propriΘtΘs
  275.     MyDrive.VolumeName = clsFile.GetDriveVolumeInfo(Me.VolumeLetter).VolumeName
  276.     
  277. End Function
  278.  
  279. '=======================================================
  280. 'CrΘΘ une archive ISO depuis le disque
  281. '=======================================================
  282. Public Function CreateIso(IsoDestination As String) As Long
  283.     CreateIso = clsFile.CreateIsoFromDrive(Me.VolumeLetter, IsoDestination)
  284. End Function
  285.  
  286.  
  287.  
  288.  
  289.  
  290. '=======================================================
  291. 'Subs de la classe
  292. '=======================================================
  293. Private Sub Class_Initialize()
  294.     'instancie la classe clsFile
  295.     Set clsFile = New FileSystem
  296. End Sub
  297.  
  298. Private Sub Class_Terminate()
  299.     'libΦre la classe clsFile
  300.     Set clsFile = Nothing
  301. End Sub
  302.  
  303.