<%@ LANGUAGE = "VBScript" %>
<%
'***************************************************************************
' 掲示板 for mobile
' テキストファイル仕様
' 2006/02 SQLｲﾝｼﾞｪｸｼｮﾝ対策修正
'***************************************************************************
On Error Resume Next 'エラー処理ON
Response.Buffer=True
'==================================================
' 初期設定
'==================================================
'//携帯判別
Dim KEITAI,wk_br,wk_hr
wk_br = "
"
wk_hr = "
"
KEITAI = Request.ServerVariables("HTTP_USER_AGENT")
If InStr(KEITAI,"DoCoMo") > 0 then
KEITAI = "i"
method = "get"
input_mode_al = "istyle=" & """" & "3" & """"
input_mode_num = "istyle=" & """" & "4" & """"
ElseIf InStr(KEITAI,"J-PHONE") > 0 then
KEITAI = "j"
method = "get"
input_mode_al = "mode=" & """" & "alphabet" & """"
input_mode_num = "mode=" & """" & "numeric" & """"
ElseIf InStr(KEITAI,"UP.Browser") > 0 then 'au対応 200404
KEITAI = "a"
method = "get"
input_mode_al = "format=" & """" & "*m" & """"
input_mode_num = "format=" & """" & "*n" & """"
wk_br = "
"
wk_hr = "
"
Else
KEITAI = "p"
method = "post"
End If
TITLE = "i-exer 掲示板 for mobile" '掲示板タイトル
BLANK = " " '２バイトスペース
COUNTER = 1 '
NEW_DATE = 86400 '２４時間以内の投稿か？
ASP_NAME = "bbs.asp" 'aspファイル名
MAX_LOG = 100 '最大ログ数
MAX_PLOG = 3 '表示件数/１ページ
DELKEY = "suko" '管理者用削除キー
Wk_sort_flg = 0 ' 最新記事をTopに表示する(0=no 1=yes)
Wk_autolink = 0 ' URLの自動リンク (0=no 1=yes)※タグ許可の場合は (0=no) とすること。
'** SQLｲﾝｼﾞｪｸｼｮﾝ対策「EncodeText」追加(2006/02)
NO = EncodeText(Request("no")) '記事番号
NAME = EncodeText(Request("name")) '名前
MAIL = EncodeText(Request("mail")) 'メールアドレス
URL = EncodeText(Request("url")) 'ＵＲＬ
DEL_ID = EncodeText(Request("del_id")) '削除ＩＤ
SUBJECT = EncodeText(Request("subject")) '題名
COMMENT = EncodeText(Request("comment")) 'コメント
NUMBER = EncodeText(Request("number")) '番号
TOTAL = EncodeText(Request("total")) '
PARENT = EncodeText(Request("parent")) '親記事NO
RES = EncodeText(Request("res")) 'レス記事
PAGE = EncodeText(Request("page")) '
MODE = EncodeText(Request("mode")) '処理モード
FLG = EncodeText(Request("flg")) 'フラグ
NEXTCNT = EncodeText(Request("nextcnt")) '
BACKCNT = EncodeText(Request("backcnt")) '
Wk_TopCnt= EncodeText(Request.Querystring("TopCnt"))
S_IJ = EncodeText(Request("ij"))
If MODE = "login" then
ID = EncodeText(Request("id")) 'ID
PASSWD = EncodeText(Request("passwd")) 'パスワード
Else
IJ = decode(S_IJ)
If IJ <> "" then
ID = Mid(IJ,1,7) 'ID
PASSWD = Mid(IJ,8,Len(IJ) - 7) 'パスワード
Else
ID = "" 'ID
PASSWD = "" 'パスワード
End If
End If
Wk_logfile = "bbs1.log" ' ログファイル名
Wk_Lockfile = "lock1.dat" 'ロックファイル名
Wk_LockAfile = "Alock1.dat" 'アンロックファイル名
Dim PARE_CNT '親記事件数
Dim LOG_CNT 'ログ総件数
Dim MAX_LOG
Dim OBJCMD, OBJID
'作業用変数
Dim Wk_AllLog_array()
ReDim Preserve Wk_AllLog_array(MAX_LOG - 1)
Dim Wk_mode
Dim Wk_tno
Dim Wk_no
Dim Wk_reno
Dim Wk_date
Dim Wk_name
Dim Wk_mail
Dim Wk_sub
Dim Wk_mes
Dim Wk_url
Dim Wk_del
Dim Wk_title
Dim Wk_comment
Dim Wk_host_ip
Dim Wk_pwd
Dim Wk_parent
Dim Wk_delflg
Dim Wk_flg
Dim Wki_word
Dim Wki_cond
Dim Wki_no
Dim Wki_reno
Dim Wki_pwd
Dim Wki_pwd2 ' クッキー用
Dim Wki_name
Dim Wki_email
Dim Wki_sub
Dim Wki_mes
Dim Wki_url
Dim Wki_pass
Dim Wki_res
Dim Cnt_All
Dim Cnt_Today
Dim Cnt_Yesterday
Dim Wk_User_Agent
Dim wk_moji,wk_mojisuu
Server.ScriptTimeout = 90
'==================================================
' 処理分岐
'==================================================
Select Case MODE
Case "login" Call LOGIN()
Case "add" Call ADD()
Case "delete" Call DELETE()
End Select
Call HEADER()
Select Case MODE
Case "" Call LOGIN_FORM()
Case "view" Call VIEW()
Case "add_form" Call ADD_FORM()
Case "del_form" Call DEL_FORM()
End Select
Call FOOTER()
'==================================================
' ヘッダー処理
'==================================================
Sub HEADER()
If KEITAI ="a" then
%>
<%=TITLE%>
<%=TITLE%>
<%= wk_hr %>
<%
Else
%>
<%=TITLE%>
<%=TITLE%>
<%= wk_hr %>
<%
End If
End Sub
'==================================================
' フッター処理
'==================================================
Sub FOOTER()
%>
<%
End Sub
'==================================================
' ログイン処理
'==================================================
Sub LOGIN_FORM()
If KEITAI ="a" then 'AUの場合 200404
%>
i-exer掲示板<%= wk_br %>
【ログイン】<%= wk_br %>
<%= wk_br %>
[TOP画面へ]<%= wk_br %>
<%= wk_hr %>
(C)sukoyaka center
<%
Else 'AU以外 200404
%>
i-exer掲示板<%= wk_br %>
【ログイン】<%= wk_br %>
<%= wk_br %>
[TOP画面へ]<%= wk_br %>
<%= wk_hr %>
(C)sukoyaka center
<%
End If
End Sub
'==================================================
' ログイン処理
'==================================================
Sub LOGIN()
If ID = "" then
CALL ERROR("ユーザーＩＤを入力してください。")
End If
If PASSWD = "" then
CALL ERROR("パスワードを入力してください。")
End If
'//ＤＢ接続
Set OBJ = Server.CreateObject("ADODB.Connection")
OBJ.Open DSN, DBUSER, DBPASSWD
'//レコードセット
'SQL = "SELECT ログインID, パスワード FROM PERSONAL_DATA WHERE ログインID = '" & Cstr(ID) & "'"
'Set RS = OBJ.Execute(SQL)
'** SQLｲﾝｼﾞｪｸｼｮﾝ対策ここから（2006/02） **
Set OBJCMD = Server.CreateObject("ADODB.Command")
OBJCMD.CommandText= "SELECT ログインID, パスワード FROM PERSONAL_DATA WHERE ログインID = ?"
'-[ｺﾏﾝﾄﾞを文字列として扱う]
OBJCMD.CommandType = 1
OBJCMD.ActiveConnection = OBJ
Set OBJID = Server.CreateObject("ADODB.Parameter")
OBJID.Value = ID
OBJID.Size = Len(ID)
OBJID.Type = 200
OBJCMD.Parameters.Append OBJID
Set RS = OBJCMD.Execute()
'** SQLｲﾝｼﾞｪｸｼｮﾝ対策ここまで（2006/02） **
eof_f = RS.EOF
If eof_f = true then
RS.Close
Set RS = Nothing
Set OBJID = Nothing
Set OBJCMD = Nothing
OBJ.Close
Set OBJ = Nothing
CALL ERROR_L("ユーザーＩＤもしくはパスワードが間違っています。")
Else
MODE = "view"
S_IJ = encode(ID,PASSWD)
End If
RS.Close
Set RS = Nothing
Set OBJID = Nothing
Set OBJCMD = Nothing
OBJ.Close
Set OBJ = Nothing
End Sub
'==================================================
' 記事の一覧表示
'==================================================
Sub VIEW()
'//ＤＢ接続
Set OBJ = Server.CreateObject("ADODB.Connection")
OBJ.Open DSN, DBUSER, DBPASSWD
'//個人情報テーブル レコードセット
SQL = "SELECT * FROM PERSONAL_DATA WHERE ログインID = '" & ID & "'"
Set RS = OBJ.Execute(SQL)
If RS.EOF = true then
RS.Close
OBJ.Close
CALL ERROR("ユーザーＩＤが間違っています。1")
End If
%>
←i-exerトップ<%= wk_br %>
[ 新規書込み ]
<%= wk_br %>
<%= wk_hr %>
<%
' 改ページ用処理
Wk_start = CInt(Wk_TopCnt) + 1
Wk_end = CInt(Wk_TopCnt) + CInt(MAX_PLOG)
On Error Resume Next
'***logファイルから記事情報を取得***
Set objFile = CreateObject("Scripting.FileSystemObject")
Set DataFile = objFile.OpenTextFile (BBSLOGDIR & Wk_logfile,1,FALSE)
If Err.Number > 0 Then
Call ERROR("ログファイルの読み込みに失敗しました１")
Else
If DataFile.AtEndOfStream = true Then '一件もなかったら表示なし
Response.Write wk_br & wk_br & vbCRLF
Exit Sub
Else
Do Until DataFile.AtEndOfStream
Wk_LineCnt = DataFile.Line - 1
If Wk_LineCnt >= 0 Then
Wk_AllLog_array(Wk_LineCnt - 1) = DataFile.ReadLine
End If
Loop
End If
End If
'
DataFile.Close
Set DataFile = Nothing
Set objFile = Nothing
'
On Error GoTo 0
Wk_Ix = 0
For Each Wkl_AllLog In Wk_AllLog_array
Wkl_AllLog_array = split(Wkl_AllLog,"<>")
If UBound(Wkl_AllLog_array) >= 9 Then
Wk_no = Wkl_AllLog_array(0)
Wk_reno = Wkl_AllLog_array(1)
Wk_name = Wkl_AllLog_array(2)
Wk_mail = Wkl_AllLog_array(3)
Wk_url = Wkl_AllLog_array(4)
Wk_del = Wkl_AllLog_array(5)
Wk_title = Wkl_AllLog_array(6)
Wk_comment = Wkl_AllLog_array(7)
Wk_date = Wkl_AllLog_array(8)
Wk_host_ip = Wkl_AllLog_array(9)
Else
Exit For
End If
Wk_Ix = Wk_Ix + 1 '親記事カウント
If (Wk_Ix < Wk_start) or (Wk_Ix > Wk_end) Then
Wkl_AllLog_array = split(Wkl_AllLog,"<>")
If UBound(Wkl_AllLog_array) < 8 Then
Wk_Ix = Wk_Ix - 1
Exit For
End If
Else
Call DTAILVIEW() ' 明細表示
End If
Next
Wk_Next_top = CInt(Wk_TopCnt) + MAX_PLOG
Wk_back_top = CInt(Wk_TopCnt) - MAX_PLOG
If ((Wk_back_top >= 0) or (Wk_Next_top < Wk_ix)) Then
Response.Write "
" & vbCRLF
End If
%>
<%
If KEITAI ="a" then 'AUの場合 200404
If Wk_back_top >= 0 Then
%>
<%
End If
If Wk_Next_top < Wk_Ix Then
%>
<%
End If
Else 'AU以外 200404
If Wk_back_top >= 0 Then
%>
<%
End If
If Wk_Next_top < Wk_Ix Then
%>
<%
End If
End If
%>
<%
End Sub
'==================================================
' ログの詳細表示
'==================================================
Sub DTAILVIEW()
If (Wk_reno = 0) and (Wk_flg = 1) Then
Wk_flg = 1
End If
If Wk_autolink = 1 Then ' 自動リンク
If Instr(Wk_comment,wk_br) > 0 Then
Wk_comment_array = Split(Wk_comment,wk_br)
For Each Wkl_mes In Wk_comment_array
If Wk_Ix > 0 Then
Wkl_mes_all = Wkl_mes_all & wk_br & auto_link(Wkl_mes)
Else
Wkl_mes_all = auto_link(Wkl_mes)
End If
Wk_Ix = Wk_Ix + 1
Next
Wk_comment = Wkl_mes_all
Else
Wk_comment = auto_link(Wk_comment)
End If
End If
%>
[<%=Wk_no%>]<%=Wk_title%><%= wk_br %>
<%
'メールリンク
If Wk_mail <> "" Then
%>
><%=Wk_name%>さん<%= wk_br %>
<% Else %>
<%=Wk_name%>さん<%= wk_br %>
<% End If %>
<%=Wk_date%><%= wk_br %>
<%= wk_br %><%=Wk_comment%><%= wk_br %>
<%= wk_br %>
[返信]
[削除]
<%= wk_hr %>
<%
Wk_flg = 1
End Sub
'==================================================
' 新規・返信 書き込み用フォーム
'==================================================
Sub ADD_FORM()
If C_URL = "" Then
C_URL = "http://"
End If
If RES = "res" Then
On Error Resume Next
'***logファイルから記事情報を取得***
Set objFile = CreateObject("Scripting.FileSystemObject")
Set DataFile = objFile.OpenTextFile (BBSLOGDIR & Wk_logfile,1,FALSE)
If Err.Number > 0 Then
Call ERROR("ログファイルの読み込みに失敗しました２")
Else
Do Until DataFile.AtEndOfStream
Wk_LineCnt = DataFile.Line - 1
If Wk_LineCnt >= 0 Then
Wk_AllLog_array(Wk_LineCnt - 1) = DataFile.ReadLine
End If
Loop
End If
'
DataFile.Close
Set DataFile = Nothing
Set objFile = Nothing
'
On Error GoTo 0
Wk_flag = 0
Wk_Ix = 0
For Each Wkl_AllLog In Wk_AllLog_array
Wkl_AllLog_array = split(Wkl_AllLog,"<>")
If UBound(Wkl_AllLog_array) >= 9 Then
Wk_no = Wkl_AllLog_array(0)
Wk_reno = Wkl_AllLog_array(1)
Wk_name = Wkl_AllLog_array(2)
Wk_mail = Wkl_AllLog_array(3)
Wk_url = Wkl_AllLog_array(4)
Wk_del = Wkl_AllLog_array(5)
Wk_title = Wkl_AllLog_array(6)
Wk_comment = Wkl_AllLog_array(7)
Wk_date = Wkl_AllLog_array(8)
Wk_host_ip = Wkl_AllLog_array(9)
End If
If NO = Wk_no Then
Wk_flag = 1
Exit For
End If
Next
If Wk_flag = 0 Then
Call ERROR("該当記事が見つかりません。")
End If
Wk_title = Replace(Wk_title,"^Re:","")
Wk_r_title = "Re:[" & Wk_no & "] " & Wk_title
Wk_parent = NO
End If
If KEITAI ="a" then 'AUの場合 200404
%>
書き込みフォーム<%= wk_br %>
<%
Else'AU以外 200404
%>
書き込みフォーム<%= wk_br %>
<%
End If
End Sub
'==================================================
' 追加処理
'==================================================
Sub ADD()
If NAME = "" Or SUBJECT = "" then
Call ERROR("必須項目を埋めてください。")
End If
wk_moji = HanTokumojicheck(trim(NAME))
If wk_moji <> "" then
Call ERROR("名前に半角特殊文字は入力できません。")
End If
If MAIL <> "" then
wk_mojisuu = Len(trim(MAIL))
wk_moji = trim(MAIL)
If InStr(wk_moji,"@") < 2 then
Call ERROR("Ｅメールアドレスが不正です。")
End If
For i = 1 to wk_mojisuu
If (Mid(wk_moji,i,1) < "!") or (Mid(wk_moji,i,1) > "~")then
Call ERROR("Ｅメールアドレスは半角で入力してください。")
Exit For
End If
NEXT
End If
If COMMENT = "" Then
Call ERROR("コメントがありません。")
End If
wk_moji = HanTokumojicheck(trim(COMMENT))
If wk_moji <> "" then
Call ERROR("コメントに半角特殊文字は入力できません。")
End If
If PARENT = "" Then
PARENT = 0
End If
URL = ""
If DEL_ID = "" Then
DEL_ID = DELKEY
Else
delno = Len(DEL_ID)
If delno <> "4" then
Call ERROR("削除キーは半角数字４桁で入力してください。")
Else
moji = trim(DEL_ID)
For i = 1 to delno
IF (Mid(moji,i,1) < "0") or (Mid(moji,i,1) > "9") then
Call ERROR("削除キーを半角数字４桁で記入してください。")
END IF
NEXT
wk_moji = HanTokumojicheck(trim(DEL_ID))
If wk_moji <> "" then
Call ERROR("削除キーに半角特殊文字は入力できません。")
End If
End If
End If
TODAY = Now
HOST_IP = Request.ServerVariables("REMOTE_ADDR")
On Error Resume Next
'***logファイルから記事情報を取得***
Set objFile = CreateObject("Scripting.FileSystemObject")
Set DataFile = objFile.OpenTextFile (BBSLOGDIR & Wk_logfile,1,FALSE)
If Err.Number > 0 Then
Call ERROR("ログファイルの読み込みに失敗しました３ ")
Else
Do Until DataFile.AtEndOfStream
Wk_LineCnt = DataFile.Line - 1
If Wk_LineCnt >= 0 Then
Wk_AllLog_array(Wk_LineCnt - 1) = DataFile.ReadLine
Wkl_Log_array = Split(Wk_AllLog_array(Wk_LineCnt - 1),"<>")
If UBound(Wkl_Log_array) >= 1 Then
Wk_last_no = Wkl_Log_array(0)
If Cint(Wk_tno) < Cint(Wk_last_no) then
Wk_tno = Wk_last_no
End If
End If
End If
Loop
End If
'
DataFile.Close
Set DataFile = Nothing
Set objFile = Nothing
'
On Error GoTo 0
' 再番用に特別処理（削除等で同じ番号がかぶらないように２倍でループ）
If CInt(Wk_tno) >= (MAX_LOG * 2) Then ' 記事Noを採番
Wk_no = CInt(1)
Wk_tno = Wk_no
Else
Wk_no = Wk_tno + 1
Wk_tno = Wk_no
End If
NAME = Replace(NAME,"<","<")
MAIL = Replace(MAIL,"<","<")
URL = Replace(URL,"<","<")
SUBJECT = Replace(SUBJECT,"<","<")
COMMENT = Replace(COMMENT,"<","<")
NAME = Replace(NAME,"'","’")
MAIL = Replace(MAIL,"'","’")
URL = Replace(URL,"'","’")
SUBJECT = Replace(SUBJECT,"'","’")
COMMENT = Replace(COMMENT,"'","’")
NAME = Replace(NAME,"\","￥")
MAIL = Replace(MAIL,"\","￥")
URL = Replace(URL,"\","￥")
COMMENT = Replace(COMMENT,"\","￥")
NAME = Replace(NAME,"*","＊")
MAIL = Replace(MAIL,"*","＊")
URL = Replace(URL,"*","＊")
COMMENT = Replace(COMMENT,"*","＊")
COMMENT = Replace(COMMENT,Chr(13) + Chr(10),wk_br)
COMMENT = Replace(COMMENT,Chr(10),wk_br)
COMNO = NUMBER & ".dat"
' 編集＆書き込み
Wkl_write_data = Wk_no & "<>"
Wkl_write_data = Wkl_write_data & PARENT & "<>"
Wkl_write_data = Wkl_write_data & NAME & "<>"
Wkl_write_data = Wkl_write_data & MAIL & "<>"
Wkl_write_data = Wkl_write_data & URL & "<>"
Wkl_write_data = Wkl_write_data & DEL_ID & "<>"
Wkl_write_data = Wkl_write_data & SUBJECT & "<>"
Wkl_write_data = Wkl_write_data & COMMENT & "<>"
Wkl_write_data = Wkl_write_data & TODAY & "<>"
Wkl_write_data = Wkl_write_data & HOST_IP & "<>"
Wkl_write_data = Wkl_write_data & "<><>"
write_data(Wkl_write_data)
End Sub
'==================================================
'* データの書き込み
'==================================================
Sub write_data(Wk_In)
On Error Resume Next
Call File_Lock()
Set objFile = CreateObject("Scripting.FileSystemObject")
Set WDateFile = objFile.OpenTextFile(BBSLOGDIR & Wk_logfile,2,true)
'
If Err.Number > 0 Then
Call ERROR("ログファイルの読み込みに失敗しました４")
Else
Wkl_In_array = split(Wk_In,"<>")
If UBound(Wkl_In_array) >= 1 Then
Wkl_no = Wkl_In_array(0)
Wkl_reno = Wkl_In_array(1)
End If
'
WDateFile.WriteLine Wk_tno & "<>" & Wk_admes & "<><><><><><><><><><><><>"
If Wkl_reno = 0 Then ' 親記事の時
WDateFile.WriteLine(Wk_In)
For Wk_Ix = 0 To (MAX_LOG - 2)
WDateFile.WriteLine(Wk_AllLog_array(Wk_Ix))
Next
Else ' 子記事の時
If Wk_sort_flg = 0 Then ' ソートしない
Wkl_sw = 0
Ix1 = 0
ReDim Preserve Wkl_AllLog_array2(MAX_LOG - 1)
For Each Wkl_Log In Wk_AllLog_array
Wkl_Log_array = split(Wkl_Log,"<>")
If UBound(Wkl_Log_array) >= 1 Then
Wkl_Log_no = Wkl_Log_array(0)
Wkl_Log_reno = Wkl_Log_array(1)
Else
Exit For
End If
If (Wkl_sw = 0) and (Wkl_reno = Wkl_Log_no) Then
Wkl_sw = 1
Else
If (Wkl_sw = 1) and (Wkl_reno <> Wkl_Log_reno) Then
Wkl_sw = 2
Wkl_AllLog_array2(Ix1) = Wk_In
Ix1 = Ix1 + 1
End If
End If
Wkl_AllLog_array2(Ix1) = Wkl_Log
Ix1 = Ix1 + 1
Next
If Wkl_sw = 1 Then
Wkl_AllLog_array2(Ix1) = Wk_In
End If
For Each Wkl_Log2 In Wkl_AllLog_array2
WDateFile.WriteLine(Wkl_Log2)
Next
Else ' 最上へのソートをする
Wkl_sw = 0
Ix1 = 0
Iy1 = 0
ReDim Preserve Wkl_AllLog_array2(MAX_LOG - 1)
ReDim Preserve Wkl_AllLog_array3(MAX_LOG - 1)
For Each Wkl_Log In Wk_AllLog_array
Wkl_Log_array = split(Wkl_Log,"<>")
If UBound(Wkl_Log_array) >= 1 Then
Wkl_Log_no = Wkl_Log_array(0)
Wkl_Log_reno = Wkl_Log_array(1)
Else
Exit For
End If
If Wkl_reno = Wkl_Log_no Then
Wkl_AllLog_array2(Ix1) = Wkl_Log
Ix1 = Ix1 + 1
Wkl_sw = 1
Else
If Wkl_reno = Wkl_Log_reno Then
Wkl_AllLog_array2(Ix1) = Wkl_Log
Ix1 = Ix1 + 1
Else
If (Wkl_sw = 1) And (Wkl_reno <> Wkl_Log_reno) Then
Wkl_AllLog_array2(Ix1) = Wk_In
Wkl_AllLog_array3(Iy1) = Wkl_Log
Ix1 = Ix1 + 1
Iy1 = Iy1 + 1
Wkl_sw = 2
Else
Wkl_AllLog_array3(Iy1) = Wkl_Log
Iy1 = Iy1 + 1
End If
End If
End If
Next
If Wkl_sw = 1 Then
Wkl_AllLog_array2(Ix1) = Wk_In
Ix1 = Ix1 + 1
End If
For Each Wkl_Log3 In Wkl_AllLog_array3
Wkl_AllLog_array2(Ix1) = Wkl_Log3
Ix1 = Ix1 + 1
Next
For Each Wkl_Log2 In Wkl_AllLog_array2
WDateFile.WriteLine(Wkl_Log2)
Next
End If
End If
End If
'
WDateFile.Close
Set WDataFile = Nothing
Set objFile = Nothing
'
Call File_UnLock()
'
On Error GoTo 0
MODE = "view"
End Sub
'==================================================
' 削除フォーム
'==================================================
Sub DEL_FORM()
If KEITAI ="a" then 'AUの場合 200404
%>
削除フォーム
<%= wk_br %>
No. <%=NO%>
を削除します。よろしいですか？<%= wk_br %>
<%= wk_br %>
<%
Else'AU以外 200404
%>
削除フォーム
<%= wk_br %>
No. <%=NO%>
を削除します。よろしいですか？<%= wk_br %>
<%= wk_br %>
<%
End If
End Sub
'==================================================
' 削除処理
'==================================================
Sub DELETE()
If DEL_ID = "" Then
Call ERROR("削除キーが未入力です")
End If
On Error Resume Next
'***logファイルから記事情報を取得***
Set objFile = CreateObject("Scripting.FileSystemObject")
Set DataFile = objFile.OpenTextFile (BBSLOGDIR & Wk_logfile,1,FALSE)
If Err.Number > 0 Then
Call ERROR("ログファイルの読み込みに失敗しました１")
Else
If DataFile.AtEndOfStream = true Then '一件もなかったら表示なし
Exit Sub
Else
Do Until DataFile.AtEndOfStream
Wk_LineCnt = DataFile.Line - 1
If Wk_LineCnt > 0 Then
Wk_AllLog_array(Wk_LineCnt - 1) = DataFile.ReadLine
Else
Wkl_Log = DataFile.ReadLine
Wkl_Log_array = Split(Wkl_Log,"<>")
If UBound(Wkl_Log_array) >= 1 Then
Wk_tno = Wkl_Log_array(0)
Wk_admes = Wkl_Log_array(1)
End If
End If
Loop
End If
End If
'
DataFile.Close
Set DataFile = Nothing
Set objFile = Nothing
'
On Error GoTo 0
Wk_flag=0
For Each Wkl_Log In Wk_AllLog_array
Wkl_Log_array = split(Wkl_Log,"<>")
If UBound(Wkl_Log_array) >= 9 Then
Wk_no = Wkl_Log_array(0)
Wk_reno = Wkl_Log_array(1)
Wk_name = Wkl_Log_array(2)
Wk_mail = Wkl_Log_array(3)
Wk_url = Wkl_Log_array(4)
Wk_del = Wkl_Log_array(5)
Wk_title = Wkl_Log_array(6)
Wk_comment = Wkl_Log_array(7)
Wk_date = Wkl_Log_array(8)
Wk_host_ip = Wkl_Log_array(9)
End If
If NO = Wk_no Then
Wk_flag = 1
Exit For
End If
Next
If Wk_flag = 0 Then
Call ERROR("既に削除済です")
End If
If Wk_del <> DEL_ID Then
Call ERROR("削除キーが違います。")
End If
CALL DEL(Wk_no) ' 削除処理
S_IJ = encode(ID,PASSWD)
MODE = "view"
End Sub
'==================================================
' データの削除
'==================================================
Sub DEL(Wk_In)
On Error Resume Next
Call File_Lock()
Set objFile = Server.CreateObject("Scripting.FileSystemObject")
Set WDateFile = objFile.OpenTextFile(BBSLOGDIR & Wk_logfile, 2, TRUE)
'
If Err.Number > 0 Then
Call ERROR("ログファイルの読み込みに失敗しました")
Else
WDateFile.WriteLine(Wk_tno & "<>" & Wk_admes & "<><><><><><><><><><><><>")
For Each Wkl_Log In Wk_AllLog_array
Wkl_Log_array = split(Wkl_Log,"<>")
If UBound(Wkl_Log_array) >= 9 Then
Wkl_no = Wkl_Log_array(0)
Wkl_reno = Wkl_Log_array(1)
Wkl_name = Wkl_Log_array(2)
Wkl_mail = Wkl_Log_array(3)
Wkl_url = Wkl_Log_array(4)
Wkl_del = Wkl_Log_array(5)
Wkl_title = Wkl_Log_array(6)
Wkl_comment = Wkl_Log_array(7)
Wkl_date = Wkl_Log_array(8)
Wkl_host_ip = Wkl_Log_array(9)
Else
Wkl_no = ""
Wkl_reno = ""
Wkl_date = ""
Wkl_name = ""
Wkl_mail = ""
Wkl_sub = ""
Wkl_mes = ""
Wkl_url = ""
Wkl_host = ""
Wkl_pwd = ""
End If
If (Wkl_no = Wk_In) or (Wkl_reno = Wk_In) Then
Else
WDateFile.WriteLine(Wkl_Log)
End If
Next
End If
'
WDateFile.Close
Set WDataFile = Nothing
Set objFile = Nothing
'
Call File_UnLock()
'
On Error GoTo 0
End Sub
'
'==================================================
'* ファイルのロック
'==================================================
Sub File_Lock()
On Error Resume Next
Set objFile1 = Server.CreateObject("Scripting.FileSystemObject")
If objFile1.FileExists(BBSLOGDIR & Wk_Lockfile) = true then
Call error("他の方が書込み中" & wk_br & "お手数ですが" & wk_br & "再度実行して下さい。")
Exit Sub
End if
'
Application.Lock
'
Set objFile2 = Server.CreateObject("Scripting.FileSystemObject")
set LockFile = objFile2.CreateTextFile(BBSLOGDIR & Wk_Lockfile,true,False)
'
Set LockFile = Nothing
Set objFile1 = Nothing
Set objFile2 = Nothing
'
On Error GoTo 0
End Sub
'
'==================================================
'* ファイルのロック解除
'==================================================
Sub File_UnLock()
On Error Resume Next
'
Set objFile = Server.CreateObject("Scripting.FileSystemObject")
set UnLockFile = objFile.DeleteFile(BBSLOGDIR & Wk_Lockfile,true)
'
Set UnLockFile = Nothing
Set objFile = Nothing
'
Application.Unlock
'
On Error GoTo 0
End Sub
'==================================================
' エラー処理
'==================================================
Sub ERROR(WORD)
%>
!! エラーメッセージ !! <%= wk_br %>
<%= WORD %><%= wk_br %><%= wk_br %>
<%
Call FOOTER()
Response.End
End Sub
'*-----------------------------------------------------------------------------*
' 自動リンク (タグがない時のみ)
' この自動リンクロジックはＷＩＮＧ☆さん に 著作権が有ります
' URL : http://www04.u-page.so-net.ne.jp/yd5/wing/aspyui/
' E-mail : wing@yd5.so-net.ne.jp
'*-----------------------------------------------------------------------------*
Function auto_link(Wk_In)
If (Instr(1,Wk_In,"http://") > 0 or Instr(1,Wk_In,"ftp://") > 0 or Instr(1,Wk_In,"mailto:") > 0) and InStr(1,Wk_In,"<") = 0 Then
Wk_In = Replace(Wk_In,"__URL__","")
flg = 0
Wk_Incp = ""
urlcp = ""
for i = 1 to len(Wk_In)
j = Mid(Wk_In,i,1)
Select Case UCase(j)
Case "A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","1","2","3","4","5","6","7","8","9","0","$","@","/","%",".","_","-","~","#","&","=","l",":","?"
If Mid(Wk_In,i,7) = "http://" or Mid(Wk_In,i,6) = "ftp://" or Mid(Wk_In,i,7) = "mailto:" Then
If flg = 1 Then
Wk_Incp = Replace(Wk_Incp,"__URL__",urlcp)
Wk_Incp = Wk_Incp & ""
urlcp = ""
End If
If Mid(Wk_In,i,7) = "mailto:" Then 'メールの場合のフォーマット設定
Wk_Incp = Wk_Incp & ""
Else 'URL又はftpの場合のフォーマット設定
Wk_Incp = Wk_Incp & ""
End If
flg = 1
End If
If flg = 1 Then urlcp = urlcp & Mid(Wk_In,i,1) End If
Case Else
If flg = 1 Then
Wk_Incp = Replace(Wk_Incp,"__URL__",urlcp)
Wk_Incp = Wk_Incp & ""
flg = 0
urlcp = ""
End If
End Select
Wk_Incp = Wk_Incp & j
Next
If flg = 1 Then
Wk_Incp = Replace(Wk_Incp,"__URL__",urlcp)
Wk_Incp = Wk_Incp & ""
End If
auto_link = Wk_Incp
Else
auto_link = Wk_In
End If
End Function
%>