global.bas

一个动易的组件源码,3.5的封装,本程序只是搜索部分,另本人己封装了动易3.5的组件,有源码,有意请联系我

Attribute VB_Name = "Global"
Public objContext As ObjectContext
Public Application As ASPTypeLibrary.Application
Public Server As ASPTypeLibrary.Server
Public Session As ASPTypeLibrary.Session
Public Response As ASPTypeLibrary.Response
Public Request As ASPTypeLibrary.Request
'----定义分页的属性
Public MaxPerPage '最大的分页
Public ShowSmallClassType
Public totalPut
Public TotalPages
Public CurrentPage


Public SkinID As Integer  '采用的皮肤
Public PageTitle As String '标题
'----定义所处位置
Public strPath As String
Public strPageTitle As String

Public SpecialName As String
Public ClassID
Public keyword As String
Public strField As String
Public sqlSearch As String
Public UserLevel As String
Public rsSearch As ADODB.Recordset
Public rsPic As ADODB.Recordset
Public Conn As ADODB.Connection '数据连接对像
Public ConnStr As String

Public sqlSpecial As String
Public sqlArticle As String
Public sqlUser As String

Public rsArticle As ADODB.Recordset
Public rsSpecial As ADODB.Recordset
Public rsUser As ADODB.Recordset


Public Const SiteName = "文章网"      '网站名称
Public Const SiteTitle = "文章网"       '网站标题
Public Const BannerUrl = "bannerurl"
Public Const WebmasterName = "abc"
Public Const WebmasterEmail = "[e-mail]"
Public Const Copyright = "copyright"
Public Const LogoUrl = "images/logo.gif"       'Logo地址
Public Const SiteUrl = ""
Public Const LayoutFileName_Index = "index2.asp"       '首页模板
Public Const ShowSiteChannel = "No"       '是否显示网站频道
Public Const ShowMyStyle = "Yes"       '是否显示自选风格
Public Const EnableArticleCheck = "Yes"       '是否启用文章审核功能
Public Const EnableUploadFile = "Yes"       '是否开放文件上传
Public Const EnableUserReg = "Yes"       '是否允许新用户注册
Public Const EmailCheckReg = "No"       '新用户注册是否需要邮件验证
Public Const AdminCheckReg = "Yes"       '新用户注册是否需要管理员认证
Public Const EnableLinkReg = "Yes"       '是否开放友情链接申请
Public Const PopAnnounce = "Yes"       '是否弹出公告窗口
Public Const HitsOfHot = 50       '热门文章点击数
Public Const SessionTimeout = 50       'Session会话的保持时间
Public Const MailObject = "Jmail"       '邮件发送组件
Public Const MailServer = "pop3.21cn.com"       '用来发送邮件的SMTP服务器
Public Const MailServerUserName = "[e-mail]"       '登录用户名
Public Const MailServerPassWord = "aaaa"       '登录密码
Public Const MailDomain = "asp163.net"       '域名
Public Const MaxFileSize = 200       '上传文件大小限制
Public Const SaveUpFilesPath = "UploadFiles"       '存放上传文件的目录
Public Const UpFileType = "rar|gif|jpg|bmp|asp|swf|exe|mid|mp3|"      '允许的上传文件类型
Public Const DelUpFiles = "Yes"      '删除文章时是否同时删除文章中的上传文件
Public Const ChannelID = 2



Public Power_Object As Object
Public Power_JScriptObject As MSScriptControl.ScriptControl
Public Sub Power_Initialize()
On Error Resume Next
    Set objContext = GetObjectContext
    Set Application = objContext.Item("Application")
    Set Server = objContext.Item("Server")
    Set Session = objContext.Item("Session")
    Set Request = objContext.Item("Request")
    Set Response = objContext.Item("Response")
    Set Power_JScriptObject = CreateObject("MSScriptControl.ScriptControl")
    Power_JScriptObject.Language = "JScript"
End Sub
Public Sub Power_Terminate()
On Error Resume Next
    SpecialName = ""
    keyword = ""
    strField = ""
    UserLevel = ""
    sqlSpecial = ""
    sqlArticle = ""
    sqlUser = ""
    sqlSearch = "" '把它置为零,
    Set Application = Nothing
    Set Server = Nothing
    Set Session = Nothing
    Set Request = Nothing
    Set Response = Nothing
    Set objContext = Nothing
    Set Power_JScriptObject = Nothing
End Sub
Public Function OpenDatabase()
  sConn = Application("conn")
  If IsObject(sConn) = False Or sConn = "" Or sConn = Empty Then
    ConnStr = "Provider=SQLOLEDB.1;Password='';Persist Security InFso=true;User ID='sa';Initial Catalog='book';Data Source='(local)'"
     Set Conn = New ADODB.Connection
       Conn.ConnectionString = ConnStr
       Conn.Open
       Application.Lock
       Set Application("conn") = Conn
       Application.UnLock
  Else

       Set Conn = Application("conn")
 End If
End Function
Public Sub Admin_ShowClass_Option(ShowType, CurrentID)
    If ShowType = 0 Then
        Response.Write "<option value='0'"
        If CurrentID = 0 Then Response.Write " selected"
        Response.Write ">无（作为一级栏目）</option>"
    End If
    Dim rsClass, sqlClass, strTemp, tmpDepth, i
    Dim arrShowLine(20)
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    sqlClass = "Select * From ArticleClass order by RootID,OrderID"
    Set rsClass = Server.CreateObject("adodb.recordset")
    rsClass.Open sqlClass, Conn, 1, 1
    If rsClass.BOF And rsClass.BOF Then
        Response.Write "<option value=''>请先添加栏目</option>"
    Else
        Dim UserLevel
        UserLevel = Request.Cookies("asp163")("UserLevel")
        If UserLevel = "" Then
            UserLevel = 5000
        Else
            UserLevel = CInt(UserLevel)
        End If
        Do While Not rsClass.EOF
            tmpDepth = rsClass("Depth")
            If rsClass("NextID") > 0 Then
                arrShowLine(tmpDepth) = True
            Else
                arrShowLine(tmpDepth) = False
            End If
            If ShowType = 2 Then
                If rsClass("LinkUrl") <> "" Then
                    strTemp = "<option value=''"
                Else
                    strTemp = "<option value='" & rsClass("ClassID") & "'"
                End If
            ElseIf ShowType = 3 Then
                If rsClass("Child") > 0 Then
                    strTemp = "<option value=''"
                ElseIf rsClass("LinkUrl") <> "" Then
                    strTemp = "<option value='0'"
                Else
                    strTemp = "<option value='" & rsClass("ClassID") & "'"
                End If
            ElseIf ShowType = 4 Then
                If rsClass("Child") > 0 Then
                    strTemp = "<option value=''"
                ElseIf rsClass("LinkUrl") <> "" Then
                    strTemp = "<option value='0'"
                ElseIf rsClass("AddPurview") < UserLevel Then
                    strTemp = "<option value='-1'"
                Else
                    strTemp = "<option value='" & rsClass("ClassID") & "'"
                End If
            Else
                strTemp = "<option value='" & rsClass("ClassID") & "'"
            End If
            If rsClass("ClassID") = CurrentID Then
                 strTemp = strTemp & " selected"
                 SkinID = rsClass("SkinID")
                 LayoutID = rsClass("LayoutID")
                 BrowsePurview = rsClass("BrowsePurview")
                 AddPurview = rsClass("AddPurview")
            End If
            strTemp = strTemp & ">"
            
            If tmpDepth > 0 Then
                For i = 1 To tmpDepth
                    strTemp = strTemp & "&nbsp;&nbsp;"
                    If i = tmpDepth Then
                        If rsClass("NextID") > 0 Then
                            strTemp = strTemp & "├&nbsp;"
                        Else
                            strTemp = strTemp & "└&nbsp;"
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            strTemp = strTemp & "│"
                        Else
                            strTemp = strTemp & "&nbsp;"
                        End If
                    End If
                Next
            End If
            strTemp = strTemp & rsClass("ClassName")
            If rsClass("LinkUrl") <> "" Then
                strTemp = strTemp & "(外)"
            End If
            If ShowType = 4 And rsClass("AddPurview") < UserLevel Then
                strTemp = strTemp & " *"
            End If
            strTemp = strTemp & "</option>"
            Response.Write strTemp
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
End Sub