<%@ Language=VBScript %>
<!--#include virtual="/inc-freehost-function/FreeHostEmail.asp"-->
<!--#include virtual="/inc-freehost-function/FreeHostFunction.asp"-->
<!--#include virtual="/inc-freehost-function/FreeHostFunctionMain.asp"-->
<%

AntiCC=false'改成true将限制二秒只能访问一个页面

If AntiCC=True Then
if DateDiff("s",Application("AntiCC_Time_aws"),NOW )<2 Then
Response.Redirect "e.asp?e=系统繁忙，请您稍等三秒再访问，谢谢您的支持。"
response.end
Else
Application("AntiCC_Time_aws")=now
End if
End If

Dim FormData,FormSize 
FormSize=Request.TotalBytes 
FormData=Request.BinaryRead(FormSize) 
Set Form=GetUpload(FormData) 


If session("username")="" Then
	ef=True
	ec="授权非法，有可能是超时造成的。"
ElseIf trim(Form ("title").value)=""  and Form("op").value="" Then
	ef=True
	ec="标题没填！"
ElseIf trim(Form ("Body").value)="" and form("op").value="" Then
	ef=True
	ec="内容没填！"
elseIf checkscript(Form ("title").value) Then
	ef=True
	ec="标题有非法字符！如<>script"
elseIf checkscript(Form ("Body").value) Then
	ef=True
	ec="内容有非法字符！如<>script"
ElseIf Form("id").value<>"" and not IsNumeric(Form("id").value) Then
	ef=True
	ec="编号必须是数字"
ElseIf Form("type1").value<>"" and not IsNumeric(Form("type1").value) Then
	ef=True
	ec="编号必须是数字"
'ElseIf Form ("Submit").value="修改" and Form ("id").value="" Then
'	ef=True
'	ec="编号ID没填！"
end If

if not ef Then
For   each   item   in   Form   
If item="ip" Then haveip=True
If item="admuser" Then haveadmuser=True
If item="admpass" Then haveadmpass=True
If item="ftpname" Then haveftpname=True
If item="url" Then haveurl=true
If Form(item).Length>102400 Then
	ef=True
	ec="文件大小不能超过100K"
End if
Next
End If


if not ef then
Set conn=Server.CreateObject("ADODB.Connection")
	conn.Open Application("FreeHostDBlink")
	Set ds = Server.CreateObject("ADODB.Recordset")	
		Sql="Select * from FreeHost.FreeHost_online_aws where username='"&session("username")&"' and id='"&Form("id").value&"'"
		ds.Open Sql,conn,1,3
if Form("id").value<>"" and ds.Eof then
	ef=True
	ec="没找到要继续发表的ID！"
end if
end if

if not ef then
if Form("id").value="" then
ds.AddNew
ds("firstposttime")=NOW
ds("username")=session("username")
ds("title")=trim(trim(Form ("title").value))
ds("con")=trim(Form ("Body").value)
ds("status")="新问题"
if session("agentname")<>"n" and session("agentname")<>session("username") then
ds("agent1")=session("agentname")

  Set dsagent = Server.CreateObject("ADODB.Recordset")	
		Sql="Select * from FreeHost.FreeHost_AGENT where username='"&ds("agent1")&"'"
		dsagent.Open Sql,conn,1,1
If Not dsagent.Eof Then
If dsagent("awstoadmin")=True Then
ds("agent1")="n"
ds("agent2")=dsagent("username")
Dim awstoadmin
awstoadmin=true
End if
end If
dsagent.close

else
ds("agent1")="n"
end if
else
if Form("op").value<>"close" then
'ds("username")=session("username")
'ds("title")=trim(trim(Request.Form ("title")))
ds("con")=ds("con")&vbcrlf&"-------"&session("username")&" 回复("&now&")-------"&vbcrlf&(Form ("Body").value)
ds("status")="待回复"
else
ds("status")="已结束"
end if
end if
ds("posttime")=NOW
ds("type1")=Form ("type1").value

If (ds("agent1")="n" Or awstoadmin=true) And Not IsNull(Application("admemail")) Then
ret=SendJmail(ds("username"),Application("Mail_from"),Application("Mail_fromName"),Application("admemail"),"新问题:"&ds("title"),now&" 新问题，用户名为："&ds("username")&" 内容为："&trim(Form ("Body").value),Application("Mail_fromServer"),Application("Mail_fromPass"),Application("Mail_emailport"),Application("Mail_EnableSsl"))
End if

If (ds("agent1")="n" Or awstoadmin=true) Then
Application("noticemesg")=Application("noticemesg")&"　用户提交了新的问题。"
End if

If haveip=True Then ds("ip")=Form ("ip").value
If haveadmuser=True Then ds("admuser")=Form ("admuser").value
If haveadmpass=True Then ds("admpass")=Form ("admpass").value
If haveftpname=True Then ds("ftpname")=Form ("ftpname").value
If haveurl=True Then ds("url")=Form ("url").value

'If Form("aboutimg").Length>100 Then ds("aboutimg").appendchunk Form("aboutimg").value

For i=1 To 5
If Form("aboutimg"&i).Length>100 Then ds("aboutimg"&i).appendchunk Form("aboutimg"&i).value
Next

ds.Update
ds.Close
set ds=nothing
conn.Close 
set conn=nothing

Response.Redirect "aws.asp"
end if
if ef then
Response.Redirect "e.asp?e="&ec
end if%>
























     
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Function GetUpload(FormData)
Dim DataStart,DivStr,DivLen,DataSize,FormFieldData
'分隔标志串(+CRLF)
DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)
'分隔标志串长度
DivLen = LenB(DivStr)
PosOpenBoundary = InStrB(FormData,DivStr)
PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
Set Fields = CreateObject("Scripting.Dictionary")
While PosOpenBoundary > 0 And PosCloseBoundary > 0
   'name起始位置(name="xxxxx")，加6是因为[name="]长度为6
   FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6
   FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart '(")的ASC值=34
'   response.write "FieldNameStart"&FieldNameStart&"<br>"
 '     response.write "FieldNameSize"&FieldNameSize&"<br>"
   FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))
   'filename起始位置(filename="xxxxx")
   FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10
   If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then
      FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart '(")的ASC值=34
      FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))
   Else
      FormFileName = ""
   End If
   'Content-Type起始位置(Content-Type: xxxxx)
   FieldFileCTStart = InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14
   If FieldFileCTStart < PosCloseBoundary  And FieldFileCTStart > PosOpenBoundary Then
      FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart
      FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))
   Else
      FormFileCT = ""
   End If
   '数据起始位置：2个CRLF开始
   DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4
   If FormFileName <> "" Then
      '数据长度，减1是因为数据文件的存取字节数问题(可能是AppendChunk方法的问题)：
      '由于字节数为奇数的图象存到数据库时会去掉最后一个字符导致图象不能正确显示,
      '字节数为偶数的数据文件就不会出现这个问题，因此必须保持字节数为偶数。
      DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1
      FormFieldData = MidB(FormData,DataStart,DataSize)
   Else
      '数据长度，减2是因为分隔标志串前有一个CRLF
      DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
      FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))
   End If
   '建立一个Dictionary集存储Form中各个Field的相关数据
   Set Field = CreateUploadField()
   Field.Name = FormFieldName
   Field.FilePath = FormFileName
   Field.FileName = GetFileName(FormFileName)
   Field.ContentType = FormFileCT
   Field.Length = LenB(FormFieldData)
   Field.Value = FormFieldData
   Fields.Add FormFieldName, Field
   PosOpenBoundary = PosCloseBoundary
   PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
Wend
Set GetUpload = Fields
End Function
'把二进制字符串转换成普通字符串函数
Function bin2str(bsString)
        Dim i
        With CreateObject("ADODB.Stream")
            .Type = 2
            .Charset = "iso-8859-1"
            .Open
            For i = 1 to LenB(bsString)
                .WriteText ChrW(AscB(MidB(bsString,i,1)))
            Next
            .Position = 0
            .Charset = "GBK"
            bin2str = .ReadText(-1)
            .Close
        End With
    End Function
'把普通字符串转成二进制字符串函数
Function str2bin(varstr)
   str2bin=""
   For i=1 To Len(varstr)
   varchar=mid(varstr,i,1)
   varasc = Asc(varchar)
   ' asc对中文字符求出来的值可能为负数，
   ' 加上65536就可求出它的无符号数值
   ' -1在机器内是用补码表示的0xffff,
   ' 其无符号值为65535,65535=-1+65536
   ' 其他负数依次类推。
   If varasc<0 Then
      varasc = varasc + 65535
   End If
   '对中文的处理：把双字节低位和高位分开
   If varasc>255 Then
      varlow = Left(Hex(Asc(varchar)),2)
      varhigh = right(Hex(Asc(varchar)),2)
      str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
   Else
      str2bin = str2bin & chrB(AscB(varchar))
   End If
   Next
End Function
'取得文件名(去掉Path)
Function GetFileName(FullPath)
   If FullPath <> "" Then
  FullPath = StrReverse(FullPath)
  FullPath = Left(FullPath, InStr(1, FullPath, "") - 1)
  GetFileName = StrReverse(FullPath)
   Else
  GetFileName = ""
   End If
End Function
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
  this.Name = null
  this.FileName = null
  this.FilePath = null
  this.ContentType = null
  this.Value = null
  this.Length = null
}
</script>