Advertisement
2002C Files/ File Controls/ Input/ Output #8887

KillFiles

I received a request from someone on help with a problem in deleting temporary files. It seems that they needed to delete all temporary files except for those with the current date. This subroutine was the result, and I though it would be good for those of you struggling with how to use the Dir and GetAttr and SetAttr functions in VB

AI

Resumo por IA: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Código fonte
original-source
Private Sub Command1_Click()
KillFiles "C:\windows\temp", ".tmp"
End Sub
Public Sub KillFiles(FilePath As String, Extension As String)
Dim curfile As String
Dim mydate As String
Dim tgtdate As String
Dim tgtpath As String
Dim oldpath As String
Dim indx As Integer
Dim attr As Integer
On Error GoTo TrapError
oldpath = CurDir      'Save Current Path and drive'
mydate = Format(Day(Now), "##00") 'Force current date to 2 digits
ChDrive FilePath         'make sure we change drive
ChDir FilePath          'and path to correct place
'
'Build full target path variable
'
If Right(FilePath, 1) = "\" Then
  tgtpath = FilePath & "*" & Extension
Else
  tgtpath = FilePath & "\*" & Extension
End If
'
' Get first target extension file in directory
'
curfile = Dir(tgtpath, vbNormal)
'
' Loop through directory of all extension files
'
While curfile <> ""
  tgtdate = FileDateTime(curfile)  'get file date
  indx = InStr(1, tgtdate, "/")   'find first date slash
  tgtdate = Mid(tgtdate, indx + 1) 'move in data
  indx = InStr(1, tgtdate, "/")   'find second slash
  tgtdate = Format(Left(tgtdate, indx - 1), "##00") 'form 2 digit date
  '
  ' Check to see if the dates are the same
  ' if not, delete the file
  '
  If tgtdate <> mydate Then
    '
    ' check attributes for readonly, system and hidden files
    '
    attr = GetAttr(curfile) And 31 ' and out unwanted bits
    If attr <> 0 Then 'file is special
     resp = MsgBox(curfile & " Is protected ... Delete?", vbYesNo)
     If resp = vbYes Then
       SetAttr curfile, vbNormal 'reset attributes so u can delete
       Kill curfile   ' delete the file
     End If
    Else
     Kill curfile ' file is normal file .. delete it
    End If
  End If
  curfile = Dir() ' get next file
Wend
ChDrive oldpath 'restore original drive
ChDir oldpath  'restore original path
Exit Sub
TrapError:
  MsgBox Error(Err) & " on " & curfile
  Resume Next
End Sub
Comentários originais (3)
Recuperado do Wayback Machine