<%
Option Explicit
'===========================================
'設定項目（パスワード未利用）
'===========================================
Const cPass = "mscn1919" 'パスワード
Const cPage = 20 '1ページ表示数
'===========================================
' 変数定義
'===========================================
Dim act,kbn,mes,page
Dim ObjConn,ObjRS,StrSQL
Dim ID
Dim title
Dim urlad
Dim comment
Dim osusume
Dim entrydate
Dim keyword
'===========================================
' パラメータの取得
'===========================================
act = Request("act") 'ページ区分
kbn = Request("kbn") '操作区分(追加、修正、削除）
ID = Request("ID") 'レコードのキー
title = Request("title")
urlad = Request("urlad")
comment = Request("comment")
osusume = Request("osusume")
entrydate = Request("entrydate")
keyword = Request("keyword")
'登録画面の設定
if act = "ent" then
Dim pass
if Session("OK") <> "1" then
pass = Request.Form("pass")
if pass = cPass then
Session("OK") = "1"
else
act = ""
end if
end if
end if
'=================================================
'----- 登録画面
'=================================================
Sub Gamen_ent( )
%>
<%
Call DispAll
End Sub
'=================================================
'----- 登録確認画面
'=================================================
'=================================================
'----- 編集画面
'=================================================
'=================================================
'----- 編集確認画面
'=================================================
'=================================================
'----- 削除確認画面
'=================================================
'=================================================
'----- 検索画面
'=================================================
Sub Gamen_src( )
%><%
if keyword <> "" then
Call DispAll
end if
End Sub
'=================================================
'----- 処理完了画面
'=================================================
Sub Gamen_kan( )
%>
<% Call Update_urldata %><%
End Sub
'=================================================
'----- 全件表示
'=================================================
Sub DispAll( )
StrSQL = "select * from urldata "
If keyword <> "" Then
StrSQL = StrSQL & " where title like '%" & keyword & "%' "
StrSQL = StrSQL & " or comment like '%" & keyword & "%' "
End If
StrSQL = StrSQL & " order by osusume desc, ID desc "
Set ObjRS = Server.CreateObject("ADODB.Recordset")
ObjRS.Open StrSQL, ObjConn,3,3
if ObjRS.EOF then Exit Sub
ObjRS.PageSize = cPage
'表示するページを設定
page = Cint(Request("page"))
if page < 1 or page = "" then
page = 1
else
if page > ObjRS.PageCount then
page = ObjRS.PageCount
end if
end if
ObjRS.AbsolutePage = page
Response.Write ObjRS.RecordCount & "件が登録されています"
%><% Call DispPageNav %>
<%
ObjRS.Close
Set ObjRS = Nothing
End Sub
'=================================================
'----- 1件表示
'=================================================
Sub DispOne()
%><%
End Sub
'=================================================
'----- ページナビゲーション表示
'=================================================
Sub DispPageNav()
Dim pp,np,tmpsql
pp = page - 1
np = page + 1
'== keyword ==
if keyword <> "" then
tmpsql = "&keyword=" & Server.URLEncode(keyword)
end if
%>
<% if page > 1 then %><% end if %>
<%
End Sub
'=================================================
'----- 登録データチェック
'=================================================
'=================================================
'----- DB接続
'=================================================
Sub ConnDB()
Set ObjConn = Server.CreateObject("ADODB.Connection")
ObjConn.open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & _
Server.Mappath("db1.mdb")
End Sub
'=================================================
'----- DB更新
'=================================================
Sub Update_urldata()
if kbn = "ent" then
StrSQL = "insert into urldata ("
StrSQL = StrSQL & " title, "
StrSQL = StrSQL & " urlad, "
StrSQL = StrSQL & " comment, "
StrSQL = StrSQL & " osusume, "
StrSQL = StrSQL & " entrydate "
StrSQL = StrSQL & ") values ("
StrSQL = StrSQL & "'" & title & "',"
StrSQL = StrSQL & "'" & urlad & "',"
StrSQL = StrSQL & "'" & comment & "',"
StrSQL = StrSQL & osusume & ","
StrSQL = StrSQL & "#" & entrydate & "#"
StrSQL = StrSQL & ")"
ObjConn.Execute(StrSQL)
If Err = 0 Then
mes ="登録完了"
End If
end if
if kbn = "edi" then
StrSQL = "update urldata set "
StrSQL = StrSQL & " title = '" & title & "',"
StrSQL = StrSQL & " urlad = '" & urlad & "',"
StrSQL = StrSQL & " comment = '" & comment & "',"
StrSQL = StrSQL & " osusume = " & osusume & ","
StrSQL = StrSQL & " entrydate = #" & entrydate & "#"
StrSQL = StrSQL & " where ID = " & ID
ObjConn.Execute(StrSQL)
If Err = 0 Then
mes ="修正完了"
End If
end if
if kbn = "del" then
StrSQL = "delete from urldata "
StrSQL = StrSQL & "where ID = " & ID
ObjConn.Execute(StrSQL)
If Err = 0 Then
mes ="削除完了"
End If
end if
End Sub
'=================================================
'----- DB閉じる
'=================================================
Sub CloseDB()
ObjConn.Close
Set ObjConn = Nothing
End Sub
ARA患者推薦病院NAVI
情報量が増え、目的の情報をとりにくくなったようです。まだ試験中ではありますが役立つとは思います。
ご利用ください。該当データがない場合は表示されません。
サイト内検索＊＊病院名・地域名・病名などで検索ください。リンクはまだ未設定。ａｎｄ検索も未対応。
<% Call ConnDB %>