导入本地收藏夹

<% Response.Buffer = True Server.ScriptTimeOut = 9999999 %> <% If Session("User_Account")="" Then Call AlertUrl("请先登陆！","Index.asp") Response.End End if %> <% If Request("action")="upload" Then '限制从外部非法提交 If Instr(Request.ServerVariables("http_referer"),"http://" & Request.Servervariables("host") ) < 1 Then Response.Write "处理 URL 时服务器上出错!请与管理员联系..." Response.End End If Const G_FS_FSO = "Scripting.FileSystemObject" 'FSO组件名称 '--------------------------------------------- Dim TextFile Dim AllowFileType AllowFileType = "htm" Dim AllowFileSize AllowFileSize = 10240 Dim Create_DateCatalog Create_DateCatalog = True '是否开启创建日期目录 '--------------------------------------------- Dim AutoReName,UpFileObj,FileObject,FormName,FileName,FileExtStr,strFileName Dim Fso,SavePath,AutoSavePath,AppearErr,ClueOn_Msg,StrJs Dim SameFileTF,No_UpFileTF,RealityPath '--------------------------------------------- SavePath = "/" '保存文件目录 If Right(SavePath,1) <> "/" Then SavePath = SavePath & "/" End If Set UpFileObj = New UpFile_Class UpFileObj.GetData(10240000) AutoReName = Trim(UpFileObj.Form("AutoRename")) '是否自动重命名文件 ClueOn_Msg = "" No_UpFileTF = True AppearErr = False If IsObjInstalled(G_FS_FSO) = True Then '------------------------------------------------------------------------------ Set Fso = Server.CreateObject(G_FS_FSO) '-------------------------------------------------------------------------- For Each FormName in UpFileObj.File '列出所有上传了的文件 Set FileObject = UpFileObj.File(FormName) '生成一个文件对象 SameFileTF = False FileName = FileObject.FileName If NoIiiegalStr(FileName) = False Then ClueOn_Msg = "文件：上传被禁止!" AppearErr = True End If FileExtStr = FileObject.FileExt If FileObject.FileSize > 1 Then '如果有文件上传 '---------------------------------------------------------------------- If Fso.FolderExists(Server.MapPath(SavePath)) = True Then '检测目录是否存在 If Create_DateCatalog = True Then '如果开启了自动创建日期目录 AutoSavePath = "UpLoadFile/" SavePath = SavePath & AutoSavePath If Not Fso.FolderExists(Server.MapPath(SavePath)) Then '如不存在目录则建立 Fso.CreateFolder Server.MapPath(SavePath) End If End If Else ClueOn_Msg = "目录不存在,无法上传文件!" AppearErr = True End If RealityPath = Server.MapPath(SavePath) & "\" '转换虚拟路径为实际路径 '---------------------------------------------------------------------- No_UpFileTF = False If FileObject.FileSize > Clng(AllowFileSize)*1024 Then ClueOn_Msg = FileName & "文件超过了限制!\n\n最大只能上传" & AllowFileSize & "K的文件" AppearErr = True End If If AutoRename = "2" Then '如果不是自动从命名文件 If Fso.FileExists(RealityPath & FileName) = True Then ClueOn_Msg = "文件:存在同名文件" AppearErr = True Else SameFileTF = False End If Else SameFileTF = True End If If CheckFileType(AllowFileType,FileExtStr) = False Then ClueOn_Msg = "此文件不允许上传!\n\n允许上传文件类型有"& AllowFileType &"" AppearErr = True End If StrJs = "" TextFile = FSOFileRead("UpLoadFile/"& strFileName) Dim regEx, Matchs, Matches, RetStr Set regEx = New RegExp regEx.Pattern = "" regEx.IgnoreCase = True regEx.Global = True Set Matches = regEx.Execute(TextFile) For Each Matchs in Matches Set regExA = New RegExp regExA.Pattern = ">.*?" regExA.IgnoreCase = True regExA.Global = True Set MatchesA = regExA.Execute(Matchs.Value) Set regExB = New RegExp regExB.Pattern = ""&Fav_sql&"
" end if Next conn.close deletefile(TextFiled) Response.Wirte "FavList.asp" Response.Redirect "FavList.asp" Response.End Else Response.Write( "请选择你要上传的文件！") Response.End End If Next Set FileObject = Nothing Set Fso = Nothing Else Response.Write "上传功能需要FSO组件支持,请检查该组件是否安装正确!" Response.End End If Set UpFileObj = Nothing End If %> 导入本地收藏夹

导入本地收藏夹两步走

第一步:导出本地收藏夹，保存好导出文件（bookmark.htm）

------------->

第二步:选择本地收藏夹文件bookmark.htm，上传

(默认不开放“共享”，恶意上传广告无用)