<!--#include file ="vb4cgi.inc"-->
<%'
'
' VB4CGI ADOlog3.asp アクセスログを残すプログラム(SQL)
'
' 実行ディレクトリにlog.mdbが必要(接続時にODBCの設定をしているのでODBCの設定はいらない)
'　記録する環境変数は好きなものを使うこと
'　ダミーのgifファイルを返すときに記録するので、1*1透過gifファイルを使う。
' 　画像からlogにハイパーリンクをつけても便利。読みだすためには読み込み可能のディレクトリにある必要がある。
'   /scripts/ではだめ。c:\/webshare/wwwroot/ or c:\/inetpub/wwwroot/などに作ること
'
' 原作者　古口正巳　[koguchi@sf.airnet.ne.jp]1998.07 V 0.9
'
'　　このプログラムはコード改変可能なフリーフェアであり、いかなる条件でも正しく動作する事を保証してません。
'　　各自のリスクで実行して下さい。このプログラムを利用していかなるトラブルが発生しても関知しません。
'
'　次のような文をＨＴＭＬ文に書き加えるとログファイルが更新される。
' <img src="/aspsamp/ADOlog3.asp">
' 直接/aspsamp/ADOlog3.aspと打って動作を確認してみてください。

cgi_main

%>

<SCRIPT  LANGUAGE=VBSCRIPT RUNAT=SERVER>

Sub cgi_main()
    Dim simgHex 'ダミーのgif変数16進データ
    Dim x
    Dim digit '画像データ格納用バイト配列　大きさははみ出さないように設定
    
    simgHex = "47494638376110001500910000FFFFFF4A7B9452C6FF0000002C00000000100015000002409C8FA9BBE20F931802D83BE77114666D54E0068CA27292635822A9DB6E5340D79D52E7013AEBB78A8AB156146191F83A064D9F086753BC5832124F8481CD2E0A003B"
    'simgHex = "47494638396101000100800000000000FFFFFF21F90401000000002C000000000100010000020144003B"
    '実際に使用するときは　1*1透過gifファイルに設定すると見えない。ここでは見えるように0を出力している。
    '下のSimgHexのコメントをはずす。
   For x = 1 To Len(simgHex) Step 2
        digit = digit & ChrB("&H" & Mid(simgHex, x, 2))
   Next
    Response.ContentType = "image/GIF" 'Send "Content-type: image/gif" & vbCrLf
    Response.BinaryWrite digit

    'データーベースを開く
    Set cn = Server.CreateObject("ADODB.Connection")
    cn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & CGI_AppPath & "\" & "log.mdb"
    
	sql = "INSERT INTO log ( "
	values = " VALUES ( "

	sql = sql & "[TIME]"
    values = values & "'" &  Now & "'"
    If CGI_RemoteAddr <> "" Then            'Null値を除く
		sql = sql & ", CGI_RemoteAddr"
        values = values & ", '" & CGI_RemoteAddr & "'"
    End If
    If CGI_RemoteHost <> "" Then
		sql = sql & ", CGI_RemoteHost"
        values = values & ", '" & CGI_RemoteHost & "'"
    End If
    If CGI_UserAgent <> "" Then
		sql = sql & ", CGI_UserAgent"
        values = values & ", '" & CGI_UserAgent & "'"
    End If
	sql = sql & " )"
	values = values & " )"
'sendheader "TEST" 'GIF OUTPUTではエラーが出力されない
'send sql & values & "<BR>"
'sendfooter

    'Queryでレコード更新
	cn.Execute sql & values

    'データーベースを閉じる
    cn.Close 'ADO
    Set cn = Nothing
End Sub

</SCRIPT>