admin_replacefiles.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

<!--#include file="Admin_Const.asp"-->
<%
if Cint(Cl.Admin_Purview(0))<>1 then
	Cl.ShowErr("<li>您无此操作权限！</li>")
end if
Server.ScriptTimeOut = 999999999
Header
Dim Action,Inum1,Inum2,Pathstr1,ThNum
Dim OldStr,NewStr
OldStr=trim(Request("OldStr"))
NewStr=trim(Request("NewStr"))
ThNum=Cl.GetClng(Request("ThNum"))

Inum1=0
Inum2=0

Action=Trim(Request("Action"))
Select Case Acrion
Case Action="Step2"
	Call Step2()
Case Else
	Call Step1()
End Select

Footer

Sub Step1()%>
<script language = "JavaScript" type="text/javascript">
function CheckForm(){
	if (document.myform.Pathstr.value==""){
	alert("请输入查找目录！");
	document.myform.Pathstr.focus();
	return false;
	}
	return true;
}
</script>
<form  action="Admin_ReplaceFiles.asp" method="post" name="myform" target="_self" id="myform" onsubmit="return CheckForm();">
<table width="100%" border="0" align="center" cellpadding="2" cellspacing="1" class="border">
	<tr class="title"><td height="22" colspan="2" align="center"><strong>文件内容批量替换设置</strong></td></tr>
	<tr class="tdbg"><td height="40" width="70" align="right">查找目录：</td><td height="40"><input name="Pathstr" type="text" value="/HTML/" size="72" />
	(请填写相对路径,如/HTML/Article/)<br/>
	<input name="searchtype" type="radio" id="searchtype" value="1" checked="checked" />
	包含子目录
	<input name="searchtype" type="radio" id="searchtype" value="0" />
	不包含子目录
	</td></tr>
	<tr class="tdbg"><td height="40" align="right">文件类型：</td><td height="40"><input name="FileType" type="text" value="txt|htm|html|shtml|asp|php|cgi" size="72" />
	(要进行替换的文件后缀名,以|分隔,留空为不限)</td></tr>
	<tr class="tdbg"><td height="40" align="right">替换数量：</td><td height="40"><input name="ThNum" type="text" value="" size="72" />
	替换多少条数据,0或不填写为不限</td></tr>
	<tr class="tdbg"><td height="40" align="right">将 字 符：</td><td height="40"><textarea name="OldStr" cols="60" rows="4"></textarea><font color="red"> *</font></td>
	</tr>
	<tr class="tdbg"><td height="40" align="right">替 换 成：</td><td height="40"><textarea name="NewStr" cols="60" rows="4"></textarea></td></tr>
	<tr class="tdbg"><td height="40" align="right">注意事项：</td><td height="40">	1、此操作不能恢复，请备份您的原始文件。<br/>2、本操作的更新时间视您数据的多少以及服务器（或本地机器）的配置决定，如果数据很多，更新可能很慢。
	<br />3、在替换过程中千万不能刷新页面或关闭浏览器，如果出现超时或者错误提示，请使用备份数据重新进行操作。</td></tr>
	<tr class="tdbg"><td height="40" colspan="2" align="center"><input type="hidden" name="Action" value="Step2" />
	<input type="submit" name="Submit" value="开始替换" /></td></tr>
</table>
</form><%
End Sub


Sub Step2()
	Dim sFso,stheFolder,stheFile,Pathstr,SearchType
	SearchType=Cl.ChkClng(Request("SearchType"))
	Pathstr=trim(Request("Pathstr"))
	Pathstr1=Replace(Server.MapPath("/"),"\","/")
	if SearchType=0 then
		Call DoReplace(Server.MapPath(Pathstr),OldStr,NewStr)
	Else
		Call BianLi(Server.MapPath(Pathstr))
	End if
	Response.write "替换结束！本次共查找到"&Inum1&"个文件，成功替换"&Inum2&"个"
End Sub

Sub DoReplace(Pathstr,OldStr,NewStr)
	if Inum1>=ThNum and ThNum>0 then Exit Sub
	Pathstr=Replace(Pathstr,"\","/")
	if right(Pathstr,1)<>"/" and right(Pathstr,1)<>"\" then Pathstr=Pathstr&"/"
	Pathstr=Replace(Pathstr,"//","/")
	dim c,theFile,theFolder,strFileType,fso,TruePath,FileType,FileType1,isTrue,i,InStream,Out,Out1,FileObject,Tempstr
	Response.Flush()'刷新
	FileType =trim(Request("FileType"))
	if FileType<>"" then
		FileType1=Split("|"&FileType&"|","|")
		isTrue=False
	Else
		isTrue=True
	End if
	Set fso = Server.CreateObject(Cl.Web_Info(13))
	Set theFolder=fso.GetFolder(Pathstr)
	For Each theFile In theFolder.Files
		c=c+1
		strFileType=lcase(mid(theFile.name,instrrev(theFile.name,".")+1))
		if FileType<>"" then
			isTrue=False
			for i=0 to Ubound(FileType1)
				if Ucase(FileType1(i))=Ucase(strFileType) then isTrue=True
			Next
		Else
			isTrue=True
		End if
		if isTrue=True Then
			Response.write Replace("<li>正在查找第 <font color=red><Strong>"&Inum1+1&"</Strong></font> 个文件："&Pathstr&theFile.name&" ",Pathstr1,"")
			Set FileObject=Server.CreateObject("Scripting.FileSystemObject")
			Set Out=FileObject.OpenTextFile(Pathstr&theFile.name,1,FALSE,FALSE)
				tempstr= Out.readall
			Out.Close
			if  instr(tempstr,OldStr)<>0 then
				Set Out1=FileObject.CreateTextFile(Pathstr&theFile.name,True,FALSE)
					Out1.Write(Replace(tempstr,OldStr,NewStr))
				Out1.Close
				Response.write "<font color=""green"">替换成功！</font>"
				Inum2=Inum2+1
			'Else
				'Response.write "<font color=black>无匹配内容！</font>"
			End if
			Response.write "</li><br/>"
			'……………………………………………… 
			If Response.IsClientConnected Then
				Response.Flush
			Else 
				Response.end
			End If
			'………………………………………………
			Inum1=Inum1+1
			if Inum1>=ThNum and ThNum>0 then Exit For
		end if
	Next

End Sub

Sub BianLi(path) 
	Dim fso,objFolder,objSubFolders,objSubFolder,nowpath
	Call DoReplace(path,OldStr,NewStr)
	Set fso=server.CreateObject(Cl.Web_Info(13))
	On Error Resume Next
	Set objFolder=fso.GetFolder(path)
	Set objSubFolders=objFolder.Subfolders
	For Each objSubFolder in objSubFolders
		nowpath=path + "/" + objSubFolder.name
		Call DoReplace(nowpath,OldStr,NewStr)
		Call BianLi(nowpath)'递归 
	Next 
	Set objFolder=Nothing 
	Set objSubFolders=Nothing 
	Set fso=Nothing 
End Sub

%>