can anyone help me speed up my code?

[zerok666]

Hi, i am making a secure file deletion program. It works great, but it is extreamly slow. Any help will be appreciated.

 Private Sub Command1_Click()
On Error Resume Next
q = ""
 
Dim file As String
CD.ShowOpen
If CD.FileName = "" Then End
file = CD.FileName
Open file For Binary As #1
tem = LOF(1)
 
Dim bytarray() As Byte
ReDim bytarray(1 To tem)
 
Get 1, 1, bytarray
q = ""
Form1.Hide
 
For b = 1 To Combo1.Text
For i = 1 To tem
mrand = Int(Rnd * (250))
bytarray(i) = Chr(mrand)
Next i
For g = 1 To tem
Put 1, g, bytarray(g)
Next g
Next b
 
Close #1
 
Kill file
 
MsgBox "Delete is complete", vbOKOnly, "Done!"
 
End
End Sub
 

[Guido Geurs]

Is it possible to attach your program?
Q1 : what is q ?
Q2 : what is tem ? ...

[zerok666]

Tem is the lof dictated in line 10 and for q, I forgot to remove it from the code.

[Guido Geurs]

Yours is working ????
This is the modification of Your code=

Option Explicit
 
Private Sub Command1_Click()
Dim BYTEARRAY() As Byte
Dim TEM As Long
Dim LOOPS As Integer
Dim BYTES As Long
Dim MRAND As Integer
'§ Select the file
   On Error GoTo No_File
   With CD
      .CancelError = True
      .ShowOpen
'§ Open the file
      On Error Resume Next
      Open .FileName For Binary As #1
         '§ put file in array
         TEM = LOF(1)
         ReDim BYTEARRAY(1 To TEM)
         Get 1, 1, BYTEARRAY
         '§ Rewrite bytes
         For LOOPS = 1 To Combo1.Text
            For BYTES = 1 To TEM
               MRAND = Int(Rnd * (250))
               BYTEARRAY(BYTES) = MRAND
               Put 1, BYTES, BYTEARRAY(BYTES)
            Next
            Label2 = LOOPS & " times rewritten"
            Label2.Refresh
         Next
      Close #1
'§ Delete file
      Kill .FileName
   End With
   MsgBox "Delete is complete", vbOKOnly, "Done!"
No_File:
End Sub
 
Private Sub Form_Load()
Dim COUNTER As Integer
'§ Fill list
   For COUNTER = 0 To 90 Step 10
      If COUNTER > 0 Then Combo1.AddItem COUNTER
   Next
End Sub
 

But I have a lot of questions with Your approach:

Q1: why rewriting the bytes more than once ?
If You disable the line "Kill .Filename", you will see if You open the file (still present) all the bytes are changed.
So once is enough.

Q2: Why randomize the bytes ? if you enter only a character (like 100 for "d"), all the chars in the fill will be the same !( check with "Kill .Filename" off.

So here is the solution:

Option Explicit
 
Private Sub Command1_Click()
Dim BYTEARRAY() As Byte
Dim TEM As Long
Dim BYTESidx As Long
'§ Select the file
   On Error GoTo No_File
   With CD
      .CancelError = True
      .ShowOpen
'§ Open the file
      On Error GoTo No_File
      Open .FileName For Binary As #1
         '§ put file in array
         TEM = LOF(1)
         ReDim BYTEARRAY(1 To TEM)
         Get 1, 1, BYTEARRAY
         '§ Rewrite bytes
         For BYTESidx = 1 To TEM
            BYTEARRAY(BYTESidx) = 100 '="d"
         Next
         Put 1, 1, BYTEARRAY
      Close #1
'§ Delete file
      Kill .FileName
   End With
   MsgBox "Delete is complete", vbOKOnly, "Done!"
Exit Sub
No_File:
   MsgBox "No file selected"
End Sub
 

[zerok666]

if they are overwritten once, than data can still be recovered. i am trying to have no data recovery.