create_pagewarecls.asp

大型黄页系统,精美黄页flash演示,10m

<%
Class Create_User_Cls
	Private Rs, SQL, Rss, SQLS, Rs5, SQL5, Rs6, SQL6, total, CreateHtml, FSO, objFSO, NewFolderPath
	Private DownloadClass_Ads
	Private HtmlTemplate
	Private SoftName
	Private userName
	Private regtime
	Private MaterialClassCode
	Private MaterialClassCode1
	Private Description
	Private depth
	Private ParentID
	Private strParent
	Private Company
	Private Grade
	Private PhoneCountry
	Private PhoneArea
	Private usertel
	Private MobileNo
	Private FaxCountry
	Private FaxArea
	Private FaxNumber
	Private address
	Private HtmlTitle
	Private postcode
	Private truename
	Private JobTitle
	Private usermail
	Private SaleKeywords
	Private BuyKeywords

	Private Contact
	Private userid
	Private HtmlTempStr
	Private NowStats
	Private TempTopStr
	Private TempFootStr
	Private Style_CSS
	Private datDate
	Private startime
	Private i
	Private j, k
	Private Rs1
	Private p
	Private d
	Private maxperpage
	Private SoftTotal
	Private TotalPage
	Private SoftNumber
	Private totalnumber
	Private action
	Private Re
	Private Sub Class_Initialize()
	    On Error Resume Next
		Set Rs = Server.CreateObject("ADODB.Recordset")
		DownsysClass.LoadTemplates ("User")
		Set DownloadClass_Ads = New Adcolumn_Cls
	End Sub

	Private Sub Class_Terminate()
		If IsObject(Conn) Then
			Conn.Close
			Set Conn = Nothing
		End If
		If IsObject(DownloadClass_Ads) Then
			Set DownloadClass_Ads = Nothing
		End If
	End Sub
	'*************************************************************
	'函数作用：生成全部信息
	'*************************************************************
	Public Sub CreateUsers()
		DownsysClass.admin_header
		Server.ScriptTimeout = 99999
		Set NC_Admin = New Check
		NC_Admin.AdminChk = "32"
		If Not(DownsysClass.IsObjectFSO(DownsysClass.Script_FSO) And CInt(DownsysClass.Setting(5)) = 0 ) Then
			NC_Admin.Error_Msg ("<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)或你后台没有选择为html方式</font></b>")
			DownsysClass.admin_footer
			Response.End
		End If
		Response.Write "<table width=""400"" border=""0"" cellspacing=""1"" cellpadding=""1"">" & vbCrLf
		Response.Write "<tr> " & vbCrLf
		Response.Write "<td align=center> <span id=txt2 name=txt2 style=""font-size:9pt"">正在生成文件请耐心等待……</span>   <span id=txt3 name=txt3 style=""font-size:9pt""></span></td></tr>" & vbCrLf
		Response.Write "</table>" & vbCrLf
		Response.Flush
		Set Rss = Server.CreateObject("adodb.recordset")
		SQLs = "select userid from [NC_User] where isLock=0"
		Rss.Open SQLs, Conn, 1, 1
		total = Rss.recordcount
		If total = 0 Then
			NC_Admin.Error_Msg ("<script>txt2.innerHTML="""";txt3.innerHTML="""";</script> 没有你选择范围内文章信息页可生成！")
			DownsysClass.admin_footer
			Response.End
		End If
		Rss.MoveFiRst
		k = 1
		Do While Not Rss.EOF
			userid = Rss("userid")
			CreateUser(userid) '生成信息信息html页
			Response.Write "<script>txt2.innerHTML=""生成进度:" & FormatNumber(k / total * 100, 2, -1) & "%"";" & vbCrLf
			Response.Write "txt3.innerHTML=""共有 <B><font color=RED>" & total & "</font></B> 个 　正在生成第 " & k & " 个"";</script>" & vbCrLf
			Response.Flush
			Rss.movenext
			DownsysClass.SqlQueryNum = DownsysClass.SqlQueryNum + 1
			k = k + 1
		Loop
		Rss.Close
		Set Rss = Nothing
		Response.Write "<script>txt2.innerHTML="""";txt3.innerHTML="""";</script>"
		NC_Admin.Succeed_Msg ("共有 <B><font color=RED>" & total & "</font></B> 个信息信息页面生成完毕！")
		DownsysClass.admin_footer
	End Sub
	'*************************************************************
	'函数作用：生成信息
	'*************************************************************
	Public Sub CreateUser(userid)
		On Error Resume Next
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select * from NC_User where userid = " & userid
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			Response.Write "Sorry！还没有找到任何信息！"
			Exit Sub
		Else
			userName = Rs("userName")
			Set Re = New RegExp
			Re.IgnoreCase =true
			Re.Global=True
			Set Re = Nothing
			regtime = Rs("regtime")
			Company = Rs("Company")
				IF Rs("Grade") = 2 then 
						Grade = "VIP会员"
				Else
						Grade = "普通会员"
				End if
			truename = "" & Trim(Rs("truename")) & " "
			PhoneCountry = Rs("PhoneCountry")
			PhoneArea = Rs("PhoneArea")
			usertel = Rs("usertel")
			MobileNo = Rs("MobileNo")
			FaxCountry = Rs("FaxCountry")
			FaxArea = Rs("FaxArea")
			FaxNumber = Rs("FaxNumber")
			MaterialClassCode = Rs("MaterialClassCode")
			address = Rs("address")
			postcode = Rs("postcode")
			JobTitle = Rs("JobTitle")
			usermail = Rs("usermail")
			SaleKeywords = Rs("SaleKeywords")
			BuyKeywords = Rs("BuyKeywords")

		End If
		Rs.Close
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select * from [MaterialClass] where MaterialClassCode = " & MaterialClassCode
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			Response.Write "Sorry！没有找到任何信息。或者您选择了错误的系统参数!"
			Response.End
		Else
			Description = Rs("Description")
			MaterialClassCode = Rs("MaterialClassCode")

				IF Rs("MaterialClassCode") <> "" then 
						Set Rs5 = CreateObject("Adodb.recordset")
						SQL5 = "select * from MaterialClass where MaterialClassCode = "&(Left((Rs("MaterialClassCode")), 4)) &""
						Rs5.Open SQL5, Conn, 1, 1
						Set Rs6 = CreateObject("Adodb.recordset")
						SQL6 = "select * from MaterialClass where MaterialClassCode = "& Rs("MaterialClassCode") &""
						Rs6.Open SQL6, Conn, 1, 1
						MaterialClassCode1 = ""& Rs5("Description") &"-"& Rs6("Description") &""
				Else
						MaterialClassCode1 = "信息不详"
				End if

		End If
		Rs.Close
		If Len(DownsysClass.temphtml(0)) < 50 Then
			TempTopStr = DownsysClass.mainhtml(0) & DownsysClass.TempHtml(1) & DownsysClass.mainhtml(2) & DownsysClass.mainhtml(3)
		Else
			TempTopStr = DownsysClass.temphtml(0)
		End If
		If Len(DownsysClass.temphtml(4)) = 0 Then
			TempFootStr = DownsysClass.mainhtml(4)
		Else
			TempFootStr = DownsysClass.temphtml(4)
		End If
		HtmlTitle = Company
		NowStats = NowStation(MaterialClassCode, Description) & "→" & Company
		Style_CSS = Replace(Replace(DownsysClass.Style_CSS, "{$SetupDir}", DownsysClass.SetupDir), "{$PicUrl}", DownsysClass.TempDir)
		HtmlTempStr = TempTopStr & DownsysClass.temphtml(2) & DownsysClass.temphtml(3) & TempFootStr
		HtmlTempStr = Replace(HtmlTempStr, "{$NavMenu}", DownsysClass.SortingMenu)
		HtmlTempStr = Replace(HtmlTempStr, "{$Width}", DownsysClass.mainset(0))
		HtmlTempStr = Replace(HtmlTempStr, "{$Style_CSS}", Style_CSS)
		HtmlTempStr = Replace(HtmlTempStr, "{$TopMeun}", DownsysClass.mainset(9))
		HtmlTempStr = Replace(HtmlTempStr, "{$FootMeun}", DownsysClass.mainset(44))
		HtmlTempStr = Replace(HtmlTempStr, "{$NowStats}", NowStats)
		HtmlTempStr = Replace(HtmlTempStr, "{$Company}", Company)
		HtmlTempStr = Replace(HtmlTempStr, "{$Title}", HtmlTitle)
		HtmlTempStr = Replace(HtmlTempStr, "{$userName}", userName)