title image


Smiley Re: ich würde einfach vorher überprüfen, ob der Speicherplatz reicht






Option Explicit



Private Const NO_ERROR = 0

Private Const HFILE_ERROR = -1

Private Const GENERIC_READ = &H80000000



Private Const OFS_MAXPATHNAME = 128

Private Type OFSTRUCT

   cBytes As Byte

   fFixedDisk As Byte

   nErrCode As Integer

   Reserved1 As Integer

   Reserved2 As Integer

   szPathName(OFS_MAXPATHNAME) As Byte

End Type

Private Type FileTime

   dwLowDateTime As Long

   dwHighDateTime As Long

End Type

Private Declare Function OpenFile Lib "kernel32" (ByVal lpszFile As String, lpOpenBuff As OFSTRUCT, ByVal fuMode As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long



Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)









Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _

                                                                                          lpSectorsPerCluster As Long, _

                                                                                          lpBytesPerSector As Long,

                                                                                          lpNumberOfFreeClusters As Long, _

                                                                                          lpTotalNumberOfClusters As Long) As Long





Public Function CalcAvalaibleSize(ByRef strPath As String) As Variant

Dim lngSectors As Long

Dim lngBytesPerSector As Long

Dim lngFreeClusters As Long

Dim lngTotalClusters As Long



Dim lngPos As String

Dim strDrive As String



   If Left$(strPath, 2) = "\\" Then

      '// UNC-Pfad

      lngPos = InStr(3, strPath, "\")

      '// Freigabe gehört zum Pfad

      lngPos = InStr(lngPos + 1, strPath, "\")

   Else

      lngPos = InStr(strPath, "\")

   End If

   strDrive = Left$(strPath, lngPos)



   If 0 = GetDiskFreeSpace(strDrive, lngSectors, lngBytesPerSector, lngFreeClusters, lngTotalClusters) Then

      CalcAvalaibleSize = 0

   Else

      CalcAvalaibleSize = CDec(lngFreeClusters) * lngSectors * lngBytesPerSector

   End If



End Function















Public Function Dateigroesse(ByRef strFileName As String) As Variant

Dim ofS As OFSTRUCT

Dim hdlFile As Long

Dim lngLow As Long

Dim lngHigh As Long

Dim lngKZ As Long

Dim varFileSize As Variant





   varFileSize = 0

   '// Datei öffnen

   hdlFile = OpenFile(strFileName, ofS, GENERIC_READ)

   If hdlFile <> HFILE_ERROR Then

      '// Dateigröße feststellen

      lngLow = GetFileSize(hdlFile, lngHigh)

      If lngLow = -1 Then

         If GetLastError <> NO_ERROR Then

            '// Fehler

            CloseHandle hdlFile

            Exit Function

         End If

      End If





      '// WICHTIG: Hier unbedingt alle Bytes des Variants auf 0 setzen

      '// Die ersten vier braucht man nicht, die stimmen (= Typkennzeichnung),

      '// aber bei den nachfolgenden sind nur die vom aktuellen Typ verwendeten Bytes 0

      '// In der Entwicklungsumgebung sind zwar alle Bytes 0, aber in der exe steht

      '// Müll an den anderen Stellen

      lngKZ = &H0&

      CopyMemory VarPtr(varFileSize) + 4, VarPtr(lngKZ), 4

      CopyMemory VarPtr(varFileSize) + 8, VarPtr(lngKZ), 4

      CopyMemory VarPtr(varFileSize) + 12, VarPtr(lngKZ), 4





      '// Dateigröße setzen

      '// Decimal-Typkennzeichen im Variant setzen

      lngKZ = &HE

      CopyMemory VarPtr(varFileSize), VarPtr(lngKZ), 4

      '// Low-Word setzen

      CopyMemory VarPtr(varFileSize) + 8, VarPtr(lngLow), 4

      '// High-Word setzen

      CopyMemory VarPtr(varFileSize) + 12, VarPtr(lngHigh), 4



      Dateigroesse = varFileSize

   End If

   CloseHandle hdlFile

End Function










Gruß
Gaga

___________________________________________________________________

Profilösungen für VB6
wenn nicht anders angegeben, sind alle Codebeispiele nicht getestet, nur getippt


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: