Webショッピング

<%@ LANGUAGE="VBSCRIPT" %> <% Option Explicit %> <% '================================================================ '　変数定義　ここから '================================================================ '' Dim p Dim pMessage ' ガイドメッセージ Dim pFormId ' フォームＩＤ Dim pSubmit ' ボタンメッセージ Dim pReset ' ' 支払い方法 ------------- Dim pMode1 Dim pMode2 Dim pMode3 ' 申込者 ------------- Dim pName1 ' 氏名 Dim pKana1 ' 氏名(カナ) Dim pPost11 ' 郵便番号(3桁) Dim pPost12 ' 郵便番号(4桁) Dim pAddress11 ' 住所 Dim pAddress12 ' Dim pAddress13 ' Dim pTel11 ' 電話番号 Dim pTel12 ' Dim pTel13 ' Dim pMail1 ' 電子メールアドレス Dim pMail2 ' Dim pCheck ' 送り先同一チェック ' 送り先 ------------- Dim pName2 ' 氏名 Dim pKana2 ' 氏名(カナ) Dim pPost21 ' 郵便番号(3桁) Dim pPost22 ' 郵便番号(4桁) Dim pAddress21 ' 住所 Dim pAddress22 ' Dim pAddress23 ' Dim pTel21 ' 電話番号 Dim pTel22 ' Dim pTel23 ' ' 注文内容 ----------- Dim pSuu1 ' 注文数１ Dim pSuu2 ' 注文数２ Dim pSuu3 ' 注文数３ Dim pKin1 ' 注文金額１ Dim pKin2 ' 注文金額２ Dim pKin3 ' 注文金額３ '' Dim v ' 支払い方法 ------------- Dim vMode ' 申込者 ------------- Dim vName1 ' 氏名 Dim vKana1 ' 氏名(カナ) Dim vPost11 ' 郵便番号(3桁) Dim vPost12 ' 郵便番号(4桁) Dim vAddress11 ' 住所 Dim vAddress12 ' Dim vAddress13 ' Dim vTel11 ' 電話番号 Dim vTel12 ' Dim vTel13 ' Dim vMail1 ' 電子メールアドレス Dim vMail2 ' Dim vCheck ' 送り先同一チェック ' 送り先 ------------- Dim vName2 ' 氏名 Dim vKana2 ' 氏名(カナ) Dim vPost21 ' 郵便番号(3桁) Dim vPost22 ' 郵便番号(4桁) Dim vAddress21 ' 住所 Dim vAddress22 ' Dim vAddress23 ' Dim vTel21 ' 電話番号 Dim vTel22 ' Dim vTel23 ' ' 注文内容 ----------- Dim vSuu1 ' 注文数１ Dim vSuu2 ' 注文数２ Dim vSuu3 ' 注文数３ Dim vKin1 ' 注文金額１ Dim vKin2 ' 注文金額２ Dim vKin3 ' 注文金額３ Dim vGoukei ' 合計金額 '' Dim err ' 申込者 ------------- Dim errName1 ' 氏名 Dim errKana1 ' 氏名(カナ) Dim errPost11 ' 郵便番号(3桁) Dim errPost12 ' 郵便番号(4桁) Dim errAddress11 ' 住所 Dim errAddress12 ' Dim errAddress13 ' Dim errTel11 ' 電話番号 Dim errTel12 ' Dim errTel13 ' Dim errMail1 ' 電子メールアドレス Dim errMail2 ' ' 送り先 ------------- Dim errName2 ' 氏名 Dim errKana2 ' 氏名(カナ) Dim errPost21 ' 郵便番号(3桁) Dim errPost22 ' 郵便番号(4桁) Dim errAddress21 ' 住所 Dim errAddress22 ' Dim errAddress23 ' Dim errTel21 ' 電話番号 Dim errTel22 ' Dim errTel23 ' ' 注文内容 ----------- Dim errSuu1 ' 注文数１ Dim errSuu2 ' 注文数２ Dim errSuu3 ' 注文数３ Dim errKin1 ' 注文金額１ Dim errKin2 ' 注文金額２ Dim errKin3 ' 注文金額３ '' Dim s,c,i Dim sStr Dim sChk1 Dim sChk2 Dim sChk3 Dim iERRNO Dim iERRMSG Dim iAPID Dim iFUNCID Dim iSTATUS '' Dim Msg Dim pMsg1 pMsg1 = "※ 全項目必須入力となっております、お間違いの無いようにご入力ください" Dim pMsg2 pMsg2 = "※ お名前を全角で入力して下さい" Dim pMsg3 pMsg3 = "※ フリガナを全角で入力して下さい" Dim pMsg4 pMsg4 = "※ 郵便番号を半角数字で入力して下さい" Dim pMsg5 pMsg5 = "※ ご住所を全角で入力して下さい" Dim pMsg6 pMsg6 = "※ 電話番号を半角数字で入力して下さい" Dim pMsg7 pMsg7 = "※ Ｅ－ＭＡＩＬを半角英数字で入力して下さい" Dim pMsg8 pMsg8 = "※ 数量を半角数字で入力して下さい" Dim pMsg9 pMsg9 = "※ 以下の内容でご注文を受け付けます。よろしければ送信をクリックして下さい" '================================================================ '　変数定義　ここまで '================================================================ '================================================================ '　お客様設定個所　ここから '================================================================ ''' 商品の値段設定 Const cHin1 = 3000 Const cHin2 = 5500 Const cHin3 = 7000 ''' 商品の名前設定 Const vHin1 = "無菌　生牡蠣(剥き身)　1kg" Const vHin2 = "無菌　生牡蠣(剥き身)　2kg" Const vHin3 = "無菌　生牡蠣(剥き身)　3kg" ''' 個数の初期値 vSuu1 = 0 vSuu2 = 0 vSuu3 = 0 ''' メール[宛先] Const mailto = "JF-ISHITOU" ''' メール[送信者] Const mailfrom = "Web Shopping" ''' メール[本文] Const body = "Web Shopping からのご注文です。" '================================================================ '　お客様設定個所　ここまで '================================================================ %> <% '================================================================ '　実処理　ここから '================================================================ Call Main '************************************************************************** ' 関数名： Main() ' 内　容：メイン処理 ' 引　数： ' 戻　値： ' 作成日： '************************************************************************* Sub Main() Select Case Request("formid") Case "ASP2" CALL xASP2 Case "ASP3" CALL xASP3 Case Else CALL xASP1 End Select End Sub '************************************************************************** ' 関数名： xASP1() ' 内　容：第１画面 ' 引　数： ' 戻　値： ' 作成日： '************************************************************************* Sub xASP1() pFormId = "ASP2" pSubmit = "確認" pReset = "reset" pMessage = pMsg1 End Sub '************************************************************************** ' 関数名： xASP2() ' 内　容：第２画面 ' 引　数： ' 戻　値： ' 作成日： '************************************************************************* Sub xASP2() ''' 前画面の内容を全て取得 CALL xRequest_Link pFormId = "ASP2" pSubmit = "確認" pReset = "reset" ''' 依頼主項目チェック ---------------------------------- ''' 名前の妥当性チェック If xName_Check(vName1) = False then pMessage = pMsg2 errName1 = "ngcolor" Exit Sub End if ''' カナの妥当性チェック If xName_Check(vKana1) = False then pMessage = pMsg3 errKana1 = "ngcolor" Exit Sub End if ''' 郵便番号11の妥当性チェック If xCode_Check(vPost11) = False then pMessage = pMsg4 errPost11 = "ngcolor" Exit Sub End if ''' 名郵便番号12の妥当性チェック If xCode_Check(vPost12) = False then pMessage = pMsg4 errPost12 = "ngcolor" Exit Sub End if ''' 住所の妥当性チェック If xName_Check(vAddress11) = False then pMessage = pMsg5 errAddress11 = "ngcolor" Exit Sub End if ''' 電話番号の妥当性チェック If xCode_Check(vTel11) = False then pMessage = pMsg6 errTel11 = "ngcolor" Exit Sub End if If xCode_Check(vTel12) = False then pMessage = pMsg6 errTel12 = "ngcolor" Exit Sub End if If xCode_Check(vTel13) = False then pMessage = pMsg6 errTel13 = "ngcolor" Exit Sub End if ''' E-MAIL1の妥当性チェック If xMail_Check(vMail1) = False then pMessage = pMsg7 errMail1 = "ngcolor" Exit Sub End if ''' E-MAIL2の妥当性チェック If xMail_Check(vMail2) = False then pMessage = pMsg7 errMail2 = "ngcolor" Exit Sub End if ''' 送り先項目チェック ---------------------------------- If vCheck <> 1 then ''' 名前の妥当性チェック If xName_Check(vName2) = False then pMessage = pMsg2 errName2 = "ngcolor" Exit Sub End if ''' カナの妥当性チェック If xName_Check(vKana2) = False then pMessage = pMsg3 errKana2 = "ngcolor" Exit Sub End if ''' 郵便番号21の妥当性チェック If xCode_Check(vPost21) = False then pMessage = pMsg4 errPost21 = "ngcolor" Exit Sub End if ''' 名郵便番号22の妥当性チェック If xCode_Check(vPost22) = False then pMessage = pMsg4 errPost22 = "ngcolor" Exit Sub End if ''' 住所の妥当性チェック If xName_Check(vAddress21) = False then pMessage = pMsg5 errAddress21 = "ngcolor" Exit Sub End if ''' 電話番号の妥当性チェック If xCode_Check(vTel21) = False then pMessage = pMsg6 errTel21 = "ngcolor" Exit Sub End if If xCode_Check(vTel22) = False then pMessage = pMsg6 errTel22 = "ngcolor" Exit Sub End if If xCode_Check(vTel23) = False then pMessage = pMsg6 errTel23 = "ngcolor" Exit Sub End if End If ''' 商品選択項目チェック ---------------------------------- ''' 個数の妥当性チェック if (vSuu1 = "") and (vSuu2 = "") and (vSuu3 = "") then pMessage = pMsg8 errSuu1 = "ngcolor" errSuu2 = "ngcolor" errSuu3 = "ngcolor" Exit Sub End if If xCode_Check2(vSuu1) = False then pMessage = pMsg8 errSuu1 = "ngcolor" Exit Sub End if If xCode_Check2(vSuu2) = False then pMessage = pMsg8 errSuu2 = "ngcolor" Exit Sub End if if vSuu1 = "" then vSuu1 = 0 if vSuu2 = "" then vSuu2 = 0 if (vSuu1 + vSuu2 + vSuu3 = 0) then pMessage = pMsg8 errSuu1 = "ngcolor" errSuu2 = "ngcolor" errSuu3 = "ngcolor" Exit Sub End if ''' 確認画面表示 ---------------------------------- if vSuu1 <> "" then vKin1 = cHin1 * vSuu1 if vSuu2 <> "" then vKin2 = cHin2 * vSuu2 vGoukei = vKin1 + vKin2 If vCheck = 1 then vName2 = vName1 vKana2 = vKana1 vPost21 = vPost11 vPost22 = vPost12 vAddress21 = vAddress11 vAddress22 = vAddress12 vAddress23 = vAddress13 vTel21 = vTel11 vTel22 = vTel12 vTel23 = vTel13 End If vMode = Request("mode") ''' 処理モード Select Case Request("mode") Case "1" ' 代引き pMode1 = "checked" pMode2 = "disabled" pMode3 = "disabled" Case "2" ' 現金書留 pMode1 = "disabled" pMode2 = "checked" pMode3 = "disabled" Case "3" ' 銀行振込 pMode1 = "disabled" pMode2 = "disabled" pMode3 = "checked" End Select pFormId = "ASP3" pSubmit = "送信" pReset = "hidden" pMessage = pMsg9 pName1 = "readonly" pKana1 = "readonly" pPost11 = "readonly" pPost12 = "readonly" pAddress11 = "readonly" pAddress12 = "readonly" pAddress13 = "readonly" pTel11 = "readonly" pTel12 = "readonly" pTel13 = "readonly" pMail1 = "readonly" pMail2 = "readonly" pName2 = "readonly" pKana2 = "readonly" pPost21 = "readonly" pPost22 = "readonly" pAddress21 = "readonly" pAddress22 = "readonly" pAddress23 = "readonly" pTel21 = "readonly" pTel22 = "readonly" pTel23 = "readonly" pSuu1 = "readonly" pSuu2 = "readonly" pSuu3 = "readonly" errName1 = "okcolor" errKana1 = "okcolor" errPost11 = "okcolor" errPost12 = "okcolor" errAddress11 = "okcolor" errAddress12 = "okcolor" errAddress13 = "okcolor" errTel11 = "okcolor" errTel12 = "okcolor" errTel13 = "okcolor" errMail1 = "okcolor" errMail2 = "okcolor" errName2 = "okcolor" errKana2 = "okcolor" errPost21 = "okcolor" errPost22 = "okcolor" errAddress21 = "okcolor" errAddress22 = "okcolor" errAddress23 = "okcolor" errTel21 = "okcolor" errTel22 = "okcolor" errTel23 = "okcolor" errSuu1 = "okcolor" errSuu2 = "okcolor" errSuu3 = "okcolor" errKin1 = "okcolor" errKin2 = "okcolor" errKin3 = "okcolor" End Sub '************************************************************************** ' 関数名： xASP3() ' 内　容：第３画面 ' 引　数： ' 戻　値： ' 作成日： '************************************************************************* Sub xASP3() Dim ObjFSO,ObjFile,ObjTS,pCSV On Error Resume Next ''' 前画面の内容を全て取得 CALL xRequest_Link ''' Object 作成 Set ObjFSO = Server.CreateObject("Scripting.FileSystemObject") Set ObjFile = ObjFSO.GetFile("E:\Www\jf-ishitou\public_html\cgi-bin\chumon.csv") Set ObjTS = ObjFile.OpenAsTextStream(2) ''' 送信内容 pCSV = "" Select Case Request("mode2") Case "1" pCSV = pCSV & "代引き" & "," Case "2" pCSV = pCSV & "現金書留" & "," Case "3" pCSV = pCSV & "銀行振込" & "," End Select pCSV = pCSV & vName1 & "," pCSV = pCSV & vKana1 & "," pCSV = pCSV & vPost11 & "-" & vPost12 & "," pCSV = pCSV & vAddress11 & vAddress12 & vAddress13 & "," pCSV = pCSV & vTel11 & "-" & vTel12 & "-" & vTel13 & "," pCSV = pCSV & vMail1 & "@" & vMail2 & "," pCSV = pCSV & vName2 & "," pCSV = pCSV & vKana2 & "," pCSV = pCSV & vPost21 & "-" & vPost22 & "," pCSV = pCSV & vAddress21 & vAddress22 & vAddress23 & "," pCSV = pCSV & vTel21 & "-" & vTel22 & "-" & vTel23 & "," pCSV = pCSV & vSuu1 & "," pCSV = pCSV & vSuu2 & "," pCSV = pCSV & vSuu3 & "," pCSV = pCSV & vKin1 & "," pCSV = pCSV & vKin2 & "," pCSV = pCSV & vKin3 ''' 書込み ObjTS.WriteLine pCSV ObjTS.Close ''' Object 開放 Set ObjTS = Nothing Set ObjFile = Nothing Set ObjFSO = Nothing iERRNO = Err.Number iERRMSG = Err.Description pMessage = iERRNO & iERRMSG If iERRNO <> 0 Then Response.Redirect("error1.html") ' エラー画面表示 Else If xSend_Mail() = False then Response.Redirect("error1.html") ' エラー画面表示 Else Response.Redirect("chumon1.html") ' 送信終了画面表示 End If End If End Sub '================================================================ '　実処理　ここまで '================================================================ '================================================================ '　関数部　ここから '================================================================ '************************************************************************** ' 関数名： xSend_Mail() ' 内　容： basp21を使ってメール送信 ' 引　数： ' 戻　値： ' 作成日： '************************************************************************** Private Function xSend_Mail() Dim bobj,svname,sbj,files,rc xSend_Mail = False Set bobj = Server.CreateObject("basp21") svname = "sjcweb.sjc-sendai.ne.jp/sjcweb" sbj = Month(Date) & "月" & Day(Date) & "日のご注文" files = "E:\Www\jf-ishitou\public_html\cgi-bin\chumon.csv" rc = bobj.SendMail(svname,mailto,mailfrom,sbj,body,files) If rc <> "" Then exit function xSend_Mail = True End Function '************************************************************************** ' 関数名： xRequest_Link() ' 内　容：全画面の内容を取得 ' 引　数： ' 戻　値： ' 作成日： '************************************************************************** Private Function xRequest_Link() ''' 処理モード Select Case Request("mode") Case "1" ' 登録 pMode1 = "checked" Case "2" ' 変更 pMode2 = "checked" Case "3" ' 削除 pMode3 = "checked" End Select vName1 = Request("name1") vKana1 = Request("kana1") vPost11 = Request("post11") vPost12 = Request("post12") vAddress11 = Request("address11") vAddress12 = Request("address12") vAddress13 = Request("address13") vTel11 = Request("tel11") vTel12 = Request("tel12") vTel13 = Request("tel13") vMail1 = Request("mail1") vMail2 = Request("mail2") if Request("check") = 1 then vCheck = 1 pCheck = "checked" End If vName2 = Request("name2") vKana2 = Request("kana2") vPost21 = Request("post21") vPost22 = Request("post22") vAddress21 = Request("address21") vAddress22 = Request("address22") vAddress23 = Request("address23") vTel21 = Request("tel21") vTel22 = Request("tel22") vTel23 = Request("tel23") vSuu1 = Request("suu1") vSuu2 = Request("suu2") vSuu3 = Request("suu3") vKin1 = Request("kin1") vKin2 = Request("kin2") vKin3 = Request("kin3") End Function '************************************************************************** ' 関数名： xCode_Check() ' 内　容：コードの妥当性をチェック ' 引　数： ' 戻　値： ' 作成日： '************************************************************************** Private Function xCode_Check(sChk1) xCode_Check = False if sChk1 = "" then exit function ''コードが未入力かチェック if Byte_Check(sChk1) = "True" then exit function ''文字列に２バイト文字が存在しないかをチェック if IsNumeric2(sChk1) = "False" then exit function ''文字列が半角数字のみかをチェック xCode_Check = True End Function '************************************************************************** ' 関数名： xCode_Check2() ' 内　容：コードの妥当性をチェック ' 引　数： ' 戻　値： ' 作成日： '************************************************************************** Private Function xCode_Check2(sChk1) xCode_Check2 = False If sChk1 <> "" Then if Byte_Check(sChk1) = "True" then exit function ''文字列に２バイト文字が存在しないかをチェック if IsNumeric2(sChk1) = "False" then exit function ''文字列が半角数字のみかをチェック End If xCode_Check2 = True End Function '************************************************************************** ' 関数名： xName_Check() ' 内　容：名前の妥当性をチェック ' 引　数： ' 戻　値： ' 作成日： '************************************************************************* Private Function xName_Check(sChk2) xName_Check = False if sChk2 = "" then exit function ''コードが未入力かチェック if Byte_Check2(sChk2) = "True" then exit function ''文字列に１バイト文字が存在しないかをチェック xName_Check = True End Function '************************************************************************** ' 関数名： xMail_Check() ' 内　容：コードの妥当性をチェック ' 引　数： ' 戻　値： ' 作成日： '************************************************************************** Private Function xMail_Check(sChk3) xMail_Check = False if sChk3 = "" then exit function ''コードが未入力かチェック if Byte_Check(sChk3) = "True" then exit function ''文字列に２バイト文字が存在しないかをチェック xMail_Check = True End Function '******************************************************************** ' 関数名： Byte_Check ' 内　容：文字列に２バイト文字が存在しないかをチェック ' 引　数： sStr (チェックする文字列) ' 戻　値：２バイト文字が存在する場合：True 存在しない場合：False ' 作成日： '******************************************************************** Function Byte_Check(Byref sStr) On Error Resume Next Dim i Dim iCode Byte_Check = False ''戻り値セット（False) For i =1 To Len(sStr) iCode = Asc(Mid(sStr,i,1)) ''各文字の文字コード取得 If iCode >= 1 And iCode <= 255 Then Else ''文字コードが半角文字コードでない場合 Byte_Check = True ''戻り値セット（True) Exit Function End If Next End Function '******************************************************************** ' 関数名： Byte_Check2 ' 内　容：文字列に１バイト文字が存在しないかをチェック ' 引　数： sStr (チェックする文字列) ' 戻　値：１バイト文字が存在する場合：True 存在しない場合：False ' 作成日： '******************************************************************** Function Byte_Check2(sStr) On Error Resume Next Dim i Dim iCode Byte_Check2 = False ''戻り値セット（False) For i =1 To Len(sStr) iCode = Asc(Mid(sStr,i,1)) ''各文字の文字コード取得 If iCode >= 1 And iCode <= 255 Then ''文字コードが半角文字の場合 Byte_Check2 = True ''戻り値セット（True) Exit Function Else End If Next End Function '******************************************************************** ' 関数名： IsNumeric2() ' 内　容：式が数値として評価できるかどうかを調べ、結果をブール型 (Boolean) で返します。 ' 　含まれる文字は+と-.0123456789のみ有功とします ' 引　数： sStr (チェックする文字列) ' 戻　値： True= IsNumeric()でTrueかつ半角文字 / False= それ以外 ' 作成日： '******************************************************************** Function IsNumeric2(sStr) On Error Resume Next Dim intCnt,intAsc If IsNumeric(sStr) = False Then ''IsNumeric()でFalseならFalseを返す IsNumeric2 = False Exit Function End If For intCnt = 1 To Len(sStr) ''+と-.0123456789のみ有功 intAsc = Asc(Mid(sStr,intCnt,1)) If ((intAsc < 43) Or (intAsc > 57)) Or (intAsc = 44) Then IsNumeric2 = False Exit Function End If Next IsNumeric2 = True ''正常終了 End Function '================================================================ '　関数部　ここまで '================================================================ '================================================================ '　ＨＴＭＬ部 '================================================================ %> Webショッピング



		宮城県漁協石巻市東部支所に関するお問い合わせ→

→ HOME　

　

　

　

　

　

<%= pMessage %>

●お支払い方法

checked> 代引き > 現金書留 > 銀行振込

●ご依頼主

お名前
（全角）

class="<%= errName1 %>"> (例：石巻　太郎）

フリガナ
（全角）

class="<%= errKana1 %>"> (例：イシノマキ　タロウ)

郵便番号
（半角数字）

〒 class="<%= errPost11 %>"> - class="<%= errPost12 %>"> (例：012-3456)

ご住所
（全角）

class="<%= errAddress11 %>">
class="<%= errAddress12 %>">
class="<%= errAddress13 %>">

TEL
（半角数字）

class="<%= errTel11 %>"> - class="<%= errTel12 %>"> - class="<%= errTel13 %>"> （例：011-123-4567）

E-mail
（半角英数）

class="<%= errMail1 %>"> ＠ class="<%= errMail2 %>">

>	ご依頼主とお届け先が同一の場合はこちらをチェックして下さい。その際、お届け先のご記入は不要となります。

●お届け先
お名前（全角）	class="<%= errName2 %>"> (例：石巻　花子）
フリガナ（全角）	class="<%= errKana2 %>"> (例：イシノマキ　ハナコ)
郵便番号（半角数字）	〒 class="<%= errPost21 %>"> - class="<%= errPost22 %>"> (例：012-3456)
ご住所（全角）	class="<%= errAddress21 %>"> class="<%= errAddress22 %>"> class="<%= errAddress23 %>">
TEL （半角数字）	class="<%= errTel21 %>"> - class="<%= errTel22 %>"> - class="<%= errTel23 %>"> (例：011-123-4567)

●商品選択

商品名	値段	数量	金額
<%= vHin1 %>	\ <%= cHin1 %>	class="<%= errSuu1 %>">	円
<%= vHin2 %>	\ <%= cHin2 %>	class="<%= errSuu2 %>">	円
		合計	円

このサイトはInternet Explorer5.0以上推奨としております。