VB清理临时文件

Option Explicit
Private Declare Function ShellExecute Lib “shell32.dll” Alias “ShellExecuteA” (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function PathFileExists Lib “shlwapi.dll” Alias “PathFileExistsA” (ByVal pszPath As String) As Long
Private Declare Function DeleteFile Lib “kernel32” Alias “DeleteFileA” (ByVal lpFileName As String) As Long
Const RECENT = &H8&
Const PAGETMP = &H20&
Const APPDATA = &H1A
Dim folderName As String, shl As Object
Dim NF As Boolean
Dim Stty As Long

Function RecurseTree(CurrPath As String) As Boolean
Dim sFileName As String, newPath As String, sPath As String, Fs As Object
Static oldPath As String
Text1.Text = “”
NF = True
On Error GoTo ErrLabel
sPath = CurrPath & Chr(92)
sFileName = Dir(sPath, 31)
Set Fs = CreateObject(“Scripting.FileSystemObject”)
Do While sFileName <> “” And NF = True
DoEvents
If sFileName <> Chr(46) And sFileName <> Chr(46) & Chr(46) Then
If GetAttr(sPath & sFileName) And vbDirectory Then
newPath = sPath & sFileName
RecurseTree newPath
sFileName = Dir(sPath, 31)
Else
SetAttr sPath & sFileName, vbNormal
Fs.DeleteFile (sPath & sFileName)
Text1.Text = Text1.Text & sPath & sFileName & vbCrLf
sFileName = Dir
End If
Else
sFileName = Dir
End If
If NF = False Or sFileName = “” Then Text1.Text = Text1.Text & vbCrLf & “-” & IIf(Stty > 0, IIf(Stty > 1, “系统临时文件清理完成！”, “网页浏览记录清理完毕！”), “最近打开的文件清理完毕！”) & “-”: RecurseTree = True: Exit Do
Loop
SetAttr CurrPath, vbNormal
Fs.deletefolder CurrPath
ErrLabel: NF = False
End Function

Private Sub CommandButton1_Click(Index As Integer)
Call Qlxt(Index)
End Sub

Private Sub Fcommand1_Click(Index As Integer)
Select Case Index
Case 0
Call ExitForm
End
Case 1
Call MaximizeForm(Me)
Case 2
Me.WindowState = 1
End Select
End Sub

Private Sub Form_Load()
Me.Caption = “清理系统历史记录”
Text1.Text = “”
Text1.BackColor = vbBlack
Fcommand1(0).Caption = “×”: Fcommand1(1).Caption = “□”: Fcommand1(2).Caption = “▁”:
CommandButton1(0).Caption = “清理最近打开的历史”: CommandButton1(1).Caption = “清理网页历史记录”: CommandButton1(2).Caption = “清理系统临时文件”: CommandButton1(3).Caption = “外挂磁盘自动修复”
Set shl = CreateObject(“shell.application”)
Call ResponseTaskbar(Me)
Call ActivateTheForm(Me)
Form_Resize
Call Qlxt(0)

Fcommand1(0).Move (Me.ScaleWidth - 400), (500 - 300) / 2, 300, 300
Fcommand1(1).Move (Fcommand1(0).Left - Fcommand1(1).Width), (500 - 300) / 2, 300, 300
Fcommand1(2).Move (Fcommand1(1).Left - Fcommand1(2).Width), (500 - 300) / 2, 300, 300
End Sub

Private Sub JBcolor(DX As Object, mStartColor As Long, mCeaseColor As Long)
Dim rSta, gSta, bSta, rEnd, gEnd, bEnd, rInfo, gInfo, bInfo, i
DX.AutoRedraw = True
rSta = mStartColor Mod 256
gSta = mStartColor \ 256 Mod 256
bSta = mStartColor \ 256 \ 256
rEnd = mCeaseColor Mod 256
gEnd = mCeaseColor \ 256 Mod 256
bEnd = mCeaseColor \ 256 \ 256
rInfo = (rEnd - rSta) / 1800
gInfo = (gEnd - gSta) / 1800
bInfo = (bEnd - bSta) / 1800
For i = 0 To 1800
DX.Line (0, i)-(DX.ScaleWidth, i), RGB(rSta + i * rInfo, gSta + i * gInfo, bSta + i * bInfo)
Next
DX.Line (0, 1800)-(DX.ScaleWidth - 8, DX.ScaleHeight - 8), Me.Point(50, 1800), BF
DX.Line (0, 0)-(DX.ScaleWidth - 8, DX.ScaleHeight - 8), RGB(0, 0, 0), B
End Sub

Private Sub Form_Resize()
Me.Cls
Call JBcolor(Me, RGB(83, 83, 83), RGB(200, 200, 200))
Fcommand1(0).Move (Me.ScaleWidth - 400), (500 - 300) / 2, 300, 300
Fcommand1(1).Move (Fcommand1(0).Left - Fcommand1(1).Width), (500 - 300) / 2, 300, 300
Fcommand1(2).Move (Fcommand1(1).Left - Fcommand1(2).Width), (500 - 300) / 2, 300, 300
CommandButton1(0).Move 50, 400
CommandButton1(1).Move (CommandButton1(0).Left + CommandButton1(0).Width), 400
CommandButton1(2).Move (CommandButton1(1).Left + CommandButton1(1).Width), 400
CommandButton1(3).Move (CommandButton1(2).Left + CommandButton1(2).Width), 400
Picture1.Move 50, (CommandButton1(0).Top + CommandButton1(0).Height), Me.ScaleWidth - 100, Me.ScaleHeight - 850
Text1.Move 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
Me.CurrentX = 100: Me.CurrentY = 100
Me.ForeColor = RGB(255, 255, 255)
Me.Print Me.Caption
End Sub

Private Sub Form_DblClick()
If Jpzj(0) = 1 And Jpzj(1) > 50 And Jpzj(1) < 500 Then Call MaximizeForm(Me)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Jpzj(0) = Button
Jpzj(1) = y
Call Formsize(Me, Button, x, y, , , 1)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Call MobileForm(Me, Button, x, y)
Call Formsize(Me, Button, x, y)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Call Formsize(Me, Button, x, y, , , 2)
End Sub

Private Sub Qlxt(Index As Integer)
On Error Resume Next
folderName = shl.NameSpace(RECENT).Self.Path
Select Case Index
Case 0
Call RecurseTree(folderName)
Stty = 0
Case 1
If RecurseTree(folderName) = True Then
folderName = shl.NameSpace(PAGETMP).Self.Path
If RecurseTree(folderName) = True Then
If RecurseTree(Environ(“temp”)) = True Then
End If
End If
DoEvents
End If
Stty = 1
Case 2
Call RecurseTree(folderName)
Stty = 2
Case 3
Call ShellExecute(Me.hwnd, “open”, “chkdsk”, “”, “c:”, 1)
End Select
End Sub
工程包下载地址：https://download.csdn.net/download/ty5858/21829858