Secure Delete

I need some code to securely delete a file.
I'd like some some opinions about the following code i wrote.

Code:

---

Public Sub SecureDelete(ByRef FilePath As String, Optional ByRef Rewrites As Long = 7)
    Dim sFiller
    Dim lFileSize As Long
    Dim lR As Long
    Dim lFF As Long
   
    On Error Resume Next
    lFileSize = FileLen(FilePath)
    If lFileSize = 0 Then
        Kill FilePath
    Else
        lFF = FreeFile
        Open FilePath For Input As lFF

        For lR = 1 To Rewrites
            Do While Len(sFiller) < lFileSize
                sFiller = sFiller & CStr((64000 * Rnd))
                DoEvents 'could take a while, don't lock the app
            Loop
            sFiller = Right$(sFiller, lFileSize)
            Print lFF, sFiller
            'to save time, instead of re-writting the whole string,
            'just shift it a a random length
            sFiller = Right$(sFiller, lFileSize - Int(500 * Rnd))
        Next
        Close lFF
    End If
    Kill FilePath
    On Error GoTo 0
End Sub

---

try this one...

Code:

---

Sub DestroyFile(sFileName As String)

    Dim Block1 As String, Block2 As String, Blocks As Long
    Dim hFileHandle As Integer, iLoop As Long, offset As Long
    'Create two buffers with a specified 'wipe-out' characters
   
    Const BLOCKSIZE = 4096
    Block1 = String(BLOCKSIZE, "X")
    Block2 = String(BLOCKSIZE, " ")
   
    'Overwrite the file contents with the wipe-out characters
    hFileHandle = FreeFile
    Open sFileName For Binary As hFileHandle
    Blocks = (LOF(hFileHandle) \ BLOCKSIZE) + 1

    For iLoop = 1 To Blocks
        offset = Seek(hFileHandle)
        Put hFileHandle, , Block1
        Put hFileHandle, offset, Block2
    Next iLoop
        Close hFileHandle
   
    'Now you can delete the file, which contains no sensitive data
    Kill sFileName
   
End Sub

---

Interesting, but a few things may need tweeking.
1. I believe you want to overwrite at least 7 times for a good shred.

2. I think you'll be making the file a little larger than the original, I believe I've read that that can cause part of the file to be moved to a new sector of the drive, possible leaving a section of the original file un touched. It would be an un-allocated sector, but the info would be there.

3 I'm not sure I'd trust just using the two chars for the over-write.

but I like the seek thing, i've never used it.

You could also Shell() an instance of SDelete v1.51

I did not code that sub longwolf, I took it from psc.com

Check the link:

http://www.planet-source-code.com/vb...=1650&lngWId=1

Quote:

---

Originally Posted by smertniki

I did not code that sub longwolf, I took it from psc.com

---

No prob, you gave me some ideas :)

Code:

---

Public Sub SecureDelete(ByRef FilePath As String, Optional ByRef Rewrites As Long = 7)
    Dim sBlock As String
    Dim lR As Long
    Dim lB As Long
    Dim lFF As Long
    Dim lBlocks As Long
    Dim lLeftOver As Long
    Dim lOffset As Long
    Const BLOCKSIZE = 4096

    On Error Resume Next
    If FileLen(FilePath) = 0 Then
        Kill FilePath
    Else
        For lR = 1 To Rewrites
            lFF = FreeFile
            Open FilePath For Input As lFF
            lBlocks = (LOF(lFF) / BLOCKSIZE)
            lLeftOver = LOF(lFF) Mod BLOCKSIZE
            Do While Len(sBlock) < BLOCKSIZE
                sBlock = sBlock & CStr((64000 * Rnd))
                DoEvents 'could take a while, don't lock the app
            Loop
            sBlock = Right$(sBlock, BLOCKSIZE)
            For lB = 1 To lBlocks
                Put lFF, , sBlock
            Next
            If lLeftOver Then
                Put lFF, , Right$(sBlock, lLeftOver)
            End If
            'to save time, instead of re-writting the whole string,
            'just shift it a a random length
            sBlock = Right$(sBlock, BLOCKSIZE - Int(500 * Rnd))
            Close lFF
        Next
    End If
    Kill FilePath
    On Error GoTo 0
End Sub

---

Are there any obvious problems with this one?

EDIT: fixed a couple of probs, still looking for more

Quote:

---

Originally Posted by dilettante

You could also Shell() an instance of SDelete v1.51

---

Thx dilettante,
I may use that on future apps.
My current app has waaaaay to may dependencies already :)

longwolf, your code is working perfectly too :wave:

Quote:

---

Originally Posted by smertniki

longwolf, your code is working perfectly too :wave:

---

You must mean the first code, just fixed a couple of probs with the second one from post #6

hummm, just tried the code in post #6.

I get a 'Bad File mode ' error on the 'Put' line.

What's it need?

this seems to work

Code:

---

Public Sub SecureDelete(ByRef FilePath As String, Optional ByRef Rewrites As Long = 7)
    Dim sBlock As String
    Dim lR As Long
    Dim lB As Long
    Dim lFF As Long
    Dim lBlocks As Long
    Dim lLeftOver As Long
    Const BLOCKSIZE = 4096

    On Error Resume Next
    If FileLen(FilePath) = 0 Then
        Kill FilePath
    Else
        For lR = 1 To Rewrites
            lFF = FreeFile
            Open FilePath For Binary Access Write As lFF
            lBlocks = int(LOF(lFF) / BLOCKSIZE)
            lLeftOver = LOF(lFF) Mod BLOCKSIZE
            Do While Len(sBlock) < BLOCKSIZE
                sBlock = sBlock & CStr((64000 * Rnd))
                DoEvents 'could take a while, don't lock the app
            Loop
            sBlock = Right$(sBlock, BLOCKSIZE)
            For lB = 1 To lBlocks
                Put lFF, , sBlock
            Next
            If lLeftOver Then
                Put lFF, , Right$(sBlock, lLeftOver)
            End If
            'to save time, instead of re-writting the whole string,
            'just shift it a a random length
            sBlock = Right$(sBlock, BLOCKSIZE - Int(500 * Rnd))
            Close lFF
        Next
    End If
    Kill FilePath
    On Error GoTo 0
End Sub

---

Id say do your research good on this one.

Normal VB coding wont totaly erase everything.

You need to use API's, to read & write to a file, then FLushtheBuffers etc...
Here are a few to get you started, but do your research.

Code:

---

.Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As Long, 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
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long 'flush file buffers

---

Quote:

---

Originally Posted by some1uk03

Id say do your research good on this one.

Normal VB coding wont totaly erase everything.

You need to use API's, to read & write to a file, then FLushtheBuffers etc...
Here are a few to get you started, but do your research.

---

Looks like this is more complex.
Doing a search turned up this code that uses most of the APIs you listed
http://www.planet-source-code.com/vb...65004&lngWId=1

I looked over the PSC code.
I don't understand why APIs are needed, except maybe for speed.

I added 3 things to the code
1. added code to burn over the file name.
2. making sure the over-write is saved by re-opening it after each over-write.
3. added code to mess with the filelength pointer

Code:

---

Option Explicit

Public Enum eShreadLvl
    Normal
    Paranoid
End Enum

Public Sub SecureDelete(ByRef FilePath As String, Optional ByRef Rewrites As Long = 7, _
                        Optional ByRef ShreadLvl As eShreadLvl = Normal)
    Dim sBlock As String
    Dim lR As Long
    Dim lB As Long
    Dim lFF As Long
    Dim lBlocks As Long
    Dim lLeftOver As Long
    Const BLOCKSIZE = 4096
    Dim sPath As String 'file path only
    Dim sNameOld As String 'file name
    Dim sNameNew As String 'file name
    Dim lDot As Long
    Dim sChar As String * 1
   
    On Error Resume Next
    If FileLen(FilePath) = 0 Then
        Kill FilePath
    Else
        sNameOld = Mid$(FilePath, InStrRev(FilePath, "\") + 1)
        sPath = Left$(FilePath, Len(FilePath) - Len(sNameOld))
        lDot = InStrRev(sNameOld, ".")
        For lR = 1 To Rewrites
            'Burn over the old file name with new file names x Times
            sNameNew = vbNullString
            For lB = 1 To Len(sNameOld)
                If lB = lDot Then
                    sNameNew = sNameNew & "."
                Else
                    sNameNew = sNameNew & Chr$(97 + Int(25 * Rnd))
                End If
            Next
            Name sPath & sNameOld As sPath & sNameNew
            DoEvents
            FilePath = sPath & sNameNew
           
            'Burn over the old file x times
            lFF = FreeFile
            Open FilePath For Binary Access Write As lFF
                lBlocks = Int(LOF(lFF) / BLOCKSIZE)
                lLeftOver = LOF(lFF) Mod BLOCKSIZE
                For lB = 1 To lBlocks
                    'build/alter the block
                    Do While Len(sBlock) < BLOCKSIZE
                        sBlock = sBlock & CStr((64000 * Rnd))
                        DoEvents 'could take a while, don't lock the app
                    Loop
                    sBlock = Right$(sBlock, BLOCKSIZE)
                    'overwrite the block
                    Put lFF, , sBlock
                   
                    'make a small,rnd block shift each pass
                    sBlock = Right$(sBlock, BLOCKSIZE - Int(50 * Rnd))
                Next
                If lLeftOver Then
                    Put lFF, , Right$(sBlock, lLeftOver)
                End If
               
                If ShreadLvl = Normal Then
                    'to save time, instead of re-writting the whole string,
                    'just shift it a a random length
                    sBlock = Right$(sBlock, BLOCKSIZE - Int(500 * Rnd))
                Else
                    'Paranoid
                    'force a completly new block
                    sBlock = vbNullString
                End If
            Close lFF
            DoEvents
           
            'make sure the over write is saved by reading one char
            lFF = FreeFile
            Open FilePath For Input As lFF
                sChar = Input$(1, lFF)
            Close lFF
            sNameOld = sNameNew
        Next
       
        'Burn over the old file length with new lengths x times
        For lR = 1 To Rewrites
            lB = Int(Rnd * 255) + 1
            sBlock = vbNullString
            Do While Len(sBlock) < lB
                sBlock = sBlock & CStr((64000 * Rnd))
            Loop
            sBlock = Right$(sBlock, lB)
            lFF = FreeFile
            Open FilePath For Output As #lFF
                Print #lFF, sBlock
            Close lFF
        Next
        Kill FilePath
    End If
    On Error GoTo 0
End Sub

---

Can anone show me the weak points?

I'd love to see this tested against a file recovery app :)

I may be wrong... But please correct me if I am.

When windows writes a file, it is at random location on the disk, instead of a fixed predefined location. So whenever you open and write something to a file and save it, it may not be writing to the same location on the disk where the previous file blocks were located. Instead it might be at a different location, but in the FAT/NTFS file system table, your file points to the new location.

So you will need to atleast erase/overwrite the original harddisk blocks to securely delete your file (maybe using some APIs or harddisk utilities). Just opening it and writing to it n number of times may still not grantee you secure deletion of your file.

Pradeep

Thx Pradeep,

From what I understand of disk use, if the file size where to change, then parts of the files could be shifted to different sectors to make better use of the drive space.

But the code is making sure to keep the file size the same during the main re-writes.

If I'm wrong, I'd love to see a reference about it.

nice code, this is prob a dumb question, but how does it know what file to delete. Is there a place where a textbox value is put in a string or something ?

Like C:\windows\notepad.exe

?

Thanks!

The path to the file you want to delete is the first parameter of the sub.
How you select that file is up to you as the programmer.

Code:

---

Public Sub SecureDelete(ByRef FilePath As String, Optional ByRef Rewrites As Long = 7, _
                        Optional ByRef ShreadLvl As eShreadLvl = Normal)

---