<% '''''''''''UELやメールの強制改行''''''''' Function GETCR(surl,lunit) '''surl = "http://yoyotaiwan777777777777777777777777.boo.jp" '''lunit = 20 If Len(surl) > lunit then cnt = Int((Len(surl)-1) / lunit) surl2 = "" For i = 1 to cnt surl2 = surl2 & Mid(surl,(i-1)*lunit+1,lunit) & "
" Next GETCR = surl2 & Mid(surl,cnt*lunit+1) Else GETCR = surl End If End Function '''''''''''UELやメールのリンク強制改行表示''''''''' Function GETLINK(scomment,icrnum) aComment = scomment sCommBefore = "" sCommAfter = aComment For i = 1 to 20 iposLink = InStr(sCommAfter,"<") if iposLink > 0 then iposEnd = InStr(sCommAfter,">") iposMeil = InStr(sCommAfter,"@") sUrlAddress = Mid(sCommAfter,iposLink+1,iposEnd-iposLink-1) if Left(sUrlAddress, 7) = "http://" then '''Response.Write "*** http ***
" sCommBefore = sCommBefore & Mid(sCommAfter,1,iposLink-1) &_ "" &_ GETCR(sUrlAddress,icrnum) & "" elseif iposMeil>0 AND iposMeil" sCommBefore = sCommBefore & Mid(sCommAfter,1,iposLink-1) &_ "" & GETCR(sUrlAddress,icrnum) & "" else '''Response.Write "*** nolink ***
" sCommBefore = sCommBefore & Mid(sCommAfter,1,iposEnd) end if sCommAfter = Mid(sCommAfter,iposEnd+1) else Exit For end if Next GETLINK = sCommBefore & sCommAfter End Function ptype = Request("ptype") Session("ptype")=ptype Dim a_read(20) Set C = Server.CreateObject("ADODB.Connection") Set R = Server.CreateObject("ADODB.Recordset") path = GetPath() C.Open path updid = Trim(Request("updid")) delkey = Trim(Request("delkey")) if (delkey="almt") and (updid="") then %> <% end if if Request("updmode")="GO" then if delkey<>"almt" then sAlmt = "" if updid="" then Call ErrorOut("書込みNoを入力してください", -1) end if if delkey="" then Call ErrorOut("削除/変更用キーを入力してください", -1) end if sql = "SELECT * FROM イベント情報 WHERE 表示識別 = 1 AND ID = " & updid else sAlmt = "almt" sql = "SELECT * FROM イベント情報 WHERE ID = " & updid end if if updid<>"" then R.Open sql, C, 1, 1, 1 if Not R.EOF then a_read(1) = R("イベント名") a_read(2) = R("イベント内容") a_read(3) = R("開催日時") a_read(4) = R("開催場所") a_read(5) = R("主催者") a_read(6) = R("問合先") a_read(7) = R("問合URL") a_read(8) = R("備考") a_read(9) = R("問合MAIL") a_read(10) = R("表示識別") a_read(11) = R("掲載期限") a_read(12) = R("削除変更キー") if (a_read(12)<>delkey) AND ("almt"<>delkey) then Call ErrorOut("削除/変更用キーに誤りがあります", -1) end if else Call ErrorOut("書込みNoが見当たりません", -1) end if R.Close end if end if if delkey<>"almt" then sql = "SELECT * FROM イベント情報 WHERE 種別ID = 1 AND 表示識別 = 1 AND 掲載期限 >= '" & Date() & "' ORDER BY ID DESC" else sql = "SELECT * FROM イベント情報 WHERE 種別ID = 1 ORDER BY ID DESC" end if R.Open sql, C, 1, 1, 1 count = 0 %>
<% if ptype <> "asn" then %> <% end if %> <% if ptype <> "asn" then %> <% end if %>
Yoppiファンとあなたをつなぐコミュニケーションサイト・・・Yoppi club・・・
トップページに戻る
<% if ptype <> "asn" then %> <% else %> <% end if %>
イベント情報イベント情報
皆さんからの情報 市民イベント情報 地区センター情報 福祉保健センターのイベント情報
皆さんからの情報
こちらの情報はYoppi利用者の方が書込まれたものです。詳細については各主催者にお問合せください。
ご利用にあたって
新規書込、書込内容の削除・修正はこちら

<% Do Until R.EOF count = count + 1 %> <% if R("表示識別")=True then %> <% if R("掲載期限")>=Date() then %> <% else %> <% end if %> <% else %> <% end if %> <% R.MoveNext Loop R.Close C.Close Set R = Nothing Set C = Nothing %>
No. イベント名・内容 開催日時・場所 主催・お問合せ先 備考
<%=R("ID")%> ●<%=R("イベント名")%>
<%=Replace(GETLINK(R("イベント内容"),25),vbcrlf,"
")%>
<%=GETLINK(R("開催日時"),15)%>
<%=GETLINK(R("開催場所"),15)%>
<%=R("主催者")%>
<%=R("問合先")%>
<% if Trim(R("問合URL"))>"" then %> <%=GETCR(R("問合URL"),20)%>
<% end if %> <% if Trim(R("問合MAIL"))>"" then %> <%=GETCR(R("問合MAIL"),20)%> <% end if %>
<%=GETLINK(R("備考"),15)%><%=R("ID")%> ●<%=R("イベント名")%>
<%=Replace(GETLINK(R("イベント内容"),25),vbcrlf,"
")%>
<%=GETLINK(R("開催日時"),15)%>
<%=GETLINK(R("開催場所"),15)%>
<%=R("主催者")%>
<%=R("問合先")%>
<% if Trim(R("問合URL"))>"" then %> <%=GETCR(R("問合URL"),20)%>
<% end if %> <% if Trim(R("問合MAIL"))>"" then %> <%=GETCR(R("問合MAIL"),20)%> <% end if %>
<%=GETLINK(R("備考"),15)%><%=R("ID")%> ●<%=R("イベント名")%>
<%=Replace(GETLINK(R("イベント内容"),25),vbcrlf,"
")%>
<%=GETLINK(R("開催日時"),15)%>
<%=GETLINK(R("開催場所"),15)%>
<%=R("主催者")%>
<%=R("問合先")%>
<% if Trim(R("問合URL"))>"" then %> <%=GETCR(R("問合URL"),20)%>
<% end if %> <% if Trim(R("問合MAIL"))>"" then %> <%=GETCR(R("問合MAIL"),20)%> <% end if %>
<%=GETLINK(R("備考"),15)%>

既に書込んだ内容の削除・変更・・・ 書込みNo.  削除・変更用キー 

<% if delkey="almt" then %> <% end if %> <% if Request("updmode")<>"GO" then %> <% else %> <% end if %>
※印は必ず記入して下さい。  また、内容、開催日時・場所、備考にURLやメールアドレスを記載する場合は、必ず<>で囲んでください。(例 <http://www.abc.co.jp> ) なお、問合せURL・メールアドレスは<>で囲まずそのまま記載してください。自動的にリンク表示されます。
●イベント名(50文字以内)
●内容(200字以内)
●開催日時(50文字以内)
●開催場所(100文字以内)
●主催
●問合せ先
●問合せURL
●問合せメールアドレス
●備考(100文字以内)
●表示識別 >表示  >非表示(削除)
●掲載期限  まで掲載  入力例:2004/12/5
●削除/変更用キー  4桁半角英数字
     

トップページに戻る