ASP函数库9

 '函数ID：0043[解密字符加解密]
  '函数名：exmw
  '作 用：解密字符加解密
  '参 数：nmw ---- 加密的字符
  '返回值：解密加密后的字符
  '示 例：
  '**************************************************
  Public Function exmw(ByVal nmw)
   exmw=""
   On Error GoTo 0
   On Error Resume Next
   Dim keya,keyb,newStr,temp
   nmw=DecodeCookie(nmw)
   keya=Mid(nmw,2,1)
   keyb=Mid(nmw,1,1)
   bLowChr=ChrB(AscB(MidB(keya, 1, 1)) Xor 128)
   bHigChr=ChrB(AscB(MidB(keya, 2, 1)) Xor 18)
   keya=bLowChr & bHigChr
   bLowChr=ChrB(AscB(MidB(keyb, 1, 1)) Xor 100)
   bHigChr=ChrB(AscB(MidB(keyb, 2, 1)) Xor 20)
   keyb=bLowChr & bHigChr
   Str=StrReverse(Mid(nmw,3,len(nmw)))
   newStr=""
   temp=""
   For i=1 to len(Str)
   temp=Mid(Str,i,1)
   bLowChr=AscB(MidB(temp, 1, 1)) Xor asc(keya)
   bHigChr=AscB(MidB(temp, 2, 1)) Xor asc(keyb)
   newStr=newStr & ChrB(bLowChr) & ChrB(bHigChr)
   Next
   If Err.Number = 0 Then
   exmw=newStr
   End If
   On Error GoTo 0
  End Function
  '**************************************************
  '函数ID：0044[创建数据表]
  '函数名：CreatTable
  '作 用：创建数据表
  '参 数：ConnStrs ---- 数据库链接字串
  '参 数：Tabnamestr ---- 数据表名称
  '参 数：CvArrstr ---- 字段表 (写法： Fname1#Type#Len#Defvalue|Fname1#Type#Len#Defvalue|...) 最后一个不要写“|”
  '参 数：SqlType ---- Sql语句类型 (0 Access 1 Mssqlserver)
  ' Fname,Type,Len,Defvalue 说明：字段名称,字段类型,字段长度,默认值
  '字段类型 Type C/c 字符 T/t 文本 I/i 二进制 D/d 日期 M/m 关键字(字符型) A/a 关键字自动编号(数值型) N/n 数值(float) Z/z 数值(int)
  '返回值：如果建立成功返回 True 否则 False
  '示 例：CreatTable(basicDB(3),"cs","fa#t##|fb#c#20#a|fc#n##5",0)
  '**************************************************
  Public Function CreatTable(ByVal ConnStrs,ByVal Tabnamestr,ByVal CvArrstr,ByVal SqlType)
   CreatTable=False
   On Error GoTo 0
   On Error Resume Next
   Dim filsarry,NeFilarry,Filstr,spfstr,templx,def_kh_l,def_kh_r,TempSqlStr
   def_kh_l=""
   def_kh_r=""
   Filstr=""
   spfstr=""
   TempSqlStr=""
   filsarry=Split(CvArrstr,"|")
   For ai = LBound(filsarry) To UBound(filsarry)
   NeFilarry=Split(filsarry(ai),"#")
   templx=""
   If UCase(NeFilarry(1))="C" Then templx="varchar(" & NeFilarry(2) & ")"
   If UCase(NeFilarry(1))="T" Then templx="TEXT"
   If UCase(NeFilarry(1))="I" Then templx="image"
   If UCase(NeFilarry(1))="D" Then templx="datetime"
   If UCase(NeFilarry(1))="M" Then templx="varchar(" & NeFilarry(2) & ") NOT NULL PRIMARY KEY"
   If UCase(NeFilarry(1))="A" Then templx="Int IDENTITY (1,1) NOT NULL PRIMARY KEY"
   If UCase(NeFilarry(1))="N" Then templx="Float"
   If UCase(NeFilarry(1))="Z" Then templx="Int"
   If SqlType =1 Then
   def_kh_l="('"
   def_kh_r="')"
   End If
   If Trim(NeFilarry(3))<>"" Then templx=templx &" DEFAULT " & def_kh_l & Trim(NeFilarry(3)) & def_kh_r
   If ai<>UBound(filsarry) Then
   spfstr= spfstr & "[" & NeFilarry(0) & "] " & templx &","
   Else
   spfstr= spfstr & "[" & NeFilarry(0) & "] " & templx
   End If
   Next
   TempSqlStr="CREATE TABLE ["&Trim(Tabnamestr)&"] (" & spfstr & ")"
   set fu_Conn=server.createobject("ADODB.Connection")
   fu_Conn.open ConnStrs
   fu_Conn.Execute TempSqlStr
   fu_Conn.Close
   Set fu_Conn=Nothing
   If Err.Number = 0 Then
   CreatTable=True
   End If
   On Error GoTo 0
  End Function
  '**************************************************
  '函数ID：0045[在数据库中插入字段值]
  '函数名：InterTbValue
  '作 用：创建数据表
  '参 数：ConnStrs ---- 数据库链接字串
  '参 数：Tabnamestr ---- 数据表名称
  '参 数：CvArrstr ---- 字段表 (写法： Fname1#Value|Fname2#Value|...) 最后一个不要写“|”
  '参 数：SqlType ---- Sql语句类型 (0 Access 1 Mssqlserver)
  ' Fname,Value 说明：字段名称,字段值
  '返回值：如果插入成功返回 True 否则 False
  '示 例：InterTbValue(basicDB(3),"cs","fa#t|fb#c|fc#n#")
  '**************************************************
  Public Function InterTbValue(ByVal ConnStrs,ByVal Tabnamestr,ByVal CvArrstr,ByVal SqlType)
   InterTbValue=False
   On Error GoTo 0
   On Error Resume Next
   Dim def_kh_l,def_kh_r,Filarray,Valuearray,Temparraya,Temparrayb,TempSqlStr1
   def_kh_l =""
   def_kh_r =""
   Temparraya=Split(CvArrstr,"|")
   For fai = LBound(Temparraya) To UBound(Temparraya)
   Temparrayb=Split(Temparraya(fai),"#")
   If (fai<> UBound(Temparraya)) Then
   Filarray =Filarray & "[" & Temparrayb(0) & "],"
   Valuearray=Valuearray & "'" & Temparrayb(1) & "',"
   Else
   Filarray =Filarray & "[" & Temparrayb(0) & "]"
   Valuearray=Valuearray & "'" & Temparrayb(1) & "'"
   End If
   Next
   TempSqlStr1="INSERT INTO [" & Tabnamestr & "] (" & Filarray & ") VALUES (" & Valuearray & ")"
   set fu1_Conn=server.createobject("ADODB.Connection")
   fu1_Conn.open ConnStrs
   fu1_Conn.Execute TempSqlStr1
   fu1_Conn.Close
   Set fu1_Conn=Nothing
   If Err.Number = 0 Then
   InterTbValue=True
   End If
   On Error GoTo 0
  End Function
  '**************************************************
  '函数ID：0046[Cookie防乱码写入时用]
  '函数名：CodeCookie
  '作 用：Cookie防乱码写入时用
  '参 数：str ---- 字符串
  '返回值：整理后的字符串
  '示 例：
  '**************************************************
  Public Function CodeCookie(str)
   If isNumeric(str) Then str=Cstr(str)
   Dim newstr
   newstr=""
   For i=1 To Len(str)
   newstr=newstr & ascw(mid(str,i,1))
   If i<> Len(str) Then newstr= newstr & "a"
   Next
   CodeCookie=newstr
  End Function
  '**************************************************
  '函数ID：0047[Cookie防乱码读出时用]
  '函数名：DecodeCookie
  '作 用：Cookie防乱码读出时用
  '参 数：str ---- 字符串
  '返回值：整理后的字符串
  '示 例：
  '**************************************************
  Public Function DecodeCookie(str)
   DecodeCookie=""
   Dim newstr
   newstr=Split(str,"a")
   For i = LBound(newstr) To UBound(newstr)
   DecodeCookie= DecodeCookie & chrw(newstr(i))
   Next
  End Function
  '**************************************************
  '函数ID：0048[检测用户名和密码是否正确]
  '函数名：DecodeCookie
  '作 用：检测用户名和密码是否正确
  '参 数：ConnStrs ---- 数据库链接字串
  '参 数：Tabnamestr ---- 数据表名称
  '参 数：Tumc ---- 用户名称字段名称
  '参 数：Cumc ---- 用户名称
  '参 数：TCumm ---- 用户密码字段名称
  '参 数：Cumm ---- 用户密码
  '参 数：TUid ---- 用户ID（标识）字段名称
  '返回值：检测成功返回 用户ID 否则 空字符串
  '示 例：
  '**************************************************
  Public Function CKUSMCMM(ByVal ConnStrs,ByVal Tabnamestr,ByVal Tumc,ByVal Cumc,ByVal Tumm,ByVal Cumm,ByVal TUid)
   CKUSMCMM=""
   On Error GoTo 0
   On Error Resume Next
   Set sfu_Conn=server.createobject("ADODB.Connection")
   Set sfu_Rs =server.createobject("ADODB.Recordset")
   sfu_Conn.open ConnStrs
   sfu_sql_str="select " & TUid & "," & Tumc & "," & Tumm & " from " & Tabnamestr
   sfu_Rs.open sfu_sql_str,sfu_Conn,1,1
   If sfu_Rs.RecordCount >0 Then
   Do While Not sfu_Rs.Eof
   If (sfu_Rs(Tumc)=Cumc) AND (exmw(sfu_Rs(Tumm))=Cumm) Then
   CKUSMCMM=sfu_Rs(TUid)
   Exit Do
   End If
   sfu_Rs.MoveNext
   Loop
   End If
   sfu_Rs.Close
   sfu_Conn.Close
   Set sfu_Rs = Nothing
   Set sfu_Conn=Nothing
   On Error GoTo 0
  End Function
  '**************************************************
  '函数ID：0049[生成时间的整数]
  '函数名：GetMyTimeNumber()
  '作 用：生成时间的整数
  '参 数：lx ---- 时间整数的类型
  ' lx=0 到分钟 lx=1 到小时 lx=2 到天 lx=3 到月
  '返回值：生成时间的整数值(最小到分钟)
  '示 例：
  '**************************************************
  Public Function GetMyTimeNumber(lx)
   If lx=0 Then GetMyTimeNumber=Year(Date)*12*30*24*60+Month(Date)*30*24*60+Day(Date)*24*60+Hour(Time)*60+Minute(Time)
   If lx=1 Then GetMyTimeNumber=Year(Date)*12*30*24+Month(Date)*30*24+Day(Date)*24+Hour(Time)
   If lx=2 Then GetMyTimeNumber=Year(Date)*12*30+Month(Date)*30+Day(Date)
   If lx=3 Then GetMyTimeNumber=Year(Date)*12+Month(Date)
  End Function
  '**************************************************
  '函数ID：0050[获得栏目的所有子栏目字符串并用","隔开]
  '函数名：GTLMfunLM
  '作 用：获得栏目的所有子栏目字符串并用","隔开
  '参 数：LMid ---- 栏目代码
  '参 数：ConnStrArray ---- 栏目数据链接串
  '返回值：子栏目字符串并用","隔开
  '示 例：hh="数据表链接字串|父栏目字段名|栏目字段名|表名"
  '示 例：GTLMfunLM(22,basicDB(3) & "|FTitId|TitId|TITS")
  '**************************************************
  Public Function GTLMfunLM(ByVal LMid,ByVal ConnStrArray)
   Dim LMstrxx,zdbz,Nlm
   zdbz=False
   LMstrxx=""
   aTempstr=GTLMfunLM_whil(LMid,ConnStrArray)
   LMstrxx=LMstrxx & aTempstr
   If InStrRev(aTempstr,",") > 0 Then
   Do While Not zdbz
   bTempstr=GTLMfunLM_Fj(aTempstr,ConnStrArray)
   LMstrxx=LMstrxx & bTempstr
   If bTempstr="" Then zdbz=True
   aTempstr=bTempstr
   Loop
   Else
   LMstrxx=aTempstr
   End If
   LMstrxx=Trim(LMstrxx)
   If LMstrxx<>"" Then If Mid(LMstrxx,Len(LMstrxx),1) = "," Then LMstrxx=Mid(LMstrxx,1,Len(LMstrxx)-1)
   GTLMfunLM=LMstrxx
  End Function
  Public Function GTLMfunLM_whil(ByVal LMidstr,ByVal ConnStrArray)
   ppTemp=Split(ConnStrArray,"|")
   GTLMfunLM_whil=""
   Set telm_Conn=server.createobject("ADODB.Connection")
   Set telm_Rs =server.createobject("ADODB.Recordset")
   telm_Conn.open ppTemp(0)
   telm_sql_str="SELECT " & ppTemp(1) & "," & ppTemp(2) & " FROM " & ppTemp(3) & " WHERE (" & ppTemp(1) & "='" & LMidstr & "')"
   telm_Rs.open telm_sql_str,telm_Conn,1,1
   If telm_Rs.RecordCount >0 Then
   Do While Not telm_Rs.Eof
   GTLMfunLM_whil=GTLMfunLM_whil & Trim(telm_Rs(ppTemp(2))) & ","
   telm_Rs.MoveNext
   Loop
   End If
   telm_Rs.Close
   telm_Conn.Close
   Set telm_Rs = Nothing
   Set telm_Conn=Nothing
  End Function
  Public Function GTLMfunLM_Fj(ByVal str,ByVal ConnStrArray)
   Dim templjid
   templjid=""
   If Trim(str)<>"" Then
   fjTemp=Split(str,",")
   For i = LBound(fjTemp) To UBound(fjTemp)
   If Trim(fjTemp(i))<>"" Then
   templjid=templjid & GTLMfunLM_whil(fjTemp(i),ConnStrArray)
   End If
   Next
   End If
   GTLMfunLM_Fj=templjid
  End Function
  
  %>