静的コンテンツに埋め込めるアクセスカウンタ (unibon)

2000年01月12日: 新規作成。
2001年06月16日: 実際に稼動しているサーバへのアクセス例を追加。
2002年09月02日: 軽微な修正(クロスブラウザに関する文章を削除)。

静的コンテンツ(ASP でない HTML)に、IMG タグでアクセスカウンタを実現します。
ASP でアクセスカウンタを実現するのは非常に簡単です。しかし、アクセスカウンタの形態で良くあるものとして、(ASP や CGI ではなく)静的コンテンツである HTML に、IMG タグだけでアクセスカウンタを埋め込む際に、埋め込まれるものを ASP で実現するのは、難しいです。
本来は、1桁用の画像ファイルをカウンタの桁数だけ連結してひとつの画像ファイルに加工する必要があります。しかし、簡易的なやりかたとしては、IMG タグを桁数分だけ用意しておき、現在のカウンタに応じて、各桁の IMG タグの画像を変化させる方法があります。
これは、厳密には常に正しい表示ができず、アクセスが集中した場合は、誤った表示をする場合がありますが、画像ファイルの加工が不要なので、比較的容易に実現できます。
なお、準備としては、以下の設定が必要です。

OpenTextFile が3箇所ありますが、最初の OpenTextFile の第1(1 から数えて)引数には、1桁の数字をあらわす画像ファイル(GIF/JPEG)を置く、フォルダのパスを指定します。
上記で指定したフォルダの中に 0.gif ～ 9.gif までの10個の画像ファイルを置きます。
後ろの2つ OpenTextFile の第1(1 から数えて)引数には、カウント数を記録したテキストファイル名を指定します。なお、ファイルはなくても構いません。ない場合は自動的に作成されます。

あと、画像ファイルをバイナリファイルとして読み込むために、多少小細工をしています。できれば、画像ファイルの容量は 2 の倍数のバイト数のほうが好ましいですが、とくにこうでなくても大丈夫のようです。もしくは、バイナリファイルを扱える外部コンポーネントを使用する方法もあるでしょう。
(2001年06月16日追加: スクリプトエンジン(VBScrip)のバージョンが古すぎると、OpenTextFile メソッドでのバイナリファイルの読み込みがうまくできないようです。IIS や ASP のバージョンとは無関係に VBScript のバージョンのみをバージョンアップすれば良いでしょう。)

2001年06月16日追加:
実際に、このページにこのアクセスカウンタを埋め込んであります(なお都合によりサーバが動いていない時もあります)。

あなたは番目のアクセスです。

使用例(アクセスカウンタを埋め込む静的コンテンツ):

<HTML>
<HEAD>
<TITLE>Access Counter</TITLE>
</HEAD>
<BODY>
あなたは
<IMG SRC=counter.asp?col=4>
<IMG SRC=counter.asp?col=3>
<IMG SRC=counter.asp?col=2>
<IMG SRC=counter.asp?col=1>
<IMG SRC=counter.asp?col=0>
番目のアクセスです。
</HTML>

アクセスカウンタ本体(counter.asp):

<%@Language=VBScript EnableSessionState=False%><%
Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Const TristateUseDefault = -2
Const TristateTrue = -1 ' Unicode
Const TristateFalse = 0 ' ASCII

Dim o
Set o = Server.CreateObject("Scripting.FileSystemObject")

If IsEmpty(Application("gifs")) Then
    Dim n
    n = Array("0.gif", "1.gif", "2.gif", "3.gif", "4.gif", "5.gif", "6.gif", "7.gif", "8.gif", "9.gif")

    Dim g(9)
    Dim i
    For i = 0 To 10 - 1
        Dim f
        Set f = o.OpenTextFile("c:\web\counter\" & n(i), ForReading, False, TristateTrue)
        g(i) = f.Read(100000)
        Call f.Close()
        Set f = Nothing
    Next

    Application("gifs") = g
End If

Call Application.Lock()
On Error Resume Next
Dim x
Set x = o.OpenTextFile("c:\web\counter\counterinst.txt", ForReading, False, TristateUseDefault)
Dim s
If Err.Number = 0 Then
    s = x.ReadLine()
    Application("counter") = CLng(s)
    Call x.Close()
ElseIf Err.Number = 53 Then ' ファイルが見つかりません。
    On Error GoTo 0
    Application("counter") = CLng(1) ' 1 オリジンの場合。
Else
    Dim e
    e = Err.Number
    On Error GoTo 0
    Call Err.Raise(e)
End If
Set x = Nothing
Call Application.Unlock()

Dim col
col = CLng(Request.QueryString("col"))

Dim c
c = CLng(Left(Right("0000000000" & CStr(Application("counter")), col + 1), 1))

Response.ContentType = "image/gif"
Call Response.BinaryWrite(Application("gifs")(c))

If col = 0 Then
    Call Application.Lock()
    Application("counter") = Application("counter") + 1
    Set x = o.OpenTextFile("c:\web\counter\counterinst.txt", ForWriting, True, TristateUseDefault)
    Call x.WriteLine(CStr(Application("counter")))
    Call x.Close()
    Set x = Nothing
    Call Application.Unlock()
End If

Set o = Nothing
%>

ASP の目次
ホーム
(このページ自身の絶対的な URL)