vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2018
 
zurück
Rubrik: Dateisystem · Dateien allgemein   |   VB-Versionen: VB4, VB5, VB611.09.02
Dateischredder

Eine Funktion, die das sichere Löschen von Dateien bietet - ohne jegliche Rekonstruier-Möglichkeit!

Autor:   Christian LütgensBewertung:     [ Jetzt bewerten ]Views:  15.339 
www.dateicommander.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Wenn man seine gebrauchte Festplatte verkauft, will man sicher gehen, dass niemand an seine alten Daten kommt!

Dieser Tipp zeigt ein Beispiel, wie man seine Dateien schnell und sicher schreddert!!

Option Explicit
 
' Benötigte APIs und Konstanten
Private Declare Function WriteFile Lib "kernel32" ( _
  ByVal hfile As Long, _
  lpBuffer As Any, _
  ByVal nNumberOfBytesToWrite As Long, _
  lpNumberOfBytesWritten As Long, _
  lpOverlapped As Any) As Long
 
Private Declare Function CreateFile Lib "kernel32.dll" _
  Alias "CreateFileA" ( _
  ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, _
  ByVal dwShareMode As Long, _
  ByVal lpSecurityAttributes As Long, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, _
  ByVal hTemplateFile As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
  ByVal hObject As Long) As Long
 
Private Declare Function SetFilePointer Lib "kernel32.dll" ( _
  ByVal hfile As Long, _
  ByVal lDistanceToMove As Long, _
  lpDistanceToMoveHigh As Long, _
  ByVal dwMoveMethod As Long) As Long
 
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_ALWAYS = 2
Const CREATE_NEW = 1
Const OPEN_ALWAYS = 4
Const OPEN_EXISTING = 3
Const TRUNCATE_EXISTING = 5
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Const FILE_FLAG_NO_BUFFERING = &H20000000
Const FILE_FLAG_OVERLAPPED = &H40000000
Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Const FILE_FLAG_WRITE_THROUGH = &H80000000
' Datei sicher "vernichten"
Public Function Dateischredder(sPath As String, _
  iAnzahl As Integer)
 
  Dim lVal, hfile, lNumWritten, i, j As Long
  Dim dCount As Double
  Dim dRest As Double
  Dim sTemp As String
  Dim lFileLength As Long
  Dim sTemp0 As String
  Dim sTemp1 As String
  Dim RetVal As Variant
  Dim Ant
  Dim AttrOld As Long
 
  Const Buffer = 32768
 
  sTemp0 = String(Buffer, Chr$(0))
  sTemp1 = String(Buffer, Chr$(255))
  lFileLength = FileLen(sPath)
  If lFileLength < Buffer Then
    dRest = lFileLength
  Else
    dCount = Int((lFileLength) / Buffer)
    dRest = lFileLength - (dCount * Buffer)
  End If
 
  ' Prüfen, ob Datei schreibgeschützt ist
  AttrOld = GetAttr(sPath)
  If AttrOld = 1 Or AttrOld = 3 Or AttrOld = 5 Or _
    AttrOld = 7 Or AttrOld = 33 Or AttrOld = 35 Or _
    AttrOld = 35 Or AttrOld = 37 Or AttrOld = 39 Then
 
    Ant = MsgBox("Die Datei : " + sPath + vbCrLf + _
      "ist schreibgeschütz, soll sie trotzdem geschreddert werden ?", _
      vbExclamation + vbYesNo, "Schreibschutz aufheben ?")
    If Ant = vbNo Then
      Exit Function
    Else
      SetAttr sPath, vbArchive
    End If
  End If
 
  ' Datei öffnen
  hfile = CreateFile(sPath, GENERIC_WRITE, 0, 0, _
    OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE Or _
    FILE_FLAG_SEQUENTIAL_SCAN Or _
    FILE_FLAG_DELETE_ON_CLOSE, 0) '
  If hfile = -1 Then
    ' Datei kann nicht geöffnet werden
    GoTo ErrSub
  End If
 
  For lVal = 1 To iAnzahl ' 8 gilt offiziell als sicher
    If lFileLength > Buffer Then
      For i = 1 To dCount
        RetVal = WriteFile(hfile, ByVal sTemp0, _
          ByVal Buffer, lNumWritten, ByVal 0&)
        DoEvents
      Next i
    End If
    sTemp = String(dRest, Chr$(90))
    RetVal = WriteFile(hfile, ByVal sTemp, _
      ByVal Len(sTemp), lNumWritten, ByVal 0&)
    sTemp = Empty
 
    ' zurück an den Anfang der Datei
    RetVal = SetFilePointer(hfile, 0, 0, 0)
 
    If lFileLength > Buffer Then
      For i = 1 To dCount
        RetVal = WriteFile(hfile, ByVal sTemp1, _
          ByVal Buffer, lNumWritten, ByVal 0&)
      Next i
    End If
    sTemp = String(dRest, Chr$(255))
    RetVal = WriteFile(hfile, ByVal sTemp, _
      ByVal Len(sTemp), lNumWritten, ByVal 0&)
    sTemp = Empty
 
    ' zurück an den Anfang der Datei
    RetVal = SetFilePointer(hfile, 0, 0, 0)
    If lFileLength > Buffer Then
      For i = 1 To dCount
        RetVal = WriteFile(hfile, ByVal sTemp1, _
          ByVal Buffer, lNumWritten, ByVal 0&)
      Next i
    End If
    sTemp = String(dRest, Chr$(140))
    RetVal = WriteFile(hfile, ByVal sTemp, _
      ByVal Len(sTemp), lNumWritten, ByVal 0&)
    sTemp = Empty
 
    ' zurück an den Anfang der Datei
    RetVal = SetFilePointer(hfile, 0, 0, 0)
  Next lVal
 
  ' noch ein paar Zufallszahlen dann läßt die Datei
  ' nicht mehr rekonstruieren
  Randomize
  For j = 1 To iAnzahl
    DoEvents
    If lFileLength > Buffer Then
      For i = 1 To dCount
        sTemp = String(Buffer, Chr(Int(255 * Rnd) + 1))
        RetVal = WriteFile(hfile, ByVal sTemp, _
          ByVal Buffer, lNumWritten, ByVal 0&)
        sTemp = Empty
      Next i
    End If
    sTemp = String(dRest, Chr(Int(255 * Rnd) + 1))
    RetVal = WriteFile(hfile, ByVal sTemp, _
      ByVal Len(sTemp), lNumWritten, ByVal 0&)
 
    sTemp = Empty
    ' zurück an den Anfang der Datei
    RetVal = SetFilePointer(hfile, 0, 0, 0)
  Next
 
  ' schließen und anschl. Datei löschen
  RetVal = CloseHandle(hfile)
 
ErrSub:
  If Err.Number > 0 Then
    MsgBox (Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Error"
  End If
End Function

Beispiel für den Aufruf:

'  Aufruf aus irgendeiner Prozedur
Dim msg As String
 
msg = "WARNUNG:  " & _
  "Dateien können nach dem Löschen nicht mehr " & _
  "rekonstruiert werden!" & vbCrLf & vbCrLf & _
  "Sind Sie ganz sicher?"
 
If MsgBox(msg, vbExclamation + vbYesNo, _
  "Dateien schreddern und löschen ?") = vbYes Then
 
  Dateischredder "d:\temp\Test1.txt", 9
End If

Dieser Tipp wurde bereits 15.339 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2018 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel