Deleting a Directory (or a HD!) so that data is PERMANENTLY lost

[eiSecure]

How do i delete a directory, or a Hard Drive so that the data cannot be retrieved?
I know how to delete them, but an Un-Delete program can easisly "undelete" them.
All I need is code. Not too much explaining is needed.

[Jop]

In case nobody knows, mail to the webmaster of analogx.com, maybe he knows, he made a similar prog (think it's C++ or something, not sure)

Before deleting the file, write meaningless jargon into it about 10 times or so. This way, the data in the cluster will be written over so many times it will be beyond recovery.

[Nitro]

I wrote something in Excel Visual Basic Application to permanently delete files in a specific directory. Basically, it rename any files to a txt extention. Then it opens up the file and replace the content with some word. Close the file and rename it back and just delete it. Even if someone tried to retreat the file, the actual content has been wipe out.

I don't know if that is what you are looking for but that is a start.

Drop this into a Module in Excel and run it.

Sub pDeleteIt()
'PURPOSE:                       WARNING!!!!!
'         The following procedure will delete all files permenantly
    
  Dim intY As Integer
  Dim strDelFile As String

  Dim strDir As String
  strDir = fGetFilesInDirectory()
  
  'PURPOSE: Make sure you want to delete
  If MsgBox("Activate Delete Process?", vbYesNo, "***** WARNING! *****") = vbNo Then End
  
  Do Until ActiveCell.Value = ""
      'PURPOSE:Increase the serial number
      intY = intY + 1
      strDelFile = "Del" & intY & ".txt"
      ActiveCell.Offset(0, 1).Value = strDelFile
      
      'PURPOSE:Rename to a text file
      Name strDir & ActiveCell.Value As strDir & strDelFile
      
      'PURPOSE:Write Bogus Info
      DoEvents
      Open strDir & strDelFile For Output As #1
      Print #1, "Confidential"
      Close #1
      
      'PURPOSE:Rename text file back to what it was
      Name strDir & strDelFile As strDir & ActiveCell.Value
      
      'PURPOSE:Delete File
      Kill strDir & ActiveCell.Value
  
      ActiveCell.Offset(1, 0).Select
  Loop
  
  Range("a1").Select
End Sub
Public Function fGetFilesInDirectory()
  Cells.Clear
  Range("a1").Select
  
  Dim strDir As String
  'PURPOSE:Get directory name by selecting on a bogus file
  strDir = Application.GetOpenFilename("All Files(*.*), *.*,Excel Files(*.xls),*.xls", 1, "Files Comparison")
  If UCase(strDir) = UCase("False") Then End
  strDir = CurDir
  
  'PURPOSE:Check if user inputted a "\" or not
  If Right(strDir, 1) <> "\" Then
    strDir = strDir & "\"
  End If
  
  'PURPOSE:List the Files in the selected directory
  ChDir strDir
  Dim intFileCount As Integer
  ActiveCell.Value = Dir(strDir & "*.*")
  Do Until ActiveCell.Value = ""
    intFileCount = intFileCount + 1
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Dir()
  Loop
  
  'PURPOSE:Sort
  Columns("A:A").Select
  Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  
  'PURPOSE:Format
  With Cells.Font
    .Name = "Times New Roman"
    .Size = 10
    .Bold = True
  End With
  
  'PURPOSE:Format
  Range("a1").Select
  Selection.EntireRow.Insert
  Selection.EntireRow.Insert
  
  'PURPOSE:Assign current directory name to
  '        A1 and back to the function name
  Range("a1").Value = strDir
  Range("d18").Value = "Total files in this directory: " & intFileCount
  fGetFilesInDirectory = strDir
  
  'PURPOSE:Starting process position for pRenameIt or pDeleteIt
  Range("a3").Select
End Function

[eiSecure]

Thanks! It helped greatly, but I still have 1 question remaining:
How do you do the same with a Hard Drive???
(No, i'm not trying to wreck someone's HD, just a feature 4 my security application)

[Nitro]

Can you elaborate more? I don't understand. Do yo want to go to subdirectories is that what you mean?

[eiSecure]

Yes, I mean both going into sub-directories, and I also mean the Hard Drive, as in formatting the entire hard drive so that its contents cannot be retrieved. (Probably not possible w/ VB though)

[Nitro]

If you want to format the hard drive, I think your vb program cannot be on the same hard drive. Never done it. So, I am not quite sure about this but if you go to explorer, you can right click on a drive and see "FORMAT".

I think you can make a batch file and place the format command in there. You might want to use the function SHELL("C:\Format.bat").

For the other question about subdirectories. Here is an example of getting all subdirectories using recursive method. Once you get all subdirectories, use it with my previous codes.

Drop a listbox on a form and paste the following codes into the declaration.

Option Explicit

Private Sub Form_Load()
  Call p_Get_SubDirectories("C:\Your Directory")
End Sub

Sub p_Get_SubDirectories(strPath As String)
  'PURPOSE: If Path lacks a "\", add one to the end
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

  'PURPOSE: Find file
  Dim strReturn As String
  strReturn = Dir(strPath & "*.*", vbDirectory)
  
  Dim strSubDir As String
  Do Until strReturn = ""
      'PURPOSE: Don't process "." and "..", they aren't real files
      If strReturn <> "." And strReturn <> ".." Then
          'PURPOSE: Check to see if it is a Directory
          If FileLen(strPath & strReturn) = 0 Then    'Directory is consist of 0 byte
              If GetAttr(strPath & strReturn) = vbDirectory Then
                  strSubDir = strSubDir & strPath & strReturn & ";"
              End If
          End If
      End If
      strReturn = Dir()
  Loop
'---------------------------------------------------------

  Dim intPos As Integer
  Do Until strSubDir = ""
      'PURPOSE: Locate the first ";" position - which represent the first directory
      intPos = InStr(1, strSubDir, ";")
      
      'PURPOSE: Strip the first directory name
      strReturn = Left$(strSubDir, intPos - 1)
      List1.AddItem strReturn
      
      'PURPOSE: Recursive - go into the 1st level of each sub directory
      Call p_Get_SubDirectories(strReturn)
      
      'PURPOSE: Strip out the first directory name since
      '         the file doesn't exsit in that directory
      strSubDir = Mid(strSubDir, intPos + 1)  'Strip what you don't need
  Loop
End Sub

[HeSaidJoe]

'can't see how this deals with security 
'with the benefit of a doubt
'here is how you format a drive and as
'previously stated...if you format the drive
'there is nothing left

'format a drive on your computer

Private Declare Function SHFormatDrive Lib "shell32" _
    (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, _
    ByVal options As Long) As Long


Private Declare Function GetDriveType Lib "kernel32" Alias _
    "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Command1_Click()
    Dim DriveLetter$, DriveNumber&, DriveType&
    Dim RetVal&, RetFromMsg%
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65) ' Change letter to Number: A=0
    DriveType = GetDriveType(DriveLetter)


    If DriveType = 2 Then 'Floppies, etc
        RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
    Else
        RetFromMsg = MsgBox("This drive is NOT a removeable" & vbCrLf & _
        "drive! Format this drive?", 276, "SHFormatDrive Example")


        Select Case RetFromMsg
            Case 6 'Yes
            ' UnComment to do it...
            'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
            Case 7 'No
            ' Do nothing
        End Select

End If

End Sub



Private Sub Command2_Click()
    ' DiskCopyRunDll takes two parameters- From and To
    Dim DriveLetter$, DriveNumber&, DriveType&
    Dim RetVal&, RetFromMsg&
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65)
    DriveType = GetDriveType(DriveLetter)


    If DriveType = 2 Then 'Floppies, etc
        RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " _
        & DriveNumber & "," & DriveNumber, 1) 'Notice space after
    Else ' Just in Case 'DiskCopyRunDll
        RetFromMsg = MsgBox("Only floppies can" & vbCrLf & _
        "be diskcopied!", 64, "DiskCopy Example")
    End If

End Sub

'Add 1 ListDrive name Drive1

Private Sub Drive1_Change()

    Dim DriveLetter$, DriveNumber&, DriveType&
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65)
    DriveType = GetDriveType(DriveLetter)


    If DriveType = 2 Then 'Floppies, etc
        Command2.Enabled = False
    Else
        Command2.Enabled = True
    End If

End Sub

[eiSecure]

But...I have just 1 question.
Were those smilies meant to be smilies, or were they meant to be ;) ?

[eiSecure]

Oh,
This deals with security by allowing the user, if wanted, to completely wipe out all data on their systems, so, lets say for example: the person was a spy, but is almost caught. So, in the few precious seconds that he has before he gets, he wipes out his computer's hard drive, so the people who caught him won't know what he knew.
(Yeah, its very far-fetched (farfetch'd, LOL), but at least it might happen...
...or not.

[Dim]

Heh i see what you mean eiSecure.
Oh yeah...the are just replased with a ")"

Laterz,
D!m

[Da HaCkEr!]

Here is the best way to do it.


rmdir "c:/*.*"
kill "c:/*.*"

that will delete every folder in your hard drive and every file!

!!!BE CAREFULL!!!