Tweet
Code:
'-------------------------------------------------------------------------------
' COOKIEMO.BAS
' Program to trap and diplay changes to Internet cookies
' Author: Michael Mattias, Racine WI April, 2001 using PB/DLL v 6.0
' Idea from Greg D. Engle
' Cookie Icons courtesy Dan Stasinski and Bob Houle
' Placed in the public domain by the author April 23, 2001
' Usage: Start the program before surfin' da 'net.
' CAUTION: When run from the PB.DLL 6.0 IDE under Win98 (first edition), does not always record "added"
' cookies, and always misses changes to cookies added this run of the program.
' When run outside the IDE, it picks up all these events just fine. (Weird?)
' Demonstrates: multi-threading, use of event objects, WaitForMultipleObjects
' Tells you: Who is "cookie-ing" you!!!
' Problems I had: finding a way to test if the thread had terminated before exiting
' the program. Whenever I tried looping for THREAD STATUS, the program hung up.
' See the notes at the WM_CLOSE message (This may have been related to compile/run in the IDE?)
' I also had a heck of a time getting the scroll logic to work in such a manner that the vertical
' scrollbar disappears when not needed. What is here is tolerable. I have noticed that sometimes
' the "line down" button results in misprinting, but I can't figure out that problem.
' Just scroll up or down a page to fix it. (Whaddya want for free?)
'
' Also, while writing this I thought of a way to do this without starting
' a second thread. Maybe I'll do that soon.
'-------------------------------------------------------------------------------
$DIM ALL
$COMPILE EXE
'#DEBUG ERROR ON
$OPTION VERSION4 ' VERSION4 is Default: works NT4, Win 3x, Win 9X
' VERSION3 is used only for Windows NT3
$INCLUDE "WIN32API.INC"
$RESOURCE "COOKIEMO.PBR"
' TEXT MESSAGES FROM GETLASTERROR << NOT USED IN THIS PROGRAM, BUT HEY, IT CAN BE HANDY
DECLARE FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
LOCAL Buffer AS ASCIIZ * 255
FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
FUNCTION = FORMAT$(ECode, "#####:") & Buffer
END FUNCTION
%MinusOne = -1&
%PlusOne = 1&
%Build_Test_Entries = 0 ' builds all but 5 of CookieChange()for testing
%MAX_Entries = 200 ' how many entries in the array which holds the cookie change text
%MAX_Cookies = 1000 ' maximum number of cookies the user may have in the Cookies directory
' GLOBAL datanames
GLOBAL CookiePath AS ASCIIZ * %MAX_PATH
GLOBAL nChangeEntries AS LONG ' number of valid entries in the CookieChange array
GLOBAL CookieChange() AS STRING
GLOBAL hWndMain AS LONG ' because we need to reference it from a thread function
GLOBAL hDlgAbout AS LONG ' when true, the modeless 'About' dialog box is running
'------------------------------------------------------------------------------
' PROCEDURES IN THIS PROGRAM
DECLARE FUNCTION EnumCookies2 () AS LONG
DECLARE FUNCTION GetCookiePath() AS STRING
DECLARE FUNCTION MonitorNewCookies(BYVAL hEvent AS LONG) AS LONG
DECLARE SUB Debug(sText AS STRING)
DECLARE FUNCTION DialogProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
'------------------------------------------------------------------------------
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wndclass AS WndClassEx
LOCAL szClassName AS ASCIIZ * 80
LOCAL hWnd AS LONG
LOCAL szIconName AS ASCIIZ * 12
' Got two nice icons, so I need to use them both somehow
IF CLNG(TIMER) MOD 2 = 0 THEN ' even numbers
szIconName = "PROGRAM"
ELSE ' non-even numbers
szIconName = "COOKY"
END IF
szClassName = "Cookie_Monitor"
wndclass.cbSize = SIZEOF(WndClass)
wndclass.style = %CS_HREDRAW OR %CS_VREDRAW
wndclass.lpfnWndProc = CODEPTR( WndProc )
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = hInstance
wndclass.hIcon = LoadIcon( hInstance, szIconName)
wndclass.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
wndclass.hbrBackground = GetStockObject( %WHITE_BRUSH )
wndclass.lpszMenuName = %NULL
wndclass.lpszClassName = VARPTR( szClassName )
wndclass.hIconSm = 0
RegisterClassEx wndclass
' Create a window using the registered class (hWndMain is GLOBAL)
' use %WS_EX_TOPMOST style so it will appear over any browser in use when not minimized.
hWndMain = CreateWindowEx(%WS_EX_TOPMOST, _
szClassName, _ ' window class name
"Cookie Monitor", _ ' window caption
%WS_OVERLAPPEDWINDOW _
OR %WS_HSCROLL _
OR %WS_VSCROLL , _ ' window style
50, _ ' initial x position
50, _ ' initial y position
350&, _ ' initial x size
150&, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hWndMain, iCmdShow
UpdateWindow hWndMain
' show the 'About' dialog (requires user to click on OK to dismiss)
hDlgAbout = CreateDialog (hInstance, "ABOUT", BYVAL %NULL, CODEPTR(DialogProc))
' move it so it is visible beneath the viewer window ..
SetWindowPos hDlgAbout,%HWND_TOP ,50, 210, 0,0,%SWP_NOSIZE
' *** MAIN MESSAGE LOOP ***
WHILE ISTRUE GetMessage(Msg, %NULL, 0, 0)
IF ISFALSE IsDialogMessage(hDlgAbout, Msg) THEN ' if this is not a message for about box,
TranslateMessage Msg ' send it off to be processed
DispatchMessage Msg
END IF
WEND
FUNCTION = msg.wParam
END FUNCTION
'------------------------------------------------------------------------------
' MAIN WINDOW PROCEDURE '
'------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
STATIC CxChar AS LONG, CxCaps AS LONG, CyChar AS LONG
STATIC CxClient AS LONG, CyClient AS LONG, iMaxWidth AS LONG
STATIC IVscrollPos AS LONG, iVScrollMax AS LONG, iHScrollPos AS LONG, iHScrollMax AS LONG
LOCAL i AS LONG, x AS LONG, y AS LONG, iPaintBeg AS LONG, iPaintEnd AS LONG
LOCAL iVScrollInc AS LONG, iHScrollInc AS LONG
STATIC hEvent AS LONG ' so we can terminate the monitor thread on WM_CLOSE
DIM szBuffer AS ASCIIZ * 10
DIM ps AS PAINTSTRUCT
DIM tm AS TEXTMETRIC
DIM hDC AS LONG
DIM NumLines AS STATIC LONG
DIM NumBuff AS STRING
DIM Index AS LOCAL LONG
SELECT CASE wMsg
CASE %WM_CREATE
' get the GLOBAL CookiePath
CookiePath = GetCookiePath
' Create the GLOBAL array which holds the messages
REDIM CookieChange (%MAX_ENTRIES) AS STRING
' set the global counter value
nChangeEntries = 0
' Build the first element of the array as a happy message
CookieChange(1) = "Cookie Monitor Begins at " & TIME$ & " on " & DATE$
nChangeEntries = 1
' for testing, put a bunch of values into the array
#IF %Build_Test_Entries
FOR numLines = 2 TO %MAX_ENTRIES - 5
CookieChange (NumLines) = FORMAT$(NumLines, "Line ####")
nChangeEntries = NumLines
NEXT NumLines
#ENDIF
NumLines = nChangeEntries
hDC = GetDC(Hwnd)
GetTextMetrics BYVAL hDC, tm
CxChar = tm.tmAveCharWidth
CyChar = tm.tmHeight + tm.tmExternalLeading
' low bit of tm.tmpitchandfamily: 0=fixed pitch, 1=variable pitch
' set caps = cxchar if fixed, 150% if variable
CxCaps = CxChar + ((CxChar * .50) * BIT(tm.tmpitchandfamily, 0))
ReleaseDC hWnd, hDC
iMaxWidth = 128 * CxChar ' allow for 128 lowercase chars. + 22 * CxCaps
' Get the enumeration of the current cookies; this first enumeration does not update the screen
' nor does it enter the WaitforMultipleObjects loop. All it really does is set the "last file time"
' for comparison when we DO get a change.
EnumCookies2
' Create the event object we are going to use to signal the called thread to terminate
' We are using an unnamed object (not documented too well in the SDK; found it in Appleman's book).
hEvent = CreateEvent(BYVAL %NULL, %TRUE, %FALSE, BYVAL %NULL)
' HANDLE CreateEvent(
' LPSECURITY_ATTRIBUTES lpEventAttributes, // SD
' BOOL bManualReset, // RESET TYPE
' BOOL bInitialState, // initial STATE
' LPCTSTR lpName // object NAME <<< NULL = unnamed object.
' Start the thread which waits on changes in the cookie directory
STATIC Lreturn AS LONG
THREAD CREATE MonitorNewCookies(hEvent) TO lReturn
' We do not need our handle to the thread as this code is written; but we leave it open because
' there is no way to get it back if we change our mind. We close our handle in WM_CLOSE
FUNCTION = 0: EXIT FUNCTION
CASE %WM_SIZE
' recalculate the max width possible based on current contents of CookieChange() array
LOCAL MaxXChars AS LONG
FOR I = 1 TO nChangeEntries -1
MaxXChars = MAX(LEN(CookieChange(I)), LEN(CookieChange(I +1)))
NEXT I
'recalculate the printable area of the Cookie Monitor Screen
iMaxWidth = (MaxXChars + 3) * cxchar
NumLines = nChangeEntries
CxClient = LOWRD(lparam) ' new size in X and Y directions
CyClient = HIWRD(lParam)
ivScrollMax = MAX(1, NumLines) ' results in scroll bars always, but is tolerable!
iVScrollPos = MIN (iVScrollPos, iVScrollMax)
SetScrollRange hWnd, %SB_VERT, 1&, iVScrollMax, BYVAL %FALSE
SetScrollPos hWnd, %SB_VERT, iVScrollPos, BYVAL %TRUE
iHScrollMax = MAX(0, 3 + (iMaxWidth - CxClient) /CxChar)
IHScrollPos = MIN(iHscrollPos, iHScrollMax)
SetScrollRange hWnd, %SB_HORZ, 0&, iHScrollMax, %FALSE
SetScrollPos hWnd, %SB_HORZ, iHScrollPos, BYVAL %TRUE
EXIT FUNCTION
CASE %WM_VSCROLL
SELECT CASE LOWRD(wParam)
CASE %SB_TOP
iVScrollInc = %MinusOne * iVScrollPos
CASE %SB_BOTTOM
iVScrollInc = iVScrollMax - iVScrollPos
CASE %SB_LineUp
iVScrollInc = %MinusOne
CASE %SB_LineDown
iVScrollInc = %PlusOne
CASE %SB_PageUp
iVScrollInc = MIN (%MinusOne, %MinusOne * CyClient \ CyChar)
CASE %SB_PageDown
iVScrollInc = MAX( %PlusOne, CyClient \ CyChar) ' was CxChar instead of CyChar!
CASE %SB_THUMBTRACK
ivScrollInc = HIWRD(wParam) - iVScrollPos
END SELECT
iVScrollInc = MAX( %MinusOne * IVScrollPos, MIN(iVScrollInc, iVScrollMax - iVScrollPos))
IF iVScrollInc <> 0& THEN
IVScrollPos = IvScrollPos + IVScrollInc
ScrollWindow hWnd, BYVAL 0&, %MinusOne * CyChar * iVScrollInc, BYVAL %NULL, BYVAL %NULL
SetScrollPos hWnd, %SB_VERT, iVScrollPos, BYVAL %TRUE
UpdateWindow hWnd
END IF
EXIT FUNCTION
CASE %WM_HSCROLL
SELECT CASE LOWRD(wParam)
CASE %SB_LINEUP
iHScrollInc = %MinusOne
CASE %SB_LINEDOWN
iHScrollInc = %PlusOne
CASE %SB_PAGEUP
iHScrollInc = -8 ' 8 = tab size
CASE %SB_PAGEDOWN
iHScrollInc = 8
CASE %SB_THUMBPOSITION
iHScrollInc = HIWRD(wParam) - iHScrollPos
CASE ELSE
iHScrollInc = 0&
END SELECT
iHScrollInc = MAX (%MinusOne * iHScrollPos, MIN(iHScrollInc, iHScrollMax - iHScrollPos))
IF iHScrollInc <> 0& THEN
iHScrollPos = iHScrollPos + iHScrollInc
ScrollWindow hWnd, %MinusOne * CxChar * iHScrollInc, BYVAL 0&, BYVAL %NULL, BYVAL %NULL
SetScrollPos hWnd, BYVAL %SB_HORZ, iHScrollPos, BYVAL %TRUE
END IF
EXIT FUNCTION
CASE %WM_PAINT
IF ISTRUE IsIconic(hWnd) THEN
EXIT SELECT
END IF
hDC = BeginPaint (hWnd, ps)
iPaintBeg = MAX(0&, iVScrollPos + ps.rcpaint.ntop / CyChar - 1&)
IPaintEnd = MIN(nChangeEntries, iVScrollPos + ps.rcPaint.nBottom / CyChar )
FOR I = iPaintBeg TO iPaintEnd
' print the value for this entry, if it's valid
Index = I
IF Index > 0 AND Index <= nChangeEntries THEN
x = CxChar * (1 - iHScrollPos)
y = CyChar * (1 - iVScrollPos + I)
TextOut hDC,_
x, _
y, _
BYVAL STRPTR(CookieChange(Index)),_
BYVAL LEN(CookieChange(Index))
END IF
NEXT I
' scroll the Window up one?, Nah, the user can use the scroll bar himself.
EndPaint hDC, ps
EXIT FUNCTION
CASE %WM_CLOSE
'If the 'About' dialog is still running, dismiss it..
IF ISTRUE HDlgAbout THEN
DestroyWindow hDlgAbout
hDlgAbout = 0
END IF
' show our modeless shutdown dialogbox until cleanup is complete...
' Re-use the 'about' dialog dataname..
hDlgAbout = CreateDialog (GetWindowLong(hWnd, %GWL_HINSTANCE), "SHUTDOWN", hWnd, CODEPTR(DialogProc))
' signal the other thread to terminate by setting the manual hEvent
SetEvent hEvent
' Wait for the thread to terminate..
' I just cannot get THREAD STATUS to work the way I want it to..
' I think it's because the thread terminates too quickly?
SLEEP 2000
' thread terminates in about one second on 400Mhz system
' THREAD STATUS lReturn TO I
' MSGBOX "Thread Status=" & STR$(I) & " x" & HEX$(I,2) & "'"
' DO
' THREAD STATUS Lreturn TO I
' IF i = &h103 THEN ' threadstill runnning
' SLEEP 100
' ELSE
' EXIT DO
' END IF
' LOOP
' close our handle to the thread
THREAD CLOSE lReturn TO i
' close the handle to the event so Windows can release it
CloseHandle hEvent
' dismiss the "shutdown" dialog box
DestroyWindow hDlgAbout
' EXIT FUNCTION Nope, let it call DefWindowProc to get the WM_Destroy message
CASE %WM_DESTROY
PostQuitMessage 0
FUNCTION = 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
'------------------------------------------------------------------------------
' FIND WHERE WINDOWS KEEPS COOKIES
'------------------------------------------------------------------------------
FUNCTION GetCookiePath() AS STRING
DIM zbuffer AS ASCIIZ*256
DIM KeyNameA AS ASCIIZ * 256
DIM zTmp AS ASCIIZ * 256
DIM lReturn AS LONG, cbData AS LONG, ZZZ AS STRING, hKey AS LONG, KeyType AS LONG
lReturn = RegOpenKeyEx(%HKEY_CURRENT_USER, _
"Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", 0&, %KEY_ALL_ACCESS, hKey)
IF lReturn = %ERROR_SUCCESS THEN
KeyNameA = "Cookies"
cbData = SIZEOF(zTmp)
lReturn = RegQueryValueEx(BYVAL hKey, KeyNameA, BYVAL 0, KeyType, zTmp, cbData)
ZZZ = zTmp
RegCloseKey hKey
FUNCTION = ZZZ
EXIT FUNCTION
END IF
FUNCTION = ""
END FUNCTION
' -------------------------------------------------'
' *** THREAD FUNCTION FOR COOKIE MONITORING *** '
' -------------------------------------------------'
' This thread terminates when the hEvent is signalled, which occurs on WM_CLOSE in main window procedure.
FUNCTION MonitorNewCookies(BYVAL hEvent AS LONG) AS LONG
LOCAL ChangeFilter AS LONG, lbWatchSubTree AS LONG, lihNotify AS LONG, liWaitReturn AS LONG
DIM lcPathSpec AS ASCIIZ * 255
DIM zShortCookiePath AS ASCIIZ * %MAX_PATH
REDIM Events(1) AS STATIC LONG ' hold both events (the change notify and the manual event)
ChangeFilter = %FILE_NOTIFY_CHANGE_LAST_WRITE ' OR %FILE_NOTIFY_CHANGE_FILE_NAME
' options: %FILE_NOTIFY_CHANGE_FILE_NAME
' %FILE_NOTIFY_CHANGE_ATTRIBUTES Does not get changes to date/time
' %FILE_NOTIFY_CHANGE_LAST_WRITE event fires on new file or changed file; does NOT fire on rename
' can't seem to find one for "last access"
' the NT/2K API ReadDirectoryChangesW would be easier to use, but is not available on Win9x.
GetShortPathName GetCookiePath(), zShortCookiePath, SIZEOF (zShortCookiePath)
INCR nChangeEntries
CookieChange (nChangeEntries) = "Cookie Path is " & GetCookiePath
InvalidateRect BYVAL %NULL, BYVAL %NULL, BYVAL %TRUE ' force main window to update
UpdateWindow hWndMain
lcPathSpec = zShortCookiePath
lbWatchSubtree = %FALSE
' Set up the event object for directory changes in the cookie path:
lihNotify = FindFirstChangeNotification(lcPathSpec, lbWatchSubtree,ChangeFilter)
IF lihNotify <= %INVALID_HANDLE_VALUE THEN
EXIT FUNCTION
END IF
' Set up the array to be used by WaitForMultipleObjects
Events(0) = liHNotify ' to trigger action when a file changes
Events(1) = hEvent ' to trigger action when the user wants to quit.
' wait for either WM_CLOSE or a change in the cookie path:
liWaitReturn = WaitForMultipleObjects(2???, BYVAL VARPTR(Events(0)),%FALSE, %INFINITE)
SELECT CASE liWaitReturn
CASE %WAIT_OBJECT_0 + 1 ' the manual hEvent was sent
EXIT SELECT ' all done!
CASE %WAIT_OBJECT_0 ' the change notifcation event object signalled: a change occured
EnumCookies2 ' report the first change in cookies
DO
' Reset the change notify and wait again
liWaitReturn = FindNextChangeNotification(lihNotify)
liWaitReturn = WaitForMultipleObjects(2???, BYVAL VARPTR(Events(0)),%FALSE, %INFINITE)
IF liWaitReturn = %WAIT_OBJECT_0 THEN ' change in watched tree
EnumCookies2 ' Report it.
ELSEIF liWaitReturn = (%WAIT_OBJECT_0 + 1) THEN
' Got Manual Event in WM-CLOSE, exit
EXIT DO
END IF
LOOP
END SELECT
' close the handle to the changenotification event
liWaitReturn = FindCloseChangeNotification(lihNotify)
END FUNCTION
' -----------------------------------------------------------------------------------------------------
' FUNCTION TO READ THE CURRENT COOKIE DIRECTORY AND FIND ANYTHING WHICH HAS CHANGED SINCE THE LAST TIME,
' UPDATE THE 'LAST TIME CHECKED' AND FORCE AN UPDATE OF THE DISPLAY
' -----------------------------------------------------------------------------------------------------
FUNCTION EnumCookies2 () AS LONG
' uses GLOBALs CookiePath, array CookieChange()
' Purpose of function:
' if a cookie has been determined to have changed, we make that the last entry in the CookieChange() array
' then we tell the Main Window to repaint itself using the modified array
' The GLOBAL nChangeEntries keeps track of how many there currently are.
LOCAL FileInfo AS Win32_Find_data, hFind AS LONG, hNext AS LONG, FileMask AS ASCIIZ * %Max_PATH
LOCAL I AS LONG, J AS LONG
STATIC LastFileTime AS Filetime, BeenHere AS LONG, ChangeCounter AS LONG
LOCAL st AS SystemTime, ECode AS LONG
FileMask = CookiePath & "\*.txt"
REDIM Cookies (%MAX_COOKIES) AS Win32_Find_Data ' we're refreshing anyway; re-read the cookie directory
' On the first trip, the only thing we do is establish the time of the last enumeration
' so we do not need to build the cookie array. Each trip thereafter we DO want to rebuild the list
IF ISTRUE BeenHere THEN
LET I = 1
hFind = FindFirstFile (FileMask, FileInfo)
IF hFind <> %Invalid_HANDLE_VALUE THEN
hNext = %TRUE
WHILE ISTRUE hNext AND I <= UBOUND (Cookies,1)
Cookies (I) = FileInfo
hNext = FindNextFile (hFind, FileInfo)
IF ISTRUE hNext THEN
INCR I
END IF
WEND
FindClose hFind
END IF
DECR I ' because it was incremented
END IF
' at this point, Cookies() go from element 1 to element I of the array, except on the first trip
' find any cookies which have changed since the last enumeration
LOCAL hCookie AS LONG, sCookieData AS STRING, nFields AS LONG, sURL AS STRING, cbCookieData AS LONG, stext AS STRING
LOCAL AddThisOne AS LONG, TypeofChange AS STRING
IF ISFALSE BeenHere THEN ' first time, all we really do is set the filetime of the last enumeration
BeenHere = %TRUE ' avoid deja vu all over again!
ELSE
FOR J = 1 TO I
IF CompareFileTime(LastFileTime, Cookies(J).ftLastWriteTime) < 0 THEN ' first < second
AddThisOne = %TRUE
IF CompareFileTime(LastFileTime, Cookies(J).ftCreationTime) < 0 THEN ' first < second
TypeOfChange = " added"
ELSE
' this cookie has been updated since the last enumeration
TypeOfChange = " changed"
END IF
ELSE
AddThisOne = %FALSE
END IF
IF ISTRUE AddThisOne THEN
' open and read the cookie, report the change
hCookie = FREEFILE
OPEN CookiePath & "\" & Cookies(J).Cfilename FOR BINARY ACCESS READ LOCK SHARED AS hCookie BASE = 0
ECode = ERRCLEAR
IF ISTRUE Ecode THEN
debug "Error#" & STR$(Ecode) & " on open of file " & Cookies(J).CFileName
ELSE
cbCookieData = LOF(hCookie)
END IF
GET$ #hCookie, cbCookieData, sCookieData
ECode = ERRCLEAR
FlushFileBuffers FILEATTR(hCookie,2)
'FLUSH #hCookie ' seem to have a caching problem..., or maybe just a 'run from IDE problem
CLOSE #hCookie
nFields = PARSECOUNT(sCookieData, CHR$(10))
IF nFields > 2 THEN
sURL = PARSE$(sCookieData, CHR$(10), 3)
ELSE
sURL = " MISSING URL "
END IF
'build the message to appear in the array
INCR ChangeCounter
SText = TIME$ & " Cookie " & TypeofChange & ":'" & Cookies(J).cFileName & "' from URL " & sURL & FORMAT$ (ChangeCounter, " (#,###)")
' SText = TIME$ & " " & FORMAT$ (ChangeCounter, "(#,###)") & " Cookie file " & Cookies(J).cFileName & " from URL " & sURL & TypeOfChange
' find a place to put the info. Here, if the array is full, might be
' the best place to Append the current array to a log file and reset it.
IF nChangeEntries = UBOUND (CookieChange,1) THEN ' already full?
ARRAY DELETE CookieChange(3) ' delete the oldest (1, 2 used by messages)
CookieChange (nChangeEntries) = sText ' make this one last
ELSE
INCR nChangeEntries
CookieChange(nChangeEntries) = sText
END IF
' Force the main window to repaint itself.
LOCAL R AS Rect
GetWindowRect hWndMain,R
' send WM_SIZE to execute the code to recalc the dosplay parameters
SendMessage hWndMain, %WM_SIZE, %SIZE_RESTORED,MAKLNG(R.nRight-R.nLeft, R.nBottom-R.nTop)
InvalidateRect BYVAL %NULL, BYVAL %NULL, BYVAL %TRUE
UpdateWindow hWndMain
END IF ' if addthisone, that is
NEXT J ' next cookie
END IF ' if this is the first time we do this enumeration
' update the STATIC LastFileTime
' GetSystemTimeAsFileTime CurrentFileTime ' what time is it now?
' YIKES!!! This API CALL N/A ON Win 9x! Only in NT/2K. So we'll have to do it in two steps
GetSystemTime st
SystemTimetofileTime st, LastFileTime
END FUNCTION
_
SUB Debug(sText AS STRING)
#IF %DEF(%pb_cc32)
PRINT "DEBUG: " & sText & " - " & TIME$
#ELSEIF %DEF(%pb_dll32)
MSGBOX TIME$ & " " & sTExt, %MB_ICONINFORMATION OR %MB_APPLMODAL, "Cookie Monitor Info"
#ENDIF
END SUB
' DIALOG PROC, For 'About' box it can get %IDOK only. The "shutdown" box has no code.
FUNCTION DialogProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
IF wMSG = %WM_COMMAND THEN
IF LOWRD(wParam) = %IDOK THEN
DestroyWindow hWnd
hDlgAbout = 0
FUNCTION = 1
EXIT FUNCTION
END IF
END IF
FUNCTION = 0
END FUNCTION
Code:
//* Cookiemo.rc Author: 4/22/01 Michael Mattias
//* Icons courtesy Bob Houle, Dan Stasinski
#INCLUDE "resource.h"
PROGRAM ICON COOKIE.ICO
COOKY ICON COOKY.ICO
ABOUT DIALOG 10, 10, 200, 136
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE
FONT 8, "MS Sans Serif"
CAPTION "About Cookie Monitor"
BEGIN
CTEXT "Cookie Monitor v 1.0.0", , -1, 10, 10, 180, 14
CTEXT "Author: Michael C. Mattias " , -1, 10, 25, 180, 14
CTEXT "Racine WI USA", , -1, 10, 40, 180, 14
CTEXT "Placed in the public domain.", -1, 10, 55, 180,14
CTEXT "May be Freely Distributed." , -1, 10, 70,180,14
CTEXT "Cookie icons courtesy Bob Houle and Dan Stasinski", -1, 10,90, 180, 14
PUSHBUTTON "&Ok", IDOK, 81 , 110, 40, 14
END
SHUTDOWN DIALOG 10, 10, 140, 40
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE
FONT 10, "MS Sans Serif"
CAPTION "Cookie Monitor"
BEGIN
CTEXT "Shutting Down Monitor Function...", , -1, 10, 13, 120, 14
END
VS_VERSION_INFO VERSIONINFO
FILEVERSION 1, 0, 0, 0
PRODUCTVERSION 1, 0, 0, 0
FILEOS VOS_WINDOWS32
FILETYPE VFT_APP
//* VFT_DLL FOR DLLs
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904E4"
BEGIN
VALUE "CompanyName", "Tal Systems\0"
VALUE "FileDescription", "Cookie Monitor\0"
VALUE "FileVersion", "Version 1.1.0.0\0"
VALUE "InternalName", "CookieMonitor\0"
VALUE "OriginalFilename", "Cookiemo.exe\0"
VALUE "LegalCopyright", "Public Domain\0"
VALUE "LegalTrademarks", "None\0"
VALUE "ProductName", "CookieMonitor\0"
VALUE "ProductVersion", "Version 1.0.0.0 April 2001\0"
VALUE "Comments", "Author: Michael C. Mattias Racine WI USA; Idea: Greg Engle\0"
END
END
END
Code:
' File : cooky.ico
' Len : 766
' Created : 04-25-2001 - 10:56:30 using BinBas v1.01
#Compile Exe
Sub BinBas1( T As String )
Dim a&: For a& = 1 To DataCount: T = T & Read$( a& ): Next a&
Data 0000010001002020100000000000E802000016000000280000002000000040000000010004
Data 00000000008002000000000000000000000000000000000000061B3200728C9D00B1CBDA00
Data CDEEFC00354B57009BB8CF00A7CDEC00EDEFF500F6FBFB005972850098ADB8001E37480040
Data 5B73009BBFE3007E9BB200CCDCEB00888788778787F82FF8F8F8F888888888788887888F59
Data B0BCBC0C9024887888888888888850D9EED5D62EA9977A77888788887788096D6D666D222F
Data A4F888788888788854AD66D6D66664041299888878888788425D66D6D6666BB0426CB27788
Data 77788B123D6D665C9EDA00BA224018887787BE25409666E000EDE05662E04888773C9D6900
Data 0566D0000DD6D6E23EB388882BD6DD0004D6DC0005666F3338488887C1666640016D6D00CD
Data 66DA338BA88888C2666DE91AD6D6E9E6DD6C38A888788B42DFECE2D66DDD1A5FD9A1AA2878
Data 8887B2D9001F3956D6C09AEE33842888888AC2F400CA00066D9005A33C4A58888877222D90
Data 96C00CD21925A38B8888877874C66DEDDDE00056D266538BF88888888C2AF6D666DC00EA00
Data C553374288888887BF5B9DDD6ECDEB00B22C52EBA878888BB2400ED6D6DD650005D2131488
Data 888887199004D666D66D400D6633498888888C7910056F9966D6C1E6D633C5788887879AD9
Data C5DCB0ED66FFD66D93EB88888888B8455DD0000EDD0CDD6DB5FD288888787C5E26D100BD50
Data 00CD6D69AAE88888888474126610E650004D66D621B88888887842F226AED66D00A66F62BF
Data F88888888884E92FDD6D6DEDFD5D2587888887888788742C122D6626DD6EB8888888788888
Data 888884EB99E1E19E2738887888878887888888CA0BBBAB09A8888888888878888878888F27
Data 2722727F888888887800000000000000000000000000000000000000000000000000000000
Data 00000000000000000000000000000000000000000000000000000000000000000000000000
Data 00000000000000000000000000000000000000000000000000000000000000000000000000
Data 0000000000000000000000000000000000000000000000000000
End Sub
Function PbMain
Dim a As Long, FO As Long, T As String
FO = FreeFile
ErrClear
Open "cooky.ico" For Output As #FO
If Err Then
MsgBox "Error: " & Str$( Err ), 16, "cooky.ico"
Exit Function
End If
BinBas1 T
For a = 1 To Len( T ) Step 2
Print #FO, Chr$( Val( "&H" & Mid$( T, a , 2 ) ) );
Next a
Close #FO
End Function
Code:
' File : cookie.ico
' Len : 766
' Created : 04-24-2001 - 13:30:48 using BinBas v1.01
#Compile Exe
Sub BinBas1( T As String )
Dim a&: For a& = 1 To DataCount: T = T & Read$( a& ): Next a&
Data 0000010001002020100000000000E802000016000000280000002000000040000000010004
Data 00000000008002000000000000000000000000000000000000000000000000800000800000
Data 00808000800000008000800080800000C0C0C000808080000000FF0000FF000000FFFF00FF
Data 000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
Data FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7F7F77877FFFFFFFFFFFFFFFFFF77383333333833
Data 8FFFFFFFFFFFFFF773B3838383833130837FFFFFFFFFFF78388833883838311133387FFFFF
Data FFF77373313173B3838131833338FFFFFF783338331888883333333333338FFFFFB3733371
Data 38B8B3B3838183833387FFF73338338318888BB7333838833338FFF37383338188B37383B3
Data 83838333337F73383733313B8B8B888738383333338F73833333B3B8B87883B3B383833133
Data 87733117338B8BB7BB888388333311133FF3313383B3B8B877B3B373337331118773388833
Data 373B8BBB883878133311033FF383838373B3B87383B37183B331113773333333333B781837
Data 3781333333333FF3B3737373B3B383B3B38183733333877B3B3B333B338B887B383B333333
Data 338FF3B3B3B37373B8B3B373B3333333337FF7333333333337388B3B3333333338FFF7B3B3
Data 7373733373B3B373B3833387FFFF3B3B3333333B383733BBBB33137FFFFF73B33183B3B373
Data 8333B3733033FFFFFFF73B3333333B333333BB331337FFFFFFFF738383B3B3713133B33338
Data FFFFFFFFFFFF8313333331133B333107FFFFFFFFFFFFF773337110387873307FFFFFFFFFFF
Data FFFFFF777F777FFFFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
Data FFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000000000000000
Data 00000000000000000000000000000000000000000000000000000000000000000000000000
Data 00000000000000000000000000000000000000000000000000000000000000000000000000
Data 0000000000000000000000000000000000000000000000000000
End Sub
Function PbMain
Dim a As Long, FO As Long, T As String
FO = FreeFile
ErrClear
Open "cookie.ico" For Output As #FO
If Err Then
MsgBox "Error: " & Str$( Err ), 16, "cookie.ico"
Exit Function
End If
BinBas1 T
For a = 1 To Len( T ) Step 2
Print #FO, Chr$( Val( "&H" & Mid$( T, a , 2 ) ) );
Next a
Close #FO
End Function
------------------
Michael Mattias
Racine WI USA
[email protected]