<%

'http://search.cpan.org/~shadowx/Image-Xbm2bmp-0.02/lib/Image/Xbm2bmp.pm
'http://dean.edwards.name/weblog/2005/06/base64-ie/

Application.Lock( )
Application("PagesToday") = Application("PagesToday") + 1
Application.Unlock 

Dim objHitConn, strHitSQLBase, strHitSQL, strHitTot, strHitSQLCOM, objHitRs, intHits, intHitsTot
Dim strHitFile, strHitFileCOM, ini, startpos, ToWrite, DiaAtu, datahora
Dim Bytes, xlen, font, debugmsg
Dim digits(10), fwidth, fheight 

Function LoadFont( font )

  select case font
  case 1
    ' Font name : Sans-Serif Bold
    ' Each digit is 16 pixels wide, 20 high
    fwidth    = 16
    fheight   = 20
    digits(0)="0000c003e007700e300c1818181818181818181818181818181818181818300c700ee007c0030000"
    digits(1)="000000018001c001e001800180018001800180018001800180018001800180018001800180010000"
    digits(2)="0000c003e007700e300c181818181818001c000c000e00078003c001e00070003800f81ff81f0000"
    digits(3)="0000c003e00f700c3818181800180018000e80078007000e0018181818183018700ce00fc0030000"
    digits(4)="00000006000700078007c007c006e00660063006380618061c06fc1ffc1f00060006000600060000"
    digits(5)="0000f81ff81f18001800180018001800d807f80f380c00180018001818181818300cf00fc0030000"
    digits(6)="0000c003f00f300c181818181800d803f80f380c181818181818181818181818300cf00fc0030000"
    digits(7)="0000f81ff81f18181818180c000c000c000600060006000600030003000300038001800180010000"
    digits(8)="00008001e0076006300c300c300c700ee007e007700e381c1818181818181818300cf00fc0030000"
    digits(9)="0000c003f00f300c181818181818181818181818301cf01fc01b001818181818300cf00fc0030000"
  case 2
    ' Font name : Western
    ' Each digit is 16 pixels wide, 20 high
    fwidth    = 16
    fheight   = 20
    digits(0)="000000000000e003380e3c1e3c1e3e1e3e3e3e3e3e3e3e3e3e3e3e1e3c1e380e380ee00300000000"
    digits(1)="000000000000f803e003e003e003e003e003e003e003e003e003e003e003e003e003f80f00000000"
    digits(2)="000000000000e007181f3c3e7c3e7c3e383e001f800fc0012000d023f83ffc1ffc1f840f00000000"
    digits(3)="000000000000f0070c1f1e3e3e3e3e3e1c1e000ec003000e1c3e3e3e3e3e1e3e0c1ff80700000000"
    digits(4)="000000000000000e000f800fc00fa00f900f900f880f840f820ffe3f800f800f800fe03f00000000"
    digits(5)="000000001818f81ff80ffc07fc0104000400f4070c1f001e1c3e3e3e3e3e1e1e0c0ff00300000000"
    digits(6)="000000000000c007f01c701f781f780e7c007c0ffc1e7c3e7c3e7c3e783e781e701ec00700000000"
    digits(7)="000000000000f023fa1ffe0ffe0ff207020200038003c003e001f001f001f001f001e00000000000"
    digits(8)="000000000000e007781e7c3e7c3e7c3e781e700ec003700e781e7c3e7c3e7c3e781ee00700000000"
    digits(9)="000000000000e003780e781e7c1e7c3e7c3e7c3e783ef03f003e701ef81ef80e380fe00300000000"
  case 3
    ' Font name : Scoreboard
    ' Each digit is 16 pixels wide, 20 high
    fwidth    = 16
    fheight   = 20
    digits(0)="00000000fc0ffa17f61b0e1c0e1c0e1c0e1c0618000006180e1c0e1c0e1c0e1cf61bfa17fc0f0000"
    digits(1)="00000000000000100018001c001c001c001c001800000018001c001c001c001c0018001000000000"
    digits(2)="00000000fc0ff817f01b001c001c001c001cf01bf807f6030e000e000e000e00f603fa07fc0f0000"
    digits(3)="00000000fc0ff817f01b001c001c001c001cf01bf807f01b001c001c001c001cf01bf817fc0f0000"
    digits(4)="000000000000021006180e1c0e1c0e1c0e1cf61bf807f01b001c001c001c001c0018001000000000"
    digits(5)="00000000fc0ffa07f6030e000e000e000e00f603f807f01b001c001c001c001cf01bf817fc0f0000"
    digits(6)="00000000fc0ffa07f6030e000e000e000e00f603f807f61b0e1c0e1c0e1c0e1cf61bfa17fc0f0000"
    digits(7)="00000000fc0ff817f01b001c001c001c001c001800000018001c001c001c001c0018001000000000"
    digits(8)="00000000fc0ffa17f61b0e1c0e1c0e1c0e1cf61bf807f61b0e1c0e1c0e1c0e1cf61bfa17fc0f0000"
    digits(9)="00000000fc0ffa17f61b0e1c0e1c0e1c0e1cf61bf807f01b001c001c001c001cf01bf817fc0f0000"
  case 4
    ' Font name : Countdown
    ' Each digit is 16 pixels wide, 20 high
    fwidth    = 16
    fheight   = 20
    digits(0)="0000fc7ffc7f0c600c600c600c600c600c600c780c780c780c780c780c780c780c78fc7ffc7f0000"
    digits(1)="00000003000300030003000300030003c003c003c003c003c003c003c003c003c003c003c0030000"
    digits(2)="0000fe3ffe3f063006300030003000300030fe3ffe3f1e001e001e001e001e001e00fe3ffe3f0000"
    digits(3)="0000fe0ffe0f060c060c000c000c000cf80ff83f003c003c003c003c003c063c063cfe3ffe3f0000"
    digits(4)="0000fe0ffe0f060c060c060c060c060c060c060c060c060c060cfe3ffe3f000f000f000f000f0000"
    digits(5)="0000fe3ffe3f06000600060006000600fe3ffe3f003c003c003c003c003c063c063cfe3ffe3f0000"
    digits(6)="0000fe1ffe1f06180618060006000600fe3ffe3f063c063c063c063c063c063c063cfe3ffe3f0000"
    digits(7)="0000fe3ffe3f00300030003000300030003c003c003c003c003c003c003c003c003c003c003c0000"
    digits(8)="0000f80ff80f180c180c180c180c180cfe3ffe3f063c063c063c063c063c063c063cfe3ffe3f0000"
    digits(9)="0000fe3ffe3f0630063006300630063006300630fe3ffe3f003c003c003c003c003c003c003c0000"
  case 5
    ' Font name : Beach
    ' Each digit is 16 pixels wide, 20 high
    fwidth    = 16
    fheight   = 20
    digits(0)="0000e003f80ffc1ffc1ffe3f3e3e3e3e3e3e3e3e3e3e3e3e3e3e3e3efe3ffc1ffc1ff80fe0030000"
    digits(1)="0000e003e003e003e003e003e003e003e003e003e003e003e003e003e003e003e003e003e0030000"
    digits(2)="0000e003f80ffc1ffc1ffe3f3e3e3e3e7e3f3c1f9c1f980fc00fc007e03ff03ff03ff83ffc3f0000"
    digits(3)="0000fc0ffc07fc03fc03fc03f001f801f803f807c007800f800fc00ffc0ffc07fc07fc03fc000000"
    digits(4)="0000c03fc03fe03fe03ff03ff03ef03ef83e783efc3efc3efc3efe3e003e003e003e003e003e0000"
    digits(5)="0000f80ff80ffc0ffc0ffc0f7c00fc01fe07fe0fc00f001f001f801ffe1ffe0ffe0ffe07fe010000"
    digits(6)="00007800f801f800fc007c007c037e07be1fbe1fff3f1f3f1f3e3f3eff3ffe1ffc1ff807f0030000"
    digits(7)="0000fe1ffe1ffe0ffe0ffe0fc00fc007c007e007e003e003f003f003f001f001f801f800fc000000"
    digits(8)="0000f001fc07fc07fe0f1e0f1e0f1e0ffc07fe0ffe0f9f1f1f1f1f1f3f1ffe0ffe0ffc07f0010000"
    digits(9)="0000f003f807fc0ffe1fff3f1f3f1f3e1f3e7f3f7e1f3e1fbc0f900fc00fc007e007e00380030000"
  case else
    ' Font name : Smart
    ' Each digit is 8 pixels wide, 10 high
    fwidth    = 8
    fheight   = 12
    digits(0)="003c66666666666666663c00"
    digits(1)="003038303030303030303000"
    digits(2)="003c66606030180c06067e00"
    digits(3)="003c66606038606060663c00"
    digits(4)="00303038383434327e307800"
    digits(5)="007e0606063e606060663c00"
    digits(6)="00380c06063e666666663c00"
    digits(7)="007e666060303018180c0c00"
    digits(8)="003c6666663c666666663c00"
    digits(9)="003c666666667c6060301c00"
  end select
End Function

' generateBitmap() - count contains number to display, font is the font number
Function GenerateBitmap( count )
  dim formattedCount, digit, xbyte, ybyte, ifim, numbytes
  
  numbytes = ( fwidth / 8 ) * 2
  if len(count) < 8 then
	formattedCount = Right("00000000" & count, 8)
  else
	formattedCount = count
  end if
  xlen = len(formattedCount)
  if xlen < 1 then
    xlen = 1
  end if
  for y=1 to fheight
    for x=1 to xlen
      digit = Mid(formattedCount, x, 1)
      xbyte = Mid(digits(digit), ((y-1)*numbytes)+1, numbytes)
      'xbyte = Mid(digits(digit), ((y-1)*4)+1, 4)
      Bytes = Bytes & xbyte
    next
  next
End Function

Function WriteBitmap
  'Response.Write "Content-type: image/x-xbitmap" & chr(13) & chr(10) & chr(13) & chr(10) 'para chilli asp
  Response.ContentType="image/x-xbitmap"
  Response.Write "#define count_width " & CStr((CLng(xlen) * fwidth )) & chr(13) & chr(10)
  Response.Write "#define count_height " & fheight & chr(13) & chr(10)
  Response.Write "static char count_bits[] = {" & chr(13) & chr(10)
  for i = 1 to ( len(Bytes) / 2 )
    if inverse = 1 then
      Response.Write "0x" & hex(255-CLng("&H" & mid(Bytes, ((i-1)*2)+1, 2)))
    else
      Response.Write "0x" & mid(Bytes, ((i-1)*2)+1, 2)
    end if
    if i <> ( len(Bytes) / 2 ) then
      Response.Write ","
      if (i mod 10) = 0 then
        Response.Write chr(13) & chr(10)
      end if
    end if
  next
  Response.Write "};" & chr(13) & chr(10)
End Function

Function FileExists(Filename)
    Set fso = server.CreateObject("Scripting.FileSystemObject")
    if Request.QueryString("debug").Count then
        Response.Write "<br>Filename=" & Filename
    end if
    'Response.End
    'fn = Server.MapPath(mid(Filename,27))
    fn = Server.MapPath(Filename)
    'fn = Server.MapPath("/")
    'fn = Server.MapPath(mid(strHitFile,instr(strHitFile,"/portal")))
    if Request.QueryString("debug").Count then
       Response.Write "<br>fn=" & fn
    end if
    'Response.End
    If (fso.FileExists(fn)) then
        FileExists = True
    else
        FileExists = False
    end if
    set fso = nothing
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'LoadFont( 0 )
'GenerateBitmap( "000000" )
'WriteBitmap
'Response.End
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

if Request.QueryString("inverse").Count then
  inverse=1
else
  inverse=0
End if

'if Request.QueryString("fn").Count then
'   strHitFile = Request.QueryString("fn")
'    if mid(strHitFile,1,1) = "d" or mid(strHitFile,1,1) = "D" then
'       if instr(strHitFile,"/htdocs") then
'          strHitFile = mid(strHitFile,instr(strHitFile,"/htdocs")+7)
'          'Response.Write "<br>" & strHitFile
'       end if
'    else
'       if instr(strHitFile,"/portal") then
'          strHitFile = mid(strHitFile,instr(strHitFile,"/wwwroot")+8)
'       end if
'    end if
'else
'    strHitFile = Request.ServerVariables("HTTP_Referer")
'end if

'if Request.QueryString("debug").Count then
'    if Request.QueryString("fn").Count = 0 then
'       strHitFile = Request.QueryString("debug")
'    end if
'    Response.Write "<br>HTTP_Referer=" & Request.ServerVariables("HTTP_Referer")
'    Response.Write "<br>Debug=" & strHitFile
'    'Response.End
'    if FileExists(strHitFile) then
'        Response.Write "<br>ACHOU"
'    else
'        Response.Write "<br>necas"
'    end if
'    Response.End
'end if

'if InStr(strHitFile,"www.espirito.org.br") then
'   strHitFile = Replace ( Request.ServerVariables("HTTP_Referer"), _
'                          "www.espirito.org.br", "www.espirito.org.br" )
'end if
'if InStr(strHitFile,"www.portaldoespirito.com.br") then
'   strHitFile = Replace ( Request.ServerVariables("HTTP_Referer"), _
'                          "www.portaldoespirito.com.br",  "www.espirito.org.br" )
'end if
'if InStr(strHitFile,"www.espiritasonline.com.br") then
'   strHitFile = Replace ( Request.ServerVariables("HTTP_Referer"), _
'                          "www.espiritasonline.com.br",   "www.espirito.org.br" )
'end if
'if InStr(strHitFile,"www.espirito.com.br") then
'   strHitFile = Replace ( Request.ServerVariables("HTTP_Referer"), _
'                          "www.espirito.com.br",          "www.espirito.org.br" )
'end if
'if InStr(strHitFile,"www.portaldoespirito.hpg.ig.com.br") then
'   strHitFile = Replace ( Request.ServerVariables("HTTP_Referer"), _
'                          "www.portaldoespirito.hpg.ig.com.br", "www.espirito.org.br" )
'end if

strHitFile = "http://www.espirito.org.br"

if Request.QueryString("font").Count and IsNumeric(Request.QueryString("font")) then
  font=Request.QueryString("font")
else
  font=0
End if

if IsNumeric(Request.QueryString) then
   ToWrite = Request.QueryString
else
  'if left(strHitFile,20) <> "http://www.espirito." OR _
  '   InStr(strHitFile,"missing.asp") or _
  '   InStr(strHitFile,"search.asp")  then
  '  debugmsg = "Entrou no primeiro if:" & strHitFile
  '  strHitFile = "http://www.espirito.org.br"
  '  strHitFileCOM = strHitFile
  'else
  '  debugmsg = "Entrou no segundo if:" & strHitFile
  '  if left(strHitFile,35) = "http://www.espirito.org.br" then
  '     strHitFile = "http://www.espirito.com.br" & mid(strHitFile,36)
  '  elseif left(strHitFile,23) <> "http://www.espirito.com" then
  '     if left(strHitFile,7) <> "http://" then
  '        ini = 1
  '     else
  '        ini = 8
  '     end if
  '     startpos = InStr(ini,strHitFile,"/")
  '     if startpos < 1 then
  '        strHitFile = "http://www.espirito.com.br"
  '     else
  '        strHitFile = "http://www.espirito.com.br" & mid(strHitFile,startpos)
  '     end if
  '  end if
  '  If right(strHitFile,1) = "/" Then
  '     if not InStr(strHitFile,"index") then
  '        strHitFile = strHitFile & "index.html"
  '     else
  '        strHitFile = left(strHitFile,len(strHitFile)-1)
  '     end if
  '  End If
  '  strHitFileCOM = strHitFile
  '  strHitFile = "http://www.espirito.org" & mid(strHitFile,24)
  '  if strHitFile = "http://www.espirito.org.br/" or _
  '     strHitFile = "http://www.espirito.org.br/index.html" or _
  '     strHitFile = "http://www.espirito.org.br/" or _
  '     strHitFile = "http://www.espirito.org.br/contador.asp" or _
  '     InStr(strHitFile,"/forum/") Then
  '     strHitFile = "http://www.espirito.org.br"
  '  End if
  'end if

  Set objHitConn = Server.CreateObject("ADODB.Connection")
  'objHitConn.Provider = "Microsoft.Jet.OLEDB.4.0"
  'objHitConn.Open Server.MapPath("/databases/contador.mdb")
  if left(Request.ServerVariables("APPL_PHYSICAL_PATH"),6) = "D:\web" then
    'objHitConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=D:\web\brnt3sp269\databases\contador.mdb"
    fn = "D:\web\brnt3sp269\databases\contador.mdb"
  else
    'fn = "c:\Program Files\Ensim\Site Data\espirito\databases\contador.mdb"
    'fn = "c:\Program Files\Ensim\SiteData\webppliance\conf\domains\espirito\Inetpub\ftproot\databases\contador.mdb"
    'fn = "c:\Program Files\Ensim\SiteData\webppliance\conf\domains\espirito\databases\contador.mdb"
    'fn = "c:\domains\espirito.org.br\db\contador.mdb"
    fn = "C:\inetpub\vhosts\espirito.org.br\private\db\contador.mdb"
  end if
  for i = 1 to 5
    On Error Resume Next
    objHitConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & fn & ";uid=;pwd=;"
    if err.number = 0 then
       exit for
    end if
  next
  if err.number <> 0 then
     LoadFont( font )
     ToWrite = CStr(9999999)
     GenerateBitmap( ToWrite )
     WriteBitmap
     'response.write "Path=" & Server.MapPath(".")
     Response.End
  end if
  'objHitConn.Open "Driver={MySQL};SERVER=localhost;DATABASE=espirito;UID=espirito;PASSWORD=123"
  'objHitConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=D:\www\espirito.org.br\databases\contador.mdb;Uid=;Pwd="
  'objHitConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("/databases/contador.mdb") & ";Mode=ReadWrite;Uid=;Pwd="
  'counter.mdb needs to have a table named "Main"
  'along with two colunms: "Page" and "Hits"
  'strHitFile = Request.ServerVariables("url")
  'response.write strHitFile
  strHitSQLBase = "SELECT Page, Hits, LastHit, IP From Main Where Page='"
  strHitSQL     = strHitSQLBase & strHitFile & "'"
  strHitSQLCOM  = strHitSQLBase & strHitFileCOM & "'"
  Set objHitRs = Server.CreateObject("ADODB.Recordset")

  ' para debug, comentar  
  'response.Write "strHitSQL:" & strHitSQL
  'objHitRs.Open "Select * from oper", objHitConn, 1, 2
  'objHitRs.AddNew
  'objHitRs.Fields("hitfile").Value = strHitFile
  'objHitRs.Fields("datahora").Value = Now
  'objHitRs.Update
  'objHitRs.Close

  objHitRs.Open strHitSQL, objHitConn, 1, 2
  If objHitRs.EOF Then
    'Response.Write "<P>Um</P>"
    objHitRs.Close
    objHitRs.Open strHitSQLCOM, objHitConn, 1, 2
  End If
  If objHitRs.EOF Then
    'Response.Write "<P>Dois</P>"
    if FileExists(strHitFile) then
       objHitRs.AddNew
       intHits = 0
       objHitRs.Fields("Page").Value = strHitFile
    else
       strHitSQL = strHitSQLBase & "http://www.espirito.org.br'"
       objHitRs.Close
       objHitRs.Open strHitSQLCOM, objHitConn, 1, 2
    end if
  Else
    intHits = objHitRs.Fields("Hits").Value
    'Response.Write "<P>Tres</P>" + CStr(objHitRs.Fields("Hits").Value)
    'Response.Write "<P>" + objHitRs.Fields("Page").Value + "</p>"
  End If

'Response.Write "<br>IntHits:" & IntHits

  intHits = CLng(intHits) + 1
  objHitRs.Fields("Page").Value = strHitFile
  objHitRs.Fields("Hits").Value = CStr(intHits)
  objHitRs.Fields("LastHit").Value = Now
  objHitRs.Fields("IP").Value = Request.ServerVariables("REMOTE_ADDR")
  objHitRs.Update
  objHitRs.Close

'response.Write "<br>IntHits:" & intHits & "," & objHitRs.Fields("Hits")
'response.end


  set objHitRs = nothing
  Set objHitRs = Server.CreateObject("ADODB.Recordset")
  datahora = Now
  DiaAtu =              DatePart("yyyy", datahora)     & "-" & _ 
           right("00" & DatePart("m",    datahora), 2) & "-" & _
           right("00" & DatePart("d",    datahora), 2)

  strHitTot = "SELECT Dia, Hits From HitsTotal Where Dia='" & DiaAtu & "'"
  'Response.Write strHitTot
  'Response.End
  objHitRs.LockType = 3
  objHitRs.Open strHitTot, objHitConn, 1, 2
  If objHitRs.EOF Then
     objHitRs.AddNew
     intHitsTot = 0
     objHitRs.Fields("Dia").Value = DiaAtu
  Else
     intHitsTot = objHitRs.Fields("Hits").Value
  End if
  intHitsTot = CLng(intHitsTot) + 1
  objHitRs.Fields("Hits").Value = CStr(intHitsTot)
  objHitRs.Update
  objHitRs.Close
  objHitConn.Close
  set objHitConn = nothing
  ToWrite = CStr(intHits)
end if

if Request.QueryString("text").Count then
   Response.Write ToWrite
else
   LoadFont( font )
   GenerateBitmap( ToWrite )
   WriteBitmap
end if
%>