auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

Internet: History & Cookie Viewer

Internet: History & Cookie Viewer via 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
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt