|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Arquivos/Diretórios)
|
|
 |
Título da Dica: Deletar arquivos enviando-os para a lixeira
|
 |
|
|
|
Postada em 8/10/2003 por ^HEAVY-METAL^
Option Explicit
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Declare Function SHFileOperation Lib "shell32.dll" (lpFileOP As SHFILEOPSTRUCT) As Long
Type BrowseInfo
hWndOwner As Long
pIDLRoor As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function blnDeleteFilesToRecycleBin _
(ParamArray vntFilename() As Variant) As Boolean
On Error GoTo ErrorToRecycleBin
Dim intK As Integer
Dim strFiles As String
Dim udtShellFileOper As SHFILEOPSTRUCT
Dim lngResult As Long
For intK = LBound(vntFilename) To UBound(vntFilename)
strFiles = strFiles & vntFilename(intK) & vbNullChar
Next
strFiles = strFiles & vbNullChar
With udtShellFileOper
.wFunc = &H3
.pFrom = strFiles
.fFlags = &H40
End With
lngResult = SHFileOperation(udtShellFileOper)
blnDeleteFilesToRecycleBin = True
Exit Function
ErrorToRecycleBin:
blnDeleteFilesToRecycleBin = False
Exit Function
End Function
Public Function strChooseFolder(hWndOwner As Long, strPrompt As String) As String
Dim intNull As Integer
Dim lngIDList As Long
Dim lngResult As Long
Dim strPath As String
Dim udtBI As BrowseInfo
With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(strPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lngIDList = SHBrowseForFolder(udtBI)
If lngIDList Then
strPath = String$(MAX_PATH, 0)
lngResult = SHGetPathFromIDList(lngIDList, strPath)
Call CoTaskMemFree(lngIDList)
intNull = InStr(strPath, vbNullChar)
If intNull Then
strPath = Left$(strPath, intNull - 1)
End If
End If
strChooseFolder = strPath
End Function
'Create a form called frmDeleteFiles
Private Sub Form_Load()
Dim strPath As String
Dim blnResult As Boolean
strPath = strChooseFolder(Me.hWnd, "Choose a folder")
If Not blnDeleteFilesToRecycleBin(strPath & "\*.url") Then MsgBox "error"
Unload frmDeleteFiles
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
T+,
Manuel
|
|
|
|
|
