| INTERNET_CACHE_ENTRY_INFO |
|
|
| Listet alle Internet-History-Einträge auf (Lesen der Registry) |
| Löschen von allen oder einzelnen History-Einträgen |
|
| Sub getcachentry(sdate As Date) |
| Dim xdate As Date, n%, i As Long, k As Long, x, xurl, xcontent |
| Dim URL() As Internet_Cache_Entry |
| Dim URLHistory() As Internet_Cache_Entry |
| Dim Cookies() As Internet_Cache_Entry |
| On Error Resume Next |
| nLabel.Caption = "" |
| ListView1.ListItems.Clear |
| x = GetURLCache(URL(), URLHistory(), Cookies()) |
| If Option1.Value = True Then |
| For n = 1 To UBound(URLHistory) |
| x = InStr(URLHistory(n).SourceUrlName, "@") |
| xurl = Right(URLHistory(n).SourceUrlName, Len(URLHistory(n).SourceUrlName) - x) |
| If x > 0 Then |
| xcontent = Mid(xurl, x, 23) |
| End If |
| xdate = DateValue(URLHistory(n).LastAccessTime) |
| If xdate = sdate And Left$(xurl, 4) = "http" And Right(xurl, 3) <> "gif" _ |
| And Right(xurl, 3) <> "jpg" And Right(xurl, 3) <> "zip" Then |
| i = i + 1 |
| ListView1.ListItems.Add , "s" & i, URLHistory(n).SourceUrlName |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, URLHistory(n).LastAccessTime |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, URLHistory(n).ExpireTime |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, URLHistory(n).HitRate |
| End If |
| Next n |
| ElseIf Option2.Value = True Then |
| For n = 1 To UBound(URL) |
| x = InStr(URLHistory(n).SourceUrlName, "@") |
| xurl = URL(n).SourceUrlName |
| xdate = DateValue(URL(n).LastAccessTime) |
| If xdate = sdate Then |
| i = i + 1 |
| ListView1.ListItems.Add , "s" & i, URL(n).SourceUrlName |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, URL(n).LastAccessTime |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, URL(n).ExpireTime |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, URL(n).HitRate |
| End If |
| Next n |
| ElseIf Option3.Value = True Then |
| For n = 1 To UBound(Cookies) |
| x = InStr(URLHistory(n).SourceUrlName, "@") |
| xurl = Cookies(n).LocalFileName |
| xdate = DateValue(Cookies(n).LastAccessTime) |
| If xdate = sdate Then |
| i = i + 1 |
| ListView1.ListItems.Add , "s" & i, Cookies(n).SourceUrlName |
| ListView1.ListItems.Item("s" & i).tag = Cookies(n).LocalFileName |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, Cookies(n).LastAccessTime |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, Cookies(n).ExpireTime |
| k = k + 1 |
| ListView1.ListItems(i).ListSubItems.Add , "m" & k & i, Cookies(n).HitRate |
| End If |
| Next n |
| End If |
| nLabel.Caption = ListView1.ListItems.Count & " gefunden" |
| If ListView1.ListItems.Count >= 1 Then |
| Me.Command1.Visible = True |
| Me.Command2.Visible = True |
| Else |
| Me.Command1.Visible = False |
| Me.Command2.Visible = False |
| End If |
| End Sub |
|
| Public Sub fillday2() |
| Dim sdate As Date, i% |
| On Error GoTo rt |
| sdate = DateAdd("d", -1, Date) |
| For i = 0 To 30 |
| sdate = DateAdd("d", -i, Date) |
| cmbday.AddItem sdate |
| Next i |
| cmbday.ListIndex = 0 |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| Exit Sub |
|
| rt: |
| MsgBox Error$ |
| Resume rte: |
| rte: |
| End Sub |
|
| Sub cmbday_Change() |
| Dim fdate$, mtdate$, xk |
| fdate = cmbday.Text |
| xk = Weekday(fdate, vbSunday) |
| Select Case xk |
| Case 1 |
| mtdate = "Sonntag" |
| Case 2 |
| mtdate = "Montag" |
| Case 3 |
| mtdate = "Dienstag" |
| Case 4 |
| mtdate = "Mittwoch" |
| Case 5 |
| mtdate = "Donnerstag" |
| Case 6 |
| mtdate = "Freitag" |
| Case 7 |
| mtdate = "Samstag" |
| End Select |
| Label1.Caption = mtdate |
| End Sub |
|
| Sub cmbday_Click() |
| Dim sdate As Date, fdate$, mtdate$, xk |
| fdate = cmbday.Text |
| xk = Weekday(fdate, vbSunday) |
| Select Case xk |
| Case 1 |
| mtdate = "Sonntag" |
| Case 2 |
| mtdate = "Montag" |
| Case 3 |
| mtdate = "Dienstag" |
| Case 4 |
| mtdate = "Mittwoch" |
| Case 5 |
| mtdate = "Donnerstag" |
| Case 6 |
| mtdate = "Freitag" |
| Case 7 |
| mtdate = "Samstag" |
| End Select |
| Label1.Caption = mtdate |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| End Sub |
|
| Sub Command1_Click() |
| Dim x As Long, y% |
| Dim Inhalt As String |
| Dim answer% |
| Dim sdate As Date |
| Dim xdone As Boolean |
| On Error Resume Next |
| answer = MsgBox("Die komplette History wird gelöscht", vbYesNo, "Warnung") |
| If answer = 6 Then |
| For y = 1 To 10 |
| For x = 1 To ListView1.ListItems.Count |
| DoEvents |
| Inhalt = ListView1.ListItems.Item(x).Text |
| xdone = deleteselecteditem(Inhalt) |
| If xdone = True Then |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| End If |
| Next x |
| Next y |
| End If |
| End Sub |
|
| Sub Command2_Click() |
| Dim Selected_Strg As String |
| Dim sdate As Date |
| Dim xdone As Boolean |
| On Error Resume Next |
| Selected_Strg = ListView1.SelectedItem.Text |
| If Selected_Strg = "" Then Exit Sub |
| xdone = deleteselecteditem(Selected_Strg) |
| If xdone = True Then |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| End If |
| End Sub |
|
| Sub Form_Load() |
| Dim fdate$, mtdate$, xk |
| fillday2 |
| Option1.Value = True |
| fdate = cmbday.Text |
| xk = Weekday(fdate, vbSunday) |
| Select Case xk |
| Case 1 |
| mtdate = "Sonntag" |
| Case 2 |
| mtdate = "Montag" |
| Case 3 |
| mtdate = "Dienstag" |
| Case 4 |
| mtdate = "Mittwoch" |
| Case 5 |
| mtdate = "Donnerstag" |
| Case 6 |
| mtdate = "Freitag" |
| Case 7 |
| mtdate = "Samstag" |
| End Select |
| Label1.Caption = mtdate |
| Me.Left = 1100 |
| Me.Top = 1100 |
|
| w1.Offline = True |
| End Sub |
|
| Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
| frmForm.Visible = True |
| End Sub |
|
| Sub ListView1_Click() |
| On Error Resume Next |
| w1.Offline = True |
| Dim xurl$, x |
| xurl = ListView1.SelectedItem.Text |
| If xurl = "" Then Exit Sub |
| If Option1.Value = True Then |
| x = InStr(xurl, "@") |
| xurl = Right(xurl, Len(xurl) - x) |
| w1.Navigate xurl |
| ElseIf Option2.Value = True Then |
| w1.Navigate xurl |
| ElseIf Option3.Value = True Then |
| xurl = ListView1.SelectedItem.tag |
| w1.Navigate xurl |
| End If |
| End Sub |
|
| Sub Option1_Click() |
| Dim sdate As Date |
| If Option1.Value = True Then |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| End If |
| End Sub |
|
| Sub Option2_Click() |
| Dim sdate As Date |
| If Option2.Value = True Then |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| End If |
| End Sub |
|
| Sub Option3_Click() |
| Dim sdate As Date |
| If Option3.Value = True Then |
| sdate = DateValue(cmbday.Text) |
| getcachentry sdate |
| End If |
| End Sub |
 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| Das steht im Modul |
|
| Public Const ERROR_CACHE_FIND_FAIL As Long = 0 |
| Public Const ERROR_CACHE_FIND_SUCCESS As Long = 1 |
| Public Const ERROR_FILE_NOT_FOUND As Long = 2 |
| Public Const ERROR_ACCESS_DENIED As Long = 5 |
| Public Const ERROR_INSUFFICIENT_BUFFER As Long = 122 |
| Public Const MAX_PATH As Long = 260 |
| Public Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096 |
|
| Public Const LMEM_FIXED As Long = &H0 |
| Public Const LMEM_ZEROINIT As Long = &H40 |
| Public Const LPTR As Long = (LMEM_FIXED Or LMEM_ZEROINIT) |
|
| Public Const NORMAL_CACHE_ENTRY As Long = &H1 |
| Public Const EDITED_CACHE_ENTRY As Long = &H8 |
| Public Const TRACK_OFFLINE_CACHE_ENTRY As Long = &H10 |
| Public Const TRACK_ONLINE_CACHE_ENTRY As Long = &H20 |
| Public Const STICKY_CACHE_ENTRY As Long = &H40 |
| Public Const SPARSE_CACHE_ENTRY As Long = &H10000 |
| Public Const COOKIE_CACHE_ENTRY As Long = &H100000 |
| Public Const URLHISTORY_CACHE_ENTRY As Long = &H200000 |
| Public Const URLCACHE_FIND_DEFAULT_FILTER As Long = NORMAL_CACHE_ENTRY Or _ |
| COOKIE_CACHE_ENTRY Or URLHISTORY_CACHE_ENTRY Or TRACK_OFFLINE_CACHE_ENTRY Or _ |
| TRACK_ONLINE_CACHE_ENTRY Or STICKY_CACHE_ENTRY |
| |
| Private Type SYSTEMTIME |
| wYear As Integer |
| wMonth As Integer |
| wDayOfWeek As Integer |
| wDay As Integer |
| wHour As Integer |
| wMinute As Integer |
| wSecond As Integer |
| wMilliseconds As Integer |
| End Type |
|
| 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 |
| 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 |
|
| Public Type Internet_Cache_Entry |
| 'dwStructSize As Long |
| SourceUrlName As String |
| LocalFileName As String |
| 'CacheEntryType As Long |
| UseCount As Long |
| HitRate As Long |
| Size As Long |
| 'dwSizeHigh As Long |
| LastModifiedTime As Date |
| ExpireTime As Date |
| LastAccessTime As Date |
| LastSyncTime As Date |
| HeaderInfo As String |
| 'dwHeaderInfoSize As Long |
| FileExtension As String |
| 'ExemptDelta As Long |
| End Type |
|
|
| ' Declarations API |
| Private Declare Function FileTimeToLocalFileTime Lib "KERNEL32" _ |
| (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long |
|
| Private Declare Function FileTimeToSystemTime Lib "KERNEL32" _ |
| (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long |
|
| Private Declare Function LocalFileTimeToFileTime Lib "KERNEL32" _ |
| (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long |
|
| Private Declare Function SystemTimeToFileTime Lib "KERNEL32" _ |
| (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long |
|
| 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 |
|
| Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _ |
| Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) 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 |
| |
| 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 |
|
| Public Function GetURLCache(URL() As Internet_Cache_Entry, URLHistory() As _ |
| Internet_Cache_Entry, Cookies() As Internet_Cache_Entry) |
| Dim ICEI As INTERNET_CACHE_ENTRY_INFO |
| Dim hFile As Long |
| Dim cachefile As String |
| Dim posUrl As Long |
| Dim posEnd As Long |
| Dim dwBuffer As Long |
| Dim pntrICE As Long |
|
| dwBuffer = 0 |
| ReDim URL(0) |
| ReDim URLHistory(0) |
| ReDim Cookies(0) |
| hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer) |
| If (hFile = ERROR_CACHE_FIND_FAIL) And _ |
| (ERR.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then |
| pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer) |
| If pntrICE Then |
| CopyMemory ByVal pntrICE, dwBuffer, 4 |
| hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer) |
| If hFile <> ERROR_CACHE_FIND_FAIL Then |
| Do |
| CopyMemory ICEI, ByVal pntrICE, Len(ICEI) |
| If (ICEI.CacheEntryType And _ |
| NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY Then |
| Select Case ICEI.CacheEntryType |
| Case URLHISTORY_CACHE_ENTRY + NORMAL_CACHE_ENTRY |
| ReDim Preserve URLHistory(UBound(URLHistory) + 1) |
| URLHistory(UBound(URLHistory) - 1).SourceUrlName = GetStrFromPtrA(ICEI.lpszSourceUrlName) |
| URLHistory(UBound(URLHistory) - 1).LocalFileName = GetStrFromPtrA(ICEI.lpszLocalFileName) |
| URLHistory(UBound(URLHistory) - 1).FileExtension = GetStrFromPtrA(ICEI.lpszFileExtension) |
| URLHistory(UBound(URLHistory) - 1).HeaderInfo = GetStrFromPtrA(ICEI.lpHeaderInfo) |
| URLHistory(UBound(URLHistory) - 1).HitRate = ICEI.dwHitRate |
| URLHistory(UBound(URLHistory) - 1).ExpireTime = FileTime2SystemTime(ICEI.ExpireTime) |
| URLHistory(UBound(URLHistory) - 1).LastAccessTime = FileTime2SystemTime(ICEI.LastAccessTime) |
| URLHistory(UBound(URLHistory) - 1).LastModifiedTime = FileTime2SystemTime(ICEI.LastModifiedTime) |
| URLHistory(UBound(URLHistory) - 1).LastSyncTime = FileTime2SystemTime(ICEI.LastSyncTime) |
| URLHistory(UBound(URLHistory) - 1).Size = ICEI.dwSizeHigh * 2 ^ 32 + ICEI.dwSizeLow |
| URLHistory(UBound(URLHistory) - 1).UseCount = ICEI.dwUseCount |
| Case COOKIE_CACHE_ENTRY + NORMAL_CACHE_ENTRY |
| ReDim Preserve Cookies(UBound(Cookies) + 1) |
| Cookies(UBound(Cookies) - 1).SourceUrlName = GetStrFromPtrA(ICEI.lpszSourceUrlName) |
| Cookies(UBound(Cookies) - 1).LocalFileName = GetStrFromPtrA(ICEI.lpszLocalFileName) |
| Cookies(UBound(Cookies) - 1).FileExtension = GetStrFromPtrA(ICEI.lpszFileExtension) |
| Cookies(UBound(Cookies) - 1).HeaderInfo = GetStrFromPtrA(ICEI.lpHeaderInfo) |
| Cookies(UBound(Cookies) - 1).HitRate = ICEI.dwHitRate |
| Cookies(UBound(Cookies) - 1).ExpireTime = FileTime2SystemTime(ICEI.ExpireTime) |
| Cookies(UBound(Cookies) - 1).LastAccessTime = FileTime2SystemTime(ICEI.LastAccessTime) |
| Cookies(UBound(Cookies) - 1).LastModifiedTime = FileTime2SystemTime(ICEI.LastModifiedTime) |
| Cookies(UBound(Cookies) - 1).LastSyncTime = FileTime2SystemTime(ICEI.LastSyncTime) |
| Cookies(UBound(Cookies) - 1).Size = ICEI.dwSizeHigh * 2 ^ 32 + ICEI.dwSizeLow |
| Cookies(UBound(Cookies) - 1).UseCount = ICEI.dwUseCount |
| Case Else |
| ReDim Preserve URL(UBound(URL) + 1) |
| URL(UBound(URL) - 1).SourceUrlName = GetStrFromPtrA(ICEI.lpszSourceUrlName) |
| URL(UBound(URL) - 1).LocalFileName = GetStrFromPtrA(ICEI.lpszLocalFileName) |
| URL(UBound(URL) - 1).FileExtension = GetStrFromPtrA(ICEI.lpszFileExtension) |
| URL(UBound(URL) - 1).HeaderInfo = GetStrFromPtrA(ICEI.lpHeaderInfo) |
| URL(UBound(URL) - 1).HitRate = ICEI.dwHitRate |
| URL(UBound(URL) - 1).ExpireTime = FileTime2SystemTime(ICEI.ExpireTime) |
| URL(UBound(URL) - 1).LastAccessTime = FileTime2SystemTime(ICEI.LastAccessTime) |
| URL(UBound(URL) - 1).LastModifiedTime = FileTime2SystemTime(ICEI.LastModifiedTime) |
| URL(UBound(URL) - 1).LastSyncTime = FileTime2SystemTime(ICEI.LastSyncTime) |
| URL(UBound(URL) - 1).Size = ICEI.dwSizeHigh * 2 ^ 32 + ICEI.dwSizeLow |
| URL(UBound(URL) - 1).UseCount = ICEI.dwUseCount |
| |
| End Select |
| End If |
| Call LocalFree(pntrICE) |
| dwBuffer = 0 |
| Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer) |
| pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer) |
| CopyMemory ByVal pntrICE, dwBuffer, 4 |
| Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer) |
| End If 'hFile |
| End If 'pntrICE |
| End If 'hFile |
| Call LocalFree(pntrICE) |
| Call FindCloseUrlCache(hFile) |
| End Function |
|
| Private Function GetStrFromPtrA(ByVal lpszA As Long) As String |
| GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0) |
| Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA) |
| End Function |
|
| Private Function FileTime2SystemTime(FileT As FILETIME) As Date |
| Dim SysT As SYSTEMTIME |
| FileTimeToLocalFileTime FileT, FileT |
| FileTimeToSystemTime FileT, SysT |
| FileTime2SystemTime = TimeSerial(SysT.wHour, SysT.wMinute, SysT.wSecond) + _ |
| DateSerial(SysT.wYear, SysT.wMonth, SysT.wDay) |
| End Function |
|
| Public Function deleteselecteditem(selec$) As Boolean |
| deleteselecteditem = DeleteUrlCacheEntry(selec) |
| End Function |
|
zurück