<% ' ==================================================================== ' スーパー実践くん4WebCollabo ' ' 共通関数群 for VBScript ' File Name : include_func.asp ' --Update Information------------------------------------------------ ' Version : V0.01 ' Developer : Takeshi Yamazaki <2002/08/09(Fri)> ' -------------------------------------------------------------------- ' Version : V0.02 ' Developer : Shinichirou Onuma <2005/07/11(Mon)> ' -------------------------------------------------------------------- ' ==================================================================== %> <% ' -------------------------------------------------------------------- ' 00. デバッグ用表示 ' -------------------------------------------------------------------- ' 戻り値 ' 引数 ' : ' -------------------------------------------------------------------- Function DebugResponse(DebugName,DebugStr) Response.Write("" & vbCrLf) Response.Write(DebugName & " = " & DebugStr & vbCrLf) Response.Write("" & vbCrLf) End Function ' -------------------------------------------------------------------- ' 00. セッションの有効期限が切れていないかをチェックする ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 不正・タイムアウト ' 正 : 正常セッション ' 引数 ' : ' -------------------------------------------------------------------- Function SessionCheck() Dim TmpHeader TmpHeader = "" TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "
" & vbCrLf Dim TmpHeaderUser TmpHeaderUser = "" TmpHeaderUser = TmpHeaderUser & "" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) SessionCheck = false ElseIf Session(DBName & "Admin") = "0" Then 'マスター照会は社長室から利用するので運用管理判定から除外 If InStr(UCase(Request.ServerVariables("URL")), UCase("/" & HomeAlias & "/admin")) > 0 And InStr(UCase(Request.ServerVariables("URL")), UCase("/" & HomeAlias & "/admin/master")) = 0 And InStr(UCase(Request.ServerVariables("URL")), UCase("/" & HomeAlias & "/admin/enshu")) = 0 Then Response.Write(TmpHeader) Response.Write("　　このPCによる運用管理者ログインが許可されていないか
") Response.Write("　　もしくは運用管理者セッションがタイムアウトしています。
") Response.Write("　　
") Response.Write("　　運用管理者セッションがタイムアウトした場合は
") Response.Write("　　一旦ウィンドウを閉じた後にアイコンから開き直してください。
") Response.Write("　　
") If GB_IEmode = "1" Then 'Edgeではログオフ後に閉じるボタンが反応しない Response.Write("　　閉じる") End If Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) SessionCheck = false Else Dim Query Dim Content Dim KurikoshiFlg KurikoshiFlg = 0 Query = "exec SPM会社取得 '" & GB_SystemCD & "', '" & GB_EnshuCD & "', '" & GB_KaisyaCD & "'" Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) If Content.Fields("会社CD") = GB_KaisyaCD Then If "" & Content.Fields("次演習繰越フラグ") = "1" Then KurikoshiFlg = 1 Exit Do End If End If Content.MoveNext Loop If KurikoshiFlg = 1 And Session(HomeAlias & "AutoLoginButton") <> "1" Then '運用管理オートログインは除外 Query = "exec SPM演習取得 '" & GB_SystemCD & "', '" & GB_EnshuCD & "'" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then Response.Write(TmpHeader) Response.Write("　　この会社は次期演習へ期末繰越処理されました。

") Response.Write(TmpHeaderUser) Response.Write("if(bClose == 1)document.write(""　　閉じる"")" & vbCrLf) Response.Write("else document.write(""　　次期演習へ移動する"")" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) SessionCheck = false Else Response.Write(TmpHeader) Response.Write("　　タイムアウトしたか、不正なページ表示です。
") Response.Write("　　ログインし直して下さい。

") Response.Write(TmpHeaderUser) Response.Write("if(bClose == 1)document.write(""　　閉じる"")" & vbCrLf) Response.Write("else document.write(""　　ログインページ"")" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) SessionCheck = false End If Else SessionCheck = True End If End If Else SessionCheck = True '運用管理は此処 End If End Function ' -------------------------------------------------------------------- ' 00. クエリ発行 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : エラー発生 ' 正 : 項目の件数 ' 引数 ' F_Query : クエリ文 ' -------------------------------------------------------------------- Function OpenQuery(F_Query) Set db = Server.CreateObject("ADODB.Connection") db.ConnectionTimeout = 60 db.CommandTimeout = 60 db.Open SQLConn Set OpenQuery = ExecQuery(db, F_Query) End Function Sub CloseQuery() db.close Set db = Nothing Set Content = Nothing End Sub Function OpenQuery2(q) Set OpenQuery2 = OpenQuery(q) End Function Function InitQuery() Dim db1 Set db1 = Server.CreateObject("ADODB.Connection") db1.Open SQLConn Set InitQuery = db1 End Function Function ExecQuery(db1, F_Query) 'データベースエラー表示機能追加（090609小野） On Error Resume Next Err.Clear() Set Content = db1.Execute(F_Query) If Err.Description <> "" Then Response.Write("データベースへの接続でエラーが発生しました


") Response.Write("メッセージ ： " & Err.Description & "

") Response.Write("送信クエリ ： " & F_Query & "


") Exit Function End If On Error Goto 0 Do While Not Content Is Nothing If Content.Fields.Count > 0 Then Exit Do End If 'データベースエラー表示機能追加（100526小野） On Error Resume Next Err.Clear() Set Content = Content.NextRecordSet() If Err.Description <> "" Then Response.Write("データベースへの接続でエラーが発生しました


") Response.Write("メッセージ ： " & Err.Description & "

") Response.Write("送信クエリ ： " & F_Query & "


") Exit Function End If On Error Goto 0 ' Set Content = Content.NextRecordSet() Loop Set ExecQuery= Content End Function Function DebugQuery(F_Query) If Request.ServerVariables("SERVER_NAME") = "Eagle-Dev" Then Response.Write(F_Query) Response.Write("
" & vbCrLf) End If End Function ' -------------------------------------------------------------------- ' 00. クエリ発行(Webcolabo) ' -------------------------------------------------------------------- ' 戻り値 ' 負 : エラー発生 ' 正 : 項目の件数 ' 引数 ' F_Query : クエリ文 ' -------------------------------------------------------------------- Function OpenQuery3(F_Query) Set db = Server.CreateObject("ADODB.Connection") db.ConnectionTimeout = 60 db.CommandTimeout = 60 db.Open TvConn Set OpenQuery3 = ExecQuery3(db, F_Query) End Function Sub CloseQuery3() db.close Set db = Nothing Set Content = Nothing End Sub Function InitQuery3() Dim db1 Set db1 = Server.CreateObject("ADODB.Connection") db1.Open TvConn Set InitQuery3 = db1 End Function Function ExecQuery3(db1, F_Query) Set Content = db1.Execute(F_Query) Do While Not Content Is Nothing If Content.Fields.Count > 0 Then Exit Do End If Set Content = Content.NextRecordSet() Loop Set ExecQuery3= Content End Function Function DebugQuery3(F_Query) If Request.ServerVariables("SERVER_NAME") = "Eagle-Dev" Then Response.Write(F_Query) Response.Write("
" & vbCrLf) End If End Function ' -------------------------------------------------------------------- ' 00. フラグからフラグ名称に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : フラグ名称 ' 引数 ' F_Flag : ' F_Type : ' -------------------------------------------------------------------- Function ConvFlagMeisyo(F_Flag, F_Type) If F_Flag = 1 Or F_Flag = "1" Then If F_Type = 1 Then ConvFlagMeisyo = "○" ElseIf F_Type = 2 Then ConvFlagMeisyo = "済" ElseIf F_Type = 3 Then ConvFlagMeisyo = "" ElseIf F_Type = 4 Then ConvFlagMeisyo = "×" ElseIf F_Type = 5 Then ConvFlagMeisyo = "済" ElseIf F_Type = 6 Then ConvFlagMeisyo = "済" End If Else If F_Type = 1 Then ConvFlagMeisyo = "×" ElseIf F_Type = 2 Then ConvFlagMeisyo = "未" ElseIf F_Type = 3 Then ConvFlagMeisyo = "×" ElseIf F_Type = 4 Then ConvFlagMeisyo = "" ElseIf F_Type = 5 Then ConvFlagMeisyo = "未発信" ElseIf F_Type = 6 Then ConvFlagMeisyo = "未発信" End If End If End Function ' -------------------------------------------------------------------- ' 00. 日付の文字列を解析・指定書式に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' F_DispType 1:YYYY/MM/DD ' 2:YYYY年MM月DD日 ' 3:HYY年MM月DD日 ' -------------------------------------------------------------------- Function SetDate(F_Target, F_DispType) Dim DateStr '日付文字列 Dim CheckFlg ' Dim Nen '年 Dim Tsuki '月 Dim Hi '日 Dim TargetDate Dim ParseDate Dim TargetDate2 Dim Nen2 '年 Dim Tsuki2 '月 Dim Hi2 '日 Dim Query Dim Content Dim GengoNameAry Dim GengoDateAry ReDim GengoNameAry(0) ReDim GengoDateAry(0) DateStr = ReplaceSpace(F_Target) If DateStr <> "" Then '元号配列作成（171031小野） Query = " SELECT * FROM TC9元号M WHERE システムCD = '" & GB_SystemCD & "' ORDER BY 開始日 DESC " Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) If "" & Content.Fields("元号") <> "" And "" & Content.Fields("開始日") <> "" Then ReDim PreServe GengoNameAry(UBound(GengoNameAry) + 1) '配列+1 ReDim PreServe GengoDateAry(UBound(GengoDateAry) + 1) '配列+1 GengoNameAry(UBound(GengoNameAry)) = "" & Content.Fields("元号") GengoDateAry(UBound(GengoDateAry)) = Content.Fields("開始日") 'Dateオブジェクト型 End If Content.MoveNext Loop CheckFlg = true DateStr = Replace(DateStr, "年", "/") DateStr = Replace(DateStr, "月", "/") DateStr = Replace(DateStr, "日", "") ParseDate = Split(DateStr, "/") Nen = ParseDate(0) Tsuki = ParseDate(1) Hi = ParseDate(2) 'DateStrに元号が含まれる場合の変換処理（通常は利用されない） If InStr(Nen, "平成") > 0 Then Nen = Int(Replace(Nen, "平成", "")) Nen = Nen + 1988 ElseIf InStr(Nen, "昭和") > 0 Then Nen = Int(Replace(Nen, "昭和", "")) Nen = Nen + 1925 ElseIf InStr(Nen, "大正") > 0 Then Nen = Int(Replace(Nen, "大正", "")) Nen = Nen + 1911 ElseIf InStr(Nen, "明治") > 0 Then Nen = Int(Replace(Nen, "明治", "")) Nen = Nen + 1867 End If 'DateStrに元号が含まれる場合の変換処理（通常は利用されない） Nen = Int(Nen) Tsuki = Int(Tsuki) Hi = Int(Hi) TargetDate = DateSerial(Nen, Tsuki, Hi) TargetDate2 = DateSerial(Nen, Tsuki, Hi + 1) Nen2 = Year(TargetDate2) Tsuki2 = Month(TargetDate2) Hi2 = Day(TargetDate2) If Not(IsNumeric(Nen)) Then CheckFlg = false End If If Not(IsNumeric(Tsuki)) Then CheckFlg = false End If If Not(IsNumeric(Hi)) Then CheckFlg = false End If If Nen < 1900 Or 2100 < Nen Then CheckFlg = false End If If Tsuki < 1 Or 12 < Tsuki Then CheckFlg = false End If If Hi < 1 Or 31 < Hi Then CheckFlg = false End If If CheckFlg = false Then Exit Function End If If F_DispType < 8 Then If Len(Tsuki) = 1 Then Tsuki = "0" & CStr(Tsuki) End If If Len(Hi) = 1 Then Hi = "0" & CStr(Hi) End If End If If F_DispType = 1 Then SetDate = Nen & "/" & Tsuki & "/" & Hi ElseIf F_DispType = 2 Then SetDate = Nen & "年" & Tsuki & "月" & Hi & "日" ElseIf F_DispType = 3 Then '元号配列から和暦に変換（171031小野） Dim Cnt For Cnt = 1 To UBound(GengoDateAry) If TargetDate >= GengoDateAry(Cnt) Then Nen = Nen - (Year(GengoDateAry(Cnt)) - 1) Nen = GengoNameAry(Cnt) & CStr(Nen) Exit For End If Next SetDate = Nen & "年" & Tsuki & "月" & Hi & "日" ElseIf F_DispType = 8 Then '期末日 If Tsuki2 <> "1" Or Hi2 <> "1" Then SetDate = "翌年" End If SetDate = SetDate & Tsuki & "月" & Hi & "日" ElseIf F_DispType = 9 Then '期首日 SetDate = Tsuki2 & "月" & Hi2 & "日" End If End If End Function '西暦年月日から元号のみを取得 Function SetGengo(F_Target) Dim DateStr '日付文字列 Dim CheckFlg ' Dim Nen '年 Dim Tsuki '月 Dim Hi '日 Dim TargetDate Dim ParseDate Dim TargetDate2 Dim Nen2 '年 Dim Tsuki2 '月 Dim Hi2 '日 Dim Query Dim Content DateStr = ReplaceSpace(F_Target) If DateStr <> "" Then CheckFlg = true DateStr = Replace(DateStr, "年", "/") DateStr = Replace(DateStr, "月", "/") DateStr = Replace(DateStr, "日", "") ParseDate = Split(DateStr, "/") Nen = ParseDate(0) Tsuki = ParseDate(1) Hi = ParseDate(2) 'DateStrに元号が含まれる場合の変換処理（通常は利用されない） If InStr(Nen, "平成") > 0 Then Nen = Int(Replace(Nen, "平成", "")) Nen = Nen + 1988 ElseIf InStr(Nen, "昭和") > 0 Then Nen = Int(Replace(Nen, "昭和", "")) Nen = Nen + 1925 ElseIf InStr(Nen, "大正") > 0 Then Nen = Int(Replace(Nen, "大正", "")) Nen = Nen + 1911 ElseIf InStr(Nen, "明治") > 0 Then Nen = Int(Replace(Nen, "明治", "")) Nen = Nen + 1867 End If 'DateStrに元号が含まれる場合の変換処理（通常は利用されない） Nen = Int(Nen) Tsuki = Int(Tsuki) Hi = Int(Hi) If Not(IsNumeric(Nen)) Then CheckFlg = false End If If Not(IsNumeric(Tsuki)) Then CheckFlg = false End If If Not(IsNumeric(Hi)) Then CheckFlg = false End If If Nen < 1900 Or 2100 < Nen Then CheckFlg = false End If If Tsuki < 1 Or 12 < Tsuki Then CheckFlg = false End If If Hi < 1 Or 31 < Hi Then CheckFlg = false End If If CheckFlg = false Then Exit Function End If TargetDate = DateSerial(Nen, Tsuki, Hi) Query = " SELECT * FROM TC9元号M WHERE システムCD = '" & GB_SystemCD & "' ORDER BY 開始日 DESC " Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) If "" & Content.Fields("元号") <> "" And "" & Content.Fields("開始日") <> "" Then If TargetDate >= Content.Fields("開始日") Then SetGengo = "" & Content.Fields("元号") Exit Do End If End If Content.MoveNext Loop End If End Function '元号から西暦年のみを取得 Function SetYearGengo(F_Target) Dim Query Dim Content If F_Target <> "" Then Query = " SELECT * FROM TC9元号M WHERE システムCD = '" & GB_SystemCD & "' AND 元号 = '" & F_Target & "' " Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then If "" & Content.Fields("開始日") <> "" Then SetYearGengo = Year(Content.Fields("開始日")) End If End If End If End Function ' -------------------------------------------------------------------- ' 00. 日付をYY/MM/DD HH:MMに変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : YYYY/MM/DD HH:MM ' 引数 ' F_DateTime :日付 ' -------------------------------------------------------------------- Function SetTimeYYMMDDHHMM(F_DateTime) Dim y1 Dim m1 Dim d1 Dim h1 Dim m2 y1 = CStr(Year (F_DateTime)) m1 = CStr(Month (F_DateTime)) d1 = CStr(Day (F_DateTime)) h1 = CStr(Hour (F_DateTime)) m2 = CStr(Minute(F_DateTime)) If Len(m1) = 1 Then m1 = "0" & m1 End If If Len(d1) = 1 Then d1 = "0" & d1 End If If Len(h1) = 1 Then h1 = "0" & h1 End If If Len(m2) = 1 Then m2 = "0" & m2 End If SetTimeYYMMDDHHMM = y1 & "/" & m1 & "/" & d1 & " " & h1 & ":" & m2 End Function ' -------------------------------------------------------------------- ' 00. 日付をYYMMDDHHMMに変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : YYYYMMDDHHMM ' 引数 ' F_DateTime :日付 ' -------------------------------------------------------------------- Function SetTimeYYMMDDHHMM2(F_DateTime) Dim y1 Dim m1 Dim d1 Dim h1 Dim m2 y1 = CStr(Year (F_DateTime)) m1 = CStr(Month (F_DateTime)) d1 = CStr(Day (F_DateTime)) h1 = CStr(Hour (F_DateTime)) m2 = CStr(Minute(F_DateTime)) If Len(m1) = 1 Then m1 = "0" & m1 End If If Len(d1) = 1 Then d1 = "0" & d1 End If If Len(h1) = 1 Then h1 = "0" & h1 End If If Len(m2) = 1 Then m2 = "0" & m2 End If SetTimeYYMMDDHHMM2 = y1 & m1 & d1 & h1 & m2 End Function ' -------------------------------------------------------------------- ' 00. 日付をMMDD変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : MMDD ' 引数 ' F_DateTime :日付 ' -------------------------------------------------------------------- Function SetTimeMMDD(F_DateTime) Dim y1 Dim m1 Dim d1 Dim h1 Dim m2 If IsNull(F_DateTime) Then Exit Function End If If F_DateTime = "" Then Exit Function End If y1 = CStr(Year (F_DateTime)) m1 = CStr(Month (F_DateTime)) d1 = CStr(Day (F_DateTime)) h1 = CStr(Hour (F_DateTime)) m2 = CStr(Minute(F_DateTime)) If Len(m1) = 1 Then m1 = "0" & m1 End If If Len(d1) = 1 Then d1 = "0" & d1 End If If Len(h1) = 1 Then h1 = "0" & h1 End If If Len(m2) = 1 Then m2 = "0" & m2 End If SetTimeMMDD = m1 & "/" & d1 End Function ' -------------------------------------------------------------------- ' 00. 日付をYYYY年MM月DD日HH時MM分に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : YYYY年MM月DD日HH時MM分 ' 引数 ' F_DateStr :日付 ' -------------------------------------------------------------------- Function SetTimeYYMMDDHHMM2Rev(F_DateStr) SetTimeYYMMDDHHMM2Rev = Left(F_DateStr, 4) & "年" & Mid(F_DateStr, 5, 2) & "月" & Mid(F_DateStr, 7, 2) & "日" & Mid(F_DateStr, 9, 2) & "時" & Mid(F_DateStr, 11, 2) & "分" End Function ' -------------------------------------------------------------------- ' 00. 日付をYYYY/MM/DDに変換 ' -------------------------------------------------------------------- ' 日付が「MM/DD/YYYY」で出力されてしまう場合の対処のため（システム設定に依存するようだが再現せずはっきりとした原因は不明）（140425小野） ' 引数 ' F_DateTime :日付（Dateオブジェクト） ' -------------------------------------------------------------------- Function SetTimeYYYYMMDD(F_DateTime) If "" & F_DateTime <> "" Then SetTimeYYYYMMDD = Year(F_DateTime) & "/" & Right("0" & Month(F_DateTime), 2) & "/" & Right("0" & Day(F_DateTime), 2) 'SetTimeYYYYMMDD = Year(F_DateTime) & "/" & Right("" & Month(F_DateTime), 2) & "/" & Right("" & Day(F_DateTime), 2) End If End Function ' -------------------------------------------------------------------- ' 00. 日付を指定の形式に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' obj :式 ' dtype : ' -------------------------------------------------------------------- Function SetDateStr(obj, dtype) Dim Year1 Dim Year2 Dim Month1 Dim Day1 Dim Hour1 Dim Minute1 Dim Second1 '式を日付に変換できるかどうか判定 If Not(IsDate(obj)) Then Exit Function End If Year1 = Year(obj) Year2 = Year1 - 2000 Month1 = Month(obj) Day1 = Day(obj) Hour1 = Hour(obj) Minute1 = Minute(obj) Second1 = Second(obj) '取得した値が1桁ならば0を付加 If Year2 < 10 Then Year2 = "0" & Year2 End If If Month1 < 10 Then Month1 = "0" & Month1 End If If Day1 < 10 Then Day1 = "0" & Day1 End If If Hour1 < 10 Then Hour1 = "0" & Hour1 End If If Minute1 < 10 Then Minute1 = "0" & Minute1 End If If Second1 < 10 Then Second1 = "0" & Second1 End If '引数dtypeを置換 dtype = Replace(dtype, "YYYY", Year1) dtype = Replace(dtype, "YY", Year2) dtype = Replace(dtype, "MM", Month1) dtype = Replace(dtype, "DD", Day1) dtype = Replace(dtype, "hh", Hour1) dtype = Replace(dtype, "mm", Minute1) dtype = Replace(dtype, "ss", Second1) SetDateStr = dtype End Function Function GetYYYYMMDD() Dim TmpYMD TmpYMD = Now() GetYYYYMMDD = Year(TmpYMD) GetYYYYMMDD = GetYYYYMMDD & "/" & Right("0" & Month(TmpYMD), 2) GetYYYYMMDD = GetYYYYMMDD & "/" & Right("0" & Day(TmpYMD), 2) End Function ' -------------------------------------------------------------------- ' 00. 金額の文字列を解析・指定書式に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' F_Yenmark : ' F_Zeronull : ' -------------------------------------------------------------------- Function SetMoney(F_Target, F_Yenmark, F_Zeronull) SetMoney = ConvIntToMoney(ConvMoneyToInt(F_Target), F_Yenmark, F_Zeronull) End Function ' -------------------------------------------------------------------- ' 00. 金額の文字列を解析・通貨型に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : 通貨型 ' 引数 ' F_Target :解析対象文字列 ' 修正履歴 '2002/8/9:Yamazaki :CLng を CCur に修正 '2002/9/6:Yamazaki :F_Target が Nullにも対応するように修正 ' -------------------------------------------------------------------- Function ConvMoneyToInt(F_Target) Dim Target Target = "" If Not(IsNull(F_Target)) Then '文字列から","を取り除く Target = Replace(F_Target,",","") '文字列から"\"を取り除く Target = Replace(Target,"\","") If Target <> "" Then '文字型から通貨型に変換 Target = CCur(Target) End If End If ConvMoneyToInt = Target End Function ' -------------------------------------------------------------------- ' 00. 金額の文字列を解析・整数の書式に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' F_Yenmark : ' F_Zeronull : ' 修正履歴 '2002/08/09:Yamazaki :-100 が -,100 と出るのを修正 '2002/08/27:Yamazaki :F_Target が Nullにも対応するように修正 ' -------------------------------------------------------------------- Function ConvIntToMoney(F_Target, F_Yenmark, F_Zeronull) Dim return1 return1 = "" If IsNull(F_Target) Then F_Target = "" End If return1 = NumComma(F_Target, F_Zeronull) If F_Yenmark And return1 <> "" Then return1 = "\" + return1 End If ConvIntToMoney = return1 End Function ' -------------------------------------------------------------------- ' 00. 整数の文字列を解析・金額の書式に変換（負は△表示） ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' F_Yenmark : ' F_Zeronull : ' 修正履歴 '2002/08/09:Yamazaki :-100 が -,100 と出るのを修正 '2002/08/27:Yamazaki :F_Target が Nullにも対応するように修正 '2007/01/26:小野 :△表示用にクローン ' -------------------------------------------------------------------- Function ConvIntToMoneySankaku(F_Target, F_Yenmark, F_Zeronull) Dim return1 return1 = "" If IsNull(F_Target) Then F_Target = "" End If return1 = NumComma(F_Target, F_Zeronull) If F_Yenmark And return1 <> "" Then return1 = "\" + return1 End If If Left(return1, 1) = "-" Then return1 = "△" + Mid(return1, 2, Len(return1)-1) End If ConvIntToMoneySankaku = return1 End Function ' -------------------------------------------------------------------- ' 00. 数字の入力文字列を解析・指定の書式に変換 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' F_Zeronull : ' -------------------------------------------------------------------- Function SetNumber(F_Target, F_Zeronull) SetNumber = NumComma(ConvMoneyToInt(F_Target), F_Zeronull) End Function ' -------------------------------------------------------------------- ' 00. 整数に区切り文字をセット ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' F_Zeronull : ' -------------------------------------------------------------------- Function NumComma(F_Target, F_Zeronull) Dim Target '変換対象 Dim return1 Dim tmp '整数部・小数部の分割Work Dim Syosu '少数部分 Dim strlen If F_Zeronull And F_Target = "0" Then NumComma = "" ElseIf F_Target <> "" Then Target = CStr(F_Target) If InStr(Target, ".") > 0 Then tmp = Split(Target, ".") Target = tmp(0) Syosu = tmp(1) End If Do While(Len(Target) > 0) strlen = 3 If Len(Target) < 3 Then strlen = Len(Target) End If return1 = Right(Target, strlen) + return1 Target = Left(Target, Len(Target) - strlen) If (Target <> "-" And Len(Target) > 0) Or (Target = "-" And Len(Target) > 1) Then return1 = "," + return1 End If Loop If Syosu <> "" Then return1 = return1 & "." & Syosu End If NumComma = return1 End If End Function ' -------------------------------------------------------------------- ' 00. 引数の文字列内のスペースを削除 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : 変換不能 ' 正 : ' 引数 ' F_Target : ' -------------------------------------------------------------------- Function ReplaceSpace(F_Target) Dim Target If Not(IsNull(F_Target)) Then Target = F_Target '半角スペース変換 Target = Replace(Target," ","") '全角スペース変換 Target = Replace(Target,"　","") End If ReplaceSpace = Target End Function ' -------------------------------------------------------------------- ' 00. 勘定科目名称へ１文字おきに全角スペースを挿入 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' F_Target : ' 備考 ' 勘定科目は5文字 ' -------------------------------------------------------------------- Function SetStringFixWidth(F_Target) Dim ii Dim jj Dim aa Dim bb If Not(IsNull(F_Target)) Then '文字列から既存のスペースを削除 F_Target = Replace(F_Target, "　", "") F_Target = Replace(F_Target, " ", "") aa = 5 For ii = 1 To Len(F_Target) SetStringFixWidth = SetStringFixWidth + Mid(F_Target, ii, 1) If ii <> Len(F_Target) Then For jj = 1 To CInt((aa - Len(F_Target)) / (Len(F_Target) - 1)) SetStringFixWidth = SetStringFixWidth + "　" Next End If Next End If End Function ' -------------------------------------------------------------------- ' 00. 文字列へ１文字おきに全角スペースを挿入 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' F_Target : ' 備考 ' 勘定科目は5文字 ' -------------------------------------------------------------------- Function SetStringInsertSpace(F_Target) Dim ii For ii = 1 To Len(F_Target) SetStringInsertSpace = SetStringInsertSpace + Mid(F_Target, ii, 1) If ii <> Len(F_Target) Then SetStringInsertSpace = SetStringInsertSpace + "　" End If Next End Function ' -------------------------------------------------------------------- ' 00. 文字列へ１文字おきに半角スペースを挿入 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' F_Target : ' 備考 ' 勘定科目は5文字 ' -------------------------------------------------------------------- Function SetStringInsertSpaceH(F_Target) Dim ii For ii = 1 To Len(F_Target) SetStringInsertSpaceH = SetStringInsertSpaceH + Mid(F_Target, ii, 1) If ii <> Len(F_Target) Then SetStringInsertSpaceH = SetStringInsertSpaceH + " " End If Next End Function ' -------------------------------------------------------------------- ' 00. 文字列の頭に0を挿入 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' F_Target : ' -------------------------------------------------------------------- Function SetStringZeroFil(F_Target,F_Len) Dim StrLen Dim StrTarget Dim ii StrTarget = CStr(F_Target) StrLen = F_Len - LEN(StrTarget) For ii = 1 TO StrLen StrTarget = "0" & StrTarget Next SetStringZeroFil = StrTarget End Function ' -------------------------------------------------------------------- ' 00. 大小判定 ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' a :比較値A ' b :比較値B ' -------------------------------------------------------------------- Function Max(a, b) If a > b Then Max = a Else Max = b End If End Function ' -------------------------------------------------------------------- ' 00. basp21を使用してコマンドを実行する ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' cmd : 実行コマンド文 ' -------------------------------------------------------------------- Function ExecCmd(cmd) Dim bobj Dim command Dim stdout Dim rc Set bobj = Server.CreateObject("basp21") Response.Write(cmd) rc = bobj.Execute(cmd,1,stdout) Response.Write("
") Response.Write("
") Response.Write(rc) Response.Write("
") Response.Write(Replace(stdout, vbCrLf, "
" & vbCrLf)) Set bobj = Nothing End Function ' -------------------------------------------------------------------- ' 00. 文字列のByte数を取得（061027小野） ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' cmd : 実行コマンド文 ' -------------------------------------------------------------------- Function AscLen(p_Str) Dim i Dim ii Dim iAscCode Dim iCount If Len(p_Str) = 0 Then AscLen = 0 Exit Function End If If IsNull(Len(p_Str)) Then AscLen = 0 Exit Function End If AscLen = 0 '初期化 iCount = 0 '初期化 For i = 1 to Len(p_Str) '1文字ずつ処理 iCount = iCount + 1 'Byteカウントアップ iAscCode = Asc(Mid(p_Str, i, 1)) 'Asc関数で文字コード取得 If Len(Hex(iAscCode)) > 2 Then '16進3桁以上なら全角文字と判定 iCount = iCount + 1 '全角文字の場合はByteカウントアップ End If Next AscLen = iCount End Function ' -------------------------------------------------------------------- ' 00. 文字列を左から指定Byte数で切り出し(2Byte文字端数は切り捨て)（061031小野） ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' cmd : 実行コマンド文 ' -------------------------------------------------------------------- Function AscLeft(p_Str,p_Len) Dim i Dim iAscCode Dim iCount If Len(p_Str) = 0 Then '文字数が0の場合 AscLeft = "" Exit Function End If If IsNull(Len(p_Str)) Then '文字列がNullの場合 AscLeft = "" Exit Function End If If p_Len = 0 Then '指定Byte数が0の場合 AscLeft = "" Exit Function End If If p_Len >= AscLen(p_Str) Then '文字列が指定Byte数に満たない場合は何もしない AscLeft = p_Str Exit Function End If AscLeft = "" '文字列初期化 i = 0 '文字数初期化 iCount = 0 'Byte数初期化 Do While iCount < p_Len '指定Byte数までループ i = i + 1 '1文字シフト iCount = iCount + 1 '1Byteシフト iAscCode = Asc(Mid(p_Str, i, 1)) 'Asc関数で文字コード取得 If Len(Hex(iAscCode)) > 2 Then '16進3桁以上なら全角文字と判定 iCount = iCount + 1 '全角文字の場合はByteカウントアップ if iCount > p_Len Then '全角文字により指定Byte数を Exit Do '　超えた場合はここでDoループアウト End If End If AscLeft = AscLeft + Mid(p_Str, i, 1) '1文字追加 Loop End Function ' -------------------------------------------------------------------- ' 00. 西暦0年から経過した時間を1万分の1秒単位で(大まかに)算出する（061107小野） ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' cmd : 実行コマンド文 ' -------------------------------------------------------------------- Function TimeUniq() 'セッションを利用し初回のみ取得する ' If "" & Session(HomeAlias & "TimeUniq") = "" Then '更新されないとデバッグにならんので廃止 Dim MonthDay(12),ii,mtmp,TmpNow 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 TmpNow = Now Do While ii < Month(TmpNow) mtmp = mtmp + MonthDay(ii) '1/1〜前月末までの日数を算出 ii = ii + 1 Loop Session(HomeAlias & "TimeUniq") = "TimeUniq=" & ((((Year(TmpNow) - 1) * 365.25 + mtmp + (Day(TmpNow) - 1)) * 24 * 60 * 60 + Timer()) * 10000) ' End If TimeUniq = Session(HomeAlias & "TimeUniq") End Function ' -------------------------------------------------------------------- ' 00. ウェイト挿入自動ジャンプ（070911小野） ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' cmd : 実行コマンド文 ' -------------------------------------------------------------------- Function WaitRedirect(URLStr,WaitTime) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("
" & vbCrLf) Response.Write("　　ただいま処理中です。しばらくお待ちください。") Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) End Function ' -------------------------------------------------------------------- ' 00. CODE39バーコードを表示する（071204小野） ' -------------------------------------------------------------------- ' 戻り値 ' 負 : ' 正 : ' 引数 ' cmd : 実行コマンド文 ' -------------------------------------------------------------------- Function BarcodeWriteCODE39(Barcode, Label) Barcode = UCase(Barcode) If Label = "" Then Label = Barcode End If Dim TmpStr TmpStr = "" 'パラメータチェック Dim TmpBarcode TmpBarcode = Replace(Barcode, "0","") TmpBarcode = Replace(TmpBarcode, "1","") TmpBarcode = Replace(TmpBarcode, "2","") TmpBarcode = Replace(TmpBarcode, "3","") TmpBarcode = Replace(TmpBarcode, "4","") TmpBarcode = Replace(TmpBarcode, "5","") TmpBarcode = Replace(TmpBarcode, "6","") TmpBarcode = Replace(TmpBarcode, "7","") TmpBarcode = Replace(TmpBarcode, "8","") TmpBarcode = Replace(TmpBarcode, "9","") TmpBarcode = Replace(TmpBarcode, "A","") TmpBarcode = Replace(TmpBarcode, "B","") TmpBarcode = Replace(TmpBarcode, "C","") TmpBarcode = Replace(TmpBarcode, "D","") TmpBarcode = Replace(TmpBarcode, "E","") TmpBarcode = Replace(TmpBarcode, "F","") TmpBarcode = Replace(TmpBarcode, "G","") TmpBarcode = Replace(TmpBarcode, "H","") TmpBarcode = Replace(TmpBarcode, "I","") TmpBarcode = Replace(TmpBarcode, "J","") TmpBarcode = Replace(TmpBarcode, "K","") TmpBarcode = Replace(TmpBarcode, "L","") TmpBarcode = Replace(TmpBarcode, "M","") TmpBarcode = Replace(TmpBarcode, "N","") TmpBarcode = Replace(TmpBarcode, "O","") TmpBarcode = Replace(TmpBarcode, "P","") TmpBarcode = Replace(TmpBarcode, "Q","") TmpBarcode = Replace(TmpBarcode, "R","") TmpBarcode = Replace(TmpBarcode, "S","") TmpBarcode = Replace(TmpBarcode, "T","") TmpBarcode = Replace(TmpBarcode, "U","") TmpBarcode = Replace(TmpBarcode, "V","") TmpBarcode = Replace(TmpBarcode, "W","") TmpBarcode = Replace(TmpBarcode, "X","") TmpBarcode = Replace(TmpBarcode, "Y","") TmpBarcode = Replace(TmpBarcode, "Z","") TmpBarcode = Replace(TmpBarcode, "-","") TmpBarcode = Replace(TmpBarcode, ".","") TmpBarcode = Replace(TmpBarcode, " ","") TmpBarcode = Replace(TmpBarcode, "$","") TmpBarcode = Replace(TmpBarcode, "/","") TmpBarcode = Replace(TmpBarcode, "+","") TmpBarcode = Replace(TmpBarcode, "%","") '不正文字が存在しなければ処理開始 If TmpBarcode = "" Then 'スタート・ストップキャラクタ追加 Barcode = "*" & Barcode & "*" 'CODE39パターン配列（連想配列） Dim Code39 Set Code39 = Server.CreateObject("Scripting.Dictionary") Code39("0") = "00110,0100" Code39("1") = "10001,0100" Code39("2") = "01001,0100" Code39("3") = "11000,0100" Code39("4") = "00101,0100" Code39("5") = "10100,0100" Code39("6") = "01100,0100" Code39("7") = "00011,0100" Code39("8") = "10010,0100" Code39("9") = "01010,0100" Code39("A") = "10001,0010" Code39("B") = "01001,0010" Code39("C") = "11000,0010" Code39("D") = "00101,0010" Code39("E") = "10100,0010" Code39("F") = "01100,0010" Code39("G") = "00011,0010" Code39("H") = "10010,0010" Code39("I") = "01010,0010" Code39("J") = "00110,0010" Code39("K") = "10001,0001" Code39("L") = "01001,0001" Code39("M") = "11000,0001" Code39("N") = "00101,0001" Code39("O") = "10100,0001" Code39("P") = "01100,0001" Code39("Q") = "00011,0001" Code39("R") = "10010,0001" Code39("S") = "01010,0001" Code39("T") = "00110,0001" Code39("U") = "10001,1000" Code39("V") = "01001,1000" Code39("W") = "11000,1000" Code39("X") = "00101,1000" Code39("Y") = "10100,1000" Code39("Z") = "01100,1000" Code39("-") = "00011,1000" Code39(".") = "10010,1000" Code39(" ") = "01010,1000" Code39("$") = "00000,1110" Code39("/") = "00000,1101" Code39("+") = "00000,1011" Code39("%") = "00000,0111" Code39("*") = "00110,1000" Dim Column Dim Column2 Dim BW 'テーブル開始 ' TmpStr = TmpStr & "

" 'クワイエットゾーン(12) For Column = 1 To 12 TmpStr = TmpStr & "" Next 'キャラクタ For Column = 1 To Len(Barcode) 'キャラクタ間ギャップ If Column > 1 Then TmpStr = TmpStr & "" End If '連想配列からカンマ区切りで白黒配列に代入 BW = Split(Code39(Mid(Barcode, Column, 1)), ",") 'バー出力 For Column2 = 1 To 5 '黒バー（5本） TmpStr = TmpStr & "" If Column2 < 5 Then '白バー（4本） TmpStr = TmpStr & "" End If Next Next 'クワイエットゾーン(12) For Column = 1 To 12 TmpStr = TmpStr & "" Next 'テーブル終了＆コード表記 ' TmpStr = TmpStr & "

" & Label & "

" & vbCrLf ' TmpStr = TmpStr & "" & Label & "" & vbCrLf End If BarcodeWriteCODE39 = TmpStr End Function Function ConvProhiStr(Str) 'サーバーサイド Dim NGStr Dim OKStr Dim rc NGStr = "ｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾊﾋﾌﾍﾎ" OKStr = "ガギグゲゴザジズゼゾダヂヅデドバビブベボパピプペポ" rc = "" Dim ii Dim c Dim n For ii = 1 To Len(Str) If Mid(Str, ii, 1) <> "ﾞ" And Mid(Str, ii, 1) <> "ﾟ" Then c = Mid(Str, ii, 1) n = InStr(NGStr, c) If n > 0 Then If ii + 1 < Len(Str) Then If Mid(Str, ii + 1, 1) = "ﾞ" Then c = Mid(OKStr, n, 1) ElseIf Mid(Str, ii + 1, 1) = "ﾟ" Then c = Mid(OKStr, n + 5, 1) '半濁音時は置換文字を5文字シフト End If End If End If rc = rc + c End If Next Str = rc NGStr = "ｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜｦﾝｧｨｩｪｫｬｭｮｯ､｡ｰ｢｣ﾞﾟ" NGStr = NGStr + "ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ" NGStr = NGStr + "１２３４５６７８９０" NGStr = NGStr + "／'""#\" OKStr = "アイウエオカキクケコサシスセソタチツテトナニヌネノ" OKStr = OKStr + "ハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォャュョッ、。ー「」　　" OKStr = OKStr + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" OKStr = OKStr + "1234567890" OKStr = OKStr + "/’”＃￥" 'Response.Write("NGStr = " & Len(NGStr) & "
") 'Response.Write("OKStr = " & Len(OKStr) & "
") 'Exit Function rc = "" For ii = 1 To Len(Str) c = Mid(Str, ii, 1) n = InStr(NGStr, c) If n > 0 Then c = Mid(OKStr, n, 1) End If rc = rc + c Next ConvProhiStr = rc End Function 'クエリ文字の日本語はプロキシによって送信出来ないケースがあるので 'submit()コマンドでヒストリバックさせるHTML構文を書き出す Function SubmitHystoryBack(Url) Dim UrlQueryString Dim UrlQueryStrAry Dim TmpCnt Dim TmpQuery Dim TmpHTML TmpHTML = "" If InStr(Url, "?") > 0 Then TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "

" & vbCrLf UrlQueryString = Mid(Url, InStr(Url, "?") + 1) UrlQueryStrAry = Split(UrlQueryString, "&") For TmpCnt = 0 To UBound(UrlQueryStrAry) TmpQuery = Split(UrlQueryStrAry(TmpCnt), "=") If UBound(TmpQuery) = 1 Then TmpHTML = TmpHTML & "" & vbCrLf End If Next TmpHTML = TmpHTML & "

" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf TmpHTML = TmpHTML & "" & vbCrLf End If SubmitHystoryBack = TmpHTML End Function 'ScriptX構文トグル出力 Function ScriptXObject() 'ブラウザ判定によるScriptXバージョンのトグル Dim TmpScriptX TmpScriptX = "ScriptX.cab#Version=5,0,4,185" If ScriptXver > 7 Then TmpScriptX = "smsx.cab#Version=6,5,439,12" 'TmpScriptX = "smsx.cab#Version=7,5,0,20" End If Dim TmpHTML TmpHTML = "" If GB_IEmode = "1" And PrintMarginControl > 0 Then TmpHTML = TmpHTML & " " & vbCrLf End If ScriptXObject = TmpHTML End Function '半角英数字の連続を途中で改行可能にする Function HardWrap(Str) Dim TmpStr Dim Cnt If Str <> "" Then For Cnt = 1 To Len(Str) If TmpStr <> "" Then TmpStr = TmpStr & "" End If TmpStr = TmpStr & Mid(Str, Cnt, 1) Next End If HardWrap = TmpStr End Function '数値文字変換を拒否する Function NumChrReject(Str) Dim TmpHeader TmpHeader = "" TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "" & vbCrLf TmpHeader = TmpHeader & "
" & vbCrLf NumChrReject = True If InStr(Str, "&#") > 0 Then Dim TmpStr TmpStr = Split(Str, "&#") Dim Cnt For Cnt = 0 To UBound(TmpStr) If InStr(TmpStr(Cnt), ";") > 0 And InStr(TmpStr(Cnt), ";") <= 7 Then Dim TmpNum TmpNum = Left(TmpStr(Cnt), InStr(TmpStr(Cnt), ";")) Response.Write(TmpHeader) Response.Write("　　特殊な漢字は利用できません。

") Response.Write("　　入力された漢字 ： &#" & Left(TmpStr(Cnt), InStr(TmpStr(Cnt), ";")) & "

") Response.Write("　　戻る" & vbCrLf) Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) NumChrReject = False Exit For End If Next End If End Function %>