Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Win32(SDK): Internet Cookie Monitor

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Win32(SDK): Internet Cookie Monitor

    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
    RESOURCE SCRIPT:

    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
    Edwin Knoppert's BINBAS output for both Cookie.ico and cooky.ico:


    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]
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com
Working...
X