Rubrik: Dateisystem · Dateien allgemein | VB-Versionen: VB4, VB5, VB6 | 11.09.02 |
Dateischredder Eine Funktion, die das sichere Löschen von Dateien bietet - ohne jegliche Rekonstruier-Möglichkeit! | ||
Autor: Christian Lütgens | Bewertung: | Views: 17.106 |
www.dateicommander.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | 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