tools.asp

this a program about talent web database used asp and VB.

<!--#include file="adovbs.inc"-->
<%
strcon="provider=sqloledb;data source=SERVER-2N94ITU1\HOUSE;database=house;uid=house;pwd=ypt8763"
set conn=server.CreateObject("adodb.connection")
conn.Open strcon

set fs=server.CreateObject("scripting.filesystemobject")

function sqlstr(data)
sqlstr="'" & replace(data,"'","''") & "'"
end function

function fhousemodel(room,hall,toilet)
if room=0 then
temp=""
else
temp=room & "室"
end if

if hall=0 then
temp=temp
else
temp=temp & hall & "厅"
end if

if toilet=0 then
temp=temp
else
temp=temp & toilet & "卫"
end if
fhousemodel=temp
end function

function outputperson(par)
strsql="select ids.tblname from tblids ids where uid=" & sqlstr(par)
set rsdo=server.CreateObject("adodb.recordset")
rsdo.Open strsql,conn
tblname=rsdo("tblname")
rsdo.Close

if tblname="tblUsers" then
strsql="select uid,header,sign from tblusers where uid=" & sqlstr(par)
else
strsql="select uid,'images/bbsimages/clear.gif' header,'-' sign from tblmembers where uid=" & sqlstr(par)
end if
rsdo.Open strsql,conn
tmp=trim(rsdo("uid")) & "," & trim(rsdo("header")) & "," & trim(rsdo("sign"))
outputperson=split(tmp,",")
end function

function showdistrict(par)
if par="浦东" then
showdistrict="浦东新区"
else
showdistrict=par & "区"
end if
end function


function clearpage(par)
if par<>"" then
if instr(par,"&page")>1 then
clearpage = Left(par, InStr(par, "&page") - 1) & "&"
elseif  instr(par,"page")=1 then
clearpage = ""
else
clearpage=par & "&"
end if
end if
end function

function ReadTxt(flodname,txtname)'读取指定目录中文本文件的内容
fpath=server.MapPath(flodname)
set fsf=fs.OpenTextFile(fpath & "\" & txtname & ".txt",1,true)
while not fsf.atendofstream
txt=txt & "&nbsp;&nbsp;&nbsp;&nbsp;" &fsf.readline & "<br>"
wend
ReadTxt=txt
fsf.close
set fs=nothing
end function

sub CheckMail(parm) '检验电子信箱
if (len(parm)<5) or (instr(parm,"@")=0) or (instr(parm,".")=0) or len(parm)>30 then ErrHandler(8)
end sub

function CheckUrl(parm) '检验网址
if parm="http://" or parm="" then
  url=""
else
  if len(parm)<10 or len(parm)>70 or instr(parm,".")=0 then ErrHandler(9)
  url=mid(parm,8,len(parm)-7)
end if
CheckUrl=url
end function

sub ErrHandler(parm)
  select case parm
    case 0
    Response.Write "错误！！"
    case 1
    Response.Write "请按要求填写帐号与口令"
    case 2
    Response.Write "请选择正确的产品类别"
    case 3
    Response.Write "请输入正确的公司名称！"
    case 4
    Response.Write "请填写正确的联系人姓名！"
    case 5
    Response.Write "请填写正确的联系电话！"
    case 6
    Response.Write "请填写正确的传真号码！"
    case 7
    Response.Write "请填写正确的联系地址！"
    case 8
    Response.Write "请输入正确的电子信箱！"
    case 9
    Response.Write "请输入正确的公司网址！"
    case 10
    Response.Write "产品关键字不能超过10字！"    
    case 11
    Response.Write "已经被人注册！"
    case 12
    Response.Write "请输入正确的邮政编码"
    case 13
    Response.Write "请输入正确的姓名"
    case 14
    Response.Write "错误的登陆帐号或密码！！"
    case 15
    Response.Write "发言标题不能为空！！"
    case 16
    Response.Write "发言标题过长！！"
    case 17
    Response.Write "留言内容不能为空！！"
    case 18
    Response.Write "留言内容超过16KB！！"
    case 19
    Response.Write "请按要求填写留言标题！！"
    case 20
    Response.Write "请按要求填写姓名！！"
    case 21
    Response.Write "您用的帐号与注册用户雷同！！"
    case 22
    Response.Write "文件上传失败！！"
    case 23
    Response.Write "文件大于50K！！"
    case 24
    Response.Write "产品名不能为空！！"
    case 23
    Response.Write "产品简介请控制在100字以内！！"
    case 25
    Response.Write"Please Input the correct id or password"
    case 26
    Response.Write "Please Input the message title!"
    case 27
    Response.Write "请输入4-10位的密码！"
    
  end select
  
  Response.Write "<p align=center>[<a href='javascript:history.go(-1)'>返回上一页</a>]</p>"
  Response.End
end sub

function GetRsd(sql) '用函数返回recordset
set rsd=conn.Execute(sql)
set GetRsd=rsd
end function

function AddNew(parm1,parm2)'显示是否加new,parm1为时间，parm2为间隔天数
if datediff("d",parm1,date())<=parm2 then
AddNew="<font size=red class=new><i><sup>new!</sup></i></font>"
else
AddNew=""
end if
end function

function FDate(parm)
min=minute(parm)
if min<10 then min="0" & min
FDate=month(parm) & "-" & day(parm) & " " & hour(parm) & ":" & min
end function

Sub ShowChild(fatherid)

sqlc="select face,topic,father,id,bbsdat,mid,length,uid,hit from tblBbsList where father=" & sqlstr(fatherid) & "  order by bbsdat desc"
set childrsd=conn.Execute(sqlc)
Response.Write "<ul>"
while not childrsd.eof
  Response.Write "<li><img src=image/" & childrsd("face") & ".gif>" & Vbcrlf
  Response.Write "<a href=showbbs.asp?id=" & childrsd("id") & ">" & childrsd("topic") & "</a>" & AddNew(childrsd("bbsdat"),5) & vbcrlf
  Response.Write "- 【" & childrsd("uid") & "】 " & "<font color=red><em>" & FDate(childrsd("bbsdat")) & "</em></font>" & vbcrlf
  Response.Write "  [ID:" & childrsd("mid") & "  点击:" & childrsd("hit") & "]" & vbcrlf
  Response.Write "  (" & childrsd("length") & "bytes) "
      sql1="select count(father) as child from tblBbsList where father=" & sqlstr(childrsd("id"))
      set rsd1=conn.execute(sql1)
      Response.Write "<font color=red>(" & rsd1("child") & ")</font>" & vbcrlf
      set rsd1=nothing
  Response.Write "</li>"
  showchild(childrsd("id"))
  childrsd.movenext
wend
Response.Write "</ul>"
end sub

sub CheckUidPwd(parm) '检验帐号和口令
if len(parm)<4 or len(parm)>12 then ErrHandler(25)
isNot=" !@#$^*()_+=-'`~\|]}[{;:/?.,<>&%"
for i=1 to len(parm)
if instr(isNot,mid(parm,i,1))>0 or instr(parm,chr(34))>0 then ErrHandler(1)
next
end sub


sub CheckBbsLogin(uid,pwd)'bbs登陆帐号检验
sql="select uid from tblUserList where uid=" & sqlstr(uid) & " and pwd=" & sqlstr(pwd)
set rsd=GetRsd(sql)
if rsd.eof and rsd.bof then ErrHandler(14)
set rsd=nothing
end sub

sub MailReply(bid,rid)  '用email回复作者 bid发送者的帖子id  rid回复的帖子id
  sql="select email from tblUserList where uid in (select uid from tblBbsList where id=" & sqlstr(bid) & ")"
  set rsdmail=conn.Execute(sql)
       set rsdmail=nothing
end sub

function GetBbsId(datparm)
GetBbsId=year(datparm) & month(datparm) & day(datparm) & hour(datparm) & minute(datparm) & second(datparm)
end function

sub ExeRsd(sql) '用conn的execute方法处理sql
  conn.Execute(sql)
end sub

sub AddTxt(flodname,txtname,txtcontent)'向指定目录中写入文本文件
fpath=server.MapPath(flodname)
set fsf=fs.CreateTextFile(fpath & "\" & txtname & ".txt",true)
fsf.write(txtcontent)
fsf.close
set fs=nothing
end sub

function FilledEmpty(content,replacechar)
if content="" then
tempf=replacechar
else
tempf=content
end if

FilledEmpty=tempf
end function

function GetCookie(CookieName,key)
GetCookie=Request.Cookies(CookieName)(key)
end function

function ReadCookie(str,key) '对cookie解码
arrcookie=split(str,key)
for i=0 to ubound(arrcookie)-1
cookie=cookie & chr(arrcookie(i))
next
ReadCookie=cookie
end function

function ReadTxtNoHtml(flodname,txtname)'读取指定目录中文本文件的内容
fpath=server.MapPath(flodname)
set fsf=fs.OpenTextFile(fpath & "\" & txtname & ".txt",1,true)
while not fsf.atendofstream
txt=txt & fsf.readline & chr(10)
wend
ReadTxtNoHtml=txt
fsf.close
set fs=nothing
end function

sub CheckContactMan(parm) '检验联系人
if len(parm)<2 or len(parm)>15 then ErrHandler(4)
end sub

sub CheckTel(parm) '检验联系电话
if len(parm)>50 or len(parm)<6 then ErrHandler(5)
end sub

sub CheckFax(parm) '检验传真
if len(parm)>20 or len(parm)<6 then ErrHandler(6)
end sub

sub CheckAddress(parm) '检验地址
if len(parm)>60 or len(parm)<5 then ErrHandler(7)
end sub

sub CheckKey(parm) '检验产品关键字
if len(parm)>20 then ErrHandler(10)
end sub

sub CheckZip(parm) '检验邮政编码
if len(parm)>6 then ErrHandler(12)
end sub

function CheckCity(CityName) '检验城市名称
if len(CityName)<0 then
  ciname=""
  elseif len(CityName)>20 then
  ErrHandler(15)
  else
  ciname=CityName
end if
end function

sub CheckCName(parm) '检验公司名称
if len(parm)>100 or len(parm)<5 then ErrHandler(3)
end sub

sub CheckProduct(parm) '检验产品名称及国家
if len(parm)<2 or len(parm)>10 then ErrHandler(2)
end sub

sub CheckName(parm) '检验用户姓名
if len(parm)>100 or len(parm)<2 then ErrHandler(13)
end sub

%>