View Source Code

SourceFileName = "samples/bbs2-search.asp"

C:\inetpub\wwwroot\aspsample\samples\bbs2-search.asp

<!-- このスクリプトはご自由にご利用頂いて結構ですが、無断転用などを禁止いたします。 -->
<!-- 下記のuseridの部分をお客様のユーザーIDと置き換えて下さい。-->
<html>
<head>
<title></title>
</head>
<%
 SENAME = Request.Form("sename")

 If SENAME = "" Then
  Call DispForm
 Else
  Call Disp2(Request("Page"))
 End if
%>
<p>　</p>
<br>
<br>
<br>
<br>
</body>
</html>

<script LANGUAGE="VBScript" RUNAT="Server"> 

Sub DispForm

Response.Write "<html>"
Response.Write "<head>"
Response.Write "<title>掲示板(検索)</title></head>"
Response.Write "<body BGCOLOR=#FFFFEE><font COLOR=BLACK>"
Response.Write "<h1 align=center><font size=5>掲示板(検索)</font></h1></font><p><br></p>"
Response.Write "<form METHOD='POST' ACTION='bbs2-search.asp'>"
Response.Write "<table BGCOLOR=#CCCCFF CELLPADDING=4 CELLSPACING=2 width=573>"
Response.Write "<tr>"
Response.Write "<td WIDTH=77><small>検索文字</small></td>"
Response.Write "<td width=476><input TYPE='text' NAME='sename' SIZE=22><small>(検索したい文字を入力してください)</small></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td width=77></td>"
Response.Write "<td width=476>　<input TYPE='submit' value='検索'><input TYPE='reset' value='クリア'>           <small><font color=#FF0000>最高３０件まで表示可能です。</font></small></td>"
Response.Write "</tr>"
Response.Write "</table>"
Response.Write "</form>"
Response.Write "</body>"
Response.Write "</html>"


End Sub


Sub Disp2(Page)
MaxLine=30
If Page="" Then Page = 0
  Call DispForm
     Set CON = Server.CreateObject("ADODB.Connection")
     CON.Open("DSN=userid_bbs")
     SQL = "Select * From 掲示板 where subject like '%" & SENAME & "%' or body like '%" & SENAME & "%' or name like '%" & SENAME & "%' or email like '%" & SENAME & "%' or link like '%" & SENAME & "%' order by [code] desc"
     Set RS = CON.Execute(SQL)
     On Error Resume Next

Response.Write "<a href='bbs2.asp'>戻る</a>"
Response.Write "<HR>"
Response.Write "「" & SENAME & "」の検索結果です。<br>"

Response.Write buf & "<HR>"

Set InStream = objFile.OpenTextFile(LogFile, 1, False)
LineCount = 1
buf = ""
     Do While Not RS.EOF
          If LineCount > MaxLine Then Exit Do
          LineCount = LineCount + 1
          buf = buf & "<TABLE CELLPADDING=4 WIDTH=100% BORDER><TR>"
          buf = buf & "<TD BGCOLOR=#CCFFCC WIDTH=60>#" & Right("0000" & CSTR(CSNG(RS("code"))), 4) & "</TD>"
          If RS("email") = "" Or RS("email") = " " Then
             buf = buf & "<TD BGCOLOR=#CCFFCC>" & RS("name") & "</TD>"
          Else
             buf = buf & "<TD BGCOLOR=#CCFFCC><A HREF=" & Chr(34) & "mailto:" & RS("email") & "?Subject=Re: " & RS("subject") & Chr(34) & ">" & RS("name") & "</A></TD>"
          End If
          buf = buf & "<TD BGCOLOR=#CCFFCC WIDTH=120 ALIGN=CENTER><FONT SIZE=2>" & RS("date") & " " & RS("time") & "</FONT></TD></TR></TABLE>"
          buf = buf & "<TABLE CELLPADDING=4 WIDTH=100% BORDER>"
          buf = buf & "<TR><TD BGCOLOR=#CCCCCC COLSPAN=3>" & RS("subject") & "</TD></TR>"
          buf = buf & "<TR><TD BGCOLOR=WHITE COLSPAN=3>" & RS("body")
          If RS("link") = "http://" Then
             buf = buf & "</TD></TR>"
          Else
             buf = buf & "<BR><A HREF=" & Chr(34) & RS("link") & Chr(34) & "target=" & Chr(34) & "_blank" & Chr(34) & ">" & RS("link") & "</A></TD></TR>"
          End If
          buf = buf & "</TABLE><BR>"
          RS.MoveNext
     Loop
     Response.Write buf
     Response.Write "<BR><HR>全部で" & LineCount - 1 & "件　表示されています。"

     Response.Write "<HR>"
     RS.Close
     Set RS = Nothing
     CON.Close
     Set CON = Nothing

End Sub

</script>