Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Sub About_Click()frmAbout.ShowEnd Sub
Private Sub Command1_Click()CommonDialog1.FileName = ""CommonDialog1.InitDir = App.PathCommonDialog1.Filter = "*.*"CommonDialog1.ShowOpenText1.Enabled = FalseText1.Text = CommonDialog1.FileNameDim fileatt As Longfileatt = SetFileAttributes(Text1.Text, 128)End Sub
Private Sub Command2_Click()EndEnd Sub
Private Sub Command3_Click()If Text1.Text = "" ThenMsgBox "请选择文件路径!", vbOKOnlyElseIf MsgBox("确实要彻底删除此文件?", vbYesNo) = vbYes ThenOn Error GoTo error1:Dim buff() As ByteDim filelong As LongProgressBar1.Min = 0Open Text1.Text For Binary Access Read Write As #1ReDim buff(1 To 2560)filelong = LOF(1)ProgressBar1.Max = filelongProgressBar1.Value = 0Do While Not EOF(1) Get #1, , buff For i = 1 To 2560 buff(i) = 255 'Debug.Print "buff" & i & "=" & buff(i) Next For i1 = 1 To filelong Step 2560 Put #1, i1, buff ProgressBar1.Value = i1 NextLoopClose #1Dim fso As New FileSystemObjectfso.DeleteFile Text1.Text, TrueText1.Text = ""MsgBox "文件删除成功!", vbOKOnly
End IfEnd IfExit Suberror1:MsgBox ErrorEnd Sub
Private Sub Form_Load()
End Sub
