home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 27 / IOPROG_27.ISO / COMMON / RTFAPI.ZIP / Api_VB / Infocomp.bas < prev    next >
Encoding:
BASIC Source File  |  1998-04-20  |  5.3 KB  |  176 lines
  1. Attribute VB_Name = "InfoComp"
  2. '    Questo Φ un file dimostrativo sull'uso delle API in VB
  3. ' Φ stato creato per la rivista ioProgrammo della DiemmeEditori
  4. '    dal  Prof. Francesco Mannarino - Italy
  5. '                         il 19 Aprile 1998
  6. Option Explicit
  7.     'Funzione API GetSystemInfo()
  8.  Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As _
  9.    SYSTEM_INFO)
  10.    
  11.    ' Funzione  API GetVolumeInformation
  12.  Declare Function GetVolumeInformation Lib _
  13.    "kernel32" Alias "GetVolumeInformationA" _
  14.    (ByVal lpRootPathName As String, _
  15.    ByVal lpVolumeNameBuffer As String, _
  16.    ByVal nVolumeNameSize As Long, _
  17.    lpVolumeSerialNumber As Long, _
  18.    lpMaximumComponentLength As Long, _
  19.    lpFileSystemFlags As Long, _
  20.    ByVal lpFileSystemNameBuffer As String, _
  21.    ByVal nFileSystemNameSize As Long) As Long
  22.     
  23.    ' Funzione  API GetDiskFreeSpace
  24. Declare Function GetDiskFreeSpace Lib _
  25.   "kernel32" Alias "GetDiskFreeSpaceA" _
  26.   (ByVal lpRootPathName As String, _
  27.     lpSectorsPerCluster As Long, _
  28.     lpBytesPerSector As Long, _
  29.     lpNumberOfFreeClusters As Long, _
  30.     lpTtoalNumberOfClusters As Long) As Long
  31.   
  32.     'costanti di GetSystemInfo()
  33.  Public Const PROCESSOR_INTEL_386 = 386
  34.  Public Const PROCESSOR_INTEL_486 = 486
  35.  Public Const PROCESSOR_INTEL_PENTIUM = 586
  36.  Public Const PROCESSOR_MIPS_R4000 = 4000
  37.  Public Const PROCESSOR_ALPHA_21064 = 21064
  38.  
  39.    ' struttura di GetSystemInfo()
  40.  Type SYSTEM_INFO
  41.     dwOemID As Long
  42.     dwPageSize As Long
  43.     lpMinimumApplicationAddress As Long
  44.     lpMaximumApplicationAddress As Long
  45.     dwActiveProcessorMask As Long
  46.     dwNumberOrfProcessors As Long
  47.     dwProcessorType As Long
  48.     dwAllocationGranularity As Long
  49.     dwReserved As Long
  50.    End Type
  51.   
  52.   ' istanza sulla struttura SYSTEM_INFO
  53.  Public MySystemInfo As SYSTEM_INFO
  54.    
  55.    ' Funzione  API GetVersionEx()
  56.  Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
  57.   (LpVersionInformation As OSVERSIONINFO) As Long
  58.    
  59.    ' Struttura di GetVersionEx()
  60.    Type OSVERSIONINFO
  61.      dwOSVersionInfoSize As Long
  62.      dwMajorVersion As Long
  63.      dwMinorVersion As Long
  64.      dwBuildNumber As Long
  65.      dwPlatformId As Long
  66.      szCSDVersion As String * 128
  67.     End Type
  68.    
  69.    ' Funzione  API GlobalMemoryStatus()
  70.  Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As _
  71.    MEMORYSTATUS)
  72.    
  73.    ' Struttura di GlobalMemoryStatus
  74.     Type MEMORYSTATUS
  75.      dwLength As Long
  76.      dwMemoryLoad As Long
  77.      dwTotalPhys As Long
  78.      dwAvailPhys As Long
  79.      dwTotalPageFile As Long
  80.      dwAvailPageFile As Long
  81.      dwTotalVirtual As Long
  82.      dwAvailVirtual As Long
  83.     End Type
  84.  
  85. '-------------------------------------------------
  86.  
  87. '   Tipi personalizzati per reperire i dati su
  88. '   GetDiskFreeSpace()   GetVolumeInformation()
  89.   Public Type ElementiHd
  90.      Percorso As String
  91.      NomeVolume As String
  92.      NrVolNameS As Long
  93.      NrSeriale As Long
  94.      MaxComp As Long
  95.      FlSysFlag As Long
  96.      FlSysNamS As String
  97.      NrFlSysNamS As Long
  98.   End Type
  99.   
  100.   Public Type DiscoFisico
  101.     lpSectorsPerCluster As Long
  102.     lpBytesPerSector As Long
  103.     lpNumberOfFreeClusters As Long
  104.     lpTtoalNumberOfClusters As Long
  105.   End Type
  106.   
  107.   ' variabili sui tipi ElementiHd e DiscoFisico
  108.   Dim MioHd As ElementiHd
  109.   Dim MioHdFis As DiscoFisico
  110.   
  111.   ' funzione che chiama e formatta i dati di GetVolumeInformation
  112. Public Function InfoHD(ByVal MioDrive As String) As Long
  113.   Dim temp&
  114.   Dim StrNulNomeVol$, StrNulFlSys$
  115.   StrNulNomeVol$ = String$(256, 0)
  116.   StrNulFlSys$ = String$(256, 0)
  117.   temp = GetVolumeInformation(MioDrive, _
  118.    StrNulNomeVol$, 255, MioHd.NrSeriale, _
  119.    MioHd.MaxComp, MioHd.FlSysFlag, StrNulFlSys$, 255)
  120.    InfoHD = temp
  121.   MioHd.NomeVolume = StrNulToStr(StrNulNomeVol$)
  122.   MioHd.FlSysNamS = StrNulToStr(StrNulFlSys$)
  123. End Function
  124.  
  125.  ' funzione che chiama e formatta i dati di GetDiskFreeSpace
  126. Public Function InfoFisHd(ByVal MioDrive As String) As Long
  127.   Dim temp&
  128.   temp = GetDiskFreeSpace(MioDrive, _
  129.    MioHdFis.lpSectorsPerCluster, _
  130.    MioHdFis.lpBytesPerSector, _
  131.    MioHdFis.lpNumberOfFreeClusters, _
  132.    MioHdFis.lpTtoalNumberOfClusters)
  133.    InfoFisHd = temp
  134. End Function
  135.  
  136. Public Function NomeVolume()
  137.    NomeVolume = MioHd.NomeVolume
  138.  End Function
  139. Public Function NrSeriale()
  140.   NrSeriale = MioHd.NrSeriale
  141. End Function
  142. Public Function MaxComp()
  143.   MaxComp = MioHd.MaxComp
  144. End Function
  145. Public Function FlSysFlag()
  146.   FlSysFlag = MioHd.FlSysFlag
  147. End Function
  148. Public Function FlSysNamS()
  149.   FlSysNamS = MioHd.FlSysNamS
  150. End Function
  151. Public Function SettoriPerCluster()
  152.  SettoriPerCluster = MioHdFis.lpSectorsPerCluster
  153. End Function
  154. Public Function BytesPerSettori()
  155.  BytesPerSettori = MioHdFis.lpBytesPerSector
  156. End Function
  157. Public Function NrClusterLiberi()
  158.   NrClusterLiberi = MioHdFis.lpNumberOfFreeClusters
  159. End Function
  160. Public Function TotNrCluster()
  161.   TotNrCluster = MioHdFis.lpTtoalNumberOfClusters
  162. End Function
  163. Public Function Capienzahd()
  164.   Capienzahd = SettoriPerCluster * BytesPerSettori * TotNrCluster
  165. End Function
  166.  
  167.  ' funzione che trasforma un stringa terminante con zero
  168.  ' in una senza
  169. Public Function StrNulToStr(ByVal Str_Nul$) As String
  170.   Dim k As Integer
  171.    For k = 1 To 256
  172.     If Asc(Mid(Str_Nul$, k, 1)) = 0 Then Exit For
  173.     StrNulToStr = StrNulToStr + Mid(Str_Nul$, k, 1)
  174.   Next
  175. End Function
  176.