ï»?% 'Option Explicit Response.Buffer = True 'Response.CodePage=65001 'Response.Charset = "utf-8" Response.expires=0 Const LinkStyle="Email:email@email.com" Const SiteMark="default" Const Manage_Name="|WebMaster|" Const SysName="WebManage" Const Sysversion="2006/12/01" Const EnabledSession=True Const IsDeBug = True 'Test Model Dim editorstyle,adminpath,editpath Dim editor editor=""'"eweb" editorstyle="style1" adminpath="/admin/" editpath="fckeditor/" 'Upload Style Const UpLoadType="Ly" If Not IsDeBug Then On Error Resume Next End If '//////////Database of admindata/////////////// ''DataBaseType:sqlserver,access Const AdminDataBaseType = "access" 'Database Model Dim DBName(4) 'Database address DBName(1)="SysDb.mdb" DBName(2)="db/SysDb.mdb" DBName(3)="../db/SysDb.mdb" DBName(4)="../../db/SysDb.mdb" Const AdminSqlDatabaseName = "dbusername" Const AdminSqlPassword = "dbpass" Const AdminSqlUsername = "dbname" Const AdminSqlLocalName = "dbipport" '//////////Database of frontdata/////////////// Const DataBaseType = "access" 'Database Model Dim DBName2(6) 'Database address DBName2(1)="../../../db/#as4t!asdf.mdb" DBName2(2)="../../db/#as4t!asdf.mdb" DBName2(3)="../../#as4t!asdf.mdb" DBName2(4)="../db/#as4t!asdf.mdb" DBName2(5)="#as4t!asdf.mdb" DBName2(6)="db/#as4t!asdf.mdb" Const SqlDatabaseName = "cixifang" Const SqlPassword = "123456" Const SqlUsername = "sa" Const SqlLocalName = "10.10.10.10" %> ï»?% Dim mysqlstr Dim SetSqlStr 'Sqlstr="Select id From Board Where upid=0 Order By morder" 'Sqlstr2="Update Board Set morder=$value$ Where id=$id$" Sub CreateOrder(Sqlstr,Sqlstr2,StartNum,conn) Dim iNum,ColName,RsList,Rsop Dim updateSql Set RsList=conn.Execute(Sqlstr) iNum=StartNum While Not RsList.Eof updateSql=Replace(Sqlstr2,"$value$",Cstr(iNum)) updateSql=Replace(Sqlstr2,"$id$",Cstr(RsList("ID"))) conn.Execute(updateSql) iNum=iNum+1 RsList.MoveNext Wend RsList.Close End Sub 'Sqlstr="Select Top 1 id,morder From Board Where morder>$value$ Order By morder Desc" 'Sqlstr2="Update Board Set morder=$value$ Where id=$id$" Sub Do_Order(Sqlstr,Sqlstr2,sid,myorder,conn) Dim Up_ID,Up_order Dim updateSql Set RsList=conn.Execute(Sqlstr) If Not RsList.Eof Then Up_ID=Rs("id") Up_Order=Rs("morder") updateSql=Replace(Sqlstr2,"$value$",Cstr(myorder)) updateSql=Replace(Sqlstr2,"$id$",Cstr(Up_ID)) objConn.Execute(Tsql) updateSql=Replace(Sqlstr2,"$value$",Cstr(Up_Order)) updateSql=Replace(Sqlstr2,"$id$",Cstr(sid)) objConn.Execute(Tsql) End If RsList.Close End Sub '********************************************** 'SetSqlStr="Select pid,pname from table where flid=@value@ and updown>0 order by updown" 'TreeList(SetSqlStr,0," ","-",conn) '********************************************** Sub TreeList(sqlstr,getvalue,myspace,splitchar,conn) Dim insqlstr insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof If Trim(Request("upid"))=Cstr(myList("pid")) Then Response.Write("") Else Response.Write("") End If Call TreeList(sqlstr,myList("pid"),myspace&"  ",splitchar,conn) myList.MoveNext Wend End Sub Sub TreeListSelect(sqlstr,getvalue,selid,myspace,splitchar,conn) Dim insqlstr if getvalue="" or IsNull(getvalue) then getValue="0" end if insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) if isNull(selid) then selid="" end if Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof If cstr(selid)=Cstr(myList("pid")) Then Response.Write("") Else Response.Write("") End If Call TreeListSelect(sqlstr,myList("pid"),selid,myspace&"  ",splitchar,conn) myList.MoveNext Wend End Sub Sub TreeListDisp(sqlstr,getvalue,myspace,splitchar,conn) Dim insqlstr if getvalue="" or IsNull(getvalue) then getValue="0" end if insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof If Trim(Request("upid"))=Cstr(myList("pid")) Then Response.Write("") Else Response.Write("") End If Call TreeListDisp(sqlstr,myList("pid"),myspace&"  ",splitchar,conn) myList.MoveNext Wend End Sub Sub GetDisp(sqlstr,getvalue,dispstr,conn) Dim insqlstr if getvalue="" or IsNull(getvalue) then getValue="0" end if insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof dispstr=Replace(dispstr,"@disp@",Cstr(myList("pname"))) Response.Write(dispstr&" ") myList.MoveNext Wend End Sub Sub GetDisps(sqlstr,getvalue,selestr,conn) Dim insqlstr,OutStr if getvalue="" or IsNull(getvalue) then getValue="0" end if insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) if isNull(selid) then selid="" end if Dim myList OutStr="" Set myList=conn.Execute(insqlstr) while not myList.Eof if instr(","&selestr&",",","&cstr(mylist("pid"))&",")>0 then OutStr=OutStr&myList("pname")&"," end if myList.MoveNext Wend if Right(OutStr,1)="," then OutStr=Left(OutStr,Len(OutStr)-1) end if if OutStr="" Then OutStr="None" end if Response.Write(OutStr) End Sub Sub TreeListCatTemp(sqlstr,getvalue,conn) Dim insqlstr if getvalue="" or IsNull(getvalue) then getValue="0" end if insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList,pid,cat_temp Set myList=conn.Execute(insqlstr) while not myList.Eof cat_temp=myList("cat_temp") pid=myList("pid") Response.Write("") Call TreeListCatTemp(sqlstr,myList("pid"),conn) myList.MoveNext Wend End Sub '********************************************** 'sqlstr="Select pid,pname from table where flid=@value@ and updown>0 order by updown" 'Deeps=0 '********************************************** Sub TreeList2(sqlstr,getvalue,myspace,Deeps,DeepLevel,conn) Dim insqlstr if getvalue="" or IsNull(getvalue) then getValue="0" end if If (DeepLevel>0 And Deeps"&myspace&"-"&myList("pname")&"-") Else Response.Write("") End If Call TreeList2(sqlstr,myList("pid"),myspace&"  ",Deeps+1,DeepLevel,conn) myList.MoveNext Wend End IF End Sub Sub ListCheckBoxs(sqlstr,getvalue,namestr,conn) Dim insqlstr insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof If myList("IsDef")="1" Then Response.Write(" ") else Response.Write(" ") end if myList.MoveNext Wend End Sub Sub ListCheckBoxSele(sqlstr,getvalue,selestr,namestr,conn) Dim insqlstr insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) if isNull(selestr) then selestr="" end if selestr=replace(selestr," ","") Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof if instr(","&selestr&",",","&cstr(mylist("pid"))&",")>0 then Response.Write(" ") else Response.Write(" ") end if myList.MoveNext Wend End Sub Sub ListRadios(sqlstr,getvalue,namestr,conn) Dim insqlstr insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList Set myList=conn.Execute(insqlstr) while not myList.Eof If myList("IsDef")="1" Then Response.Write(" ") Else Response.Write(" ") End If myList.MoveNext Wend End Sub Sub ListRadioSele(sqlstr,getvalue,selid,namestr,conn) Dim insqlstr insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList if isNull(selid) then selid="" end if Set myList=conn.Execute(insqlstr) while not myList.Eof If cstr(selid)=cstr(mylist("pid")) Then Response.Write(" ") Else Response.Write(" ") End If myList.MoveNext Wend End Sub '************************************************* '************************************************* mysqlstr="Select id From T_NewsCate Where upid In (@value@) And id Not In (@value@)" Function GetID(id,Conn) Dim GetID1,GetID2,GetID3,mysql Dim nRs,mysqlExe GetID1=Cstr(id) GetID2=Cstr(id) GetID3=Cstr(id) While GetID2<>"" Set nRs=Server.CreateObject("Adodb.RecordSet") 'mysqlExe="Select id From fllm Where flid In ("&GetID3&") And id Not In ("&GetID3&")" mysqlExe=Replace(mysqlstr,"@value@",GetID3) nRs.Open mysqlExe,Conn GetID2="" While Not nRs.Eof GetID2=GetID2+","+Cstr(nRs("ID")) nRs.MoveNext Wend nRs.Close GetID1=GetID1+GetID2 GetID3="-1"+GetID2 Wend GetID=GetID1 End Function mysqlstr="Select upid as upid From T_NewsCate Where id=@value@" Function GetUpIDs(id,Conn) Dim GetID1,GetID2 Dim flag Dim mysql Dim nRs GetID1=Cstr(id) GetID2=Cstr(id) flag=true While flag mysql=Replace(mysqlstr,"@value@",Cstr(GetID2)) Set nRs=Conn.Execute(mysql) If Not nRs.Eof Then GetID1=GetID1&","&nRs("upid") GetID2=nRs("upid") Else flag=false End If nRs.CLOSE Wend GetUpIDs=GetID1 End Function Sub TreeList3(sqlstr,getvalue,myspace,conn) Dim insqlstr insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) Dim myList Set myList=conn.Execute(insqlstr) If not myList.Eof Then Response.Write("") while not myList.Eof If Trim(Request("text"))=Cstr(myList("pid")) Then Response.Write("") Else Response.Write("") End If Response.Write("") myList.MoveNext Wend Response.Write("
"&myspace&""&myList("pname")&"
"&myspace&""&myList("pname")&"
") Call TreeList3(sqlstr,myList("pid"),myspace&"  ",conn) Response.Write("
") End If End Sub Sub TreeList3_1(sqlstr,getvalue,SplitChar,myspace,conn) Dim insqlstr,NewSplit insqlstr=Replace(sqlstr,"@value@",Cstr(getvalue)) if SplitChar<>"" Then NewSplit=Replace(myspace,"$",SplitChar) End If Dim myList Set myList=conn.Execute(insqlstr) If not myList.Eof Then Response.Write("") while not myList.Eof 'If Trim(Request("text"))=Cstr(myList("pid")) Then Response.Write("") 'Else ' Response.Write("") 'End If Response.Write("") myList.MoveNext Wend Response.Write("
"&NewSplit&""&myList("pname")&"
"&NewSplit&""&myList("pname")&"
") Call TreeList3_1(sqlstr,myList("pid"),SplitChar,"  "&myspace,conn) Response.Write("
") End If End Sub Function FormatDateWithC(inDate,sChar) Dim sDate If IsDate(inDate) Then sDate=Cstr(Year(inDate)) If Len(Cstr(Month(inDate)))<>2 Then sDate=sDate&sChar&"0"&Cstr(Month(inDate)) Else sDate=sDate&sChar&Cstr(Month(inDate)) End If If Len(Cstr(Day(inDate)))<>2 Then sDate=sDate&sChar&"0"&Cstr(Day(inDate)) Else sDate=sDate&sChar&Cstr(Day(inDate)) End If Else sDate="1900"&sChar&"01"&sChar&"01" End If FormatDateWithC=sDate End Function Function FormatDate(inDate) Dim sDate If IsDate(inDate) Then sDate=Cstr(Year(inDate)) If Len(Cstr(Month(inDate)))<>2 Then sDate=sDate&"-0"&Cstr(Month(inDate)) Else sDate=sDate&"-"&Cstr(Month(inDate)) End If If Len(Cstr(Day(inDate)))<>2 Then sDate=sDate&"-0"&Cstr(Day(inDate)) Else sDate=sDate&"-"&Cstr(Day(inDate)) End If Else sDate="1900-01-01" End If FormatDate=sDate End Function Function My_FormatDateTime(inDate) Dim sDate If IsDate(inDate) Then sDate=Cstr(Year(inDate)) If Len(Cstr(Month(inDate)))<>2 Then sDate=sDate&"-0"&Cstr(Month(inDate)) Else sDate=sDate&"-"&Cstr(Month(inDate)) End If If Len(Cstr(Day(inDate)))<>2 Then sDate=sDate&"-0"&Cstr(Day(inDate)) Else sDate=sDate&"-"&Cstr(Day(inDate)) End If sDate=sDate&" " If Len(Cstr(Hour(inDate)))<>2 Then sDate=sDate&"0"&Cstr(Hour(inDate)) Else sDate=sDate&Cstr(Hour(inDate)) End If If Len(Cstr(Minute(inDate)))<>2 Then sDate=sDate&":0"&Cstr(Minute(inDate)) Else sDate=sDate&":"&Cstr(Minute(inDate)) End If If Len(Cstr(Second(inDate)))<>2 Then sDate=sDate&":0"&Cstr(Second(inDate)) Else sDate=sDate&":"&Cstr(Second(inDate)) End If Else sDate="1900-01-01 00:00:00" End If My_FormatDateTime=sDate End Function Function GetIp() Dim LastIP LastIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If LastIP = "" Then LastIP = Request.ServerVariables("REMOTE_ADDR") End If GetIp=LastIp End Function '************************************************** 'å–LyfUpload.UploadFile上传文件的文件扩展å '************************************************** Function GetFileTypeByLy(sFileName) Dim iStart,iEnd,iStart2 iEnd=Instr(10,sFileName,"Content-Type:") iStart=Instr(1,sFileName,"""") iStart=Instr(iStart+1,sFileName,".") iStart2=Instr(iStart+1,sFileName,".") While iStart2>iStart And iEnd>iStart2 iStart=Instr(iStart+1,sFileName,".") iStart2=Instr(iStart+1,sFileName,".") Wend iEnd=Instr(iStart+1,sFileName,"Content-Type:") If iEnd>iStart+1 Then iEnd=iEnd-3 End If GetFileTypeByLy=Mid(sFileName,iStart,iEnd-iStart) End Function Function Re_ClearAll(str) Dim Rstr Rstr=str While Instr(Rstr,"<")>0 If INSTR(Rstr,">")>0 Then Rstr=Left(Rstr,Instr(Rstr,"<")-1)&Right(Rstr,Len(Rstr)-INSTR(Rstr,">")) End If Wend Re_ClearAll=Rstr End Function Function GetIDByCode(sqlstr,id,conn) dim rs,getid getid=0 if sqlstr="" then sqlstr="select id from t_basecat where id=@value@" end if if not isnumeric(id) then id="0" end if sqlstr=replace(sqlstr,"@value@",id) set rs=conn.execute(sqlstr) if not rs.eof then getid=rs("id") end if GetIDByCode=getid End Function Function sLeft(str,num,stradd) Dim Rstr if not isnumeric(num) then num=10 else num=cint(num) end if if IsNull(str) Or Len(str)="" then Rstr="   " elseif len(str)>num then Rstr=left(str,num)&stradd else Rstr=left(str,num) end if sLeft=Rstr End Function 'fckeditor plus Sub CreateEditor(strname,strvalue,strpath,strpath2) Dim sBasePath sBasePath = Lcase(Request.ServerVariables("PATH_INFO")) sBasePath = Left( sBasePath, InStrRev( sBasePath, strpath )) sBasePath=sBasePath&strpath2 If editor="eweb" then Response.Write("
") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("
Editor Loading....
") Response.Write("
") Response.Write("") Response.Write("") else Dim oFCKeditor Set oFCKeditor = New FCKeditor oFCKeditor.ToolbarSet=editorstyle oFCKeditor.BasePath = sBasePath oFCKeditor.Value = strvalue oFCKeditor.Create strname end if End Sub Sub CreateEditorH(strname,strvalue,strpath,strpath2,height) Dim sBasePath sBasePath = Lcase(Request.ServerVariables("PATH_INFO")) sBasePath = Left( sBasePath, InStrRev( sBasePath, strpath )) sBasePath=sBasePath&strpath2 If editor="eweb" then Response.Write("
") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("
Editor Loading....
") Response.Write("
") Response.Write("") Response.Write("") else Dim oFCKeditor Set oFCKeditor = New FCKeditor oFCKeditor.ToolbarSet=editorstyle oFCKeditor.BasePath = sBasePath oFCKeditor.Height = height oFCKeditor.Value = strvalue oFCKeditor.Create strname End If End Sub %> Please Choose a database type.
DataBase Connection error.