<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="conn.asp"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
</head>
<body>
<%
'以下程序批量改名文件夹中的文件名并批量添加到动易数据库
'本程序作者：eMaill
'个人主页：www.591kj.com ；QQ：75854093
'本程序可自由传播，修改源代码请保留本信息，并邮件通知本人最新版本，电邮：eMini@591kj.com
' 变量说明
Dim fProcedure
Dim strFromDir '源文件夹
Dim strTargetDir '目标文件夹
Dim objFS '文件操作对象
Dim objRootFolder '文件夹对象
Dim objFile '文件对象
Dim strNewFolder '新文件夹
Dim strFileNameLen '文件名长度
Dim strPrevFileName '改名前的文件名
Dim strFileExt '文件扩展名
Dim strFileNameCount '格式化的文件名
Dim strNewFileName '新的文件名
Dim strRealCount '处理的文件数量
Dim strFileSize '文件大小
fProcedure = False
dtNow=now()
' 如果点击了开始按钮
If (Request.Form("GoButton")) = "开始" then
'创建文件系统对象
Set objFS = Server.CreateObject("Scripting.FileSystemObject")
' 指定源文件夹和目标文件夹
strServerPath=server.mappath("./") '得到根目录
strFromDir=strServerPath & "/" & Request.Form("FromDir") '指定源文件夹
Response.Write "From Directory is " & strFromDIr & "<br>" & vbCrLf
strNewFolder= year(dtNow) & right("0" & month(dtNow),2) '用年月作为文件夹
strTargetDir= strServerPath & "/" & strNewFolder
if not objFS.FolderExists(server.mappath(strNewFolder)) then
objFS.CreateFolder server.mappath(strNewFolder)
end if
strTargetDir=strTargetDir & "/"
Response.Write "Target Directory is " & strTargetDir & "<br>" & vbCrLf
'将处理文件数量设置为0
strRealCount = 0
'创建文件夹对象
Set objRootFolder = objFS.GetFolder(strFromDir)
'得到文件夹下的所有对象
For each objFile in objRootFolder.Files
strFileNameLen = Len (objFile.Name)
If Mid (objFile.Name,(strFileNameLen - 3),1) = "." then
strFileExt = right(objFile.Name, 4)
Else
strFileExt = right(objFile.Name, 5)
End If
strPrevFileName = objFile.Name
'产生年月日+随机数的文件名
randomize
ranNum=int(900*rnd)+100
strFileNameCount=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
strNewFileName = strFileNameCount & strFileExt '新的文件名加后缀
objFile.Move strTargetDir & strNewFileName '把文件移到新的文件夹
strFileSize= round(objFile.Size/1024) '得到文件的大小
Response.Write "源文件: " &strFromDir&strPrevFileName & " > 移动并改名为: " &strTargetDir& strNewFileName & "文件大小:"& Cstr(strFileSize) & "K" & "<br>" & vbCrLF
strRealCount = strRealCount + 1
Call AddFileRecordToDatabase
Next
Response.Write "<p><b>一共处理: " & (strRealCount) & " 个文件</B>" & vbCrLf
Set objRootFolder = Nothing
Set objFS = Nothing
fProcedure = True
End if
If fProcedure Then
Response.Write("<p><b>批量文件批量移动和改名</b>") & vbCrLf
Else
Response.Write("<center><br><form method=""post"" action=""FConverterAndToDB.asp"" 0ID=form1 name=""form1"">") & vbCrLf
Response.Write("<input type=""text"" ID=""FromDir"" value=""源文件夹"" name=""FromDir"">") & vbCrLf
Response.Write("<input type=""text"" ID=""ClassID"" value=""添文件类别"" name=""ClassID"">") & vbCrLf
Response.Write("<input type=""SUBMIT"" value=""开始"" ID=""GoButton"" name=""GoButton"">") & vbCrLf
Response.Write("</form>") & vbCrLf
Response.Write("<p>课件[ClassID=3]试题[ClassID=16]教案[ClassID=17]论文[ClassID=20]") & VbCrLf
Response.Write("<p><b>点击按钮对文件进行批量移动和改名</b></center>") & VbCrLf
End If
%>
<%
Sub AddFileRecordToDatabase
Dim trs
Dim SoftID, ClassID, SpecialID, SoftName, SoftVersion, SoftType, SoftLanguage, CopyrightType, OperatingSystem, Author, AuthorEmail, AuthorHomepage
Dim DemoUrl, RegUrl, SoftPicUrl, SoftIntro, Keyword, DecompressPassword, SoftSize, DownloadUrls, Inputer
Dim mrs, intMaxID
Set mrs = Conn.Execute("select max(SoftID) from PE_Soft")
If IsNull(mrs(0)) Then
intMaxID = 0
Else
intMaxID = mrs(0)
End If
Set mrs = Nothing
SoftID=intMaxID+1
ChannelID=2
ClassID =CLng(Request.Form("ClassID"))
SpecialID = 0
SoftName = Trim(left(strPrevFileName,strFileNameLen-Len(strFileExt)))
SoftVersion =""
SoftType =7
SoftLanguage =2
CopyrightType = 1
OperatingSystem ="Win9x/NT/2000/XP/"
Author ="网上交流|591kj整理"
AuthorEmail ="eMini@591kj.com"
AuthorHomepage =" http://www.591kj.com"
DemoUrl = " http://www.591kj.com"
RegUrl = " http://www.591kj.com"
SoftPicUrl ="UploadSoftPic/200504/591kj.jpg"
SoftIntro = SoftName & vbCrLf & "免费提供课件试题教案论文图片尽在[我就要课件网]-www.591kj.com"
Keyword ="|" & SoftName & "|免费|课件|试题|教案|论文|图片|"
DecompressPassword = "www.591kj.com"
SoftSize = Trim(strFileSize)
DownloadUrls ="下载地址| http://www.xqedu.net/kj/"&strNewFolder&strNewFileName
Inputer = "eMaill"
Editor="Giantlab"
Set rs = Server.CreateObject("adodb.recordset")
sql = "select top 1 * from PE_Soft"
rs.open sql, Conn, 1, 3
rs.addnew
rs("SoftID") = SoftID
rs("ChannelID") = ChannelID
rs("ClassID") = ClassID
rs("SpecialID") = SpecialID
rs("SoftName") = SoftName
rs("SoftVersion") = SoftVersion
rs("SoftType") = SoftType
rs("SoftLanguage") = SoftLanguage
rs("CopyrightType") = CopyrightType
rs("OperatingSystem") = OperatingSystem
rs("Author") = Author
rs("AuthorEmail") = AuthorEmail
rs("AuthorHomepage") = AuthorHomepage
rs("DemoUrl") = DemoUrl
rs("RegUrl") = RegUrl
rs("SoftPicUrl") = SoftPicUrl
rs("SoftIntro") = SoftIntro
rs("Keyword") = Keyword
randomize
'作弊呀，请慎用！
rs("Hits") = int(100*rnd)+500
rs("DayHits") = int(100*rnd)
rs("WeekHits") = int(200*rnd)+100
rs("MonthHits") = int(200*rnd)+300
rs("SoftLevel") = 9999
rs("SoftPoint") = 0
rs("Stars") = int(5*rnd)
rs("UpdateTime") = Now()
rs("Passed") = True
rs("OnTop") = False
rs("Elite") = False
rs("DecompressPassword") ="" '设密码让网友感觉很麻烦的，建议为空
rs("SoftSize") = SoftSize
rs("DownloadUrl") = DownloadUrls
rs("Inputer") = Inputer
rs("Editor") = Editor
rs("SkinID") = 0
rs("TemplateID") = 0
rs("Deleted") = False
rs.Update
rs.Close
Set rs = Nothing
Conn.Execute ("update PE_Channel set ItemCount=ItemCount+1,ItemChecked=ItemChecked+1 where ChannelID=" & ChannelID & "")
Conn.Execute ("update PE_Class set ItemCount=ItemCount+1 where ClassID=" & ClassID & "")
End sub
%>
</body>
</html>
<!--#include file="conn.asp"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
</head>
<body>
<%
'以下程序批量改名文件夹中的文件名并批量添加到动易数据库
'本程序作者：eMaill
'个人主页：www.591kj.com ；QQ：75854093
'本程序可自由传播，修改源代码请保留本信息，并邮件通知本人最新版本，电邮：eMini@591kj.com
' 变量说明
Dim fProcedure
Dim strFromDir '源文件夹
Dim strTargetDir '目标文件夹
Dim objFS '文件操作对象
Dim objRootFolder '文件夹对象
Dim objFile '文件对象
Dim strNewFolder '新文件夹
Dim strFileNameLen '文件名长度
Dim strPrevFileName '改名前的文件名
Dim strFileExt '文件扩展名
Dim strFileNameCount '格式化的文件名
Dim strNewFileName '新的文件名
Dim strRealCount '处理的文件数量
Dim strFileSize '文件大小
fProcedure = False
dtNow=now()
' 如果点击了开始按钮
If (Request.Form("GoButton")) = "开始" then
'创建文件系统对象
Set objFS = Server.CreateObject("Scripting.FileSystemObject")
' 指定源文件夹和目标文件夹
strServerPath=server.mappath("./") '得到根目录
strFromDir=strServerPath & "/" & Request.Form("FromDir") '指定源文件夹
Response.Write "From Directory is " & strFromDIr & "<br>" & vbCrLf
strNewFolder= year(dtNow) & right("0" & month(dtNow),2) '用年月作为文件夹
strTargetDir= strServerPath & "/" & strNewFolder
if not objFS.FolderExists(server.mappath(strNewFolder)) then
objFS.CreateFolder server.mappath(strNewFolder)
end if
strTargetDir=strTargetDir & "/"
Response.Write "Target Directory is " & strTargetDir & "<br>" & vbCrLf
'将处理文件数量设置为0
strRealCount = 0
'创建文件夹对象
Set objRootFolder = objFS.GetFolder(strFromDir)
'得到文件夹下的所有对象
For each objFile in objRootFolder.Files
strFileNameLen = Len (objFile.Name)
If Mid (objFile.Name,(strFileNameLen - 3),1) = "." then
strFileExt = right(objFile.Name, 4)
Else
strFileExt = right(objFile.Name, 5)
End If
strPrevFileName = objFile.Name
'产生年月日+随机数的文件名
randomize
ranNum=int(900*rnd)+100
strFileNameCount=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
strNewFileName = strFileNameCount & strFileExt '新的文件名加后缀
objFile.Move strTargetDir & strNewFileName '把文件移到新的文件夹
strFileSize= round(objFile.Size/1024) '得到文件的大小
Response.Write "源文件: " &strFromDir&strPrevFileName & " > 移动并改名为: " &strTargetDir& strNewFileName & "文件大小:"& Cstr(strFileSize) & "K" & "<br>" & vbCrLF
strRealCount = strRealCount + 1
Call AddFileRecordToDatabase
Next
Response.Write "<p><b>一共处理: " & (strRealCount) & " 个文件</B>" & vbCrLf
Set objRootFolder = Nothing
Set objFS = Nothing
fProcedure = True
End if
If fProcedure Then
Response.Write("<p><b>批量文件批量移动和改名</b>") & vbCrLf
Else
Response.Write("<center><br><form method=""post"" action=""FConverterAndToDB.asp"" 0ID=form1 name=""form1"">") & vbCrLf
Response.Write("<input type=""text"" ID=""FromDir"" value=""源文件夹"" name=""FromDir"">") & vbCrLf
Response.Write("<input type=""text"" ID=""ClassID"" value=""添文件类别"" name=""ClassID"">") & vbCrLf
Response.Write("<input type=""SUBMIT"" value=""开始"" ID=""GoButton"" name=""GoButton"">") & vbCrLf
Response.Write("</form>") & vbCrLf
Response.Write("<p>课件[ClassID=3]试题[ClassID=16]教案[ClassID=17]论文[ClassID=20]") & VbCrLf
Response.Write("<p><b>点击按钮对文件进行批量移动和改名</b></center>") & VbCrLf
End If
%>
<%
Sub AddFileRecordToDatabase
Dim trs
Dim SoftID, ClassID, SpecialID, SoftName, SoftVersion, SoftType, SoftLanguage, CopyrightType, OperatingSystem, Author, AuthorEmail, AuthorHomepage
Dim DemoUrl, RegUrl, SoftPicUrl, SoftIntro, Keyword, DecompressPassword, SoftSize, DownloadUrls, Inputer
Dim mrs, intMaxID
Set mrs = Conn.Execute("select max(SoftID) from PE_Soft")
If IsNull(mrs(0)) Then
intMaxID = 0
Else
intMaxID = mrs(0)
End If
Set mrs = Nothing
SoftID=intMaxID+1
ChannelID=2
ClassID =CLng(Request.Form("ClassID"))
SpecialID = 0
SoftName = Trim(left(strPrevFileName,strFileNameLen-Len(strFileExt)))
SoftVersion =""
SoftType =7
SoftLanguage =2
CopyrightType = 1
OperatingSystem ="Win9x/NT/2000/XP/"
Author ="网上交流|591kj整理"
AuthorEmail ="eMini@591kj.com"
AuthorHomepage =" http://www.591kj.com"
DemoUrl = " http://www.591kj.com"
RegUrl = " http://www.591kj.com"
SoftPicUrl ="UploadSoftPic/200504/591kj.jpg"
SoftIntro = SoftName & vbCrLf & "免费提供课件试题教案论文图片尽在[我就要课件网]-www.591kj.com"
Keyword ="|" & SoftName & "|免费|课件|试题|教案|论文|图片|"
DecompressPassword = "www.591kj.com"
SoftSize = Trim(strFileSize)
DownloadUrls ="下载地址| http://www.xqedu.net/kj/"&strNewFolder&strNewFileName
Inputer = "eMaill"
Editor="Giantlab"
Set rs = Server.CreateObject("adodb.recordset")
sql = "select top 1 * from PE_Soft"
rs.open sql, Conn, 1, 3
rs.addnew
rs("SoftID") = SoftID
rs("ChannelID") = ChannelID
rs("ClassID") = ClassID
rs("SpecialID") = SpecialID
rs("SoftName") = SoftName
rs("SoftVersion") = SoftVersion
rs("SoftType") = SoftType
rs("SoftLanguage") = SoftLanguage
rs("CopyrightType") = CopyrightType
rs("OperatingSystem") = OperatingSystem
rs("Author") = Author
rs("AuthorEmail") = AuthorEmail
rs("AuthorHomepage") = AuthorHomepage
rs("DemoUrl") = DemoUrl
rs("RegUrl") = RegUrl
rs("SoftPicUrl") = SoftPicUrl
rs("SoftIntro") = SoftIntro
rs("Keyword") = Keyword
randomize
'作弊呀，请慎用！
rs("Hits") = int(100*rnd)+500
rs("DayHits") = int(100*rnd)
rs("WeekHits") = int(200*rnd)+100
rs("MonthHits") = int(200*rnd)+300
rs("SoftLevel") = 9999
rs("SoftPoint") = 0
rs("Stars") = int(5*rnd)
rs("UpdateTime") = Now()
rs("Passed") = True
rs("OnTop") = False
rs("Elite") = False
rs("DecompressPassword") ="" '设密码让网友感觉很麻烦的，建议为空
rs("SoftSize") = SoftSize
rs("DownloadUrl") = DownloadUrls
rs("Inputer") = Inputer
rs("Editor") = Editor
rs("SkinID") = 0
rs("TemplateID") = 0
rs("Deleted") = False
rs.Update
rs.Close
Set rs = Nothing
Conn.Execute ("update PE_Channel set ItemCount=ItemCount+1,ItemChecked=ItemChecked+1 where ChannelID=" & ChannelID & "")
Conn.Execute ("update PE_Class set ItemCount=ItemCount+1 where ClassID=" & ClassID & "")
End sub
%>
</body>
</html>
558
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
