<% option Explicit %> <% Response.Buffer = True %> <% '################################################ ' 名称 :共通変数・関数の定義 ' 作成日 :2008/10/29 ' 作成者 :小野 '################################################ %> <% Dim GB_IEmode GB_IEmode = "" 'EdgeのIEモードは「MSIE」文字が無いので「Trident」文字で判定 If InStr(Request.ServerVariables("HTTP_USER_AGENT"), "; MSIE ") > 1 Or InStr(Request.ServerVariables("HTTP_USER_AGENT"), "Trident") > 1 Then GB_IEmode = "1" Else 'MailCheckInterval = 86400 'IEモードでない場合は受発信文書チェック間隔を延ばして実質無効化 MailCheckInterval = 1111 'IEモードでない場合は受発信文書チェック間隔をセッションが切れない20分未満間隔に延ばす End If Response.AddHeader "Content-Type", "text/html; charset=Shift_JIS" '文字化け対策 If GB_IEmode = "1" Then Response.AddHeader "X-UA-Compatible", "IE=5" End If Session.Timeout = 1440 Server.ScriptTimeout = 1200 'ホームエイリアスを取得する(090909小野) Dim HomeAlias 'ホームエイリアス名格納変数 Dim HomeAliasAry '環境変数SCRIPT_NAMEを分解格納する配列 Dim HomeAliasCnt 'ループカウンタ HomeAlias = Request.ServerVariables("SCRIPT_NAME") HomeAliasAry = Split(HomeAlias, "/") For HomeAliasCnt = 0 To UBound(HomeAliasAry) 'SCRIPT_NAMEの先頭にスラッシュが複数入ってるとブランク配列が生じるので文字列を探す If "" & HomeAliasAry(HomeAliasCnt) <> "" Then HomeAlias = HomeAliasAry(HomeAliasCnt) Exit For End If Next Dim HomeAliasSL 'ホームエイリアス名格納変数(前後スラッシュ付き) HomeAliasSL = "/" & HomeAlias & "/" Dim SQLConn SQLConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & DBUser & ";Password=" & DBPass & ";Initial Catalog=" & DBName & ";Data Source=" & SQLServer 'グローバル変数の生成 Dim MES_AppCD MES_AppCD = Session("MES_AppCD") Dim MES_SystemCD MES_SystemCD = Session("MES_SystemCD") Dim MES_DBName MES_DBName = Session("MES_DBName") Dim MES_DBUser MES_DBUser = Session("MES_DBUser") Dim MES_DBPass MES_DBPass = Session("MES_DBPass") Dim MES_Admin MES_Admin = Session("MES_Admin") 'Adminフラグ整数化 If "" & MES_Admin = "" Then MES_Admin = 0 ElseIf Not(IsNumeric("" & MES_Admin)) Then MES_Admin = 0 Else MES_Admin = CInt(MES_Admin) End If Dim MES_ForceEnshu MES_ForceEnshu = Session("MES_ForceEnshu") Dim MES_Enshu MES_Enshu = Session("MES_Enshu") Dim MES_Group MES_Group = Session("MES_Group") Dim MES_User MES_User = Session("MES_User") Dim MES_KanriID MES_KanriID = Session("MES_KanriID") '呼び出し元アプリのデータベースの接続文字列 Dim APLConn APLConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & MES_DBUser & ";Password=" & MES_DBPass & ";Initial Catalog=" & MES_DBName & ";Data Source=" & SQLServer Dim HtmlFooter HtmlFooter = "" HtmlFooter = HtmlFooter & "" & vbCrLf Function SessionCheck() If "" & Session("MES_Admin") = "" Or ("" & Session("MES_Admin") = "2" And "" & Session("MES_Enshu") = "") Or ("" & Session("MES_Admin") = "0" And "" & Session("MES_User") = "") Then Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & AppTitle & "" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("
" & vbCrLf) Response.Write("  タイムアウトしたか、不正なページ表示です。
") Response.Write("  閉じる

") Response.Write("  システムCD:" & Session("MES_SystemCD") & "
" & vbCrLf) Response.Write("  アプリケーションCD:" & Session("MES_AppCD") & "
" & vbCrLf) Response.Write("  データベース名:" & Session("MES_DBName") & "
" & vbCrLf) Response.Write("  データベースユーザー:" & Session("MES_DBUser") & "
" & vbCrLf) Response.Write("  データベースパスワード:" & Session("MES_DBPass") & "
" & vbCrLf) Response.Write("  管理者識別:" & Session("MES_Admin") & "
" & vbCrLf) Response.Write("  演習コード:" & Session("MES_Enshu") & "
" & vbCrLf) Response.Write("  ユーザーID:" & Session("MES_User") & "
" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) SessionCheck = false Else SessionCheck = True End If End Function Function TimeUniq() Dim MonthDay(12),ii,mtmp MonthDay(1) = 31 '月別日数配列 MonthDay(2) = 28.25 MonthDay(3) = 31 MonthDay(4) = 30 MonthDay(5) = 31 MonthDay(6) = 30 MonthDay(7) = 31 MonthDay(8) = 31 MonthDay(9) = 30 MonthDay(10) = 31 MonthDay(11) = 30 MonthDay(12) = 31 ii = 1 mtmp = 0 Do While ii < Month(Now) mtmp = mtmp + MonthDay(ii) '1/1〜前月末までの日数を算出 ii = ii + 1 Loop TimeUniq = (((Year(Now)-1)*365.25+mtmp+(Day(Now)-1))*24*60*60+Timer())*10000 End Function '※ModeにCSSファイル名を指定できる。複数指定時はセミコロン区切り。 Function HtmlHeader(Mode) 'Mode引数の前後にセミコロンを付加(InStr判定のため) Mode = ";" & Mode & ";" Dim Kaisou Kaisou = "" Dim TmpScriptName '環境変数SCRIPT_NAMEを分解格納する配列 Dim Cnt 'ループカウンタ Dim TmpCnt 'カーソルカウンタ TmpCnt = 0 TmpScriptName = Request.ServerVariables("SCRIPT_NAME") TmpScriptName = Split(TmpScriptName, "/") 'HomeAliasを探す For Cnt = 0 To UBound(TmpScriptName) If "" & TmpScriptName(Cnt) = HomeAlias Then TmpCnt = Cnt Exit For End If Next 'HomeAliasより下の階層数を相対パスにする TmpCnt = TmpCnt + 1 For Cnt = TmpCnt To UBound(TmpScriptName) 'ファイルが見付かったら終了 If InStr("" & TmpScriptName(Cnt), ".") > 0 Then Exit For End If Kaisou = Kaisou & "../" Next HtmlHeader = "" HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf '日本語指定 HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf If InStr(Mode, ";-messenger;") < 1 Then 'マイナス指定の場合のみmessenger.cssを除外する HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboblack;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboblack11;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboblackPRT09;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboblacks;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyobored;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyobored1;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyobored2;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyobored11;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboredPRT09;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboredPRT10;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If InStr(Mode, ";sj3tyoboreds;") > 0 Then HtmlHeader = HtmlHeader & "" & vbCrLf End If If Mode = ";Calc;" Then HtmlHeader = HtmlHeader & "電卓" & vbCrLf Else HtmlHeader = HtmlHeader & "" & AppTitle & "" & vbCrLf End If HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf ' HtmlHeader = HtmlHeader & "" & vbCrLf ' HtmlHeader = HtmlHeader & "" & vbCrLf ' HtmlHeader = HtmlHeader & "" & vbCrLf ' HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf If InStr(Mode, ";Chart;") > 0 Then 'チャートライブラリを読み込む ' HtmlHeader = HtmlHeader & "" & vbCrLf HtmlHeader = HtmlHeader & "" & vbCrLf End If HtmlHeader = HtmlHeader & "" & vbCrLf End Function Function HtmlDesign(i) If i = 11 Then HtmlDesign = "" HtmlDesign = HtmlDesign & "" & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & "
 Messenger 
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & "
 
 
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & " " & vbCrLf HtmlDesign = HtmlDesign & "   " & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf HtmlDesign = HtmlDesign & "
" & vbCrLf End If End Function Function HttpL3_1(btn1,btn1c, btn2, btn2c, btn3, btn3c, btn4, btn4c, btn5, btn5c) HttpL3_1 = "" HttpL3_1 = HttpL3_1 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf If btn1 <> "" Then HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf End If If btn2 <> "" Then HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf End If If btn3 <> "" Then HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf End If If btn4 <> "" Then HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf End If If btn5 <> "" Then HttpL3_1 = HttpL3_1 & " " & vbCrLf End If HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & "
" & btn1 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & "
 " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & "
" & btn2 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & "
 " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & "
" & btn3 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & "
 " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & "
" & btn4 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & "
 " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & " " & vbCrLf HttpL3_1 = HttpL3_1 & "
" & btn5 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & "
" & vbCrLf HttpL3_1 = HttpL3_1 & "
" & vbCrLf End Function Function HttpL4 (title1, title2) HttpL4 = "" HttpL4 = HttpL4 & "
" If title2 = "" Then HttpL4 = HttpL4 & title1 ElseIf Len(title2) <= 3 Then HttpL4 = HttpL4 & title1 & " <" & title2 & ">" Else HttpL4 = HttpL4 & title1 & " <" & title2 & ">" End If HttpL4 = HttpL4 & "" & vbCrLf HttpL4 = HttpL4 & "
" & vbCrLf End Function %>