<%
function htmlencode(str)
    dim result
    dim l
    if isNULL(str) then 
       htmlencode=""
       exit function
    end if
    l=len(str)
    result=""
	dim i
	for i = 1 to l
	    select case mid(str,i,1)
	           case "<"
	                result=result+"&lt;"
	           case ">"
	                result=result+"&gt;"
              case chr(13)
	                result=result+"<br>"
	           case chr(34)
	                result=result+"&quot;"
	           case "&"
	                result=result+"&amp;"
              case chr(32)	           
	                'result=result+"&nbsp;"
	                if i+1<=l and i-1>0 then
	                   if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then	                      
	                      result=result+"&nbsp;"
	                   else
	                      result=result+" "
	                   end if
	                else
	                   result=result+"&nbsp;"	                    
	                end if
	           case chr(9)
	                result=result+"    "
	           case else
	                result=result+mid(str,i,1)
         end select
       next 
       htmlencode=result
   end function

function sustainhtml(str)
    dim result
    dim l
    if isNULL(str) then 
       sustainhtml=""
       exit function
    end if
    l=len(str)
    result=""
	dim i
	for i = 1 to l
	    select case mid(str,i,1)
	           case chr(13)
	                result=result+"<br>"
	           case chr(34)
	                result=result+"&quot;"
                   case chr(32)	           
	                'result=result+"&nbsp;"
	                if i+1<=l and i-1>0 then
	                   if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then	                      
	                      result=result+"&nbsp;"
	                   else
	                      result=result+" "
	                   end if
	                else
	                   result=result+"&nbsp;"	                    
	                end if
	           case "&"
	                result=result+"&amp;"
	           case chr(9)
	                result=result+"    "
	           case else
	                result=result+mid(str,i,1)
         end select
       next 
       sustainhtml=result
   end function

 ' 检查sql字符串中是否有单引号，有则进行转化
   function CheckStr(str)
       dim tstr,l,i,ch
	   l=len(str)
	   for i=1 to l
	       ch=mid(str,i,1)
	       if ch="'" then
		      tstr=tstr+"'"
		   end if
		   tstr=tstr+ch
	   next
	   CheckStr=tstr
   end function


function IsValidEmail(email)

dim names, name, i, c

'Check for valid syntax in an email address.

IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
   IsValidEmail = false
   exit function
end if
for each name in names
   if Len(name) <= 0 then
     IsValidEmail = false
     exit function
   end if
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit function
     end if
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit function
   end if
next
if InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if

end function


Function gotTopic(ByVal str, ByVal strlen)
    If str = "" Then
        gotTopic = ""
        Exit Function
    End If
    Dim l, t, c, i, strTemp
    str = Replace(Replace(Replace(Replace(str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
    l = Len(str)
    t = 0
    strTemp = str
    strlen = CLng(strlen)
    For i = 1 To l
        c = Abs(Asc(Mid(str, i, 1)))
        If c > 255 Then
            t = t + 2
        Else
            t = t + 1
        End If
        If t >= strlen Then
            strTemp = Left(str, i)
            Exit For
        End If
    Next
    If strTemp <> str Then
        strTemp = strTemp & "."
    End If
    gotTopic = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
End Function
Function LoadFile(ByVal File) 
Dim objStream 
On Error Resume Next 
Set objStream = Server.CreateObject("ADODB.Stream") 
If Err.Number=-2147221005 Then 
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>" 
Err.Clear 
Response.End 
End If 
With objStream 
.Type = 2 
.Mode = 3 
.Open 
.LoadFromFile Server.MapPath(File) 
If Err.Number<>0 Then 
Response.Write "<div align='center'>文件<font color='#ff0000'>"&File&"</font>无法被打开，请检查是否存在!</font></div>" 
Err.Clear 
Response.End 
End If 
.Charset = "GB2312" 
.Position = 2 
LoadFile = .ReadText 
.Close 
End With 
Set objStream = Nothing 
End Function
Sub SaveToFile(ByVal strBody,ByVal File) 
Dim objStream 
On Error Resume Next 
Set objStream = Server.CreateObject("ADODB.Stream") 
If Err.Number=-2147221005 Then 
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>" 
Err.Clear 
Response.End 
End If 
With objStream 
.Type = 2 
.Open 
.Charset = "GB2312" 
.Position = objStream.Size 
.WriteText = strBody 
.SaveToFile Server.MapPath(File),2 
.Close 
End With 
Set objStream = Nothing 
End Sub
Function rijire(ByVal str)
rijire=replace(str,"{title}",title)
rijire=replace(rijire,"{emot}",xq)
rijire=replace(rijire,"{weather}",tq)
rijire=replace(rijire,"{class}","<a target=_blank href='../?i="&userid&"&fid="&typeids(0)&"'>"&typeids(1)&"</a>")
rijire=replace(rijire,"{diaryname}",bookname)
rijire=replace(rijire,"{writer}",user)
rijire=replace(rijire,"{time}",now())
rijire=replace(rijire,"{content}",content)
rijire=replace(rijire,"{diarynameid}",userid)
rijire=replace(rijire,"{diaryid}",did)
rijire=replace(rijire,"{topbg}",bg)
rijire=replace(rijire,"{diarybg}",diarybg)
rijire=replace(rijire,"{diarydir}",diarydir)
booklistbnav="<span id='navi'><a href='"&diarydir&"index.asp'>首页</a>　<a href='"&diarydir&sitelistdir&"/NewList.htm'>最新日记</a> <a href='"&diarydir&sitelistdir&"/goodList.htm'>佳作推荐</a> <a href='"&diarydir&sitelistdir&"/Newbook.htm'>最新日记本</a> <a href='"&diarydir&sitelistdir&"/BookOrder.htm'>日记本排行</a> <a href='"&diarydir&"u/search.asp'>日记搜索</a> <a href='/mybook.asp'>管理日记</a> <a href='/?i=128' target='_blank'>服务中心</a></span>"
rijire=replace(rijire,"{bnav}",booklistbnav)
End Function

Function booklistre0(ByVal str,ByVal bt)
set rslist0=server.CreateObject("adodb.recordset")
sql="select top "&(diarylistno+1)&" * from diaryuser order by userid desc"
rslist0.open sql,conn,1,1
rb=bt Mod diarylistno
rslist0.movenext
Do While Not rslist0.eof
booklistm="<table width='272' border='0' cellpadding='0' cellspacing='0' id='table11'><tr bordercolor='DDE7AB'><td width='2'></td><td width='3'><img border='0' src='../diary/kon.gif' width='2' height='20'></td><td width='125'><a target='_blank' href='{diarydir}?i={userid}'><font color='#51300C'>{bookname}</font></a></td><td width='97'><a target='_blank' href='{diarydir}?i={userid}'><font color=#00ACF0>{username}</font></a><td><font color=#FF6600><p align='right'>{amount}篇</font></td></tr></table>"
booklistm=replace(booklistm,"{userid}",rslist0("userid"))
booklistm=replace(booklistm,"{diarydir}",diarydir)
booklistm=replace(booklistm,"{username}",rslist0("username"))
booklistm=replace(booklistm,"{bookname}",rslist0("bookname"))
booklistm=replace(booklistm,"{amount}",rslist0("amount"))
booklistall=booklistall&booklistm
rslist0.movenext
Loop
rslist0.close
Set rslist0=Nothing

If bt=diarylistno+1 Then
booklistp="<a href='"&diarydir&sitelistdir&"\newbook.htm'><font color=#5690BE>首页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newbook.htm'><font color=#5690BE>上页</a>&nbsp;</font><font color='#808080'>下页</font>&nbsp;<font color='#808080'>尾页</font>"
Else
If bt>diarylistno*2 then
booklistp="<a href='"&diarydir&sitelistdir&"\newbook.htm'><font color=#5690BE>首页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newbook_"&(Int((bt-1)/diarylistno)+1)&".htm'><font color=#5690BE>上页</font></a>&nbsp;</font><a href='"&diarydir&sitelistdir&"\newbook_"&(Int((bt-1)/diarylistno)-1)&".htm' ><font color='#5690BE'>下页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newbook_1.htm'><font color='#5690BE'>尾页</font></a>"
End if
End If
str=replace(str,"{rijibenlistpage}",booklistp)
booklistre0=replace(str,"{rijibenlist}",booklistall)
End Function

Function booklistre(ByVal str)
set rslist=server.CreateObject("adodb.recordset")
sql="select * from diaryuser order by userid desc"
rslist.open sql,conn,1,1
booktotal=rslist.recordcount
rb=booktotal Mod diarylistno
If rb=0 Then rb=15
For i=1 To rb
booklistm="<table width='272' border='0' cellpadding='0' cellspacing='0' id='table11'><tr bordercolor='DDE7AB'><td width='2'></td><td width='3'><img border='0' src='../diary/kon.gif' width='2' height='20'></td><td width='125'><a target='_blank' href='{diarydir}?i={userid}'><font color='#51300C'>{bookname}</font></a></td><td width='97'><a target='_blank' href='{diarydir}?i={userid}'><font color=#00ACF0>{username}</font></a><td><font color=#FF6600><p align='right'>{amount}篇</font></td></tr></table>"
booklistm=replace(booklistm,"{userid}",rslist("userid"))
booklistm=replace(booklistm,"{diarydir}",diarydir)
booklistm=replace(booklistm,"{username}",rslist("username"))
booklistm=replace(booklistm,"{bookname}",rslist("bookname"))
booklistm=replace(booklistm,"{amount}",rslist("amount"))
booklistall=booklistall&booklistm
rslist.movenext
Next
rslist.close
Set rslist=Nothing

If rb<diarylistno Then
Randomize
set rslist=server.CreateObject("adodb.recordset")
sqlrdn="select top "&(diarylistno-rb)&" * from diaryuser order by Rnd("&Rnd()&"-userid)"
rslist.open sqlrdn,conn,1,1
j=0
Do While Not rslist.eof
booklistm="<table width='272' border='0' cellpadding='0' cellspacing='0' id='table11'><tr bordercolor='DDE7AB'><td width='2'></td><td width='3'><img border='0' src='../diary/kon.gif' width='2' height='20'></td><td width='125'><a target='_blank' href='{diarydir}?i={userid}'><font color='#51300C'>{bookname}</font></a></td><td width='97'><a target='_blank' href='{diarydir}?i={userid}'><font color=#00ACF0>{username}</font></a><td><font color=#FF6600><p align='right'>{amount}篇</font></td></tr></table>"
booklistm=replace(booklistm,"{userid}",rslist("userid"))
booklistm=replace(booklistm,"{diarydir}",diarydir)
booklistm=replace(booklistm,"{username}",rslist("username"))
booklistm=replace(booklistm,"{bookname}",rslist("bookname"))
booklistm=replace(booklistm,"{amount}",rslist("amount"))
booklistall=booklistall&booklistm
j=j+1
If j=(diarylistno-rb) Then Exit do
rslist.movenext
Loop
rslist.close
Set rslist=nothing
End If

If booktotal<diarylistno+1 Then
booklistp="<font color=#808080>首页&nbsp;上页&nbsp;</font><font color='#808080'>下页</font><font color='#808080'>尾页</font>"
else
booklistp="<font color=#808080>首页&nbsp;上页&nbsp;</font><a href='"&diarydir&sitelistdir&"\newbook_"&Int((booktotal-1)/diarylistno)&".htm' ><font color='#5690BE'>下页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newbook_1.htm'><font color='#5690BE'>尾页</font></a>"
End If

booklistbnav="<span id='navi'><a href='"&diarydir&"index.asp'>首页</a>　<a href='"&diarydir&sitelistdir&"/NewList.htm'>最新日记</a> <a href='"&diarydir&sitelistdir&"/goodList.htm'>佳作推荐</a> <a href='"&diarydir&sitelistdir&"/Newbook.htm'>最新日记本</a> <a href='"&diarydir&sitelistdir&"/BookOrder.htm'>日记本排行</a> <a href='"&diarydir&"u/search.asp'>日记搜索</a> <a href='/mybook.asp'>管理日记</a> <a href='/?i=128' target='_blank'>服务中心</a></span>"
str=replace(str,"{bnav}",booklistbnav)

str=replace(str,"{rijibenlistpage}",booklistp)
booklistre=replace(str,"{rijibenlist}",booklistall)
End Function

'newlist
Function newlistre0(ByVal str,ByVal bt)
set rslist0=server.CreateObject("adodb.recordset")
sql="select top "&(diarylistno+1)&" * from diary order by diaryid desc"
rslist0.open sql,conn,1,1
rb=bt Mod diarylistno
rslist0.movenext
Do While Not rslist0.eof
booklistm="<table width='272' border='0' cellpadding='0' cellspacing='0'  id='table11'><tr bordercolor='DDE7AB'><td width='2'></td><td width='53'>{xq}</td><td width='170'><font color='#51300C'><a target='_blank' title='{title}' href='{diarydir}{htmldir}/riji{diaryid}.htm'>{title}</a></font></td><td width='26'><img src='{diarydir}diary/{tq}' border='0' align='middle'></td><td width='23'><a title='{time}' href='#'><img border='0' src='{diarydir}diary/TIME.gif' width='24' height='20'></a></td></tr></table>"
booklistm=replace(booklistm,"{title}",rslist("title"))
booklistm=replace(booklistm,"{diarydir}",diarydir)
booklistm=replace(booklistm,"{htmldir}",htmldir)
booklistm=replace(booklistm,"{tq}",rslist("tq"))
booklistm=replace(booklistm,"{time}",rslist("diarytime"))
Set rx = Server.CreateObject("ADODB.Recordset")
  sql="select * from xqlist where xqorder="&CInt(rslist("xq"))
   rx.open sql,conn,3,2
   xq=rx("xqcontent")
   rx.update
   rx.close
booklistm=replace(booklistm,"{xq}",xq)
booklistm=replace(booklistm,"{diaryid}",rslist("diaryid"))
booklistall=booklistall&booklistm
rslist0.movenext
Loop
rslist0.close
Set rslist0=Nothing

If bt=diarylistno+1 Then
booklistp="<a href='"&diarydir&sitelistdir&"\newlist.htm'><font color=#5690BE>首页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newlist.htm'><font color=#5690BE>上页</a>&nbsp;</font><font color='#808080'>下页</font>&nbsp;<font color='#808080'>尾页</font>"
Else
If bt>diarylistno*2 then
booklistp="<a href='"&diarydir&sitelistdir&"\newlist.htm'><font color=#5690BE>首页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newlist_"&(Int((bt-1)/diarylistno)+1)&".htm'><font color=#5690BE>上页</font></a>&nbsp;</font><a href='"&diarydir&sitelistdir&"\newlist_"&(Int((bt-1)/diarylistno)-1)&".htm' ><font color='#5690BE'>下页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newlist_1.htm'><font color='#5690BE'>尾页</font></a>"
End if
End If
booklistp=booklistp&"<font color='#5690BE'> 当前页:"&(maxpage-page+1)&" 总页数:"
str=replace(str,"{rijibenlistpage}",booklistp)
newlistre0=replace(str,"{rijibenlist}",booklistall)
End Function

Function newlistre(ByVal str)
set rslist=server.CreateObject("adodb.recordset")
'sql="select top "&diarylistno&" * from diary order by diaryid desc"
sql="select * from diary order by diaryid desc"
rslist.open sql,conn,1,1
booktotal=rslist.recordcount

rb=booktotal Mod diarylistno

If rb=0 Then rb=diarylistno
'For i=1 To rb tempuseless
For i=1 To diarylistno
booklistm="<table width='272' border='0' cellpadding='0' cellspacing='0'  id='table11'><tr bordercolor='DDE7AB'><td width='2'></td><td width='53'>{xq}</td><td width='170'><font color='#51300C'><a target='_blank' title='{title}' href='{diarydir}{htmldir}/riji{diaryid}.htm'>{title}</a></font></td><td width='26'><img src='{diarydir}diary/{tq}' border='0' align='middle'></td><td width='23'><a title='{time}' href='#'><img border='0' src='{diarydir}diary/TIME.gif' width='24' height='20'></a></td></tr></table>"
booklistm=replace(booklistm,"{title}",rslist("title"))
booklistm=replace(booklistm,"{diarydir}",diarydir)
booklistm=replace(booklistm,"{htmldir}",htmldir)
booklistm=replace(booklistm,"{tq}",rslist("tq"))
booklistm=replace(booklistm,"{time}",rslist("diarytime"))
Set rx = Server.CreateObject("ADODB.Recordset")
sql="select * from xqlist where xqorder="&CInt(rslist("xq"))
rx.open sql,conn,3,2
xq=rx("xqcontent")
rx.update
rx.close
booklistm=replace(booklistm,"{xq}",xq)
booklistm=replace(booklistm,"{diaryid}",rslist("diaryid"))
booklistall=booklistall&booklistm

rslist.movenext
Next
rslist.close
Set rslist=Nothing

'If rb<diarylistno Then
If thisword="tempuseless" Then
Randomize
set rslist=server.CreateObject("adodb.recordset")

sqlrdn="select top "&(diarylistno-rb)&" * from diary order by Random"
'sqlrdn="select top "&(diarylistno-rb)&" * from diary order by Rnd("&Rnd()&"-diaryid)"

rslist.open sqlrdn,conn,1,1
j=0

Do While Not rslist.eof

booklistm="<table width='272' border='0' cellpadding='0' cellspacing='0'  id='table11'><tr bordercolor='DDE7AB'><td width='2'></td><td width='53'>{xq}</td><td width='170'><font color='#51300C'><a target='_blank' title='{title}' href='{diarydir}{htmldir}/riji{diaryid}.htm'>{title}</a></font></td><td width='26'><img src='{diarydir}diary/{tq}' border='0' align='middle'></td><td width='23'><a title='{time}' href='#'><img border='0' src='{diarydir}diary/TIME.gif' width='24' height='20'></a></td></tr></table>"
booklistm=replace(booklistm,"{title}",rslist("title"))
booklistm=replace(booklistm,"{diarydir}",diarydir)
booklistm=replace(booklistm,"{htmldir}",htmldir)
booklistm=replace(booklistm,"{tq}",rslist("tq"))
booklistm=replace(booklistm,"{time}",rslist("diarytime"))
Set rx = Server.CreateObject("ADODB.Recordset")
  sql="select * from xqlist where xqorder="&CInt(rslist("xq"))
   rx.open sql,conn,3,2
   xq=rx("xqcontent")
   rx.update
   rx.close
booklistm=replace(booklistm,"{xq}",xq)
booklistm=replace(booklistm,"{diaryid}",rslist("diaryid"))
booklistall=booklistall&booklistm

j=j+1
If j=(diarylistno-rb) Then Exit do
rslist.movenext
Loop
rslist.close
Set rslist=nothing
End If

If booktotal<diarylistno+1 Then
booklistp="<font color=#808080>首页&nbsp;上页&nbsp;</font><font color='#808080'>下页</font><font color='#808080'>尾页</font><font color='#5690BE'> 页次:1/1&nbsp;&nbsp; </font></td></tr></table>"
else
booklistp="<font color=#808080>首页&nbsp;上页&nbsp;</font><a href='"&diarydir&sitelistdir&"\newlist_"&Int((booktotal-1)/diarylistno)&".htm' ><font color='#5690BE'>下页</font></a>&nbsp;<a href='"&diarydir&sitelistdir&"\newlist_1.htm'><font color='#5690BE'>尾页</font></a>"
End If
booklistp=booklistp&"<font color='#5690BE'> 当前页:"&(maxpage-page+1)&" 总页数:"

booklistbnav="<span id='navi'><a href='"&diarydir&"index.asp'>首页</a>　<a href='"&diarydir&sitelistdir&"/NewList.htm'>最新日记</a> <a href='"&diarydir&sitelistdir&"/goodList.htm'>佳作推荐</a> <a href='"&diarydir&sitelistdir&"/newbook.htm'>最新日记本</a> <a href='"&diarydir&sitelistdir&"/BookOrder.htm'>日记本排行</a> <a href='"&diarydir&"u/search.asp'>日记搜索</a> <a href='/mybook.asp'>管理日记</a> <a href='/?i=128' target='_blank'>服务中心</a></span>"
str=replace(str,"{bnav}",booklistbnav)
str=replace(str,"{rijibenlistpage}",booklistp)
newlistre=replace(str,"{rijibenlist}",booklistall)

End Function

''*******************************************************************************
''************函数功能：去掉函数参数中的HTML标记*********************************
''*******************************************************************************
Function stripHTML(strtext)
dim arysplit,i,j, strOutput

arysplit=split(strtext,"<")
if len(arysplit(0))>0 then j=1 else j=0
for i=j to ubound(arysplit)
  if instr(arysplit(i),">") then
   arysplit(i)=mid(arysplit(i),instr(arysplit(i),">")+1)
  else
   arysplit(i)="<" & arysplit(i)
  end if
next

strOutput = join(arysplit, "")
strOutput = mid(strOutput, 2-j)
strOutput = replace(strOutput,">",">")
strOutput = replace(strOutput,"<","<")

stripHTML = strOutput
End Function
''*******************************************************************************
''**应用方法：StripHTML("string")，其中，string为要去掉HTML标记的字符串**********
''*******************************************************************************
Function BytesToBstr(strBody,CodeBase)
   dim objStream
   set objStream = Server.CreateObject("Adodb.Stream")
   objStream.Type = 1
   objStream.Mode =3
   objStream.Open
   objStream.Write strBody
   objStream.Position = 0
   objStream.Type = 2
   objStream.Charset = CodeBase
   BytesToBstr = objStream.ReadText 
   objStream.Close
   set objStream = nothing
End Function

''获取任何表任何字段信息函数
    Public Function HX_SetRSD(ColsStr,TaNameStr,OrderBystr)
	    If ColsStr="" then ColsStr="*"
         set HX_SetRSD=server.CreateObject("adodb.recordset")
		 if DataBaseType=1 then
             HX_SetRSD.open replace(replace(replace("select "&ColsStr&" from "&TaNameStr&OrderBystr,"#","'"),"False","1"),"True","0"),conn,1,3	
		 else
             HX_SetRSD.open "select "&ColsStr&" from "&TaNameStr&OrderBystr,conn,1,3	
		 end if		 	 
     End Function 
'写入任何表任何字段信息函数
	Public Sub InToColumn(TableName,ColumnName,ColumnValue)
		On Error Resume Next		
		conn.Execute("insert into ["&TableName&"] ("&ColumnName&") values ("&Replace(Replace(ColumnValue,"True","1"),"False","0")&")")
		If Err Then
			Response.Write "在数据库表"&TableName&"中添加记录失败！原因：<font color=red>" & Err.Description
			Err.Clear
			'Response.end
		End If
	End Sub
'单记录添加	
	Public Sub UPDATAColumn(TableName,ColumnName,ColumnValue)
		On Error Resume Next		
		conn.Execute("update ["&TableName&"] set "&ColumnName&"="&ColumnValue)
		If Err Then
			Response.Write "在数据库表"&TableName&"中更新记录失败！原因：<font color=red>" & Err.Description
			Err.Clear
			'Response.end
		End If
	End Sub

Const ObjFSO = "Scripting.FileSystemObject"

Rem 建立目录 
Function LjfCreateFolder(Foldername) 
 Dim fso 
 If Foldername <> "" Then 
  Foldername = Server.MapPath(Foldername) 
  Set fso = Server.CreateObject(ObjFSO)   
  If fso.FolderExists(Foldername) = False Then  
   fso.CreateFolder Foldername 
   LjfCreateFolder = "Ok" 
  Else 
   LjfCreateFolder = "FolderExists" 
  End If 
  Set fso = Nothing
 End If  
End Function

Rem 删除目录 
Function LjfDeleteFolder(Foldername) 
 Dim fso 
 If Foldername <> "" Then 
  Foldername = Server.MapPath(Foldername) 
  Set fso = Server.CreateObject(ObjFSO) 
  If fso.FolderExists(Foldername) Then 
   fso.DeleteFolder Foldername 
   LjfDeleteFolder = "Ok" 
  Else 
   LjfDeleteFolder = "NoFolder" 
  End If 
  Set fso = Nothing 
 End If 
End Function

Rem 移动目录，参数：DirName; 预拷贝文件的相对路径，DirNewName 拷贝目标名 
Function LjfMoveFolder(FolderName,FolderNewName) 
 Dim fso,f 
 If FolderName <> "" And FolderNewName <> "" Then 
  FolderName = Server.MapPath(FolderName) 
  FolderNewName = Server.MapPath(FolderNewName) 
  Set fso = Server.CreateObject(ObjFSO)    
  fso.MoveFolder FolderName,FolderNewName 
  Set fso = Nothing 
  LjfMoveFolder = "Ok" 
 End If 
End Function

Rem 建立文件 
Function LjfCreateFile(Filename) 
 Dim fso 
 If Filename <> "" Then 
  Filename = Server.MapPath(Filename) 
  Set fso = Server.CreateObject(ObjFSO)   
  If fso.FileExists(Filename) = False Then  
   fso.CreateTextFile Filename 
   LjfCreateFile = "Ok" 
  Else 
   LjfCreateFile = "FileExists" 
  End If 
  Set fso = Nothing 
 End If  
End Function
 
Rem 删除文件 
Function LjfDeleteFile(Filename) 
 Dim fso 
 If Filename <> "" Then 
  Filename = Server.MapPath(Filename) 
  Set fso = Server.CreateObject(ObjFSO) 
  If fso.FileExists(Filename) Then 
   fso.DeleteFile Filename 
   LjfDeleteFile = "Ok" 
  Else 
   LjfDeleteFile = "NoFile" 
  End If 
  Set fso = Nothing 
 End If 
End Function

Rem 移动文件，参数：Filename 预拷贝文件的相对路径，Filenewname 拷贝目标名 
Function LjfMoveFile(FileName,FileNewName) 
 Dim fso,f 
 If Filename <> "" And FileNewName <> "" Then 
  FileName = Server.MapPath(FileName) 
  FileNewName = Server.MapPath(FileNewName) 
  Set fso = Server.CreateObject(ObjFSO)    
  fso.MoveFile FileName,FileNewName 
  Set fso = Nothing 
  LjfMoveFile = "Ok" 
 End If 
End Function

%>
