<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' index.asp
'----------------------------------------------------
' 処 理:TOP画面 キーワード検索
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Option Explicit
Response.Buffer = True
%>
<%
'--- 共通変数 ----
dim cn
dim MaxCont '登録件数
dim arrCtg()
call Main()
sub Main()
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' Main
'----------------------------------------------------
'処 理：メインルーチン
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
dim ErrMsg 'エラーメッセージ
dim strSQL 'SQL文字列
dim rs 'レコードセット
dim flg 'エラーフラグ
dim strMsg 'エラー表示メッセージ
strMsg=""
'-- DB Connect
if dbConnect(ErrMsg,cn) = false then
call dispErrWrite(ErrMsg)
call dbClose(cn)
exit sub
end if
Set rs = Server.CreateObject("ADODB.RecordSet")
'-- 総件数取得
strSQL ="SELECT COUNT(ID) AS DCNT FROM TBL_REPORT;"
rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
MaxCont=FormatNumber(rs("DCNT"),0,true,false,true)
rs.close
set rs = nothing
'-- 検索項目入力チェック
select case request.querystring("PG")
case "T"
'-- タイムアウト
strMsg="接続が切れました。お手数ですが、再度検索してください。"
session.Contents.removeall
case "SRC"
if fncInputCheck(ErrMsg) then
call dispComplete(ErrMsg, "index.asp", "入力にエラーがあります")
response.End()
exit sub
else
response.Redirect("result.asp")
end if
case "ERR"
'-- 検索結果一覧にて不正入力チェック
session.Contents.removeall
case else
call GetDispCategoryStr(cn)
call DispBody(strMsg)
end select
call dbClose(cn)
end sub
function fncInputCheck(strMsg)
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' fncInputCheck(msg)
'----------------------------------------------------
'処 理：入力チェック
'引 数：msg(O) エラーメッセージ
'戻り値：True エラー有 False 正常終了
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
dim blnRet
dim blnInputChk
dim i
dim BaspObj
dim arrInp
dim marrKw(10)
dim flg
'初期化
blnRet=false
blnInputChk=false
strMsg=""
flg=false
set BaspObj = createobject("BASP21")
'フォームの値を作業用配列に格納
marrKw(0)=trim(request.form("txtNenFm"))
marrKw(1)=trim(request.form("txtNenTo"))
marrKw(2)=trim(request.form("txtGoFm"))
marrKw(3)=trim(request.form("txtGoTo"))
marrKw(4)=trim(request.form("txtTitle"))
marrKw(5)=trim(request.form("txtKeyword"))
marrKw(6)=trim(request.form("txtReporter"))
marrKw(7)=trim(request.form("rep_and_or"))
marrKw(8)=setCheckBoxValue(cn)
marrKw(9)=trim(request.form("sel1"))
marrKw(10)=trim(request.form("sel2"))
arrInp=Array("発行年(FROM)","発行年(TO)","記載号(FROM)","記載号(TO)","タイトル","キーワード","報告者")
'値のチェック
if marrKw(0)<>"" and isnull(marrKw(0))=false then
blnInputChk=true
if len(marrKw(0)) > 5 or isnumeric(marrKw(0))=false then
strMsg=strMsg & "・" & arrInp(0) & "は4桁の半角数字で入力してください。 "
blnRet=true
else
if cint(marrKw(0))< 1000 or cint(marrKw(0)) > 9999 then
strMsg=strMsg & "・" & arrInp(0) & "の入力が正しくありません。 "
blnRet=true
else
if (marrKw(9)=1) then
if marrKw(1)="" or isnull(marrKw(1)) then
strMsg=strMsg & "・範囲検索の場合は" & arrInp(1) & "を入力してください。 "
blnRet=true
else
if len(marrKw(1)) > 5 or isnumeric(marrKw(1))=false then
strMsg=strMsg & "・" & arrInp(1) & "は4桁の半角数字で入力してください。 "
blnRet=true
else
if cint(marrKw(1))< 1000 or cint(marrKw(1)) > 9999 then
strMsg=strMsg & "・" & arrInp(1) & "の入力が正しくありません。 "
blnRet=true
end if
end if
end if
end if
end if
end if
end if
if marrKw(2)<>"" and isnull(marrKw(2))=false then
blnInputChk=true
if len(marrKw(2)) > 5 or isnumeric(marrKw(2))=false then
strMsg=strMsg & "・" & arrInp(2) & "は2桁以内の半角数字で入力してください。 "
blnRet=true
else
if cint(marrKw(2))< 1 or cint(marrKw(2)) > 99 then
strMsg=strMsg & "・" & arrInp(2) & "の入力が正しくありません。 "
blnRet=true
else
if (marrKw(10)=1) then
if marrKw(3)="" or isnull(marrKw(3)) then
strMsg=strMsg & "・範囲検索の場合は" & arrInp(3) & "を入力してください。 "
blnRet=true
else
if len(marrKw(3)) > 5 or isnumeric(marrKw(3))=false then
strMsg=strMsg & "・" & arrInp(3) & "は半角数字で入力してください。 "
blnRet=true
else
if cint(marrKw(3))< 1 or cint(marrKw(3)) > 99 then
strMsg=strMsg & "・" & arrInp(3) & "の入力が正しくありません。 "
blnRet=true
end if
end if
end if
end if
end if
end if
end if
for i=4 to 6
if marrKw(i)<>"" and isnull(marrKw(i))=false then
blnInputChk=true
'-- 半角文字 (1 バイト) を全角文字 (2 バイト) に変換
marrKw(i)=BaspObj.StrConv(marrKw(i),4)
if len(marrKw(i))>100 then
strMsg=strMsg & "・" & arrInp(i) & "は100文字以内で入力してください。 "
blnRet=true
end if
end if
next
select case marrKw(8)
case "ERR"
strMsg=strMsg & "・分野の入力が不正です。 "
blnInputChk=true
blnRet=true
case "NO_DATA"
case else
blnInputChk=true
end select
set BaspObj=nothing
if blnInputChk=false then
blnRet=true
strMsg=strMsg & "・検索項目を入力してください。"
else
session("SRC")=marrKw
end if
fncInputCheck=blnRet
end function
function setCheckBoxValue(cn)
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' setChekBoxValue()
'----------------------------------------------------
'処 理：チェックボックスの入力チェックと値のセット
'引 数：なし
'戻り値："NO_DATA"：チェックなし
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
dim ret
dim i
dim rs2
dim strSQL
dim intCnt
dim intCode
intCnt=0
ret=""
Set rs2 = Server.CreateObject("ADODB.RecordSet")
strSQL="SELECT COUNT(CODE) AS CNT FROM MST_CATEGORY;"
rs2.Open strSQL, cn, adOpenStatic, adLockReadOnly
intCnt=rs2("CNT")
rs2.close
for i=0 to intCnt
intCode=request.Form("chk" & i)
if intCode<>"" then
if len(intCode) >5 or isnumeric(intCode)=false then
ret="ERR"
exit for
else
if ret="" then
ret= request.Form("chk" & i)
else
ret=ret & "," & request.Form("chk" & i)
end if
end if
end if
next
if ret="" then
ret="NO_DATA"
end if
setCheckBoxValue=ret
end function
sub GetDispCategoryStr(cn)
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' GetDispCategoryStr()
'----------------------------------------------------
'処 理：分野の項目を二次元配列にセットする
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
dim rs2
dim i
dim strSQL
i=0
Set rs2 = Server.CreateObject("ADODB.RecordSet")
strSQL="SELECT CODE, STR FROM MST_CATEGORY ORDER BY SORT_NO;"
rs2.Open strSQL, cn, adOpenStatic, adLockReadOnly
do until rs2.eof
redim preserve arrCtg(1,i)
arrCtg(0,i)=" " & rs2("STR") & " "
rs2.movenext
if rs2.eof then
arrCtg(1,i)="DATA_END"
else
arrCtg(1,i)="" & rs2("STR") & " "
rs2.movenext
i=i+1
end if
loop
rs2.close
end sub
sub DispBody(msg)
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' DispBody()
'----------------------------------------------------
'処 理：本文表示
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
dim i
%>
リバーフロント研究所報告検索システム
