<% ipadd_local = Request.ServerVariables("REMOTE_ADDR") set fs = createobject("scripting.filesystemobject") set a = fs.opentextfile(Server.MapPath("ipadd.txt"),1) if a.AtEndOfStream then else ipadd = a.readline ipblock = split(ipadd,",") for i = 0 to ubound(ipblock) if 0 < instr(ipadd_local,ipblock(i)) then Response.Redirect("http://www.carabao.net/webboard") exit for end if next end if %>
<% '----------------------------------------------------------------------------- 'Muli File's upload Created by Bhushan Paranjpe '----------------------------------------------------------------------------- Sub BuildUploadRequest(RequestBin) 'Get the boundary PosBeg = 1 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13))) if PosEnd = 0 then Response.Write "Form was submitted with no ENCTYPE=""multipart/form-data""
" Response.Write "Please correct the form attributes and try again." Response.End end if boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg) boundaryPos = InstrB(1,RequestBin,boundary) 'Get all data inside the boundaries Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--"))) 'Members variable of objects are put in a dictionary object Dim UploadControl Set UploadControl = CreateObject("Scripting.Dictionary") 'Get an object name Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition")) Pos = InstrB(Pos,RequestBin,getByteString("name=")) PosBeg = Pos+6 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34))) Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)) PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename=")) PosBound = InstrB(PosEnd,RequestBin,boundary) 'Test if object is of file type If PosFile<>0 AND (PosFile "") Then ' ตอนแรกยังไม่ทำ if UploadQueryString <> "" then AF_uploadAction = AF_uploadAction & "&" & UploadQueryString end if End If If (CStr(Request.QueryString("AF_upload")) <> "") Then RequestBin = Request.BinaryRead(Request.TotalBytes) Dim UploadRequest Set UploadRequest = CreateObject("Scripting.Dictionary") BuildUploadRequest RequestBin AF_keys = UploadRequest.Keys for AF_i = 0 to UploadRequest.Count - 1 AF_curKey = AF_keys(AF_i) 'Save all uploaded files if UploadRequest.Item(AF_curKey).Item("FileName") <> "" then AF_value = UploadRequest.Item(AF_curKey).Item("Value") AF_valueBeg = UploadRequest.Item(AF_curKey).Item("ValueBeg") AF_valueLen = UploadRequest.Item(AF_curKey).Item("ValueLen") File_Name = "carabao-" & AF_value if right(File_Name,3) = "gif" or right(File_Name,3) = "jpg" or right(File_Name,4) = "jpeg" then if AF_valueLen = 0 then Response.Write "An error has occured saving uploaded file!

" Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "
" Response.Write "File does not exists or is empty.
" Response.Write "Please correct and try again" Response.End end if 'Create a Stream instance Dim AF_strm1, AF_strm2 Set AF_strm1 = Server.CreateObject("ADODB.Stream") Set AF_strm2 = Server.CreateObject("ADODB.Stream") 'Open the stream AF_strm1.Open AF_strm1.Type = 1 'Binary AF_strm2.Open AF_strm2.Type = 1 'Binary AF_strm1.Write RequestBin AF_strm1.Position = AF_ValueBeg AF_strm1.CopyTo AF_strm2,AF_ValueLen 'Create and Write to a File AF_curPath = Request.ServerVariables("PATH_INFO") AF_curPath = Trim(Mid(AF_curPath,1,InStrRev(AF_curPath,"/")) & "") if Mid(AF_curPath,Len(AF_curPath),1) <> "/" then AF_curPath = AF_curPath & "/" end if 'on error resume next Randomize aaa=Rnd() aaa = int(aaa*1000) bbb = len(File_Name)-4 File_Name = left(File_Name,bbb) & aaa & right(File_Name,4) AF_strm2.SaveToFile Trim(Server.mappath(AF_curPath))& "\images_upload\" & File_Name,2 'Upload File to images_file Folder if err then Response.Write "An error has occured saving uploaded file!

" Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "
" Response.Write "Maybe the destination directory does not exist, or you don't have write permission.
" Response.Write "Please correct and try again" err.clear response.End end if else Response.Write "Plese upload file type is GIF or JPG

" Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "
" Response.Write "Please correct and try again" err.clear response.End end if 'copy file to email name (rename file) and delete file original ' dim filesys, demofile ' set filesys = CreateObject ("Scripting.FileSystemObject") ' set demofile = filesys.GetFile(server.mappath("picture_file\" & File_Name)) ' file_extension = right(File_Name,3) ' File_Name = userName & "." & file_extension ' demofile.Copy(server.mappath("picture_file\" & userName & "." & file_extension)) ' demofile.Delete end if next MemCheck = "" 'PostType = UploadRequest.Item("PostType").Item("Value") Name = UploadRequest.Item("Name").Item("Value") Pass = UploadRequest.Item("Pass").Item("Value") Subject = UploadRequest.Item("Subject").Item("Value") Message = UploadRequest.Item("Message").Item("Value") ParentId = UploadRequest.Item("ParentId").Item("Value") memberCh = false if File_Name = "" then File_Name = "space.gif" end if if Name <> "" And Pass <> "" Then Set ConnCheck =Server.CreateObject("ADODB.Connection") dbname12="/member/CbaoMember0948.mdb" dbpath12="DBQ=" & server.mappath(dbname12) ConnCheck.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & dbpath12 sqlCheck = "select top 1 id, nickName, mType from register where userName = '" & Name & "' and password = '" & Pass & "' order by id desc" set rsCheck = ConnCheck.execute(sqlCheck) if rsCheck.eof then Response.Write "" Response.Redirect("default.asp") end if ConnCheck.Close End if Set Conn0=Server.CreateObject("ADODB.Connection") dbname="/member/CbaoMember0948.mdb" dbpath="DBQ=" & server.mappath(dbname) Conn0.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & dbpath sql0 = "select top 1 id, nickName, mType from register where userName = '" & Name & "' and password = '" & Pass & "' order by id desc" set rs0=Conn0.execute(sql0) if rs0.eof then memberType = "0,0" memberNon = "NoMember" MemCheck = "Err" Else MemCheck = rs0("mType") if rs0("id") < 7055 Then memberType = rs0("id") & ",0" Name = rs0("nickName") memberType1 = rs0("id") else memberType = rs0("id") & "," & rs0("mType") Name = rs0("nickName") memberType1 = rs0("id") end if end if Conn0.Close Message = Message & vbcr & vbcr '& "" & vbcr & Request("OldMessage") EmailMessage = Message oldstring = Message newstring = "" for i=1 to Len(oldstring) If Mid(oldstring, i, 1) = vbCr Then newstring = newstring & "
" Else newstring = newstring & Mid(oldstring, i, 1) End If Next Message = newstring 'Detect http:// and create link to it oldstring = Message newstring = "" for i = 1 to Len(oldstring) - 7 If LCASE(Mid(oldstring, i, 7)) = "http://" Then for j = i to Len(oldstring) If Mid(oldstring,j,1) = " " or Mid(oldstring,j,1) = vbcr Then Exit For End If next strLink = Mid(oldstring,i,(j-i)) newstring = newstring & "" & strLink & "" & Mid(oldstring,j,1) i = i + (j-i) Else newstring = newstring & Mid(oldstring,i,1) End If next Message = newstring & Mid(oldstring,i,i+7) Set Conn=Server.CreateObject("ADODB.Connection") Conn.ConnectionTimeout=150 Conn.CommandTimeout=300 dbname="CbaoBoard0948.mdb" dbpath="DBQ=" & server.mappath(dbname) Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & dbpath Set Cmd=Server.CreateObject("ADODB.Command") Set RS=Server.CreateObject("ADODB.Recordset") Set Cmd.ActiveConnection = Conn Cmd.CommandText="Select SortCd, MajorSort from Message where MessageId = " & ParentId RS.Open Cmd, , 0, 1 Prefix = RS("SortCd") MajorSort = RS("MajorSort") RS.Close Cmd.CommandText="Select COUNT(MessageId) as [NPeer] from Message where ParentId = " & ParentId RS.Open Cmd, , 0, 1 NPeer = RS("NPeer") RS.Close SortCd = int(NPeer) + 1 Select Case len(SortCd) Case 1 SortCd = "000" & SortCd Case 2 SortCd = "00" & SortCd Case 3 SortCd = "0" & SortCd End Select SortCd = Prefix & "." & SortCd 'if memberType1 < 7055 then 'if memberNon = "NoMember" and File_Name <> "space.gif" then if memberType1 < 7055 and File_Name <> "space.gif" then dim filesys, demofile set filesys = CreateObject ("Scripting.FileSystemObject") set demofile = filesys.GetFile(server.mappath("images_upload\" & File_Name)) demofile.Delete File_Name = "space.gif" end if 'end if if MemCheck = "m" Or MemCheck = "x" Or MemCheck = "" Or MemCheck = "Err" then Cmd.CommandText="Select * from Message" RS.Open Cmd, , 2, 2 RS.AddNew RS("ParentId") = ParentId RS("Name") = Name RS("Email") = memberType RS("Subject") = Subject RS("Description") = Message RS("MajorSort") = MajorSort RS("SortCD") = SortCD RS("MessageDate") = now()'month(now) & "/" &day (now) & "/" & year(now) & " " & Time RS("Picture_Name") = File_Name RS("ipadd") =Request.ServerVariables("REMOTE_ADDR") RS("Status") = "H" RS.Update RS.Close Conn.Close Response.Write "" if memberType1 < 7055 and memberNon <> "NoMember" then memberCh = true else Response.Redirect "messageDetail.asp?MessageId=" & int(ParentId) end if else Cmd.CommandText="Select * from Message" RS.Open Cmd, , 2, 2 RS.AddNew RS("ParentId") = ParentId RS("Name") = Name RS("Email") = memberType RS("Subject") = Subject RS("Description") = Message RS("MajorSort") = MajorSort RS("SortCD") = SortCD RS("MessageDate") = now()'month(now) & "/" &day (now) & "/" & year(now) & " " & Time RS("Picture_Name") = File_Name RS("ipadd") =Request.ServerVariables("REMOTE_ADDR") RS.Update RS.Close Conn.Close if memberType1 < 7055 and memberNon <> "NoMember" then memberCh = true else Response.Redirect "messageDetail.asp?MessageId=" & int(ParentId) end if end if 'Response.Redirect("messageDetail.asp") end if %> <%if memberCh then%>



ขณะนี้ท่านเป็นสมาชิก [M] เดิม กรุณาสมัครสมาชิกในระบบใหม่ [MC] ทันที คลิ๊กที่นี่
คาราบาว.เน็ต จะทำการยกเลิกระบบสมาชิก [M] เดิมทั้งหมด ภายใน 16 มกราคม 2549


กลับไป ดูกระทู้ของท่านที่เวทีสนทนาภาษา'บาว







<%else%> <% '**************** ตรวจสอบชื่อที่ห้ามโพสข้อความ ************************** session("PostBlock") = False set fs = createobject("scripting.filesystemobject") set a = fs.opentextfile(Server.MapPath("PostBlock.txt"),1) if not a.AtEndOfStream then blockName = a.readline blockName = split(blockName,",") session("PostBlock") = True end if a.Close '********************************************************************* '**************** ตรวจสอบชื่อที่จำกัดข้อความ *************************** session("PostLimit") = False set fs = createobject("scripting.filesystemobject") set a = fs.opentextfile(Server.MapPath("PostLimit.txt"),1) if not a.AtEndOfStream then LimitName = a.readline LimitName = split(LimitName,",") session("PostLimit") = True end if a.Close '********************************************************************* %> <% MessageId = Request("MessageId") %> <% Set Conn=Server.CreateObject("ADODB.Connection") Conn.ConnectionTimeout=150 Conn.CommandTimeout=300 dbname="CbaoBoard0948.mdb" dbpath="DBQ=" & server.mappath(dbname) Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & dbpath Set Cmd=Server.CreateObject("ADODB.Command") Set RS=Server.CreateObject("ADODB.Recordset") Set RS1=Server.CreateObject("ADODB.Recordset") Cmd.CommandType = 1 Set Cmd.ActiveConnection = Conn Cmd.CommandText="SELECT Message.MessageId, Message.ParentId, Message.Email, Message.ipAdd, Message.Subject, Message.Description, Message.SortCd, Message.MessageDate, Message.Name as [Posted By], Message.Picture_Name, Message.Description as [Message], Message.TimeCount " & _ "From Message " & _ "Where Message.Status = 'N' And Message.MessageId = " & MessageId & " " & _ "Order By Message.MessageDate DESC" RS.Open Cmd, , 0, 1 if request("Name") = "" then sum= 1 + rs("TimeCount") ssql = "UPDATE Message Set TimeCount = '" & sum & "' Where Message.MessageId = " & MessageId & " " conn.execute(ssql) end if If not RS.EOF Then if rs("MessageId") > 153296 then ip = " : " & rs("ipAdd") & "" else ip = "" end if LenghtLimit = "" MemberNo = "" if instr(rs("email"),",") > 0 then email = split(rs("email"),",") MemberNo = email(0) on error resume next if email(0) > 0 and email(1) <> 0 then if email(1) = "m" then mType = "[รออนุมัติ] " & RS("Posted By") & "" else mType = "[MC] " & RS("Posted By") & "" end if elseif email(0) > 0 and email(1) = 0 then mType = "[M] " & RS("Posted By") & "" else mType = RS("Posted By") & ip end if elseif rs("email") = 0 then mType = RS("Posted By") & ip else mType = "[M] " & RS("Posted By") & "" end if %>
 
   
<%if session("PostBlock") then for iBlock = 0 to ubound(blockName) if trim(blockName(iBlock))= MemberNo then isBlock = true exit for else isBlock= false end if next end if %> <%if rs("MessageId") < 744881 or not isBlock then %> <%if session("PostLimit") then LenghtLimit = LimitName(0) for iLimit = 0 to ubound(LimitName) if trim(LimitName(iLimit))= MemberNo then isLimit = true exit for else isLimit= false end if next end if %> <%if rs("MessageId") < 744881 or not isLimit then %> <%else%> <%end if%> <%end if%>
<%=RS("Subject")%>
<%=RS("Description")%>
" border="0">

" target="_blank" onClick="ShowSpec=open('comment.asp?id=<%=rs("SortCd")%>','showDetails','width=250,height=200,statusbar=no,toolbar=no,locationbar=no,scrollbars=yes,resizable=no');return false; " >แจ้งลบกระทู้   จากคุณ : <%=mType%> : <%=formatdatetime(RS("MessageDate"),1)%> - <%=formatdatetime(RS("MessageDate"),4)%> น.
<%=Left(RS("Description"),LenghtLimit)%>
" target="_blank" onClick="ShowSpec=open('comment.asp?id=<%=rs("SortCd")%>','showDetails','width=250,height=200,statusbar=no,toolbar=no,locationbar=no,scrollbars=yes,resizable=no');return false; " >แจ้งลบกระทู้   จากคุณ : <%=mType%> : <%=formatdatetime(RS("MessageDate"),1)%> - <%=formatdatetime(RS("MessageDate"),4)%> น.
<% RS.Close End If %>
ข้อความแสดงความคิดเห็น <% Cmd.CommandText="SELECT Me.MessageId, Me.Email, Me.ipAdd, Me.Subject, Me.Description,Me.Picture_Name, Me.SortCd, Me.MessageDate, Me.Name as [Posted By], (Select COUNT(M.MessageId) From Message M Where ParentId = Me.MessageId ) as [Replies] " & _ "From Message Me " & _ "Where Me.ParentId = " & MessageId & " And Me.Status = 'N' " & _ "Order By Me.MessageDate" ' "Order By Me.MessageDate DESC" RS1.Open Cmd, , 0, 1 If not RS1.EOF Then Response.Write("") j= 0 While not RS1.EOF j=j+1 'ip = "" if rs1("MessageId") > 153296 then ip = " : " & rs1("ipAdd") & "" else ip = "" end if LenghtLimit = "" MemberNo = "" if instr(rs1("email"),",") > 0 then email1 = split(rs1("email"),",") MemberNo = email1(0) on error resume next if email1(0) > 0 and email1(1) <> 0 then if email1(1) = "m" then mType = "[รออนุมัติ] " & RS1("Posted By") & "" else mType = "[MC] " & RS1("Posted By") & "" end if elseif email1(0) > 0 and email1(1) = 0 then mType = "[M] " & RS1("Posted By") & "" else mType = RS1("Posted By") & ip end if elseif rs1("email") = 0 then mType = RS1("Posted By") & ip else mType = "[M] " & RS1("Posted By") & "" end if %>

<%if session("PostBlock") then for iBlock = 0 to ubound(blockName) if trim(blockName(iBlock))= MemberNo then isBlock = true exit for else isBlock= false end if next end if %> <%if rs1("MessageId") < 744881 or not isBlock then%> <%'response.write "aaa : " & MemberNo%>
 
<%if session("PostLimit") then 'response.write "bbb : " & MemberNo LenghtLimit = LimitName(0) for iLimit = 0 to ubound(LimitName) if trim(LimitName(iLimit))= MemberNo then isLimit = true exit for else isLimit= false end if next end if %> <%if rs1("MessageId") < 744881 or not isLimit then %> <%else%> <%end if%>
ความคิดเห็นที่ <%=int(right(rs1("SortCd"),3))%>.
<%=RS1("Description")%>
" border="0">
" target="_blank" onClick="ShowSpec=open('comment.asp?id=<%=rs1("SortCd")%>','showDetails','width=250,height=200,statusbar=no,toolbar=no,locationbar=no,scrollbars=yes,resizable=no');return false; " >แจ้งลบกระทู้ จากคุณ : <%=mType%> : <%=formatdatetime(RS1("MessageDate"),1)%> - <%=formatdatetime(RS1("MessageDate"),4)%> น.
ความคิดเห็นที่ <%=int(right(rs1("SortCd"),3))%>.
<%=Left(RS1("Description"),LenghtLimit)%>
" target="_blank" onClick="ShowSpec=open('comment.asp?id=<%=rs1("SortCd")%>','showDetails','width=250,height=200,statusbar=no,toolbar=no,locationbar=no,scrollbars=yes,resizable=no');return false; " >แจ้งลบกระทู้ จากคุณ : <%=mType%> : <%=formatdatetime(RS1("MessageDate"),1)%> - <%=formatdatetime(RS1("MessageDate"),4)%> น.
<%end if%>
<% RS1.MoveNext Wend End If RS1.Close Conn.Close %>

ร่วมแสดงความคิดเห็น

<% Set Conn2=Server.CreateObject("ADODB.Connection") dbname="CbaoBoard0948.mdb" dbpath="DBQ=" & server.mappath(dbname) Conn2.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & dbpath sql = "SELECT * FROM ConfigSetting " set rs = Conn2.execute(sql) %> onsubmit="return ValidateNotMem(this); <% Else %>onsubmit="return Validate(this); <% end if %>">
ชื่อ / Username : ได้ทั้ง ไทย / English ขึ้นอยู่กับตอนสมัครครั้งแรก
รหัสผ่าน (เฉพาะสมาชิก) : ลืมรหัสผ่านคลิ๊กที่นี่  : สมัครสมาชิกใหม
รูปภาพ : * เฉพาะสมาชิก [MC] เท่านั้น
แสดงความคิดเห็น :
<% '*********************************************** 'เพิ่มส่วนของการ block ipaddress ipadd_local =Request.ServerVariables("REMOTE_ADDR") 'ipadd_local = left(ipadd_local,instrrev(ipadd_local,".")-1) 'ipadd_local = left(ipadd_local,instrrev(ipadd_local,".")-1) set fs = createobject("scripting.filesystemobject") set a = fs.opentextfile(Server.MapPath("ipadd.txt"),1) if a.AtEndOfStream then response.Write("") else ipadd = a.readline ipblock = split(ipadd,",") for i = 0 to ubound(ipblock) 'response.write ipblock(i) & "ip: " & ipadd_local & "
" if 0 < instr(ipadd_local,ipblock(i)) then 'response.write "instr > 0" session("postsubmit") = false exit for else session("postsubmit") = true end if next if session("postsubmit") then response.Write("") session("postsubmit") = true end if end if 'loop session("postsubmit") = false a.Close '************************************************* %>
<%end if%>