您的位置:寻梦网首页编程乐园ASP编程>asp批量转换文件编码
ASP世界
asp批量转换文件编码
作者:清风的学习园地  转自:http://blog.csdn.net/anwell/

asp批量转换文件编码(只把汉字转换成utf8)
''编写目的:批量转换asp文件编码,只转换汉字,wap开发用;
''特别提示:请建立新的网站放在根目录下使用,切勿在虚拟目录中使用;server支持fso
''使用前说明:把代码复制保存为gb-utf.asp,放在web文件夹根目录下面,在web根目录下面新建utf8文件夹(存放转换后的web文件);一切完成后访问运行gb-uft.asp即可;如我本机是http://127.0.0.1/gb-utf.asp;


gb-utf.asp文件内内容为:


timeStart = now()''页面开始执行时间

set fileSysObj = CreateObject("Scripting.FileSystemObject")''建立fso对象
set f = fileSysObj.GetFolder(server.MapPath("/"))


''检查是否存在输出的根目录
if not fileSysObj.folderexists(server.MapPath("/")) then
fileSysObj.CreateFolder(server.MapPath("/utf8"))
end if


''遍历根目录下面的文件,除了gb-utf.asp文件
response.Write "=====================转换文件清单如下======================="
set ffl = f.files
for each fil in ffl
if fil.name <> "gb-utf.asp" then
if right(fil.name,3) = "asp" then
call gb2312_utf8("",fil.name)
else
call CopyFiles("",fil.name)
end if
response.Write fil.name&""
end if
next


''遍历各个子目录下的文件,除了uft8文件夹
set fc = f.SubFolders
for each f1 in fc
if f1.name <> "utf8" then
Set folders = fileSysObj.GetFolder(server.MapPath("/"&f1.name))
set fss = folders.files
for each fls in fss
if right(fls.name,3) = "asp" then
call gb2312_utf8(f1.name,fls.name)
else
call CopyFiles(f1.name,fls.name)
end if
response.Write f1.name&"/"&fls.name&""
next
end if
next
response.Write "====================="&now()&"======================="
response.Write "=====================耗时:"&cstr(round(cdbl((now()-timeStart)*24*60*60),4))&"秒======================="


''读取文件内容并转换为utf-8编码(只转换汉字)
function gb2312_utf8(fordeName,filname)
if fordeName = "" then
filesUrl = server.MapPath("/utf8")
filesNameUrl = filname
else
filesUrl = server.MapPath("/utf8/"&fordeName)
filesNameUrl = fordeName&"/"&filname
end if
dim tf,unicode,c
''遍历文件夹读取所有文件夹下面的asp文件
filPath = server.mappath(filesNameUrl) ''取得文本文件的绝对路径
if (fileSysObj.fileExists(filPath)) then
set tf = filesysobj.OpenTextFile(filPath, 1)
do while not tf.atendofstream ''如果当前指针不在objstream流末尾
strlinetext = tf.readline ''逐行读取文本内容
readlineContent = strlinetext & vbCrLf '每一行文本内容输出+回车换行
for i = 1 to Len(readlineContent)
c = Mid(readlineContent, i, 1)
if asc(c) < 0 then ''如果是汉字,则转换
unicode = unicode & "&#x" & Hex(AscW(c)) & ";"
else
unicode = unicode & c
end if
next
loop
tf.Close
else
unicode = "找不到文件"
end if
''若文件夹不存在则创建
if not fileSysObj.folderexists(filesUrl) then
fileSysObj.CreateFolder(filesUrl)
end if
''把转换后的内容写入新文件
dim objStream
set objStream = Server.CreateObject("ADODB.Stream")
if err.number=-2147221005 then
response.write "server不支持ADODB.Stream,不能使用本程序"
err.clear
response.end
end If
with objStream
.type = 2
.open
.charset = "utf-8"
.position = objStream.size
.writeText = unicode
.saveToFile server.mapPath("/utf8/"&filesNameUrl),2
.close
end with
set objStream = nothing
end function


''把转换后的文件内容写到新文件里,并以utf-8编码保存
function CopyFiles(fordeName,filname)
if fordeName = "" then
filesUrl = server.MapPath("/utf8")
filesNameUrl = filname
else
filesUrl = server.MapPath("/utf8/"&fordeName)
filesNameUrl = fordeName&"/"&filname
end if
if not fileSysObj.folderexists(filesUrl) then
fileSysObj.CreateFolder(filesUrl)
end if
Set filesName = fileSysObj.Getfile(server.MapPath("/"&filesNameUrl))
filesName.copy server.MapPath("/utf8/"&filesNameUrl)
set filesName = nothing
end function