📄 getpartstrandbyteslen.asp

📁 本房地产网站功能强大
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
		CodeStr=Lcase(Trim(Request.Form("fyasp_cd")))
		If CStr(Session("fyasp_cds"))=CStr(CodeStr) And CodeStr<>""  Then
			fy_CodeIsTrue=True
			Session("fyasp_cds")=empty
		Else
			fy_CodeIsTrue=False
			Session("fyasp_cds")=empty
		End If	
End Function
'=================================================
'Createhtmldir(strdir)
'strdir           ----(要检查的目录)
'检查生成目录是否存在，没有则创建
'=================================================
Sub Createhtmldir(strdir)
Set fsoc = CreateObject("Scripti"&"ng.File"&"SystemO"&"bject")
if Not fsoc.FolderExists(strdir) then
fsoc.CreateFolder(strdir)
end if
Set Fsoc = Nothing
end sub
'=================================================
'fy_DelFolder(strFolder)
'strFolder          ----(要删除的文件夹)
'删除指定文件夹
'=================================================
Sub fy_DelFolder(strFolder)
		if strFolder="" then Exit Sub
		dim fso,arrFolder,i
		On Error Resume Next
		Err=0
		strFolder=replace(strFolder,"/","")
		Set fso = CreateObject("Scripti"&"ng.File"&"SystemO"&"bject")
			if fso.FolderExists(strFolder) then
				fso.DeleteFolder(strFolder)
				if 0=Err then
				RefreshHtml2 "txt1","<font color=blue>清除文件（"&strFolder&"）成功！</font>"
				else
				RefreshHtml2 "txt1","<font color=red>清除文件夹夹（"&strFolder&"）失败！</font>"
				end if
			end if
		Set fso = Nothing
		Err=0
End Sub
Sub Admin_ShowErr(sErrMsg)
	Response.Write "<html><head><title>信息提示</title>"
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
	Response.Write "</head><body><br><br>"
	Response.Write "<table cellpadding=2 cellspacing=1 border=0 class=""border"" align=center>"
	Response.Write "<tr align=""center"" class=""title""><td height=""22""><strong>信息提示</strong></td></tr>"
	Response.Write "<tr class=""tdbg""><td height=""100"" valign=""top"">"&sErrMsg&"</td></tr>"
	Response.Write "<tr align=""center"" class=""tdbg""><td>【<a href=""javascript:history.go(-1)"">返回上一步</a>】&nbsp;&nbsp;【<a href=""javascript:window.close();"">关闭窗口</a>】</td></tr>"
	Response.Write "</table></body></html>"
	CloseAllObj
	response.end
End Sub
'=================================================
'生成单个文件:Create_gq_file(url,filepath,cname)
'url		----- (网址)
'sid         ----- (文件路径)
'lx         ----- (文件名称)
'=================================================
Sub Create_house_file(url,filepath,cname)
if cname="" then
cname="静态文件"
end if
	RefreshHtml2 "txt1","<font color=#ff0033>正在生成"&cname&"，请稍后......</font>"
	RefreshHtml2 "txt4","共有 <b>1</b> 个"&cname&"要生成！"
	Dim strMakeData
	strMakeData=getHTTPPage(url)
	strMakeData=strMakeData& vbNewLine & "<!--Copyright 2000-2006 Http://Www.FyAsp.Com " &_
				".All Rights Reserved  CreateDate:"&Now&"-->"
	MakeHtml strMakeData,filepath
	RefreshHtml ""&cname&"生成完毕！",1,1
	RefreshHtml2 "txt1","<font color=blue>恭喜您，"&cname&"生成完毕！</font>"
	apn=apn+1
End Sub
Sub RefreshHtml(txt,Nown,Alln)
	Response.Write "<script>img1.width=" & Fix((Nown/Alln) * 500) & ";" & VbCrLf & _
					"txt2.innerHTML=""" & FormatNumber(Nown/Alln*100,2,-1) & """;" & VbCrLf & _
					"txt3.innerHTML=""<br>"&txt&""";" & _
					"</script>"
	Response.Flush
End Sub
Sub RefreshHtml2(SName,SValue)
	Response.Write "<script>" & vbCrLf & _
					SName & ".innerHTML=""" & SValue & """;" & vbCrLf & _
					"</script>"
	Response.Flush
End Sub
Sub ShowCreateWindow(w_title,w_href)
	Response.Write "<table border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">"
	Response.Write "<tr class=""title""><td align=""center"" height=""22""><b>HTML生成管理窗口</b></td></tr>"
	Response.Write "<tr class=""tdbg""><td align=""center"" height=""22""><span id=txt1 name=txt1 style=""font-size:12pt""><b>"&w_title&"</b><br /><font color=red>注意，在未完成时，请不要关闭浏览器或刷新本页。</font></span></td></tr>"
	Response.Write "<tr class=""tdbg""><td align=""center"" valign=""middle"">"
	Response.Write "<table cellpadding=""3"" cellspacing=""1"" border=""0"" width=""500"">"
	Response.Write "<tr><td height=""33"" align=""center"" colspan=2><span id=txt4 name=txt4 style=""font-size:9pt""></span></td></tr>"
	Response.Write "<tr><td width=""500"" height=""22"" align=""center"">"
	Response.Write "<table width=""500"" border=""1"" cellspacing=""0"" cellpadding=""1"">"
	Response.Write "<tr><td><img src=""../Images/bar/bar3.gif"" width=0 height=16 id=img1 name=img1 align=absmiddle></td></tr></table>"
	Response.Write "</td></tr>"
	Response.Write "<tr><td><span id=txt2 name=txt2 style=""font-size:9pt"">0</span><span style=""font-size:9pt"">%</span></td></tr>"
	Response.Write "<tr><td><span id=txt5 name=txt5 style=""font-size:9pt""></span></td></tr></table>"
	Response.Write "<table cellpadding=""3"" cellspacing=""1"" border=""0"" width=""500"">"
	Response.Write "<tr><td height=""33"" align=""center"" colspan=2><input type=""button"" name=""cancel"" value="" 取 消 "" onclick=""window.location.href='"&w_href&"';"">&nbsp;&nbsp;<Input id=isshowwork name=isshowwork type=Checkbox value=1 onclick=work() checked><span id=showw>查看详细进程</span></td></tr>"
	Response.Write "</table>"
Response.Write "<Div ID=""work""><table cellpadding=""3"" cellspacing=""1"" border=""0"" width=""500"">"
Response.Write "<tr><td><span id=txt3 name=txt3 style=""font-size:9pt""></span></td></tr></table></Div>"
	Response.write "</td></tr></table>"
	Response.write "<script type=""text/javascript"">" & VbCrLf
	Response.write "<!--" & VbCrLf
	Response.write "function work(){" & VbCrLf
	Response.write "if (document.getElementById('isshowwork').checked == true) {" & VbCrLf
	Response.write "	document.getElementById('work').style.display = '';" & VbCrLf
	Response.write "	document.getElementById('showw').innerText='关闭详细进程';" & VbCrLf
	Response.write "}else{" & VbCrLf
	Response.write "	document.getElementById('work').style.display = 'none';" & VbCrLf
	Response.write "	document.getElementById('showw').innerText='查看详细进程';" & VbCrLf
	Response.write "}" & VbCrLf
	Response.write "}" & VbCrLf
	Response.write "//-->" & VbCrLf
	Response.write "</script>"
	Response.Flush
End Sub
Function getHTTPPage(Path)
on error resume next
        t = GetBody(Path)
        getHTTPPage=BytesToBstr(t,"GB2312")
End function

Function GetBody(url) 
        on error resume next
        Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
        With Retrieval 
        .Open "Get", url, False, "", "" 
        .Send 
        GetBody = .ResponseBody
        End With 
        Set Retrieval = Nothing 
End Function

Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("Adodb." & "Str" & "eam")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function
Function Newstring(wstr,strng)
        Newstring=Instr(lcase(wstr),lcase(strng))
        if Newstring<=0 then Newstring=Len(wstr)
End Function
Sub MakeHtml(MakeData,MakeFileName)
		Dim Fso,Make
		On Error Resume Next
		Err=0
		MakeFileName=Trim(MakeFileName)
		Set fso = Server.CreateObject("Scripti"&"ng.File"&"SystemO"&"bject")
			Set Make = Fso.CreateTextFile(Server.MapPath(MakeFileName), True)
			Make.Write MakeData& vbNewLine & _
				"<!--Powered by:Http://Www.FyAsp.Com " &_
						"CreateDate:"&Now&"--> "
			Set Make = Nothing
		Set Fso = Nothing
		If 0 <> Err Then
			Response.Write "<font color=red>生成（"&MakeFileName&"）失败！</font><br>"
		End if
		Err=0
End Sub
Function strint(id)
If IsNumeric(id) = 0 or id = "" Then id = 0
strint = Clng(id)
End Function
Function HtmlEncode(Content)
IF content="" or isnull(content) Then exit function
  Content = trim(Content)
  Content = Replace(Content,"%20"  , ""       )'特殊字符过滤
  Content = Replace(Content,chr(62),  "＞"  )' > 
  Content = Replace(Content,chr(60),  "＜"  )' < 
  Content = Replace(Content,chr(39),  "＇"    )' ' 
  Content = Replace(Content,chr(37),  "％"    )' % 
  Content = Replace(Content, vbcrlf,  ""      )
  Content = Replace(Content,chr(34),  "”")' "
  Content = Replace(Content,chr(40),  "（"    )' ( 
  Content = Replace(Content,chr(41),  "）"    )' ) 
  Content = Replace(Content,chr(91),  "［"    )' [ 
  Content = Replace(Content,chr(93),  "］"    )' ] 
  Content = Replace(Content,chr(123), "｛"    )' { 
  Content = Replace(Content,chr(125), "｝"    )' } 
  Content = Replace(Content, CHR(13),   "")   
  Content = Replace(Content,CHR(10), "")
  HtmlEncode = content 
End Function
'/检查门店注册权限/
'会员类型,登录名,用户ID

Function Isregmd(fyasp_regtype,vUsername,wdreg)
'exit function
OpenDataConn
'0无权注册
'1已经注册
'2未注册可以注册
'3关闭注册
Isregmd=0'无权限
	Set rdsUser = Server.CreateObject("ADODB.Recordset")
	sqlUser = "Select * From fyasp_mendian Where username='"& vUserName &"'"
	rdsUser.Open sqlUser,conn
	If Not rdsUser.EOF Then
		Isregmd=1'已经注册,管理
		exit function
	Else'未注册门店

        Select case clng(wdreg)
  	Case clng(3)'所有会员
		Isregmd=2'有权注册
		exit function
 	Case clng(1)
		if fyasp_regtype="0" then
		Isregmd=2
		else
		Isregmd=0
		end if
		exit function
	Case clng(2)
		if fyasp_regtype="1" then
		Isregmd=2
		else
		Isregmd=0
		end if
		exit function
	Case clng(0)
		Isregmd=3
		exit function
End Select

	End if
	rdsUser.Close
	set rdsUser = nothing
End Function
%>
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -