<%

Dim sIP, sURL, sDate, sImgHex
Dim sCoString, sSQL
Dim digit
Dim i

'-- 訪問者のIPアドレス、訪問ページを取得
sIP   = Request.ServerVariables("REMOTE_ADDR")
sURL  = Request.ServerVariables("HTTP_REFERER")
sDate = formatdatetime(DateAdd("n", 1027, now),2) '日本時間に変更 17時間7分

If Trim(sURL) = "http://www.c-mind.co.jp/cnt/count.asp" Then
    sURL = "ASP"
End If

If IsNull(sURL) Then
    sURL = "NULL"
End If

If Trim(sURL) <> "" Then

    On Error Resume Next

    '-- データベースのオープン　ここから
    sCoString = "DBQ=" & Server.MapPath("count.mdb") & ";"
    sCoString = sCoString & "Driver={Microsoft Access Driver (*.mdb)};PWD=sato0101;DriverId=25;"
    sCoString = sCoString & "FIL=MS Access;ImplicitCommitSync=Yes;"
    sCoString = sCoString & "MaxBufferSize=512;MaxScanRows=8;PageTimeout=5;"
    sCoString = sCoString & "SafeTransactions=0;Threads=3;UserCommitSync=Yes;"

    Set cn = Server.CreateObject("ADODB.Connection")
    cn.Open sCoString

    '-- データベースのオープン　ここまで

    '-- 履歴テーブルに書き込む
    sSQL = "SELECT * FROM visitorpast "
    sSQL = sSQL & "WHERE ip  = '" & sIP & "' "
    sSQL = sSQL & "AND   url = '" & sURL & "' "
    sSQL = sSQL & "AND   date = '" & sDate & "'"

    Set rs = Server.CreateObject("ADODB.Recordset")
    rs.Open sSQL, cn, 3, 3, 1

    If rs.EOF Then
        rs.AddNew
        rs("url")  = sURL
        rs("ip")   = sIP
        rs("date") = sDate
        rs.UpDate
    End If
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

    On Error Goto 0

End If

'透過gif
sImgHex = "47494638396101000100800000000000FFFFFF21F90401000000002C000000000100010000020144003B"
For i = 1 To Len(sImgHex) Step 2
   digit = digit & ChrB("&H" & Mid(sImgHex, i, 2))
Next

Response.ContentType = "image/GIF"
Response.BinaryWrite digit

%>