cls.db.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<%
Class Cls_DB
'i  WRDB
   Private iRs,iKey,iClass,iParentPath,iI,i_UserFlag,i_Flag,iSql,iIntro,iTags,iTag,iXML
   
   Private Sub Class_Initialize()
     If IsObject(Conn) = False Then Call DBConnBegin()
	 Set iRs = Server.CreateObject("ADODB.Recordset")
   End Sub
   Private Sub Class_Terminate()
     Set iRs = Nothing
   End Sub
   
   '======================================
   '获取分类名称
   'iTableName 表名
   '======================================
   Function GetClassName(iTableName,iID)
     If iID < 1 Then GetClassName = WR_Area(0):Exit Function
	 Set iRs = Conn.Execute("Select WM_Name from "&iTableName&" Where WM_id="&iID)
	 If Not iRs.Eof Then
	   GetClassName = iRs(0)
	 End If
	 iRs.Close
   End Function
   '======================================
   '地区提取函数：GetAreaSort
   'IsNUllSelect 是否显示一个空的选项,0不，1要，2添加一个当前城市
   'IsDredge：是否只显示开通分站城市 1为是 0为否
   'Num：对应值，如果此值与列表中一个对应，则为selected
   'FormName：表单名
   '======================================
   Function GetAreaSort(IsNUllSelect,IsDredge,Num,FormName)
     GetAreaSort = "<select name="&FormName&">" & vbCrLf
	 Select Case IsNUllSelect
	   Case 1
	     GetAreaSort = GetAreaSort & "<option value=''></option>" & vbCrLf
	   Case 2
	     GetAreaSort = GetAreaSort & "<option value='-1'"&WRMPS.GetCheckVer(-1,Int(Num),0)&">当前城市</option>" & vbCrLf
	 End Select
     If IsDredge > 0 Then
 	   GetAreaSort = GetAreaSort & "<option value=0"&WRMPS.GetCheckVer(0,Int(Num),0)&">"&WR_Area(0)&"</option>" & vbCrLf
	   iKey = " Where WM_Key=1"
	 Else
	   iKey = ""
	 End If
	  Set iRs = Conn.Execute("Select WM_Name,WM_ID from WM_Area"&iKey&" Order By WM_ClassID,WM_Taxis")
      Do While Not iRs.Eof
        GetAreaSort = GetAreaSort & "<option value="&iRs(1)&""&WRMPS.GetCheckVer(Int(iRs(1)),Int(Num),0)&">"&iRs(0)&"</option>" & vbCrLf
	  iRs.Movenext
	  Loop
	  iRs.Close
     GetAreaSort = GetAreaSort & "</select>" & vbCrLf
   End Function
    
   '======================================
   '按ID调其子ID
   'iTableName 表名
   '======================================
   Function GetChildClass(iID,iTableName)
       iParentPath="":GetChildClass="":iClass=""
       If Instr(iID,"|") = 0 Then
	     Set iRs = Conn.Execute("Select WM_ParentPath,WM_ID from "&iTableName&" where WM_ParentID > 0")
	       Do While not iRs.Eof
		    If Instr(","&iRs(0)&",",","&iID&",") Then
			  If iClass = "" Then iClass=iRs(1) Else iClass=iClass&","&iRs(1)
			End If
	       iRs.MoveNext
	       Loop
	     iRs.Close
	   Else
	     iID = Replace(iID,"|",",")
	   End If
	   If iClass <> "" Then GetChildClass = iID&","&iClass Else GetChildClass = iID
   End Function
   
   '======================================
   'Message 短消息发送
   'iAddressee 收件人  iAddresser 发件人
   '======================================
   Function SendMessage(iAddressee,iAddresser,iTitle,iMessage)
     Dim imessageCount,iType
     SendMessage = False
	 If iAddressee = iAddresser Or Int(WR_Mail(17)) < 1 Then Exit Function
     If iAddressee = "" Or IsNUll(iAddressee) Then iAddressee = Null
	 If iAddresser = "" Or IsNUll(iAddresser) Then iAddresser = Null:iType = 1 Else iType = 0
     If iAddressee <> "" and IsNull(iAddressee) = False Then
	   Set iRs = Conn.Execute("Select WM_Message From WM_Member Where WM_UserName = '"&iAddressee&"'")
	   If Not iRs.Eof Then
	     imessageCount = iRs(0)
	     imessageCount = Int(Split(imessageCount,"|")(0))+1&"|"&Int(Split(imessageCount,"|")(1))+1
	     Conn.Execute("Update WM_Member Set WM_Message = '"&imessageCount&"' Where WM_UserName = '"&iAddressee&"'")
	   Else
	     Exit Function
	   End If
	   iRs.Close
	 End If
	 Conn.Execute("insert into WM_Message(WM_Addresser,WM_Addressee,WM_Title,WM_Message,WM_Time,WM_Key,WM_Type)values('"&iAddresser&"','"&iAddressee&"', '"&iTitle&"', '"&iMessage&"',"&ConnTime&",0,"&iType&")")
	 SendMessage = True
   End Function
   
   '=====================================
   '用户账户明细操作：SaveConsume
   'aType：是否检查账户余额，1可以为负数，0不可以为负数
   'aUser：用户所属用户
   'aRemark：说明
   '=====================================
  Function SaveConsume(aType,aUser,aMoney,aCountOut,aIntegral,aFaith,aRemark)
     SaveConsume = False
	 If aMoney = "" Then aMoney = 0
	 If aCountOut = "" Then aCountOut = 0
	 If aIntegral = "" Then aIntegral = 0
	 If aFaith = "" Then aFaith = 0
	 If (aUser = "" Or IsNull(aUser)) Or (aMoney = 0 and aCountOut = 0 and aIntegral = 0 and aFaith = 0) Then SaveConsume = True:Exit Function
	 If Len(aRemark) > 50 Then aRemark = Left(aRemark,47) & "..."
	 Set iRs = Conn.Execute("Select WM_Money,WM_CountOut,WM_Integral,WM_Faith From WM_Member Where WM_UserName='"&aUser&"'")
     If Not iRs.Eof Then
	   If aType < 1 Then
	     If aMoney <> 0 Then If aMoney + iRs(0) < 0 Then Call WRMPS.ErrView("·账户余额不足！",0):Exit Function
	     If aCountOut <> 0 Then If aCountOut + iRs(1) < 0 Then Call WRMPS.ErrView("·账户"&WR_Other(0)&"不足！",0):Exit Function
	     If aIntegral <> 0 Then If aIntegral + iRs(2) < 0 Then Call WRMPS.ErrView("·账户积分不足！",0):Exit Function
	     If aFaith <> 0 Then If aFaith + iRs(3) < 0 Then Call WRMPS.ErrView("·账户信用不足！",0):Exit Function
	   End If
       If aMoney <> 0 Then
	     Conn.Execute ("Update WM_Member Set WM_Money = WM_Money + " & aMoney & " Where WM_UserName = '" & aUser & "'")
         Conn.Execute ("INSERT Into WM_ConsumeList(WM_User,WM_Type,WM_Note,WM_Time,WM_Remark)values('"&aUser&"',1,"&aMoney&","&ConnTime&",'"&aRemark&"')")
	     If MemID <> "" Then WRMPS.DelCookies "QianFeiMsg"
	   End If
       If aCountOut <> 0 Then
	     Conn.Execute ("Update WM_Member Set WM_CountOut = WM_CountOut + " & aCountOut & " Where WM_UserName = '" & aUser & "'")
         Conn.Execute ("INSERT Into WM_ConsumeList(WM_User,WM_Type,WM_Note,WM_Time,WM_Remark)values('"&aUser&"',2,"&aCountOut&","&ConnTime&",'"&aRemark&"')")
	     If MemID <> "" Then WRMPS.DelCookies "QianFeiMsg"
	   End If
       If aIntegral <> 0 Then
	     Conn.Execute ("Update WM_Member Set WM_Integral = WM_Integral + " & aIntegral & " Where WM_UserName = '" & aUser & "'")
         Conn.Execute ("INSERT Into WM_ConsumeList(WM_User,WM_Type,WM_Note,WM_Time,WM_Remark)values('"&aUser&"',3,"&aIntegral&","&ConnTime&",'"&aRemark&"')")
	   End If
       If aFaith <> 0 Then
	     Conn.Execute ("Update WM_Member Set WM_Faith = WM_Faith + " & aFaith & " Where WM_UserName = '" & aUser & "'")
         Conn.Execute ("INSERT Into WM_ConsumeList(WM_User,WM_Type,WM_Note,WM_Time,WM_Remark)values('"&aUser&"',4,"&aFaith&","&ConnTime&",'"&aRemark&"')")
	   End If
	 End If
	 iRs.Close
	 SaveConsume = True
  End Function
  '取得会员权限
  Function GetUserFlag(aUser)
	Set iRs = Conn.Execute("Select WM_Flag From WM_Member where WM_UserName = '"&aUser&"'")
	If Not iRs.Eof Then
	  GetUserFlag = iRs(0)
	  iRs.Close
	Else
	  iRs.Close
	  Set iRs = Conn.Execute("Select Top 1 WM_GroupFlag From WM_UserGroup Order By WM_ID")
	  i_UserFlag = iRs(0)
	  i_UserFlag = Split(i_UserFlag,"|")
	  For iI = 0 To UBound(i_UserFlag)
		If Instr(i_UserFlag(iI),"§") > 0 Then i_Flag = "0§0" Else i_Flag = "0"
	    If GetUserFlag = "" Then
		  GetUserFlag = i_Flag
		Else
		  GetUserFlag = GetUserFlag&"|"&i_Flag
		End If
	  Next
	End If
  End Function   
End Class
Set WRDB = New Cls_DB
%>