Sessionモニタ
ホーム
ホームページ
更新履歴
NOW!
チャット
ボイスチャット
ボイスメール
分身一覧
中継一覧
チャットメンバー

MSサポート情報検索
検索ページ
システム概要

パスワード変更
システム概要
ダウンロード

フォロー
一覧
WINTIS97

ツール、TIPS
Urlコンポーネント
Sessionモニタ
Excel作成
webinfo
きゃらメール
delold.vbs
rentoday.vbs
ASP TIPS
IRC伝言サービス
IRC計算サービス
プロファイル aspProfile
時間計測 TimeTool
MIMEマップ操作
電話番号11桁対応
ServerVariables
IPアドレス設定
Mediaモニタ
数式電卓
ファイル表示
CHOCOA URL紹介

お勧め
ソフトウェア
ハードウェア
リンク

WinNT WebRing
サイト一覧
前へ
次へ
ランダム
  
日本骨髄バンク  
PASSJ  
【楽天市場】ホビー・ペット・コレクション  
 
 
 
ASP (Active Server Pages) での Session 状況をリアルタイムでモニタする
プログラムを作成してみました。

ある仕事に追われて徹夜した時の、朝、ふとASP-MLやチャットをしながら、思いついて
作ってみました。
今も、継続して自分のサイトを監視し、気づいた点を改良していっています。

2000/6/8　検索サイトからのHTTP_REFERER を解析するようにしました

※一時、セッションモニタのサービスを停止します。
　実装方法に問題が発覚したため、XMLベースに変更する予定です。
■現在のモニタ状況
このサイトの現在の状況は、
セッションモニタ
に表示しています。
セッション状況を、一分間隔にリロードすることによりリアルタイムに表示しています。
■目次 ■実装方法
主に次のポイントがあります。
  1. global.asa の Session_OnStartにて Session に固有の情報を 
    SessionスコープのDictionaryに保存し、
    さらに、ApplicationスコープのDictionaryに追加する
  2. global.asa の Session_OnEnd にて、Session に固有の情報を 
    Applicationスコープの Dictionary から削除する
  3. 各ページにて、ページ情報やアクセス日時を更新する。
  4. Sessionモニタページにて、Application スコープの Dictionary を表示する。
  5. 検索エンジンや巡回ソフトからのアクセスは、モニタしない。
  6. 他のサイトへのリンクも、履歴に記録する。
■必要な環境
この処理では、IIS/ASPに加えて、WSC(Windows Scripting Component),
いくつかのフリーのコンポーネントを利用しています。
コンポーネント利用できない場合は、利用している部分を削除してください。
■global.asaのオブジェクト定義
次のオブジェクトを宣言します。
<object ID="dicSessions" runat="Server" Scope="Application" ProgID="Scripting.Dictionary"></object>
<object ID="dicSession" runat="Server" Scope="Session" ProgID="Scripting.Dictionary"></object>
dicSessions は、Application スコープの変数です。
dicSession は、Sessionスコープの変数です。
dicSessions には、全ての dicSession を追加します。
■global.asaのApplication_OnStart
Application_OnStart では、カウンタを初期化しています。
カウンタを別途管理している場合には、必要ありません。
このカウンタは、セッション単位にカウントします。
ページビューでは、ありません。
<SCRIPT LANGUAGE=VBScript RUNAT=Server>
SUB Application_OnStart
　　'--- カウンタを初期化
 　　On Error Resume Next
　　VisitorCountFilename = Replace(Server.MapPath ("/visitors.txt"), "wwwroot", "data")
　　Set FileObject = Server.CreateObject("Scripting.FileSystemObject")
　　Set Out= FileObject.OpenTextFile (VisitorCountFilename, 1, FALSE, FALSE)
　　Application("visitors") = Out.ReadLine
　　Application("VisitorCountFilename") = VisitorCountFilename
　　'--- Lock/Unlock 用ダミー変数
　　Application("Lock") = 0
END SUB
</SCRIPT>
■global.asaのApplication_OnEnd
Application_OnEnd では、カウンタを保存しています。
カウンタを別途管理している場合には、必要ありません。
<SCRIPT LANGUAGE=VBScript RUNAT=Server>
SUB Application_OnEnd
　　'--- カウンタを出力
　　Set FileObject = Server.CreateObject("Scripting.FileSystemObject")
　　Set Out= FileObject.CreateTextFile (Application("VisitorCountFilename"), TRUE, FALSE)
　　Out.WriteLine(application("visitors"))
　　Set Out = Nothing
　　Set FileObject = Nothing
END SUB
</SCRIPT>
■global.asaのSession_OnStart
Sessionモニタの中心です。
ここでは、ロボットの判定、ホスト名の逆引き、カウンタの更新と、
dicSession の作成と、dicSessions への登録を行っています。
現在 dicSession に保存している値は、次のようになっています。

項目名 内容 現在の値
SessionID Session.SessionID の値
StartTime Session開始日時
Visitor カウンタ
RemoteAddr クライアントのIPアドレス
RemoteHost クライアントのホスト名
HttpReferer リンク元(HTTP_REFERERの値)
HttpUserAgent ブラウザの種類 (HTTP_USER_AGENTの値)
LastPage 最後に表示したページのタイトル Sessionモニタ
LastTime 最後に表示した日時 2008/11/21 10:22:19
Pages 表示したページの履歴 (最後のものが先頭にくる) Sessionモニタ

ホスト名を得るコンポーネントは、netal の System Scripting Runtime を
利用しています。
無料で使える、とても強力なコンポーネントです。

ロボットの判定は、HTTP_USER_AGENT 文字列に特定の文字列があるかどうかを調べています。

<SCRIPT LANGUAGE=VBScript RUNAT=Server>
SUB Session_OnStart
　　Dim blnIsRobot
　　'--- Sessionバグ対策
　　Session("StartTime") = Now
　　'--- ロボット確認
　　blnIsRobot = IsRobot(Request.ServerVariables("HTTP_USER_AGENT"))
　　'--- カウンタインクリメント
　　If Not blnIsRobot　　Then
　　　　Application.lock
　　　　Application("visitors")= application("visitors") + 1
　　　　Session("visitors") = application("visitors")
　　　　If t_visitors MOD 10 = 0 Then
　　　　　　'--- カウンタを出力
　　　　　　Set FileObject = Server.CreateObject("Scripting.FileSystemObject")
　　　　　　Set Out= FileObject.CreateTextFile (Application("VisitorCountFilename"), TRUE, FALSE)
　　　　　　Out.WriteLine(application("visitors"))
　　　　　　Set Out = Nothing
　　　　　　Set FileObject = Nothing
　　　　End If
　　　　Application.unlock
　　End If

　　'--- ホスト名を得る
　　Dim objIPNetwork, strRemoteHost
　　Set objIPNetwork = Server.CreateObject("SScripting.IPNetwork")
　　strRemoteHost = objIPNetwork.DNSLookup(strIPAddress)
　　Set objIPNetwork = Nothing
　　If strError = "" Then
　　　　Session("REMOTE_HOST") = strRemoteHost
　　Else
　　　　Session("REMOTE_HOST") = Request.ServerVariables("REMOTE_ADDR")
　　End If

　　'--- dicSession作成
　　dicSession.Add "SessionID", Session.SessionID
　　dicSession.Add "StartTime", Now()
　　dicSession.Add "Visitor", Session("visitors")
　　dicSession.Add "RemoteAddr", Request.ServerVariables("REMOTE_ADDR")
　　dicSession.Add "RemoteHost", Session("REMOTE_HOST")
　　dicSession.Add "HttpReferer", Request.ServerVariables("HTTP_REFERER")
　　dicSession.Add "HttpRefererSummary", GetSummary(Request.ServerVariables("HTTP_REFERER"))
　　dicSession.Add "HttpUserAgent", Request.ServerVariables("HTTP_USER_AGENT")
　　dicSession.Add "LastPage", ""
　　dicSession.Add "LastTime", Now()
　　dicSession.Add "Pages", ""

　　'--- dicSessions へ dicSession を追加
　　Application.Lock
　　Application("Lock") = 0
　　On Error Resume Next
　　dicSessions.Add CStr(Session.SessionID), dicSession
　　If Err <> 0 Then
　　　　dicSessions.Remove(CStr(Session.SessionID))
　　　　dicSessions.Add CStr(Session.SessionID), dicSession
　　End If
　　Err.Clear
　　Application.Unlock　　

　　'--- ロボットの場合は、セッションを終了させる
　　If blnIsRobot Then
　　　　Session.Abandon
　　End If
END SUB

'--- HTTP_REFERER から要約を得る
 Function GetSummary(strUrl)
　　Dim objUrl
　　
　　GetSummary = ""
　　If strUrl = "" Then
　　　　Exit Function
　　End If
　　Set objUrl = GetObject("script:D:\kawabata\wwwroot\com\kawabataCom_Url.wsc")
　　GetSummary = objUrl.GetSummary(strUrl)
　　Set objUrl = Nothing
End Function

'--- ロボットかどうかを判定する
Function IsRobot(strUserAgent)
　　Dim aryKeys, strKeys, nKey

　　strKeys = "WWWC,Wget,Scooter,Infoseek Sidewinder,MSIECrawler" _
　　　　& ",InfoNaviRobot,ArchitextSpider,WiseWire,indexpert,PNWalker" _
　　　　& ",Gulliver,moget"
　　aryKeys = Split(strKeys, ",")
　　IsRobot = False
　　If Trim(strUserAgent) = "" Then
　　　　IsRobot = True
　　　　Exit Function
　　End If
　　For Each nKey In aryKeys
　　　　If InStr(1, strUserAgent, nKey, vbTextCompare) > 0 Then
　　　　　　IsRobot = True
　　　　　　Exit Function
　　　　End If
　　Next
End Function
</SCRIPT>
■global.asaのSession_OnEnd
Session_OnEnd では、dicSession を dicSessions から削除しています。

<SCRIPT LANGUAGE=VBScript RUNAT=Server>
SUB Session_OnEnd
　　'--- セッション履歴
　　Application.Lock
　　Application("Lock") = 0
　　dicSessions.Remove(CStr(Session.SessionID))
　　Application.Unlock　　
　　Exit Sub

END SUB
</SCRIPT>
■dicSessionInc.asp : インクルードファイル
このファイルは、Sessionモニタ用のインクルードファイルです。
それぞれの asp ファイルで
<!-- #include virtual="/dicSessionInc.asp" --%gt;
と宣言して利用します。

ASPページ内では、次のようにプログラムします。
dicSessionAddPage "テストページ"
dicSessionAddPageURL "テストページ", "/testpage.asp"

このサイトの場合は、すべてのページで読み込まれるテンプレートページの中で
処理しています。

<%
'--- dicSession 管理

'--- dicSession 履歴追加
Sub dicSessionAddPage(strTitle)
　　dicSession("LastPage") = strTitle
　　dicSession("LastTime") = Now()
　　If dicSession("Pages") = "" Then
　　　　dicSession("Pages") = strTitle
　　Else
　　　　dicSession("Pages") = strTitle & vbTab & dicSession("Pages")
　　End If
　　Exit Sub
End Sub

'--- dicSession 履歴追加 URL 付
Sub dicSessionAddPageUrl(strTitle, strUrl)
　　dim strAdd
　　
　　strAdd = "<a href=""" & strUrl & """>" & strTitle & "</a>"
　　dicSession("LastPage") = strAdd
　　dicSession("LastTime") = Now()
　　If dicSession("Pages") = "" Then
　　　　dicSession("Pages") = strAdd
　　Else
　　　　dicSession("Pages") = strAdd & vbTab & dicSession("Pages")
　　End If
　　Exit Sub
End Sub

%>
■sessions.asp : モニタ
Session モニタです。
dicSessions の内容を TABLE 形式に一覧表示しています。

このページが新たにSessionを作らないようにするため、、@ENABLESESSIONSTATE=False　を宣言しています。

<% @ENABLESESSIONSTATE=False%>
<% Response.Buffer = True %>
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.0//EN" "html.dtd">
<html>
<head>
<META NAME="AUTHOR" CONTENT="Yoshihiro Kawabata">
<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
<META NAME="MS.LOCALE" CONTENT="JA">
<meta http-equiv="REFRESH" CONTENT="60">
<title>セッションモニタ(リロード)</title>
<style>
th {font-size:10pt; }
td {font-size:10pt; }
</style>
<base target="_blank">
</head>

<body topmargin="0" leftmargin="0">
<%
　　Response.Flush
%>
<TABLE width="100%">
<TD BGCOLOR=#147CB5 ><FONT SIZE=-1 COLOR=#F8F7D9><B>セッション:<% = dicSessions.Count %></B></FONT></TD>
</TABLE>
<%
　　sTableOpen Array("カウンタ<br>SessionID" _
　　　　, "開始/最終" _
　　　　, "アドレス" _
　　　　, "UserAgent/Referer" _
　　　　, "履歴" _
　　　　)
　　Response.Flush
　　For Each strKey In dicSessions.Keys
　　　　If dicSessions.Exists(strKey) Then
　　　　　　If Not IsEmpty(dicSessions(strKey)) Then
　　　　　　　　With dicSessions(strKey)
　　　　　　　　　　'-- On Error Resume Next
　　　　　　　　　　strReferer = Trim(.Item("HttpReferer"))
　　　　　　　　　　strRefererSummary = Trim(.Item("HttpRefererSummary"))
　　　　　　　　　　If strReferer <> "" Then
　　　　　　　　　　　　If strRefererSummary = "" Then
　　　　　　　　　　　　　　strReferer = "<a href=""" & strReferer & """>" & strReferer & "</a>"
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　strReferer = "<a href=""" & strReferer & """>" & strRefererSummary & "</a>"
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　　　sTableLine Array( _
　　　　　　　　　　　　.Item("Visitor") & "<br>" & .Item("SessionID") _
　　　　　　　　　　　　, FormatDateTime(.Item("StartTime") , vbShortTime) _
　　　　　　　　　　　　 & " (" & GetDateTimeDiff(.Item("StartTime")) & "前)"_
　　　　　　　　　　　　 & "<BR>" & vbCrLf _
　　　　　　　　　　　　 & FormatDateTime(.Item("LastTime") , vbShortTime) _
　　　　　　　　　　　　 & " (" & GetDateTimeDiff(.Item("LastTime")) & "前)"_
　　　　　　　　　　　　, HtmlFromHost(.Item("RemoteHost")) & "<br>" & vbCrLf & .Item("RemoteAddr") _
　　　　　　　　　　　　, .Item("HttpUserAgent") & "<br>" & vbCrLf & strReferer _
　　　　　　　　　　　　, Replace(.Item("Pages"), vbTab, "<br>" & vbCrLf) _
　　　　　　　　　　　　) _
　　　　　　　　　　　　, Array( _
　　　　　　　　　　　　 "NOWRAP" _
　　　　　　　　　　　　, "NOWRAP" _
　　　　　　　　　　　　, "NOWRAP" _
　　　　　　　　　　　　, "" _
　　　　　　　　　　　　, "NOWRAP" _
　　　　　　　　　　　　)
　　　　　　　　　　On Error Goto 0
　　　　　　　　　　If Err <> 0 Then
　　　　　　　　　　　　Response.Write Err & ":" & Err.Description
　　　　　　　　　　End If
　　　　　　　　End With
　　　　　　End If
　　　　End If
　　　　Response.Flush
　　Next
　　sTableClose
　　
　　Response.Flush
%>

<%
'--- 一行出力
Sub WriteLine(strMessage)
　　Response.Write strMessage & "<BR>" & vbCrLf
End Sub

'--- RemoteHostにリンクをつけてHTMLに変換
Function HtmlFromHost(strHost)
　　HtmlFromHost = strHost
　　
　　
　　If strHost = "" Then
　　　　Exit Function
　　End If

　　aryHost = split(strHost, ".")
　　lngL = LBound(aryHost)
　　lngU = UBound(aryHost)
　　strA = aryHost(lngU)

　　If UBound(aryHost) > 2 And strcomp(strA, "jp", vbTextCompare) = 0 Then
　　　　strResult = ""
　　　　For lngP = lngL To lngU - 3
　　　　　　strResult = strResult & aryHost(lngP) & "."
　　　　Next
　　　　strLink = aryHost(lngU - 2) & "." & aryHost(lngU - 1) & "." & aryHost(lngU)
　　　　HtmlFromHost = strResult & "<A href=""http://www." & strLink & "/"">" & strLink & "</a>"
　　　　Exit Function
　　End If
　　
　　If UBound(aryHost) > 1 And strcomp(strA, "com", vbTextCompare) = 0 Then
　　　　strResult = ""
　　　　For lngP = lngL To lngU - 2
　　　　　　strResult = strResult & aryHost(lngP) & "."
　　　　Next
　　　　strLink = aryHost(lngU - 1) & "." & aryHost(lngU)
　　　　HtmlFromHost = strResult & "<A href=""http://www." & strLink & "/"">" & strLink & "</a>"
　　　　Exit Function
　　End If
　　
End Function

'--- 時間差分
Function GetDateTimeDiff(dtmValue)
　　Dim lngM, lngH, lngD
　　
　　GetDateTimeDiff = ""
　　lngS = DateDiff("s", dtmValue, Now)
　　If lngS < 60 Then
　　　　GetDateTimeDiff = lngS & " 秒"
　　　　Exit Function
　　End If

　　lngM = DateDiff("n", dtmValue, Now)
　　If lngM < 60 Then
　　　　GetDateTimeDiff = lngM & " 分"
　　　　Exit Function
　　End If

　　lngH = DateDiff("h", dtmValue, Now)
　　If lngH < 24 Then
　　　　GetDateTimeDiff = lngH & " 時間"
　　　　Exit Function
　　End If

　　lngD = DateDiff("d", dtmValue, Now)
　　GetDateTimeDiff = lngD & " 日"
End Function

'--- テーブル開始
Sub sTableOpen(aryValue)
　　Response.Write "<Table border=""1"" width=""98%"">"
　　If IsArray(aryValue) Then
　　　　Response.Write "<TR>"
　　　　For lngN = LBound(aryValue) To UBound(aryValue)
　　　　　　Response.Write "<TH bgcolor=""#DDDA4A"" NOWRAP>" & aryValue(lngN) & "</TH>"
　　　　Next
　　　　Response.Write "</TR>"
　　　　Response.Write vbCrLf
　　End If
End Sub

'--- テーブル行
Sub sTableLine(aryValue, aryAttr)
　　Dim strAttr
　　
　　If IsArray(aryValue) Then
　　　　Response.Write "<TR>"
　　　　For lngN = LBound(aryValue) To UBound(aryValue)
　　　　　　strAttr = aryAttr(lngN)
　　　　　　varValue = aryValue(lngN)
　　　　　　varValue = Trim(CStr(varValue))
　　　　　　If varValue = "" Then
　　　　　　　　varValue = " "
　　　　　　End If
　　　　　　If IsNumeric(varValue) Then
　　　　　　　　Response.Write "<TD " & strAttr & " align=""Right"" valign=""top"">" & varValue & "</TD>"
　　　　　　Else
　　　　　　　　Response.Write "<TD " & strAttr & " valign=""top"">" & varValue & "</TD>"
　　　　　　End If
　　　　Next
　　　　Response.Write "</TR>"
　　　　Response.Write vbCrLf
　　End If
End Sub

'--- テーブル終了
Sub sTableClose()
　　Response.Write "</Table>"
　　Response.Write vbCrLf
End Sub
%>
</html>
■redirect.asp : リンク先へのリダイレクト
他のサイトへリンクについては、 <a href="/redirect.asp?Title=xxxxx&URL=http://xxxx/xxxx">xxxxx</a> という形式にすることにより、 他のサイトへ飛んでいったことを、履歴に保存するようにしています。

<!-- #include virtual="/dicSessionInc.asp" -->

<%
strURL = Trim(Request("URL"))
strTitle = Trim(Request("TITLE"))
If strTitle = "" Then
　　strTitle = strURL
End If
If strURL <> "" Then
　　dicSessionAddPageUrl "→ " & strTitle, strUrl
　　Response.Redirect strURL
　　Response.End
End If
%>
リダイレクト先が指定されていません
■実際にやってみて、おもしろかったこと
今は、一日、これをVAIOノートで表示して、見ています。

「お客さん」
「あ、入ってきた」
「ふむふむ、メーリングリストのログをみてくれたのですね」
「あー、お客さん、こっちも、みていってよ」

て状況です。
いままで、自分のWWWサイトは、
「どこかの軒先に置かせてもらった、自動販売機」
あるいは、
「アルバイトにまかせている、コンビニ」
のように、
来客集計や統計は、わかるけど、もうひとつ、なんか
お客様の顔が見えないなぁ。
という思いがありましたが、

モニタをみていると、
「自分の店のカウンタにたっている」
ように、思えます。

イントラネットでも、インターネット上のサイトでも、
このような「感覚」が必要だなと思っています。

最近は、このモニタをみながら、あー、こんなことも必要だとか、
思いついてみたり、
更新しようという「やる気」が沸いてきたりしています。
■細かな修正
まだ、ときどき、テーブルへの出力中にとまることがあります。

html ファイルへのアクセスには、対応できていません。
<img src="/logo.asp"> なととして、
logo.asp は、なにかロゴでも表示するとともに、
dicSession を更新すればいいかと考えています。

ページの中にケイサイしている他のサイトへリンクについては、
<a href="/redirect.asp?Title=xxxxx&URL=http://xxxx/xxxx">xxxxx</a>
という形式にすることにより、
他のサイトへ飛んでいったことを、履歴に保存するようにしています。

ロボットからのアクセスは、セッションを爆発させます。
ちょうど今朝、動作に無駄のある検索ロボットがうちのサイトにきて、
すべてのリンクをたどったのですが、一時的にセッション数が、400を超えまし
た。
対策として、HTTP_USER_AGENT よりロボットを検出して、
ロボットの場合は、Session_OnStart の最後に Session.Abandon を
実行することにより、対処しました。

HTTP_REFERER をみると、検索エンジンからのアクセスである場合が多くありま
す。
このHTTP_REFERER より、どのようなキーワードで検索されたのかを
自動的に分析して、表示するようにしました。
この対応として、KawabataCom_Url.wsc を開発し、組み込みました。
■検討中
どなたか、解析関数をつくられていませんでしょうか ?
メジャーな検索ポータルには、比較的簡単に対応できるかと考えています。
■備考
とりあえず、あまりアクセス負荷の高くないサイトには、このような実装でも
問題ないのではないかと思います。
まだまだ、完全ではないのですが、いかがでしょうか。
拡張性、完全性を考えれば、ISAPI フィルタとして実装したほうがいいかと思って
います。
作成:河端
Hotmail,MSN Messanger:YoshihiroKawabata
参照:
管理:/sessionmonitor.asp
　　 管理ツール