<%
vercode=""    '安全校验码，请在此处设置

if trim(vercode)<>trim(request.Form("vercode")) then
    response.Write("[err]安全校验码vercode不相符[/err]")
    response.End()
end if


'UTF-8 To GB2312

function UTF2GB(UTFStr)
    for Dig=1 to len(UTFStr)
        if mid(UTFStr,Dig,1)="%" then
            if len(UTFStr) >= Dig+8 then
                GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
                Dig=Dig+8
            else
                GBStr=GBStr & mid(UTFStr,Dig,1)
            end if
        else
            GBStr=GBStr & mid(UTFStr,Dig,1)
        end if
    next
    UTF2GB=GBStr
end function


function ConvChinese(x) 
    A=split(mid(x,2),"%")
    i=0
    j=0
    
    for i=0 to ubound(A) 
        A(i)=c16to2(A(i))
    next
        
    for i=0 to ubound(A)-1
        DigS=instr(A(i),"0")
        Unicode=""
        for j=1 to DigS-1
            if j=1 then 
                A(i)=right(A(i),len(A(i))-DigS)
                Unicode=Unicode & A(i)
            else
                i=i+1
                A(i)=right(A(i),len(A(i))-2)
                Unicode=Unicode & A(i) 
            end if 
        next
        
        if len(c2to16(Unicode))=4 then
            ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode)))
        else
            ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode)))
        end if
    next
end function

function c2to16(x)
    i=1
    for i=1 to len(x)  step 4 
        c2to16=c2to16 & hex(c2to10(mid(x,i,4))) 
    next
end function 
    
function c2to10(x)
    c2to10=0
    if x="0" then exit function
    i=0
    for i= 0 to len(x) -1
        if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
    next 
end function

function c16to2(x)
    i=0
    for i=1 to len(trim(x)) 
        tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
        do while len(tempstr)<4
        tempstr="0" & tempstr
        loop
        c16to2=c16to2 & tempstr
    next
end function

function c10to2(x)
    mysign=sgn(x)
    x=abs(x)
    DigS=1
    do 
        if x<2^DigS then
            exit do
        else
            DigS=DigS+1
        end if
    loop
    tempnum=x
    
    i=0
    for i=DigS to 1 step-1
        if tempnum>=2^(i-1) then
            tempnum=tempnum-2^(i-1)
            c10to2=c10to2 & "1"   
        else
            c10to2=c10to2 & "0"
        end if
    next
    if mysign=-1 then c10to2="-" & c10to2
end function


'正则表达式替换
function myRegrpl(oldstr,pat,newstr)
    if oldstr<>"" then
      Dim regEx        ' 建立变量。
      Set regEx = New RegExp            ' 建立正则表达式。
      regEx.Pattern =pat            ' 设置模式。
      regEx.IgnoreCase = true            ' 设置是否区分字符大小写。
      regEx.Global = True            ' 设置全局可用性。
      myRegrpl = regEx.replace(oldstr,newstr)    ' 执行搜索。
      set regEx=nothing
    else
         myRegrpl = oldstr
    end if
End function

function makefile(ourl,content)
dim fso,ofile
    Server.ScriptTimeOut=9000
    on error resume next
        set fso=server.CreateObject("Scripting.FileSystemObject")
        '生成单独TXT文件
        set ofile=fso.CreateTextFile(server.mappath(ourl), True)
        ofile.write(content)
        ofile.close
        set ofile=nothing
        set fso=nothing
    If Err<>0 Then
        Err=0
        makefile =false '失败
    else
        makefile =true '成功
    end if
    Server.ScriptTimeOut=300

end function

function makeutf8file(ourl,content)
Dim objstream,newurl
    newurl=UTF2GB(ourl)
    Server.ScriptTimeOut=9000
    on error resume next
set objstream = server.createobject("adodb.stream") 
    with objstream
    .open 
    .charset = "utf-8" 
    .position = objstream.size 
    .writetext=content 
    .savetofile server.mappath(newurl),2  
    .close 
    end with 
    If Err<>0 Then
        Err=0
        makeutf8file =false '失败
    else
        makeutf8file =true '成功
    end if
set objstream = Nothing
    Server.ScriptTimeOut=300
end function

Function CreateMultiFolder(ByVal CFolder) 
Dim objFSO, PhCreateFolder, CreateFolderArray, CreateFolder 
Dim i, ii, CreateFolderSub, PhCreateFolderSub, BlInfo 
BlInfo = False 
CreateFolder = CFolder 
On Error Resume Next 
Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
If Err Then 
Err.Clear() 
Exit Function 
End If 
If Right(CreateFolder, 1) = "/" Then 
CreateFolder = Left(CreateFolder, Len(CreateFolder) -1) 
End If 
CreateFolderArray = Split(CreateFolder, "/") 
For i = 0 To UBound(CreateFolderArray) 
CreateFolderSub = "" 
For ii = 0 To i 
CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/" 
Next 
PhCreateFolderSub = Server.MapPath(CreateFolderSub) 
If Not objFSO.FolderExists(PhCreateFolderSub) Then 
objFSO.CreateFolder(PhCreateFolderSub) 
End If 
Next 
If Err Then 
Err.Clear() 
Else 
BlInfo = True 
End If 
CreateMultiFolder = BlInfo 
End Function

filename=trim(request.Form("filename"))    '文件名参数
if filename="" then
    response.Write("[err]文件名参数filename不能为空[/err]")
    response.End()
end if
filename=replace(filename,"yyyy",year(date),1,-1,1)
filename=replace(filename,"yy",right(year(date),2),1,-1,1)
filename=replace(filename,"mm",right("0"&month(date),2),1,-1,1)
filename=replace(filename,"dd",right("0"&day(date),2),1,-1,1)
filename=replace(filename,"hh",right("0"&hour(date),2),1,-1,1)
filename=replace(filename,"ii",right("0"&minute(date),2),1,-1,1)
filename=replace(filename,"ss",right("0"&second(date),2),1,-1,1)

filepath=trim(request.Form("filepath"))    '文件名参数
if filepath<>"" then
    filepath=replace(filepath,"yyyy",year(date),1,-1,1)
    filepath=replace(filepath,"yy",right(year(date),2),1,-1,1)
    filepath=replace(filepath,"mm",right("0"&month(date),2),1,-1,1)
    filepath=replace(filepath,"dd",right("0"&day(date),2),1,-1,1)
    filepath=replace(filepath,"hh",right("0"&hour(date),2),1,-1,1)
    filepath=replace(filepath,"ii",right("0"&minute(date),2),1,-1,1)
    filepath=replace(filepath,"ss",right("0"&second(date),2),1,-1,1)
    if right(filepath,1)<>"/" then
        filepath=filepath&"/"
    end if
    if not CreateMultiFolder(filepath) then
        response.Write("[err]创建目录失败[/err]")
        response.End()
    end if
end if

text=trim(request.Form("text"))    '文件样式参数
if text="" then
    response.Write("[err]内容参数text不能为空[/err]")
    response.End()
end if

If request.Form("isutf8")=1 Then
    if makeutf8file(filepath&filename,text) then
        response.Write("[ok]")
    else
        response.Write("[err]生成文件失败[/err]")
    end if
Else
    if makefile(filepath&filename,text) then
        response.Write("[ok]")
    else
        response.Write("[err]生成文件失败[/err]")
    end if
End if


%>