<% '################################################ ' 名称 :ダウンロードダイアログ ' 作成日 :2008/1/21 ' 作成者 :小野 ' 目的 :ダウンロードダイアログを開く ' 概要 : '################################################ %> <% main() Sub main Dim Query Dim Content Dim FileName FileName = Request("FileName") Dim SystemCD SystemCD = Request("SystemCD") Dim TmpLoginID TmpLoginID = Request("TmpLoginID") Dim TmpShukei TmpShukei = Request("TmpShukei") Dim FromYmd FromYmd = Request("FromYmd") Dim ToYmd ToYmd = Request("ToYmd") Dim FilePath FilePath = "./Temp/" Dim objFSO Set objFSO = CreateObject("Scripting.FileSystemObject") Dim objTS If TmpShukei = "" Then 'ログインID一覧 Set objTS = objFSO.OpenTextFile(Server.MapPath(FilePath & FileName), 2, True) '2=上書き専用:True=無ければ新規作成 objTS.Write("接続日時") 'システム名称トグル If SystemCD = "" Then objTS.Write(",アプリケーション") End If objTS.Write(",ログインID,パスワード,接続元IPアドレス,接続の成否" & vbCrLf) objTS.Close Set objTS = objFSO.OpenTextFile(Server.MapPath(FilePath & FileName), 8, True) '8=追記専用:True=無ければ新規作成 Query = "exec SP0アクセスログ一覧 '" & SystemCD & "'" Query = Query & ", '" & TmpLoginID & "'" 'ログインID If FromYmd <> "" Then Query = Query & ", '" & FromYmd & " 00:00:00'" '集計開始日 Else Query = Query & ", '1753/01/01 12:00:00.00'" End If If ToYmd <> "" Then Query = Query & ", '" & ToYmd & " 23:59:59.99'" '集計終了日 Else Query = Query & ", '9999/12/31 23:59:59.99'" End If Set Content = OpenQuery(Query) Do While Not(Content.EOF Or Content.EOF) objTS.Write(Content.Fields("ログイン試行日時")) 'システム名称トグル If SystemCD = "" Then objTS.Write("," & Content.Fields("システム名称")) End If objTS.Write("," & Content.Fields("ログインID") & "," & Content.Fields("ログインパスワード") & "," & Content.Fields("リモートアドレス") & "," & Content.Fields("ユーザー区分") & vbCrLf) Content.MoveNext Loop objTS.Close Else '集計一覧 Dim ShukeiMeisho Query = "" Query = Query & " SELECT * " Query = Query & " FROM TA区分 " Query = Query & " WHERE 分類 = '集計区分' " Query = Query & " AND 区分 = '" & TmpShukei & "' " Set Content = OpenQuery(Query) If Not(Content.EOF Or Content.EOF) Then ShukeiMeisho = Content.Fields("名称") End If Set objTS = objFSO.OpenTextFile(Server.MapPath(FilePath & FileName), 2, True) '2=上書き専用:True=無ければ新規作成 objTS.Write(ShukeiMeisho & ",回数" & vbCrLf) objTS.Close Set objTS = objFSO.OpenTextFile(Server.MapPath(FilePath & FileName), 8, True) '8=追記専用:True=無ければ新規作成 Query = "exec SP0アクセスログ集計 '" & SystemCD & "'" Query = Query & ", '" & TmpShukei & "'" '集計区分 If FromYmd <> "" Then Query = Query & ", '" & FromYmd & " 00:00:00'" '集計開始日 Else Query = Query & ", '1753/01/01 12:00:00.00'" End If If ToYmd <> "" Then Query = Query & ", '" & ToYmd & " 23:59:59.99'" '集計終了日 Else Query = Query & ", '9999/12/31 23:59:59.99'" End If Set Content = OpenQuery(Query) Do While Not(Content.EOF Or Content.EOF) objTS.Write(Content.Fields("集計名称") & "," & Content.Fields("集計回数") & vbCrLf) Content.MoveNext Loop objTS.Close End If 'ContentType指定でクライアントにダウンロードダイアログを開かせる Response.Expires = 0 Response.Buffer = TRUE Response.Clear Response.Charset = "shift_jis" Response.ContentType = "application/octet-stream; name=" & FileName Response.AddHeader "Content-Disposition", "attachment; filename=" & FileName Dim objBASP Dim objBinary Set objBASP = Server.CreateObject("Basp21") objBinary = objBASP.BinaryRead(Server.MapPath(FilePath & FileName)) Set objBASP = Nothing Response.AddHeader "Content-Length", UBound(objBinary) + 1 Response.BinaryWrite objBinary End Sub %>