webHits

This program lets you track hits to your web pages. You can track multiple pages.

[|Documentation:] [|webhits.zip]

The webhits.bas program logs web hits to the webhits.txt file in the webhits project. This is the program that is called from your web pages. It logs; 1. Date 2. Time 3. ip 4. The page hit ID you define in your web page 5. Platform 6. User infor for browser and OS

You can use your favoriate text editor to edit the file

The webhitsLog.bas program reads the webhist.txt file and reports the data. You can: 1. Sort the data to farious formats 2. Drill down with wild card searches on any data item 3. Display Graphs on drilled down data

This program has security. You can change the user/pass by changing lines 5 and 6: keyUser$ = "admin"keyPass$ = "admin" As you can see the default is admin/admin

This is the html you place in your web pages. You can track multiple pages by changing the ??? to any name you like. That name is tracked in the log. code 

code

This is the webhits.bas program called by your web pages. It resides in the webhits project code ' - ' log user hits ' - yourDir$       = "../webhits_project/"        ' need your directory projectDir$    = "webhits_project"        ' need your project directory webhitsFile$   = DefaultDir$ + "\projects\" + projectDir$ + "\webhits.txt"

open webhitsFile$ for append as #f print #f, date$("yyyy-mm-dd");" || ";time$;" || ";UserAddress$;"   || ";word$(UrlKeys$,2,"&");" || ";Platform$;" || ";UserInfo$ close #f ' thats all folks end code

This is the webhitslog.bas program. You can call it whatever you like. Currently it is in the webhistlog project. code ' *********************************************************** ' webhits log ' *********************************************************** call SetCSS keyUser$ = "admin" keyPass$ = "admin" canMaint$ = "Y" dbWhere$ = "" groupBy$ = "" dbJoin$ = "" q$  = "','" global #sql line0bg$   = "#FAF0E6" line1bg$   = "#FFE4C4" fields$    = "logDate,logTime,logIp,logPage,logPlatform,logInfo,logOs,logBrowser" tblFields$ = "log.logDate,log.logTime,log.logIp,log.logPage,log.logPlatform,log.logInfo,log.logOs,log.logBrowser" bf$     = "" fc$   = ""

' -- ' create in memory database ' -- sqliteconnect #sql, ":memory:" sql$   = "CREATE TABLE log (  logDate   date,  logTime   varchar(10),  logIp         text,  logPage       varchar(10),  logPlatform   text,  logInfo       text,  logOs         text,  logBrowser    text );    CREATE INDEX IDXlogDate ON log(logDate,logTime);    CREATE INDEX IDXlogPage ON tree(logIp)" #sql execute(sql$)

projectDir$    = "webhits_project"         ' need your project directory webhitsFile$   = DefaultDir$ + "\projects\" + projectDir$ + "\webhits.txt"

open webhitsFile$ for input as #f while not(eof(#f)) line input #f, a$   logDate$        = trim$(word$(a$,1,"||")) logTime$       = trim$(word$(a$,2,"||")) logIp$         = word$(a$,3,"||") logPage$       = trim$(word$(a$,4,"||")) logPlatform$   = trim$(word$(a$,5,"||")) logInfo$       = trim$(word$(a$,6,"||")) 'print a$ if trim$(a$) = "" then goto [skipIt]

i = 1 x$ = "" p$ = "" logIp$ = strip$(logIp$) logIp$ = trim$(logIp$) while (word$(logIp$,i,".")) <> "" x$ = x$ + p$ + right$("000";word$(logIp$,i,"."),3) i = i + 1 p$ = " " wend logIp$ = x$

aa$ = upper$(a$)

if instr(aa$,"MSIE") then logOs$     = "Windows" logBrowser$ = "MSIE" end if

if instr(aa$,"LINUX") then logOs$     = "Linux" end if

if instr(aa$,"FIREFOX") then logBrowser$ = "Firefox" end if

if instr(aa$,"SAFARI") then logBrowser$ = "Safari" end if

if instr(aa$,"MACINTOSH") then logOs$ = "Mac" end if

sql$   = "INSERT INTO log (logDate,logTime,logPlatform,logInfo,logIp,logPage,logOs,logBrowser) VALUES ('";logDate$;"','";logTime$;"','";logPlatform$;"','";logInfo$;"','";logIp$;"','";logPage$;"','";logOs$;"','";logBrowser$;"')" 'print logDate$ 'print logTime$ 'print sql$ 'input xx

[skipIt] wend close #f
 * 1) sql execute(sql$)

' - ' Possible Sorts Array ' - numSorts = 8 dim sortDescr$(numSorts) dim sortSel$(numSorts) sortDescr$(1)   = "Date"      : sortSel$(1) = "log.logDate,log.logTime" sortDescr$(2)   = "Time"      : sortSel$(2) = "log.logTime,log.logDate" sortDescr$(3)   = "Ip"        : sortSel$(3) = "log.logIp,log.logDate,log.logTime" sortDescr$(4)   = "Page"      : sortSel$(4) = "log.logPage" sortDescr$(5)   = "Platform"  : sortSel$(5) = "log.logPlatform,log.logDate,log.logTime" sortDescr$(6)   = "Info"      : sortSel$(6) = "log.logInfo" sortDescr$(7)   = "OS"        : sortSel$(7) = "log.logOs,log.logDate,log.logTime" sortDescr$(8)   = "Browser"   : sortSel$(8) = "log.logBrowser,log.logDate,log.logTime"

' - ' Possible Search Array ' - numSrch = 8 dim srchDescr$(numSrch) dim srchSel$(numSrch) srchDescr$(1)   = "Date"     : srchSel$(1) = "log.logDate" srchDescr$(2)   = "Time"     : srchSel$(2) = "log.logTime" srchDescr$(3)   = "Ip"       : srchSel$(3) = "log.logIp" srchDescr$(4)   = "Page"     : srchSel$(4) = "log.logPage" srchDescr$(5)   = "Platform" : srchSel$(5) = "log.logPlatform" srchDescr$(6)   = "Info"     : srchSel$(6) = "log.logInfo" srchDescr$(7)   = "OS"       : srchSel$(7) = "log.logOs" srchDescr$(8)   = "Browser"  : srchSel$(8) = "log.logBrowser"

' ================================================= ' log List ' ================================================= [logList] ' ' how many records ' cls [logList1] if numRecords   = 0 then sql$   = "SELECT count(*) as numRecords FROM log" + dbJoin$ + dbWhere$ result$ = #sql nextrow$(" |") numRecords = val(word$(result$,1,"|")) end if
 * 1) sql execute(sql$)

gosub [logHeading]         ' display headin and message area

' - ' Record Heading ' - html bf$;" " wait

' --- ' Get data from database SQL command ' --- [logGetData] logDate$       = trim$(word$(result$,1,"|")) logTime$       = trim$(word$(result$,2,"|")) logIp$         = trim$(word$(result$,3,"|")) logPage$       = trim$(word$(result$,4,"|")) logPlatform$   = trim$(word$(result$,5,"|")) logInfo$       = trim$(word$(result$,6,"|")) logOs$         = trim$(word$(result$,7,"|")) logBrowser$    = trim$(word$(result$,8,"|")) rowid$         = trim$(word$(result$,9,"|")) RETURN

' ' log Maintenance '

[logVue] acd$ = "Vue" goto [logMnt]

[chglog] acd$ = "Chg" goto [logMnt]

[dellog] acd$ = "Delete" goto [logMnt]

[addlog] acd$ = "Add"

[logMnt] thislogrowid$  = EventKey$

cls gosub [HeadingMsg]

sql$ = "SELECT ";fields$;" FROM log WHERE rowid = '";thislogrowid$;"'" result$ = #sql nextrow$(" |") gosub [logGetData] if acd$ = "Add" then ' blank fields result$ = " | | | | | | | | |" gosub [logGetData] ' set default values end if
 * 1) sql execute(sql$)

if acd$ = "Vue" then goto [ViewIt]

html " " wait

' - ' View Detail ' - [ViewIt] html bf$;" " wait

' ===================================== ' Do requested Add Change Delete ' ===================================== [dologAcd]

if acd$ = "Delete" then sql$ = "DELETE FROM log WHERE rowid = '";thislogrowid$;"'" goto [execACD] wait end if

dbFields$ = "logDate,logTime,logIp,logPage,logPlatform,logInfo,logOs,logBrowser"

' - ' Get data from the screen ' - logDate$    = trim$(#logDate     contents$) logTime$    = trim$(#logTime      contents$) logIp$         = trim$(#logIp       contents$) logPage$    = trim$(#logPage       contents$) logPlatform$    = trim$(#logPlatform       contents$) logInfo$    = trim$(#logInfo       contents$) logOs$        = trim$(#logOs       contents$) logBrowser$    = trim$(#logBrowser       contents$) if errNum > 0 then gosub [doMsg] wait end if q$  = "','" dbVals$ = "'";dblQuote$(logDate$);q$;dblQuote$(logTime$);q$;dblQuote$(logIp$);q$;dblQuote$(logPage$);q$;dblQuote$(logPlatform$);q$;dblQuote$(logInfo$);q$;dblQuote$(logOs$);q$;dblQuote$(logBrowser$);"'"

if acd$ = "Chg" then GOSUB [sqlSet] sql$  = "UPDATE log SET ";sql$;" WHERE rowid = '";thislogrowid$;"'" END IF if acd$ = "Add" then sql$ = "INSERT into log ("; dbFields$; ") VALUES ("; dbVals$ ; ")"

[execACD]
 * 1) sql execute(sql$)

goto [logList] wait ' ' They want Lines per page ' [doLpp] if lpp   = 0 then lpp = 20 lpp   = min(10,lpp) goto [logList]

' ' They want next page ' [doNext] lastPageNum   = val(EventKey$) pageNum       = val(#pageNum contents$) if lastPageNum   = pageNum then pageNum = pageNum + 1 goto [logList]

' ' They want prev page ' [doPrev] lastPageNum   = val(EventKey$) pageNum       = val(#pageNum contents$) if lastPageNum   = pageNum then pageNum = pageNum - 1 if pageNum < 1 then pageNum = 1 goto [logList]

' - ' User Search screen ' - [logdoSearch] cls wa$ = "" html bf$;" " html " " html " "

html " "

wait

[doFind] dbWhere$ = "" for i = 1 to numSrch oVar$   = "#srch(";i;")" srch$   = trim$(#oVar$ contents$) if srch$ <> "" then wld$ = goWild$(srchSel$(i),srch$) dbWhere$ = dbWhere$ + wld$ end if next i if dbWhere$ <> "" then dbWhere$ = " WHERE " + dbWhere$ numRecords  = 0 goto [logList]

FUNCTION goWild$(fld$,str$) global wa$ goWild$ = trim$(str$) l  = len(goWild$) if l > 0 then if INSTR(goWild$,"*") <> 0 then wld$ = "Y" if INSTR(goWild$,"%") <> 0 then wld$ = "Y" if wld$ <> "Y" then goWild$ = goWild$ + "%" if right$(goWild$,1)  = "*" then goWild$ = left$(goWild$,l - 1) + "%" if left$(goWild$,1)   = "*" then goWild$ = "%" + mid$(goWild$,2) goWild$   = wa$;fld$;" LIKE ";"'";goWild$;"'" wa$   = " AND " else goWild$   = "" end if END FUNCTION

' ' They wanna sort ' [logdoSort] cls html bf$;" " WAIT [logdoSortSel] sortNum   = val(EventKey$) ss$   =   #dds selection$ if ss$ <> "" then for i   = 1 to numSorts if sortDescr$(i)   = ss$ then orderBy$ = " ORDER BY ";sortSel$(i) next i end if

goto [logList]

WAIT

' ============================================ ' List Heading ' ============================================ [logHeading] ' --- ' Did they change the lines per page lpp ' --- x = #lpp ISNULL if x = 0 then lpp = val(#lpp contents$)

pageNum = max(1,pageNum)    ' make user it has a page number if lpp  < 1 then lpp = 20   ' lines per page must be specified lpp     = max(5,lpp)        ' make sure it has a least 5 lines per page lpp     = min(100,lpp)      ' don not allow over 100 lines per page

totPages = int(numRecords / lpp) if lpp * totPages <> numRecords then totPages = totPages + 1 pageNum = min(totPages,pageNum) pageNum = max(1,pageNum) limitBeg = (pageNum * lpp) - lpp 'limit begin value

dispLine = 0

limit$  = " LIMIT " ; limitBeg ; "," ; lpp

html bf$;" " [HeadingMsg] html " " gosub [doMsg] RETURN

' ' Stats ' [stats] cls gosub [logHeading] html " " html "" WEND html "" RETURN

html ""

wait

' --- ' Messages and error handling ' --- [doMsg] html " document.getElementById('infoMsg').innerHTML = '" br$ = "" for i = 1 to infoNum html br$;infoMsg$(i) br$ = "" next i html "'; "

html " document.getElementById('wrnMsg').innerHTML = '" br$ = "" for i = 1 to wrnNum html br$;wrnMsg$(i) br$ = "" next i html "'; "

html " document.getElementById('errMsg').innerHTML = '" br$ = "" for i = 1 to errNum html br$;errMsg$(i) br$ = "" next i html "'; "

infoNum = 0 wrnNum  = 0 errNum  = 0 on error goto [handler] RETURN

[handler] errNum = errNum + 1 errMsg$(errNum) = "Err number:";Err;" Description:";Err$ gosub [doMsg] on error goto [handler] WAIT [handler1] on error goto [handler] wait

' - ' Get outta here ' - [doExit] cls print "Close Window (Y/N)"; input x$ if x$ = "Y" then html "<script language='javascript' type='text/javascript'> var a   = history.length; a     = a - 1; window.open(,'_parent',); window.close; history.go(-a); " end if

wait

' - ' help - please help me I can't get up ' - [logdoHelp] cls numHelp = 11    ' set number of help items dim helpItem$(numHelp) if helpItem$(1) = "" then helpItem$(1) = "[Add]|Use the [Add] or the [A]dd in the list to add a record" helpItem$(2) = "[Sort]|You can sort in different sequences by selecting the field from the drop down list" helpItem$(3) = "[Search]|This helps you find information. You can use any or all of them at once." helpItem$(4) = "[Exit]|Leave the system" helpItem$(5) = "[Prev]|Go to the previous page" helpItem$(6) = "Page Num|Enter a page number to go directly to that page. Then use [Next]" helpItem$(7) = "[Next]|Go to the next page" helpItem$(8) = "LPP|Set Lines Per Page. The default is 20" helpItem$(9) = "[View]|View record detail" helpItem$(10)   = "[C]|Change a record" helpItem$(11)   = "[D]|Delete a record" end if html " "

wait

' --- ' Convert sql field and values notation to set notation ' --- [sqlSet] ix  = 1 sql$ = "" qq$ = "" cma$ = "" while (word$(fields$,ix,",") <> "") sql$  = sql$ + cma$ + word$(fields$,ix,",") + " = " + qq$ + word$(dbVals$,ix,",'") cma$  = ", " qq$   = "'" ix = ix + 1 WEND RETURN

' - ' Convert single quotes to double quotes ' - FUNCTION dblQuote$(str$) i   = 1 qq$ = "" while (word$(str$,i,"'")) <> "" dblQuote$  = dblQuote$;qq$;word$(str$,i,"'") qq$ = "''" i  = i + 1 WEND END FUNCTION

' ' Numeric Check ' FUNCTION isNumeric(f$) if str$(val(f$)) = f$ then isNumeric = 1 else isNumeric = 0 end if END FUNCTION

' - ' strip junk ' - FUNCTION strip$(str$) strip$ = "" for i = 1 to len(str$) a$ = MID$(str$,i,1) a = ASC(a$) if a > 31 then if a < 123 then if a$ <> "'" then if a$ <> """" then strip$ = strip$ + a$              end if             end if           end if        end if    next i END FUNCTION

' - ' set CSS ' -- SUB SetCSS

CSSClass "a.lBtn", "{ Text-Align:Center; Border-Width:1px; Border-Style:solid; background:#FDDD8C; Border-Color:black; Font-Size:10pt; Font-Weight:Bold; Font-Family: Arial; Text-Decoration:  None; }" cssid  #len2,"{ width: 20px }"

END SUB

code