定义字符

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Dim rp As Response
Dim rq As Request
Dim ap As Application
Dim sr As Server
Dim sn As Session

Public Sub OnStartPage(MyScriptingContext As ScriptingContext)
Set rp = MyScriptingContext.Response
Set rq = MyScriptingContext.Request
Set sr = MyScriptingContext.Server
Set ap = MyScriptingContext.Application
Set sn = MyScriptingContext.Session
End Sub

Public Sub OnEndPage()
Set rp = Nothing
Set rq = Nothing
Set sr = Nothing
Set ap = Nothing
Set sn = Nothing
End Sub
'以上语句是必须的,将原本的对象作了简化处理,并在两个基本函数中作了处理

Public Function ConnectDB() As Variant
ConnectDB = "driver={Microsoft Access Driver (*.mdb)};uid=;pwd=123;DBQ="
End Function
'上面这个函数是处理前半部分字符串的,直接返回这个字符串的内容

'另外定义下面这个函数来处理后半部分内容
Public Function DBPath() As Variant
DBPath = sr.MapPath("DB.asp")
End Function
'注意上面使用的是sr,不要使用成Server了








'''''''''''''''''''''''''''''''''''''''''''
封装conn





VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "conn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Dim Response As Response
Dim Request As Request
Dim Application As Application
Dim Server As Server
Dim Session As Session


Public Sub OnStartPage(MyScriptingContext As ScriptingContext)
Set Response = MyScriptingContext.Response
Set Request = MyScriptingContext.Request
Set Server = MyScriptingContext.Server
Set Application = MyScriptingContext.Application
Set Session = MyScriptingContext.Session
End Sub

Public Sub OnEndPage()
Set Response = Nothing
Set Request = Nothing
Set Server = Nothing
Set Application = Nothing
Set Session = Nothing
End Sub
'以上语句是必须的,将原本的对象作了简化处理,并在两个基本函数中作了处理

Public Function hainanlive() As Connection
    Set cn = Server.CreateObject("adodb.connection")
    strcon = "Provider = Sqloledb; User ID = sq_hainanlive; Password = tel51015977; Initial Catalog = sq_hainanlive; Data Source = .;"
    cn.Open strcon
    Set hainanlive = cn
End Function

Public Function eArticle() As Connection
    Set cn = Server.CreateObject("adodb.connection")
    strcon = "Provider = Sqloledb; User ID = sq_earticle; Password = tel51015977; Initial Catalog = sq_earticle; Data Source = .;"
    cn.Open strcon
    Set eArticle = cn
End Function

Public Function hnfcbbs() As Connection
    Set cn = Server.CreateObject("adodb.connection")
    strcon = "Provider = Sqloledb; User ID = sq_hnfcbbs; Password = bbs51015977; Initial Catalog = sq_hnfcbbs; Data Source = .;"
    cn.Open strcon
    Set hnfcbbs = cn
End Function

Public Function hctrip() As Connection
    Set cn = Server.CreateObject("adodb.connection")
    strcon = "Provider = Sqloledb; User ID = sq_917hainan; Password = hctrip8008208006; Initial Catalog = sq_917hainan; Data Source = .;"
    cn.Open strcon
    Set hctrip = cn
End Function

Public Function hctripbbs() As Connection
    Set cn = Server.CreateObject("adodb.connection")
    strcon = "Provider = Sqloledb; User ID = sq_hctripbbs; Password = bbs34140800; Initial Catalog = sq_hctripbbs; Data Source = .;"
    cn.Open strcon
    Set hctripbbs = cn
End Function




'''''''''''''''''''''''''''''''''''''''''''

<%

Dim db
set db=Server.CreateObject("db.conn")
set rs=server.createobject("adodb.recordset")
sql = "select top 1 * from hCity order by hcID "
rs.open sql,db.conn,1,1
response.Write rs(0)&"|"&rs(1)&"|"&rs(2)&"|"&rs(3)
rs.close
set rs=nothing
set conn=Nothing

%>












''''''''''''''''''''''''''''''''''''''''''''''''
封装记录集

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Dim Response As Response
Dim Request As Request
Dim Application As Application
Dim Server As Server
Dim Session As Session

Public Sub OnStartPage(MyScriptingContext As ScriptingContext)
Set Response = MyScriptingContext.Response
Set Request = MyScriptingContext.Request
Set Server = MyScriptingContext.Server
Set Application = MyScriptingContext.Application
Set Session = MyScriptingContext.Session
End Sub

Public Sub OnEndPage()
Set Response = Nothing
Set Request = Nothing
Set Server = Nothing
Set Application = Nothing
Set Session = Nothing
End Sub
'以上语句是必须的,将原本的对象作了简化处理,并在两个基本函数中作了处理

Public Function ConnectDB() As Variant
ConnectDB = "driver={Microsoft Access Driver (*.mdb)};uid=;pwd=123;DBQ="
End Function
'上面这个函数是处理前半部分字符串的,直接返回这个字符串的内容

'另外定义下面这个函数来处理后半部分内容
Public Function DBPath() As Variant
DBPath = Server.MapPath("DB.asp")
End Function
'注意上面使用的是Server,不要使用成Server了




Public Sub dblist()
On Error GoTo err
Set conn = Server.CreateObject("adodb.connection")
strcon = "Provider = Sqloledb; User ID = sa; Password = huang2ma@!#$%sgxd3df; Initial Catalog = ss221; Data Source = (local);"
conn.Open strcon
Set rs = Server.CreateObject("adodb.recordset")
sql = "select * from china_city"
rs.Open sql, conn, 1, 1
Response.Write "<html>" & vbCrLf
Response.Write "<head>" & vbCrLf
Response.Write "<meta http-equiv=""content-type"" content=""text/html; charset=gb2312"">" & vbCrLf
Response.Write "<title>文章管理系统-csstudio</title>" & vbCrLf
Response.Write "</head>" & vbCrLf
Response.Write "<body bgcolor=""#ffffff"" topmargin=""0"">" & vbCrLf
Response.Write "<table width=""100%"" border=""0"" cellpadding=""2"" cellspacing=""0"">" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td width=""742"" height=""20"">文章标题</td>" & vbCrLf
Response.Write " <td width=""90"">点击</td>" & vbCrLf
Response.Write " <td width=""145"">添加日期</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
While Not rs.EOF And rows < rs.PageSize
Response.Write "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td width=""747"" height=""20"">☆<a href=""view.asp?id="
Response.Write rs("cityid")
Response.Write """>" & vbCrLf
Response.Write " "
Response.Write rs("oneid")
Response.Write "</a></td>" & vbCrLf
Response.Write " <td width=""94"">"
Response.Write rs("twoid")
Response.Write "</td>" & vbCrLf
Response.Write " <td width=""148"">"
Response.Write rs("typename")
Response.Write "</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
rs.MoveNext
Wend
Response.Write "</body>" & vbCrLf
Response.Write "</html>" & vbCrLf
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
Exit Sub
err:
If err.Number = -13572468 Then Exit Sub
Resume Next
End Sub




Public Sub dblist1()
Set conn = Server.CreateObject("adodb.connection")
strcon = "Provider = Sqloledb; User ID = sa; Password = huang2ma@!#$%sgxd3df; Initial Catalog = ss221; Data Source = (local);"
conn.Open strcon
Set rs = Server.CreateObject("adodb.recordset")
sql = "select cityid,cityname from china_city order by cityid"
rs.Open sql, conn, 1, 1
Response.Write "<table border=""0"" cellpadding=""2"" cellspacing=""0"">" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td width=""100"" height=""20"">ID</td>" & vbCrLf
Response.Write " <td width=""100"">名称</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
While Not rs.EOF And rows < rs.PageSize
Response.Write " <tr>" & vbCrLf
Response.Write " <td height=""20"">" & rs("cityid") & "</td>" & vbCrLf
Response.Write " <td >" & rs("cityname") & "</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
rs.MoveNext
Wend
Response.Write "</table>" & vbCrLf
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
Exit Sub
End Sub




Public Sub dblist2()
Set conn = Server.CreateObject("adodb.connection")
strcon = "Provider = Sqloledb; User ID = sa; Password = huang2ma@!#$%sgxd3df; Initial Catalog = ss221; Data Source = (local);"
conn.Open strcon
Set rs = Server.CreateObject("adodb.recordset")
sql = "select dataid,cd_title,cd_color,cd_bgcolor,cd_text,usernameid,username,cd_date from china_data where cd_isno=1 and DateDiff(day,cd_date,'" & Now() & "') < cd_date_stop order by cd_show_type desc,cd_date desc,dataid desc"

Dim listsum As Integer
Dim i As Integer
Dim ii As Integer
Dim title_color As String
Dim div_bgcolor As String
Dim a_link As String

listsum = 4 '每页显示条数
rs.Open sql, conn, 1, 1
If rs.RecordCount <> 0 Then
rs.PageSize = listsum
page = CLng(Request.QueryString("page"))
If page < 1 Then page = 1
If page > rs.PageCount Then page = rs.PageCount
show rs, page
Else
Response.Write "<div class=""listInfo""><h2></h2><p>暂时没有记录,等待系统更新</p><span></span></div>"
End If

If city_type = 11 Or city_type = 12 Or city_type = 13 Then
'call PageNum(page,rs.pagecount,"/type_one.asp?cityid="&cityid&"&citytwoid="&citytwoid&"&citythreeid="&citythreeid&"&typeid="&typeid&"&typetwoid="&typetwoid&"&typetthreeid="&typetthreeid&"&page=")
Else
'call PageNum1(page,rs.pagecount,"/type_one.asp?cityid="&cityid&"&citytwoid="&citytwoid&"&citythreeid="&citythreeid&"&typeid="&typeid&"&typetwoid="&typetwoid&"&typetthreeid="&typetthreeid&"&page=")
End If
For ii = 1 To rs.PageCount
Response.Write ii & " "
Next
Response.Write "<li>共" & rs.RecordCount & "条 " & page & "/" & rs.PageCount & "页</li>"
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
Exit Sub
End Sub


Sub show(rs, page)
rs.AbsolutePage = page
For i = 1 To rs.PageSize

If Len(Trim(rs("cd_color"))) = 7 Then
title_color = "<font color=""" & rs("cd_color") & """>" & rs("cd_title") & "</font>"
Else
title_color = rs("cd_title")
End If

If Len(Trim(rs("cd_bgcolor"))) = 7 Then
div_bgcolor = " style=""background-color:" & rs("cd_bgcolor") & ";"""
Else
div_bgcolor = ""
End If

a_link = rs("dataid") & ".html"


Response.Write "<div class=""listInfo"" " & div_bgcolor & ">"
Response.Write "<h2><a href=""" & a_link & """ target=""_blank"">" & title_color & "</a></h2>"
Response.Write "<p>" & rs("cd_text") & "</p><span>"

If Trim(rs("usernameid")) & "" <> "" Then
Response.Write "<a href=""/wo/?yonghu=" & Trim(rs("usernameid")) & """ target=""_blank"">"
Response.Write rs("username")
End If
If Trim(rs("usernameid")) & "" <> "" Then
Response.Write "</a>"
End If
Response.Write "<em>" & FormatDateTime(rs("cd_date"), 3) & "</em></span></div>"
rs.MoveNext
If rs.EOF Then Exit For
Next
Exit Sub
End Sub

''''''''''''''''''''''''''''''''''''

<%

Dim az
set az=Server.CreateObject("azdll.class1")
az.dblist2
set ConDB=Nothing

%>












''''''''''install.bat

echo off
echo 欢迎使用ConnDB接口系统!
echo 请确认您已经将新的DLL放置于本文件同一个目录
echo 本文件将自动引导我们通过以下几个过程来注册DLL组件
echo 在此期间,您可能需要多次点击确定。程序结束会自动关闭本窗口。
echo 一:复制Dll到系统目录
echo 二:注册Dll组件
copy hcdb.dll %windir%\system32
regsvr32 %windir%\system32\hcdb.dll







'''''''unstall.bat

net stop iisadmin /y
regsvr32/u %windir%\system32\db.dll
del %windir%\system32\db.dll
net start w3svc