freelin.asp

一个不错的酒店源码,从别的地方找来的!希望能换点积分!

<LINK href="../images/style.css" type=text/css rel=stylesheet>
<%
'###########################################################################################
'			   Copyright (C) 2006 FreeLin rights reserved.                                 '
'			      本系统由FREELIN工作室独立开发2006.3.20                                      '
'				     版权所有,并保留所有版权,不得修改传播                                       '
'					    http://www.yisky.com                                          '
'						     [e-mail]                                                '
'###########################################################################################
picType = "jpg,gif,png,bmp"

Function list_class()
	set rs = conn.execute("select * from class")
	do while not rs.eof
	%>
	<option value=<%=rs("className")%>><%=rs("className")%></option>
	<%
	rs.movenext
	loop
	conn.close
End Function

Function xln_showmsg(xln_title,xln_msg,xln_url,in_or_out)
	Response.write "<title>FreeLin 提示："&xln_title&"！</title><p>&nbsp;</p><table width='300' align='center' border='1' cellpadding='0' cellspacing='0' bordercolor='#f0f0f0'><tr><td height='30' align='center' bgcolor='#FAFAFA'><B>FreeLin 提示："&xln_title&"！</B></td></tr><tr><td height='90' align='center' bgcolor='#FEFEFE'><font color='red'>"&xln_msg&"<font><br><br><A HREF='"&xln_url&"'>"&in_or_out&"</A></td></tr></table><meta http-equiv='refresh' content='3 url="&xln_url&"'>"
	Response.end
End function

Function IsvalidFile(sFileName)   '上传文件类型
	IsvalidFile = False
	TypeArry = split(picType,",")
	If instr(sFileName,".") > 0 Then
		FileTypeName = right(sFileName,3)
		Dim TypeName
		For Each TypeName in TypeArry
			If FileTypeName = TypeName Then
				IsvalidFile = True
				Exit For
			End If
		Next
	End If
End Function

Function Bytes2bStr(vin)
if lenb(vin) =0 then
	Bytes2bStr = ""
	exit function
end if
''二进制转换为字符串
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("ADODB.Stream")
	BytesStream.Type = 2 
	BytesStream.Open
	BytesStream.WriteText vin
	BytesStream.Position = 0
	BytesStream.Charset = "gb2312"
	BytesStream.Position = 2
	StringReturn = BytesStream.ReadText
	BytesStream.close
Set BytesStream = Nothing
Bytes2bStr = StringReturn
End Function

Function Myrequest(fldname)
	''取表单数据
	''支持对同名表单域的读取
	dim i
	dim fldHead
	dim tmpvalue
	for i = 0 to loopcnt-1
		fldHead = fldInfo(i,0)
		if instr(lcase(fldHead),lcase(fldname))>0 then
			''表单在数组中
			''判断该表单域内容
			tmpvalue = FldInfo(i,1)
			if instr(fldHead,"filename=""")<1 then
				Tmpvalue = Bytes2bStr(tmpvalue)
				if myrequest <> "" then 
					myrequest = myrequest & "," &tmpvalue
				else
					MyRequest = tmpvalue
				end if				
			else
				myrequest = tmpvalue
			end if				
		end if
	next
end function

function GetFileName(fldName)
	''都取原上传文件文件名
	dim i
	dim fldHead
	dim fnpos
	for i = 0 to loopcnt-1
		fldHead = lcase(fldInfo(i,0))
		if instr(fldHead,lcase(fldName)) > 0 then
			fnpos = instr(fldHead,"filename=""")
			if fnpos < 1 then exit for
			fldHead = mid(fldHead,fnpos+10)
			''表单内容
			GetFileName = mid(fldHead,1,instr(fldHead,"""")-1)
			GetfileName = mid(GetFileName,instrRev(GetFileName,"\")+1)
		end if
	next
end function

Sub SaveToFile(fd,path,fname)
''保存文件''参数说明:''fd:byte（）类型数据，文件内容''path:保存路径后面必须带"/"''fname:文件名
	dim Fstream
	Set FStream = Server.CreateObject("adodb.stream")
	fstream.mode = 3
	fstream.type = 1
	fstream.open
	fstream.position = 0
	fstream.Write fd
	fstream.savetofile Server.Mappath(path&fname),2
	fstream.close
	set fstream = nothing
end sub

function IDname(str)
  str = replace(str,"-","")
  str = replace(str," ","") 
  str = replace(str,":","")
  str = replace(str,"PM","")
  str = replace(str,"AM","")
  str = replace(str,"上午","")
  str = replace(str,"下午","")
  IDname = right(str,9)
end function 
%>