asp createTextFile生成文本文件支持utf8

  Function createTextFile(Byval content,Byval fileDir,Byval code)

  dim fileobj,fileCode : fileDir=replace(fileDir, "", "/")

  if isNul(code) then fileCode=Charset else fileCode=code

  call createfolder(fileDir,"filedir")

  if fileCode="utf-8" then

  on error resume next

  With objStream

  .Charset=fileCode:

  .Type=2:

  .Mode=3:

  .Open:

  .Position=0

  .WriteText content:

  .SaveToFile Server.MapPath(fileDir), 2

  .Close

  End With

  else

  on error resume next:err.clear

  set fileobj=objFso.CreateTextFile(server.mappath(fileDir),True)

  fileobj.Write(content)

  set fileobj=nothing

  end if

  if Err Then err.clear :createTextFile=false : errid=err.number:errdes=err.description:Err.Clear : echoErr err_09,errid,errdes else createTextFile=true

  End Function

  Sub echoErr(byval str,byval id, byval des)

  dim errstr,cssstr

  cssstr=""

  cssstr=cssstr&""

  errstr=cssstr&"

错误号:"&id&"
错误描述:"&des&"
返回上一页 返回首页
Powered by AspCms2.0
"

  cssstr=""

  die(errstr)

  End Sub

  Function createFolder(Byval dir,Byval dirType)

  dim subPathArray,lenSubPathArray, pathDeep, i

  on error resume next

  dir=replace(dir, "", "/")

  if trim(sitePath) = "" then pathDeep = "/" else pathDeep = sitePath

  pathDeep = server.MapPath(pathDeep)

  dir=replace(server.mappath(dir), pathDeep, "")

  subPathArray=split(dir, "")

  select case dirType

  case "filedir"

  lenSubPathArray=ubound(subPathArray) - 1

  case "folderdir"

  lenSubPathArray=ubound(subPathArray)

  end select

  for i=0 to lenSubPathArray

  if trim(subPathArray(i)) <> "" then

  pathDeep=pathDeep&""&subPathArray(i)

  if not objFso.FolderExists(pathDeep) then objFso.CreateFolder pathDeep

  end if

  next

  if Err Then createFolder=false : errid=err.number:errdes=err.description:Err.Clear : echoErr err_10,errid,errdes else createFolder=true

  End Function