"" then
Response.WriteBlock(3)
Response.Write(colNum+1)
Response.WriteBlock(4)
Response.Write(Title)
Response.WriteBlock(5)
end if
Response.WriteBlock(6)
for num=0 to colNum
Response.WriteBlock(7)
Response.Write(arrCol(num)(1))
Response.WriteBlock(8)
Response.Write(arrCol(num)(0))
Response.WriteBlock(9)
next
Response.WriteBlock(10)
dim rowNum,aa,fname,fvalue
dim re,Matchs,Match
set re=new RegExp
re.Pattern="\[(.*?)\]"
re.IgnoreCase=true
re.Global=true
rowNum=1
if not Rs.EOF then
while not Rs.EOF
Response.WriteBlock(11)
for num=0 to colNum
if IsAlt then
if rowNum mod 2 = 0 then
Response.WriteBlock(12)
Response.Write(arrCol(num)(2))
Response.WriteBlock(13)
else
Response.WriteBlock(14)
Response.Write(arrCol(num)(2))
Response.WriteBlock(15)
end if
else
Response.WriteBlock(16)
Response.Write(arrCol(num)(2))
Response.WriteBlock(17)
end if
aa=arrCol(num)(3)
set matchs=re.Execute(aa)
for each macth in matchs
fname=macth.value
fname=replace(fname,"[","")
fname=replace(fname,"]","")
fvalue=rs(fname)
if isnull(fvalue) then
fvalue=""
else
fvalue=replace(fvalue,vbcrlf,"
")
end if
if isnull(fvalue) then fvalue=""
aa=replace(aa,macth.value,fvalue)
next
'response.Write aa
if left(aa,1)="=" then
aa="aa" & aa
'response.Write aa
Execute(aa)
end if
Response.Write aa
Response.WriteBlock(18)
next
Response.Write ""
Rs.MoveNext
rowNum=rowNum+1
wend
if ShowTail then
Response.WriteBlock(19)
Response.Write(colNum+1)
Response.WriteBlock(20)
Response.Write(Amount)
Response.WriteBlock(21)
Response.Write(CurBNum)
Response.WriteBlock(22)
Response.Write(CurENum)
Response.WriteBlock(23)
Response.Write(PageNo)
Response.WriteBlock(24)
Response.Write(AllPageCount)
if URL<>"" then
URL = URL & "Amount=" & Amount & "&"
Response.WriteBlock(25)
if PageNo <> 1 then
Response.WriteBlock(26)
Response.Write(URL)
Response.WriteBlock(27)
end if
if PageNo > 1 then
Response.WriteBlock(28)
Response.Write(URL)
Response.WriteBlock(29)
Response.Write(PageNo-1)
Response.WriteBlock(30)
end if
if AllPageCount > PageNo then
Response.WriteBlock(31)
Response.Write(URL)
Response.WriteBlock(32)
Response.Write(PageNo+1)
Response.WriteBlock(33)
end if
if PageNo <> AllPageCount then
Response.WriteBlock(34)
Response.Write(URL)
Response.WriteBlock(35)
Response.Write(AllPageCount)
Response.WriteBlock(36)
end if
Response.WriteBlock(37)
end if
Response.WriteBlock(38)
end if
else
Response.WriteBlock(39)
Response.Write(colNum+1)
Response.WriteBlock(40)
end if
Response.WriteBlock(41)
End Function
End Class
' 通用数据库操作函数
dim sysOptArea,sysOptPosition,sysOptCompanyType
sysOptArea = "北京,天津,上海,重庆,香港,河北,山东,吉林,辽宁,黑龙江,内蒙古,山西,河南,陕西,甘肃,宁夏,新疆,青海,西藏,安徽,湖北,湖南,四川,江苏,江西,福建,广西,浙江,广东,海南,云南,贵州,深圳,国外"
sysOptPosition = "企业负责人,高级管理人员,业务人员,科研人员,学生,其他"
sysOptCompanyType = "生产企业,经销企业,政府部门,科研教育机构,信息服务企业,个体经营企业,其它"
sysOptDepartment = "采购部门,价管部门,财务部门,管理部门,信息部门,市场\销售部,工程技术部门,科研部门,其它"
sysOptRegType = "新注册用户|0,试用用户|1,正式用户|9"
SysOptSnCompany = "亿览网|COM"
SysOptSnIO = "收入|I,支出|O"
SysOptSnContract = "信息销售合同|I,报告销售合同|R,会议服务合同|C"
dim sysMailHost,sysMailUser,sysMailPwd
'sysMailHost="mail.comelan.com"
'sysMailUser="comelan@comelan.com"
'sysMailPwd="comelan"
sysMailHost="mail.comelan.com"
sysMailUser="comelan@comelan.com"
sysMailPwd="comelan"
' 系统参数
'********************************
'通用的程序调试函数
'1、Sub WriteError(str) '目的：显示调试信息
'2、Sub WriteErrorLn '显示调试信息
'3、Sub WriteRequest() '输出所有表单提交信息
'4、Sub WriteArray(theA,endFlag) '察看数组的所有值
'********************************
dim m_g_IsDebug
m_g_IsDebug = true '是否为调试版本，当正式发布程序时，可以改为m_g_IsDebug=false
'**************************
'目的：显示调试信息
'*************************
Sub WriteError(str)
IF m_g_IsDebug Then
Response.write str & "
"
End IF
End Sub
Sub WriteVar(varName)
if m_g_IsDebug then
dim varValue
Execute("varValue=" & varName)
response.Write varName & "=" & varValue & "
"
end if
End Sub
'**************************
'目的：显示调试信息 Response.End
'*************************
Sub WriteErrorLn(str)
IF m_g_IsDebug Then
Response.write str & "
"
Response.End
End IF
End Sub
'**************************
'输出所有表单提交信息
'*************************
Sub WriteRequest()
IF m_g_IsDebug Then
For Each thing In Request.Form
WriteError thing & "=" & Request(thing) & "
"
Next
End IF
End Sub
'**************************
'察看数组的所有值
'endFlag=1时中断
'*************************
Sub WriteArray(theA,endFlag)
IF m_g_IsDebug Then
If typename(theA)<>"Variant()"then
WriteError("不是数组！")
Else
WriteError "数组aTheClassId=
"
For i=0 to ubound(theA)
WriteError(i&". "&theA(i)&"
")
Next
End if
If endFlag="1" then
Response.end
End if
End IF
End Sub
' 通用程序调试函数
'***************************************************************************
' 字符处理函数
'***************************************************************************
'1、function StrLength(str) 返回字符串的长度 中文字符=2
'2、function IsInteger(para) 判断para是否为整型,是返回1 否返回0
'3、function cutStr(str,strLen) 截字符串前strLen个字串,判断中文字符
'4、function HTMLEncode(fString) 字符串编码
'5、function HTMLDecode(fString) 字符串解码
'6、function HTMLcode(fString) 字符串编码(只对回车编码)
'7、function strFill(str1,strlen,chrFill) 对字符串不满strLen长度的用chrFill从左填充
'8、function chkInputStr(str,length) 对输入的字串值和长度进行判断,如果长度大于length则取前length个
'***************************************************************************
'返回字符串的长度，判断中文字符
function StrLength(str)
dim result,WINNT_CHINESE
on error resume next
if str="" or isnull(str) then
result=0
else
WINNT_CHINESE = (len("中文")=2)
if WINNT_CHINESE then
dim l,c,i
l=len(str)
result=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+ 65536
if c>255 then result=result+1
next
else
result=len(str)
end if
if Err.number<>0 then Err.Clear
end if
strLen=result
end function
function IsInteger(para)
On Error Resume next
dim result
result=1
dim str,l,i
if isnull(para) then '是否输入值为NULL
result=0
else
str=cstr(para)
if trim(str)="" then '是否输入值为空
result=0
else
l=len(str)
for i=1 to l
dim char
char=mid(str,i,1)
if(char>"9" or char<"0") then '是否输入值有非数字字符
result=0
Exit for
end if
next
end if
end if
if Err.number<>0 then Err.Clear
isInteger=result
end function
function CutStr(str,strLen)
dim result,WINNT_CHINESE
if isnull(str) or str="" then
cutStr=""
Exit function
end if
result=""
WINNT_CHINESE = (len("中文")=2)
if WINNT_CHINESE then
dim l,t,c,i
l=len(str)
t=0
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+ 65536
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strLen then
result=left(str,i)
Exit for
end if
next
if result="" then result=str
else
if len(str)>strLen then
result=left(str,strLen)
else
result=left(str,strlen)
end if
end if
cutStr=result
end function
'字符串进行HTML编码处理
function HTMLEncode(fString)
if Not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), " ")
fString = Replace(fString, CHR(10), "
")
HTMLEncode = fString
end if
end function
'字符串进行HTML去编码处理
function HTMLDecode(fString)
if Not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, "", CHR(13))
fString = Replace(fString, "
", CHR(10) & CHR(10))
fString = Replace(fString, "
", CHR(10))
HTMLDecode = fString
end if
end function
'对字符串不满strLen长度的用chrFill从左填充
function StrFill(str1,strlen,chrFill)
if int(strlen)<2 or len(chrFill)<>1 then
strFill=""
Exit function
end if
if len(str1)>=strlen then
strFill=str1
Exit function
end if
strFill=Replicate(chrFill,strlen-len(str1)) + str1
end function
function ChkInputStr(str,length)
str=trim(str)
dim result
if length>0 then
result=cutStr(str,length)
else
if length=0 then
result=str
else
result=""
end if
end if
result = Replace(result, CHR(34), """)
result = Replace(result, CHR(39), "'")
chkInputStr=result
end function
'如果不是数字，则为空
function ChkInputNum(str)
if str<>"" then
if isnumeric(str) then
ChkInputNum=str
else
ChkInputNum=""
end if
else
ChkInputNum=""
end if
end function
function ChkInputDate(str)
if str<>"" then
if isdate(str) then
ChkInputDate=str
else
ChkInputDate=""
end if
else
ChkInputDate=""
end if
end function
function TitleStr(str,maxlen)
dim result
result=chkInputStr(str,maxlen)
if result<>str then result=result & "..."
titleStr=result
end function
' 通用字符处理相关函数
'******************************************************************
' 通用工具类函数
' 最后修改时间：2006-06-17
'******************************************************************
'2、sub Notes(str,strFlag) 通用提示信息函数 strFlag=1 返回,strFlag=0只提示,strFlag=2 关闭窗口,如果str=""则不出提示框
'3、sub NotesGo(str,url) 通用提示信息函数并跳转到指定的URL (JAVASCRIPT方式) 如果str=""则不出提示框
'4、sub ShowMessage(Title, Info,javastr) 通用提示信息函数并跳转到指定的URL (ASP方式)
'4、function PowerTrim(str) 去掉str中所有空格
'5、function FormatDate(DateValue,FormatString) 格式化显示日期
'FormatString yyyy四位年,yy两位年,mm月,m不带前导0.dd日,hh时，nn分,ss秒
'6、function GenRandom(Length,hasNum,hasLowerChar,hasUpperChar,hasOtherChar) 生成随机字符串,length生成字符串的长度,
'hasNum,hasLowerChar,hasUpperChar,hasOtherChar值为0或1,依次为包含数字、小写字母、大写字母、其它字符
'7、function Repeat(str,num) 返回重复num次str的字符串
'9、function translate(sourceStr,fieldStr) 处理逻辑表达式的转化问题
'10、function chkEmail(email) 检查邮件有否正确,正确返回1,错误返回0
'11、function browser(info) 取客户浏览器信息
'12、function system(info) 取客户操作系统信息
'13、function IIF(theInputExp,trueValue,falseValue) IIF函数
'******************************************************************
sub Notes(str,strFlag)
Response.WriteBlock(42)
if str<>"" then
Response.WriteBlock(43)
Response.Write(str)
Response.WriteBlock(44)
end if
if strFlag="1" then
Response.WriteBlock(45)
ElseIf strFlag="2" then
Response.WriteBlock(46)
ElseIf strFlag="3" then
Response.WriteBlock(47)
end if
Response.WriteBlock(48)
response.End
end sub
'********************
'通用提示信息函数,提示
'********************
sub NotesGo(str,url)
Response.WriteBlock(49)
if str<>"" then
Response.WriteBlock(50)
Response.Write(str)
Response.WriteBlock(51)
end if
Response.WriteBlock(52)
Response.Write(url)
Response.WriteBlock(53)
response.end
end sub
'********************
'去掉str中间的空格,返回值为处理后的字符串
'********************
function PowerTrim(str)
dim i,ln,result
ln=len(cstr(str))
for i=1 to ln
if mid(str,i,1)<>" " then
result=result & mid(str,i,1)
end if
next
PowerTrim=result
end function
'********************
'目的：格式化显示日期
'输入：日期值、格式化串
'返回值：字符串
'例 FormatDate(now(),"yyyymmdd h:n") 返回值为 "20021009 10:3"
'例 FormatDate(now(),"yyyy-m-d hh:nn") 返回值为 "2002-10-9 10:03"
'********************
function FormatDate(DateValue,FormatString)
'FormatString yyyy四位年,yy两位年,mm月,m不带前导0.dd日,hh时，nn分,ss秒
dim strResult
strResult=lcase(FormatString)
if IsDate(DateValue) then
'Response.Write DateValue
strYear=year(DateValue)
if len(strYear)=2 then
strYear="20" & strYear
end if
strMonth=month(DateValue)
if len(strMonth)=1 then strMonth="0" & strMonth
strDay=day(DateValue)
if len(strDay)=1 then strDay="0" & strDay
if IsNull(hour(DateValue)) then
strHour="00"
else
strHour=hour(DateValue)
if len(strHour)=1 then strHour="0" & strHour
end if
if IsNull(minute(DateValue)) then
strMinute="00"
else
strMinute=minute(DateValue)
if len(strMinute)=1 then strMinute="0" & strMinute
end if
if IsNull(second(DateValue)) then
strSecond="00"
else
strSecond=second(DateValue)
if len(strSecond)=1 then strSecond="0" & strSecond
end if
if Instr(strResult,"yyyy")>0 then
strResult=replace(strResult,"yyyy",strYear)
ElseIf Instr(strResult,"yy")>0 then
strResult=replace(strResult,"yy",right(strYear,2))
end if
if Instr(strResult,"mm")>0 then
strResult=replace(strResult,"mm",strMonth)
ElseIf Instr(strResult,"m")>0 then
strResult=replace(strResult,"m",cstr(cint(strMonth)))
end if
if Instr(strResult,"dd")>0 then
strResult=replace(strResult,"dd",strDay)
ElseIf Instr(strResult,"d")>0 then
strResult=replace(strResult,"d",cstr(cint(strDay)))
end if
if Instr(strResult,"hh")>0 then
strResult=replace(strResult,"hh",strHour)
ElseIf Instr(strResult,"h")>0 then
strResult=replace(strResult,"h",cstr(cint(strHour)))
end if
if Instr(strResult,"nn")>0 then
strResult=replace(strResult,"nn",strMinute)
ElseIf Instr(strResult,"n")>0 then
strResult=replace(strResult,"n",cstr(cint(strMinute)))
end if
if Instr(strResult,"ss")>0 then
strResult=replace(strResult,"ss",strSecond)
ElseIf Instr(strResult,"s")>0 then
strResult=replace(strResult,"s",cstr(cint(strSecond)))
end if
else
strResult="0"
end if
FormatDate=strResult
end function
'生成随机字符串,length生成字符串的长度,hasNum,hasLowerChar,hasUpperChar,hasOtherChar值为0或1,依次为包含数字、小写字母、大写字母、其它字符
function GenRandom(Length,hasNum,hasLowerChar,hasUpperChar,hasOtherChar)
dim result
dim LatterNum,LatterLower,LatterUpper,LatterOther
dim arrLatter
'初始化可生成的字符值
LatterNum="0123456789"
LatterLower="abcdefghigklmnopqrstuvwxyz"
LatterUpper="ABCDEFGHIGKLMNOPQRSTUVWXYZ"
LatterOther="-=\[]"
'判断生成字符串长度输入是否正确
if Not isnumeric(length) Or Length<0 then
GenRandom=""
Exit function
end if
'初始化动态数据
dim num
num=0
if hasNum then num=num+1
if hasLowerChar then num=num+1
if hasUpperChar then num=num+1
if hasOtherChar then num=num+1
if num=0 then
GenRandom=""
exit function
end if
redim arrLatter(num-1)
num=0
if hasNum then
arrLatter(num)=LatterNum
num=num+1
end if
if hasLowerChar then
arrLatter(num)=LatterLower
num=num+1
end if
if hasUpperChar then
arrLatter(num)=LatterUpper
num=num+1
end if
if hasOtherChar then
arrLatter(num)=LatterOther
num=num+1
end if
Randomize()
dim i,index,position
for i=1 to Length
index=int((ubound(arrLatter)+1)*Rnd())
position=int(len(arrLatter(index))*Rnd()+1)
result=result + mid(arrLatter(index),position,1)
next
GenRandom=result
end function
'************************
'返回字符重复次数
'************************
function Repeat(str,num)
dim Result
Result=""
do while num>0
Result=Result + str
num=num-1
Loop
Repeat=Result
end function
function IntToStr(value,maxlen,fillchar)
dim result
result=cstr(value)
if len(result)0 then
dim isOperator
isOperator = true
sourceList=split(sourceStr) '以空格分隔
rem Response.Write "num:" & cstr(ubound(sourceList)) & "
"
for i = 0 to ubound(sourceList)
rem Response.Write i
Select Case ucase(sourceList(i))
Case "AND","&","和","与"
resultStr=resultStr & " and "
isOperator = true
Case "OR","|","或"
resultStr=resultStr & " or "
isOperator = true
Case "NOT","!","非","！","！"
resultStr=resultStr & " not "
isOperator = true
Case "(","（","（"
resultStr=resultStr & " ( "
isOperator = true
Case ")","）","）"
resultStr=resultStr & " ) "
isOperator = true
Case else
if sourceList(i)<>"" then
if not isOperator then resultStr=resultStr & " and "
if inStr(sourceList(i),"%") > 0 then
resultStr=resultStr&" "&fieldStr& " like '" & replace(sourceList(i),"'","''") & "' "
else
resultStr=resultStr&" "&fieldStr& " like '%" & replace(sourceList(i),"'","''") & "%' "
end if
isOperator=false
end if
end Select
rem Response.write resultStr+"
"
next
translate=resultStr
else '单条件
if inStr(sourcestr,"%") > 0 then
translate=" " & fieldStr & " like '" & replace(sourceStr,"'","''") &"' "
else
translate=" " & fieldStr & " like '%" & replace(sourceStr,"'","''") &"%' "
end if
rem 前后各加一个空格，免得连sql时忘了加，而出错。
end if
end function
'**************************************
'检查邮件有否正确,正确返回ture,错误返回false
'**************************************
function IsValidEmail(strEmail)
dim re
Set re = new RegExp
re.pattern = "^[a-zA-Z][A-Za-z0-9_.-]+@[a-zA-Z0-9_]+?\.[a-zA-Z]{2,3}$"
chkEMail=re.Test(strEmail)
set re=nothing
end function
function browser(info)
if Instr(info,"MSIE 5.5")>0 then
browser="浏 览 器：Internet Explorer 5.5"
ElseIf Instr(info,"MSIE 6.0")>0 then
browser="浏 览 器：Internet Explorer 6.0"
ElseIf Instr(info,"MSIE 5.01")>0 then
browser="浏 览 器：Internet Explorer 5.01"
ElseIf Instr(info,"MSIE 5.0")>0 then
browser="浏 览 器：Internet Explorer 5.00"
ElseIf Instr(info,"MSIE 4.0")>0 then
browser="浏 览 器：Internet Explorer 4.01"
else
browser="浏 览 器：未知"
end if
end function
function system(info)
if Instr(info,"NT 5.1")>0 then
system=system+"操作系统：Windows XP"
ElseIf Instr(info,"NT 5")>0 then
system=system+"操作系统：Windows 2000"
ElseIf Instr(info,"NT 4")>0 then
system=system+"操作系统：Windows NT4"
ElseIf Instr(info,"98")>0 then
system=system+"操作系统：Windows 98"
ElseIf Instr(info,"95")>0 then
system=system+"操作系统：Windows 95"
else
system=system+"操作系统：未知"
end if
end function
sub ShowMessage(Title, Info,javastr)
Response.Write ""
end sub
function IIF(theInputExp,tValue,fValue)
if theInputExp then
IIF=tValue
else
IIF=fValue
end if
end function
'获取IP地址
Function GetIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
GetIP = Trim(Mid(strIPAddr, 1, 30))
End Function
'通过调用XMLHTTP,使用POST方式提交
function HTTP_POST(str_url,str_content)
on error resume next
dim objxml,serviceurl
dim stra,result
set objxml=server.CreateObject("Microsoft.XMLHTTP")
stra = URLEncoding(str_content)
objxml.Open "post",str_url,false
objxml.setrequestheader "content-length",len(stra)
objxml.setrequestheader "content-type","application/x-www-form-urlencoded"
objxml.send stra
result = objxml.responsetext
set objxml = nothing
HTTP_POST = result
end function
function URLEncoding(vstrIn)
strReturn = ""
For i = 1 To Len(vstrIn)
ThisChr = Mid(vStrIn,i,1)
If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00)\ &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
URLEncoding = strReturn
end function
'发送邮件函数
sub SendMail(MailToList,MailFrom,MailSubject,MailContent)
On Error Resume next
dim MailHost
MailHost=sysMailHost
Dim Mailer
Dim MailTo
Dim MailAddress
Set Mailer=server.CreateObject("JMail.Message")
Mailer.From=MailFrom
Mailer.FromName = "亿览网"
Mailer.mailserverusername=sysMailUser
Mailer.mailserverpassword=sysMailPwd
Mailer.Subject = MailSubject
Mailer.Charset = "gb2312"
Mailer.AppendHTML MailContent
if MailToList="" or isnull(MailToList) then
exit sub
end if
MailTo=split(MailToList,",")
for each MailAddress in MailTo
if MailAddress<>"" then
Mailer.AddRecipient MailAddress
end if
next
Mailer.Send(MailHost)
Mailer.Close()
set mailer=nothing
end sub
' 通用通用工具类相关函数
'******************************************************************
' 通用页面元素显示函数
' 最后修改时间：2003-03-20
'******************************************************************
'1、Sub CommonSelect(idname,liststr,valuestr,selectstr) '通用的实现