Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: EnigmaX en Julio 31, 2011, 07:50:58 pm
-
Hello,
Por favor, alguien puede ayudarme con una función para borrar la caché y cookies de los navegadores más comunes, Internet Explorer, Firefox, chorme.
Gracias!!!
[]'s
-
de internet explorer es facil, podes encontrar varios codigos, obvio con apis, aca uno:
FindFirstUrlCacheEntry: Delete the IE Cache (http://vbnet.mvps.org/index.html?code/internet/deleteurlcache.htm)
ahora para Firefox, es otra cosa ya que almacena el historial y demas en una base de datos de SQLite...de chrome ni idea.
saludos.
-
Este codigo borra los archivos temporales, los cookies y el historial de IE, usa las apis de wininet.dll
FindFirstUrlCacheEntry, FindNextUrlCacheEntry, FindCloseUrlCache, DeleteUrlCacheEntry
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_21284759.html (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_21284759.html)
Este codigo debes guardarlo como clearcache.frm, agregarlo a un proyecto y ejecutar :)
VERSION 5.00
Begin VB.Form F_ClearCache
Caption = "ClearCache"
ClientHeight = 1845
ClientLeft = 60
ClientTop = 345
ClientWidth = 3885
ControlBox = 0 'False
LinkTopic = "Form1"
ScaleHeight = 1845
ScaleWidth = 3885
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Total
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2057
SubFormatType = 1
EndProperty
Height = 285
Left = 2265
TabIndex = 7
Top = 1035
Width = 1140
End
Begin VB.CheckBox C_Hist
Caption = "Clear History"
Height = 285
Left = 210
TabIndex = 6
Top = 660
Width = 1605
End
Begin VB.CheckBox C_Cookies
Caption = "Clear Cookies"
Height = 285
Left = 210
TabIndex = 5
Top = 375
Width = 1605
End
Begin VB.CheckBox C_Temp
Caption = "Clear Temporary Files"
Height = 285
Left = 210
TabIndex = 4
Top = 90
Width = 1950
End
Begin VB.TextBox T_Hist
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2057
SubFormatType = 1
EndProperty
Height = 285
Left = 2265
TabIndex = 3
Top = 660
Width = 1140
End
Begin VB.TextBox T_Cookies
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2057
SubFormatType = 1
EndProperty
Height = 285
Left = 2265
TabIndex = 2
Top = 375
Width = 1140
End
Begin VB.TextBox T_Temp
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2057
SubFormatType = 1
EndProperty
Height = 285
Left = 2265
TabIndex = 1
Top = 90
Width = 1140
End
Begin VB.CommandButton Command1
Caption = "Go"
Height = 345
Left = 1530
TabIndex = 0
Top = 1455
Width = 855
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Total:"
Height = 240
Left = 1185
TabIndex = 8
Top = 1057
Width = 870
End
End
Attribute VB_Name = "F_ClearCache"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Text
'--------------------------Types, consts and structures
Private Const ERROR_CACHE_FIND_FAIL As Long = 0
Private Const ERROR_CACHE_FIND_SUCCESS As Long = 1
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Public Enum eCacheType
enormal = &H1&
eEdited = &H8&
eTrackOffline = &H10&
eTrackOnline = &H20&
eSticky = &H40&
eSparse = &H10000
ecookie = &H100000
eURLHistory = &H200000
eURLFindDefaultFilter = 0&
eCacheAllFiles = &HFFFFFF
End Enum
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
dwStructSize As Long
lpszSourceUrlName As Long
lpszLocalFileName As Long
CacheEntryType As Long 'Type of entry returned
dwUseCount As Long
dwHitRate As Long
dwSizeLow As Long
dwSizeHigh As Long
LastModifiedTime As FILETIME
ExpireTime As FILETIME
LastAccessTime As FILETIME
LastSyncTime As FILETIME
lpHeaderInfo As Long
dwHeaderInfoSize As Long
lpszFileExtension As Long
dwExemptDelta As Long
End Type
'--------------------------Internet Cache API
Private Declare Function FindFirstUrlCacheEntry _
Lib "Wininet.dll" _
Alias "FindFirstUrlCacheEntryA" _
(ByVal lpszUrlSearchPattern As String, _
lpFirstCacheEntryInfo As Any, _
lpdwFirstCacheEntryInfoBufferSize As Long _
) As Long
Private Declare Function FindNextUrlCacheEntry _
Lib "Wininet.dll" _
Alias "FindNextUrlCacheEntryA" _
(ByVal hEnumHandle As Long, _
lpNextCacheEntryInfo As Any, _
lpdwNextCacheEntryInfoBufferSize As Long _
) As Long
Private Declare Function FindCloseUrlCache _
Lib "Wininet.dll" _
(ByVal hEnumHandle As Long _
) As Long
Private Declare Function DeleteUrlCacheEntry _
Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String _
) As Long
'--------------------------Memory API
Private Declare Function LocalAlloc _
Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long _
) As Long
Private Declare Function LocalFree _
Lib "kernel32" _
(ByVal hMem As Long _
) As Long
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Declare Function lstrcpyA _
Lib "kernel32" _
(ByVal RetVal As String, _
ByVal Ptr As Long _
) As Long
Private Declare Function lstrlenA _
Lib "kernel32" _
(ByVal Ptr As Any _
) As Long
Dim bView As Boolean
Dim bTemp As Boolean
Dim bHist As Boolean
Dim bCookies As Boolean
Dim ANumEntries As Long
Dim TNumEntries As Long
Dim CNumEntries As Long
Dim HNumEntries As Long
'Purpose : Deletes the specified internet cache file
'Inputs : sCacheFile The name of the cache file
'Outputs : Returns True on success.
'Author : Andrew Baker
'Date : 03/08/2000 19:14
'Notes :
'Revisions :
Function InternetDeleteCache(sCacheFile As String) As Boolean
InternetDeleteCache = CBool(DeleteUrlCacheEntry(sCacheFile))
End Function
'Purpose : Returns an array of files stored in the internet cache
'Inputs : eFilterType An enum which filters the files returned by their type
'Outputs : A one dimensional, one based, string array containing the names of the files
'Author : Andrew Baker
'Date : 03/08/2000 19:14
'Notes :
'Revisions :
Sub InternetCacheList(bDelete As Boolean)
Dim ICEI As INTERNET_CACHE_ENTRY_INFO
Dim lhFile As Long, lBufferSize As Long, lptrBuffer As Long
Dim sCacheFile As String
'Determine required buffer size
lBufferSize = 0
lhFile = FindFirstUrlCacheEntry(0&, ByVal 0&, lBufferSize)
If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
'Allocate memory for ICEI structure
lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
If lptrBuffer Then
'Set a Long pointer to the memory location
CopyMemory ByVal lptrBuffer, lBufferSize, 4
'Call first find API passing it the pointer to the allocated memory
lhFile = FindFirstUrlCacheEntry(vbNullString, ByVal lptrBuffer, lBufferSize) '1 = success
If lhFile <> ERROR_CACHE_FIND_FAIL Then
'Loop through the cache
Do
'Copy data back to structure
CopyMemory ICEI, ByVal lptrBuffer, Len(ICEI)
' and add to the all file count if first pass
If Not bDelete Then ANumEntries = ANumEntries + 1
If bDelete Then sCacheFile = StrFromPtrA(ICEI.lpszSourceUrlName)
' is it a url history?
If ICEI.CacheEntryType And eURLHistory Then
If Not bDelete Then HNumEntries = HNumEntries + 1
If bDelete And bHist Then
InternetDeleteCache sCacheFile
HNumEntries = HNumEntries - 1
End If
If Me.Visible Then T_Hist.Text = CStr(HNumEntries)
' or a cookie?
ElseIf ICEI.CacheEntryType And ecookie Then
If Not bDelete Then CNumEntries = CNumEntries + 1
If bDelete And bCookies Then
InternetDeleteCache sCacheFile
CNumEntries = CNumEntries - 1
End If
If Me.Visible Then T_Cookies.Text = CStr(CNumEntries)
Else
If Not bDelete Then TNumEntries = TNumEntries + 1
If bDelete And bTemp Then
InternetDeleteCache sCacheFile
TNumEntries = TNumEntries - 1
End If
If Me.Visible Then T_Temp.Text = CStr(TNumEntries)
End If
If Me.Visible Then Total.Text = CStr(TNumEntries + CNumEntries + HNumEntries)
Me.Refresh
'Free memory associated with the last-retrieved file
Call LocalFree(lptrBuffer)
'Call FindNextUrlCacheEntry with buffer size set to 0.
'Call will fail and return required buffer size.
lBufferSize = 0
Call FindNextUrlCacheEntry(lhFile, ByVal 0&, lBufferSize)
'Allocate and assign the memory to the pointer
lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
CopyMemory ByVal lptrBuffer, lBufferSize, 4&
Loop While FindNextUrlCacheEntry(lhFile, ByVal lptrBuffer, lBufferSize)
End If
End If
End If
'Free memory
Call LocalFree(lptrBuffer)
Call FindCloseUrlCache(lhFile)
End Sub
'Purpose : Converts a pointer to an ansi string into a string.
'Inputs : lptrString A long pointer to a string held in memory
'Outputs : The string held at the specified memory address
'Author : Andrew Baker
'Date : 03/08/2000 19:14
'Notes :
'Revisions :
Function StrFromPtrA(ByVal lptrString As Long) As String
'Create buffer
StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0)
'Copy memory
Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString)
End Function
Private Sub Command1_Click()
If Command1.Caption = "Go" Then
Me.Caption = "Please Wait - Clearing your Internet Cache"
bHist = C_Hist.Value = vbChecked
bTemp = C_Temp.Value = vbChecked
bCookies = C_Cookies.Value = vbChecked
T_Temp.Text = ""
T_Cookies.Text = ""
T_Hist.Text = ""
Total.Text = ""
Me.Refresh
InternetCacheList True
MsgBox "Done clearing cache - " & CStr(ANumEntries - CLng(Total.Text)) & " entries deleted"
End If
Unload Me
End Sub
Private Sub Form_Load()
Dim hadslash As Boolean
Dim i As Integer, j As Integer
If Command = "" Then
InternetCacheList False
T_Temp.Text = CStr(TNumEntries)
T_Cookies.Text = CStr(CNumEntries)
T_Hist.Text = CStr(HNumEntries)
Total.Text = CStr(TNumEntries + CNumEntries + HNumEntries)
Me.Visible = True
Exit Sub
End If
Me.Visible = False
' Command can be any combination of:
' /t - Temporary files
' /c - Cookies
' /h - History
' OR /a - all
' and /v - visible interface
' As in 'c' may be /c/t/h or /c /t /h or /cth
j = 0
For i = 1 To Len(Command)
Select Case Mid(Command, i, 1)
Case "/"
hadslash = True
Case "a"
If hadslash Then
If Not bTemp Then
bTemp = True
Else
j = 0
Exit For
End If
If Not bCookies Then
bCookies = True
Else
bCookies = False
j = 0
Exit For
End If
If Not bHist Then
bHist = True
Else
bHist = False
j = 0
Exit For
End If
j = j + 1
End If
Case "t"
If hadslash Then
If Not bTemp Then
bTemp = True
Else
j = 0
Exit For
End If
j = j + 1
End If
Case "c"
If Not bCookies Then
bCookies = True
Else
bCookies = False
j = 0
Exit For
End If
j = j + 1
Case "h"
If Not bHist Then
bHist = True
Else
bHist = False
j = 0
Exit For
End If
j = j + 1
Case "v"
If Not bView Then
bView = True
Else
bView = False
j = 0
Exit For
End If
j = j + 1
Case " ", ","
hadslash = False
Case Else
j = 0
End Select
Next
If j > 0 And j < 5 Then
If bView Then
If bCookies Or bHist Or bTemp Then
C_Temp.Value = vbUnchecked
C_Hist.Value = vbUnchecked
C_Cookies.Value = vbUnchecked
If bTemp Then C_Temp.Value = vbChecked
If bHist Then C_Hist.Value = vbChecked
If bCookies Then C_Cookies.Value = vbChecked
End If
InternetCacheList False
C_Temp.Enabled = False
C_Hist.Enabled = False
C_Cookies.Enabled = False
Command1.Visible = False
T_Temp.Text = CStr(TNumEntries)
T_Cookies.Text = CStr(CNumEntries)
T_Hist.Text = CStr(HNumEntries)
Total.Text = CStr(TNumEntries + CNumEntries + HNumEntries)
Me.Caption = "Please Wait - Clearing your Internet Cache"
Me.Visible = True
Else
Me.Visible = False
End If
InternetCacheList True
Unload Me
Exit Sub
End If
' Invalid Command line
If j = 0 Or j > 4 Then
MsgBox "Invalid Command line " & Command & vbCrLf & _
"Should be:" & vbCrLf & _
"/t (Temporary files)" & vbCrLf & _
"/c (Cookies)" & vbCrLf & _
"/h (History URLs)" & vbCrLf & _
"Or:" & vbCrLf & _
"/a (All cache entries)" & vbCrLf & _
"/v (Visible interface)" & vbCrLf & _
"Multiple switches may be combined viz:" & vbCrLf & _
"/tc or /ch (/tch = /a)", vbCritical
Unload Me
End If
End Sub
y como dice seba123neo, para los otros ni idea :-[
-
Encontre esto para FireFox
http://webcache.googleusercontent.com/search?q=cache:GmV1aI73Jk0J:www.hackforums.net/archive/index.php/thread-712511.html+vb6+clear+mozilla+cookie&cd=10&hl=es&ct=clnk&gl=cl&source=www.google.cl (http://webcache.googleusercontent.com/search?q=cache:GmV1aI73Jk0J:www.hackforums.net/archive/index.php/thread-712511.html+vb6+clear+mozilla+cookie&cd=10&hl=es&ct=clnk&gl=cl&source=www.google.cl)
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function FindFirstFileA Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileA Lib "kernel32.dll" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 255
cAlternate As String * 14
End Type
Private Sub Form_Load()
'Credits to marjinz
'as well as this: http://social.msdn.microsoft.com/Forums/en-US/ieextensiondevelopment/thread/ce81943b-32b8-437b-b620-171c3d5893e7
Call ClearFireFoxData(Environ$("appdata") & "\Mozilla\FireFox\Profiles\")
Call ClearIEData
End Sub
Private Function ClearIEData()
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 1", vbHide) 'History
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 2", vbHide) 'Cookies
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 8", vbHide) 'Temporary Internet Files
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 16", vbHide) 'Form Data
End Function
Public Function ClearFireFoxData(ByVal Path As String)
On Error Resume Next
Dim WFD As WIN32_FIND_DATA, hFile As Long, strPath As String, tmpString As String, Directory As String, File As String
hFile = FindFirstFileA(Path & "*.*", WFD)
If hFile <> -1 Then
Do
tmpString = StripNull(WFD.cFileName)
If (WFD.dwFileAttributes And vbDirectory) Then
If AscW(WFD.cFileName) <> 46 Then
TerminateProcessName ("firefox.exe")
strPath = Path & Directory & tmpString
SecureDeleteFile strPath & "\" & "cookies.sqlite", 3
SecureDeleteFile strPath & "\" & "places.sqlite", 3
End If
End If
DoEvents
Loop While FindNextFileA(hFile, WFD)
End If
End Function
Public Sub SecureDeleteFile(sFileName As String, times As Integer)
On Error GoTo err
Dim i, x As Long, BlockSize As Long
Dim ff As Long
Dim LastData As Boolean
ff = FreeFile
BlockSize = 4096
Open sFileName For Binary As #ff
For x = 1 To times 'loop until satisfied
Do While Not EOF(ff) 'to length of file in characters
If LOF(ff) - Loc(ff) <= BlockSize Then
BlockSize = LOF(ff) - Loc(ff)
LastData = True
End If
Put #ff, , RandomChar(BlockSize) 'overwrite file (length of random data = 1)
DoEvents
FlushFileBuffers (ff) 'clear buffers
If LastData = True Then Exit Do
Loop
Next x
Close #ff
Kill sFileName
Exit Sub
err:
Exit Sub
End Sub
Public Function RandomChar(Length As Long) As String
Randomize
Dim i As Long
For i = 1 To Length
RandomChar = RandomChar & Int(5 * Rnd) + 1
Next i
End Function
Private Function TerminateProcessName(EXEname As String)
Dim Process As Object
For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & EXEname & "'")
Process.Terminate
Next
End Function
Private Function StripNull(ByVal OriginalStr As String) As String
On Error Resume Next
StripNull = Left$(OriginalStr, InStr(OriginalStr, vbNullChar) - 1)
End Function
-
holla,
Muchas Gracias mismo pelas respuestas seba123neo y Lolabyte, voy probar ahora y digo el resultado.
alguien tiene algo para el chorme?
[]'s
-
holla,
Win7 probado en 64 bits y funcionó. Creo que no hay manera de chorme por vb6.
[]'s
-
Y aprovechando este hilo......¿como borrar las cookies de conexion en los webbrowser propios del VB?. Me explico. En mi trabajo nos conectamos a la web oficial de la empresa, que pide Usser y Pass. Cuando hago codigo y ejecuto con F5 el VB en tiempo de programacion, me pide conectarme la primera vez. Las siguientes veces que ejecuto la aplicacion dentro del diseñador del VB no me vuelve a pedir acceso. Esto me viene muy bien porque asi puedo hacer pruebas en caliente y modificar el codigo sin tener que loquearme cada vez. Pero sin embargo, una vez complilado el proyecto y pasado a EXE, el login se hace cada vez que uso el EXE. Esto es lo correcto, pero el servidor donde nos conectamos son 4 servidores, y hay momentos del dia que alguno de ellos se cae o va demasiado lento. Entonces los compañeros del trabajo nos preguntamos entre nosotros "Oye....¿esto va lento o solo es a mi"....y si algun compañero dice "pues a mi me va bien"....es que necesitamos conectarnos a otro servidor de los 4 que hay. La unica manera que tenemos hasta ahora es cerrar mi aplicacion y volverla a abrir, con lo cual se vuelve a logear y si hay suerte lo hace en el servidor mas rapido.
¿Hay alguna manera de borrar las cookies desde VB para que me vuelva a pedir logearme sin tener que cerrar la aplicacion. Es un muermazo hacerlo ya que trabajamos con muchas ventanas hijos que llevan un rato volver a abrir y calibrar. Gracias
-
hola,
Private Function ClearIEData()
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 1", vbHide) 'History
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 2", vbHide) 'Cookies
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 8", vbHide) 'Temporary Internet Files
Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 16", vbHide) 'Form Data
End Function
Limpia de Windows 7, sino que muestra una ventana de ejecución mientras se utiliza el parámetro vbHide. ¿Alguna sugerencia para ejecutar completamente invisible.
[]'s