<%
'-------------------------------------------------------------------------------
' 名 称：rireki1.asp
' 機 能：購買履歴の検索条件入力画面
' 戻り画面：custmenu.asp
' 送 信 先：rireki1.asp（照会）
' 次 画 面：rireki2.asp
' キ ー ６：shopping.asp
' ０：default.asp
'-------------------------------------------------------------------------------
%>
<%option explicit%>
<%'PC版共通定義%>
<%'サイト毎の定義＆既存アプリ定義%>
<%
'on error resume next
Dim l_clsSession
Dim l_objDbClass 'データベース
Dim l_rs 'レコードセット
Dim l_strSql
Dim l_params
Dim Msg
Dim i
Dim Fast
Dim DateFromYY '注文日（開始）年
Dim DateFromMM '注文日（開始）月
Dim DateFromDD '注文日（開始）日
Dim DateToYY '注文日（終了）年
Dim DateToMM '注文日（終了）月
Dim DateToDD '注文日（終了）日
Dim DataBase
Dim SessionID
SessionID = Trim(Request("sessionid"))
Msg = ""
Fast = Trim(Request("FAST"))
DateFromYY = Trim(Request("datefrom_yy"))
DateFromMM = Trim(Request("datefrom_mm"))
DateFromDD = Trim(Request("datefrom_dd"))
DateToYY = Trim(Request("dateto_yy"))
DateToMM = Trim(Request("dateto_mm"))
DateToDD = Trim(Request("dateto_dd"))
Set l_objDbClass = new CDb
l_objDbClass.Connect(Session(C_WEBSHOP_CON))
'Sessionオブジェクト作成
Set l_clsSession = new CSession
Call l_clsSession.SetSessionId(SessionID)
Call l_clsSession.SelectSession
l_strSql = "select * from INIT where ACODE = ? and ID = '1'"
Redim l_params(1)
l_params(1) = ACODE
Set l_rs = l_objDbClass.doSelect(l_strSql, l_params)
DataBase = cint(l_rs.Fields("DBTYPE"))
if cint(l_rs("検索結果保存ﾌﾗｸﾞ")) = 2 then
Dim l_paramsx
Dim l_Sqlx 'SQL文
l_Sqlx = "insert into USERLOG values("
l_Sqlx = l_Sqlx & "?,"
l_Sqlx = l_Sqlx & "?,"
l_Sqlx = l_Sqlx & "?,"
l_Sqlx = l_Sqlx & "?,"
l_Sqlx = l_Sqlx & "?,"
l_Sqlx = l_Sqlx & "?,"
session("kaijyun") = clng(session("kaijyun")) + 1
l_Sqlx = l_Sqlx & "131,"
l_Sqlx = l_Sqlx & "null, null, null, null, null, null, null, null, null, null, null,"
l_Sqlx = l_Sqlx & "'注文日')"
Redim l_paramsx(6)
l_paramsx(1) = session("shop")
l_paramsx(2) = cdate(session("raiten"))
l_paramsx(3) = session("jikan")
l_paramsx(4) = session("RIPｱﾄﾞﾚｽ")
l_paramsx(5) = clng(session("countno"))
l_paramsx(6) = clng(session("kaijyun")) + 1
Call l_objDbClass.doTranzaction(l_sqlx, l_paramsx)
end if
l_rs.Close
Set l_rs = Nothing
If Fast <> "" Then
'****************************************
'* 注文日入力チェック開始 *
'****************************************
Const FromMsg = "注文日(開始)"
Const ToMsg = "注文日(終了)"
Dim AllDateFrom '注文日(開始)全部
Dim AllDateTo '注文日(終了)全部
Dim Today '本日の日付
Dim DateFrom '注文日FROM
Dim DateTo '注文日TO
Dim ResultNumber '数値チェックの結果
Dim ResultYMD '日付チェックの結果
Dim ResultFeb '閏年チェックの結果
AllDateFrom = DateFromYY & DateFromMM & DateFromDD
AllDateTo = DateToYY & DateToMM & DateToDD
DateFrom = DateFromYY & "/" & DateFromMM & "/" & DateFromDD
DateTo = DateToYY & "/" & DateToMM & "/" & DateToDD
Today = Date
'------注文日(開始)のチェック
If AllDateFrom <> "" Then
'------桁数・数字チェック
ResultNumber = NumberCheck(DateFromYY,DateFromMM,DateFromDD,AllDateFrom,FromMsg)
If ResultNumber <> "" Then
Msg = ResultNumber
Else
'------日付の妥当性チェック
ResultYMD = YMDCheck(DateFromYY,DateFromMM,DateFromDD)
If ResultYMD = 0 Then
Msg = FromMsg & "が誤りです。ご確認ください。"
Else
'------現在の日付との前後関係チェック
If DateDiff("d",DateFrom,Today) < 0 Then
Msg = "注文日(開始)が現在の日付より後になっています。"
End If
End If
End If
End If
'------注文日(終了)のチェック
If Msg="" and AllDateTo <> "" Then
'------桁数・数字チェック
ResultNumber = NumberCheck(DateToYY,DateToMM,DateToDD,AllDateTo,ToMsg)
If ResultNumber <> "" Then
Msg = ResultNumber
Else
'------日付の妥当性チェック
ResultYMD = YMDCheck(DateToYY,DateToMM,DateToDD)
If ResultYMD = 0 Then
Msg = ToMsg & "が誤りです。ご確認ください。"
ElseIf AllDateFrom <> "" Then
'------注文日(開始)との前後関係チェック
If DateDiff("d",DateFrom,DateTo) < 0 Then
Msg = "注文日(開始)が注文日(終了)より後になっています。"
End If
End If
End If
End If
If Msg = "" Then
'SESSION更新
Call l_clsSession.UpdateSession
Session("sessionid") = SessionID
Session("datefrom_yy") = DateFromYY
Session("datefrom_mm") = DateFromMM
session("datefrom_dd") = DateFromDD
session("dateto_yy") = DateToYY
session("dateto_mm") = DateToMM
session("dateto_dd") = DateToDD
server.transfer("rireki2.asp")
End If
End If
'****** 桁数・数値チェック関数 *******
Function NumberCheck(YY,MM,DD,ALL,MSG)
NumberCheck = ""
'------空欄チェック
If (YY = "") or (MM = "") or (DD = "") Then
NumberCheck = MSG & "を入力してください。"
'------桁数チェック
ElseIf (Len(YY)<>2) or (Len(MM)<>2) or (Len(DD)<>2) Then
NumberCheck = MSG & "は全桁入力してください。"
Else
'------数値チェック
Const Number = "0123456789"
For i=1 To 6
If InStr(Number,Mid(ALL,i,1)) < 1 Then
NumberCheck = MSG & "は半角数字で入力してください。"
Exit For
End If
Next
End If
End Function
'****** 日付の妥当性チェック関数 ******
Function YMDCheck(Y,M,D)
Dim YY
Dim MM
Dim DD
YY = CInt("20" & Y)
MM = CInt(M)
DD = CInt(D)
YMDCheck = 1
'------月のチェック
If (MM < 1) or (MM > 12) Then
YMDCheck = 0
'------日のチェック
ElseIf (DD < 1) or (DD > 31) Then
YMDCheck = 0
'------2月のチェック
ElseIf MM = 2 Then
'------閏年チェック
ResultFeb = FebCheck(YY)
If ResultFeb = 1 Then '------閏年の場合
If DD > 29 Then
YMDCheck = 0
End If
Else '------閏年でない場合
If DD > 28 Then
YMDCheck = 0
End If
End If
'------4,6,9,11月のチェック
ElseIf (MM = 4) or (MM = 6) or (MM = 9) or (MM = 11) Then
If DD > 30 Then
YMDCheck = 0
End If
End If
End Function
'****** 閏年チェック関数 ******
Function FebCheck(Y)
If (Y Mod 400) = 0 Then
FebCheck = 1
ElseIf (Y Mod 100) = 0 Then
FebCheck = 0
ElseIf (Y Mod 4) = 0 Then
FebCheck = 1
Else
FebCheck = 0
End If
End Function
'****************************************
'* 注文日入力チェック終了 *
'****************************************
%>
購買履歴照会入力
<%
'SESSION更新
Call l_clsSession.UpdateSession
Call l_clsSession.dberrchk()
Set l_clsSession = Nothing
Call l_objDbClass.dberrchk()
Set l_objDbClass = Nothing
%>