dhfun.aspx.vb

本程序修改自飞天BBS 7.0 将原来的ASP语法迁移为ASP.NET并封装成DLL ASP.NET相对ASP有更快的执行效率以及更高的并发访问量 基于ASP.NET的DLL可以运行在支持ASP

            adnl = adnl & adstr '171
            adnl = adnl & "</td></tr></tbody></table>" '172
        ElseIf AspToAspX_CheckDBNull ( adtype ) = 3 Then '173
            adstr = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=" & ad_w & " height=" & ad_h & ">" '174
            adstr = adstr & "<param name=""movie"" value=" & adtitle & ">" '175
            adstr = adstr & "<param name=""quality"" value=""high"">" '176
            adstr = adstr & "<embed src=" & adtitle & " quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=" & ad_w & " height=" & ad_h & "></embed></object>" '177
            adnl = "<table cellspacing=0 cellpadding=0 width=""980"" align=center border=0><tbody><tr>" '178
            adnl = adnl & "<td height=" & ad_h + 10 & " width=120 align=""left""><a href=""/""><img src=""../images/tmlogo.gif"" width=""112"" height=""50""></a></td><td height=" & ad_h + 10 & " align=""right"">" '179
            adnl = adnl & adstr '180
            adnl = adnl & "</td></tr></tbody></table>" '181
        End If '182
        adnl = "document.write('" & adnl & "')" '183
    Else '184
        adstr = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""600"" height=""60"">" '185
        adstr = adstr & "<param name=""movie"" value=""../flashad/ftbbs600x60.swf"">" '186
        adstr = adstr & "<param name=""quality"" value=""high"">" '187
        adstr = adstr & "<embed src=""../flashad/ftbbs600x60.swf"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""600"" height=""60""></embed></object>" '188
        adnl = "<table cellspacing=0 cellpadding=0 width=""980"" align=center border=0><tbody><tr>" '189
        adnl = adnl & "<td height=70 width=120 align=""left""><a href=""/""><img src=""../images/tmlogo.gif"" width=""112"" height=""50""></a></td><td height=70 align=""right"">" '190
        adnl = adnl & adstr '191
        adnl = adnl & "</td></tr></tbody></table>" '192
        adnl = "document.write('" & adnl & "')" '193
    End If '194
    rs.Close ( ) '195
    bbsadurl = "../inc/htmtop.js" '196
    SaveToFile ( adnl , bbsadurl ) '197
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP htmtop:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP
Function ftbbshomead(ByRef  ft )
On Error GoTo _AspToAspX_Err
    Dim adtype
    Dim adtitle
    Dim adurl
    Dim ad_h
    Dim ad_w
    Dim adnl
    Dim bbsadurl
    sql = "select top 1 * from " & ft & "ftbbs_ad where adflag=0 and ad_p=1 and (adtype=2 or adtype=3) order by id desc" '200
    rs = New ADODB.Recordset ( ) '201
    rs.Open ( sql , conn , 3 , 1 ) '202
    If Not rs.EOF Then '203
        adtype = AspToAspX_CheckDBNull(rs.Fields ( "adtype" ) .Value) '204
        adtitle = AspToAspX_CheckDBNull(rs.Fields ( "adtitle" ) .Value) '205
        adurl = AspToAspX_CheckDBNull(rs.Fields ( "adurl" ) .Value) '206
        ad_h = AspToAspX_CheckDBNull(rs.Fields ( "ad_h" ) .Value) '207
        ad_w = AspToAspX_CheckDBNull(rs.Fields ( "ad_w" ) .Value) '208
        If AspToAspX_CheckDBNull ( adtype ) = 2 Then '209
            adnl = "<a href=" & adurl & " target=""_blank""><img src=" & adtitle & " width=" & ad_w & " height=" & ad_h & " border=""0"" /></a>" '210
        ElseIf AspToAspX_CheckDBNull ( adtype ) = 3 Then '211
            adnl = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=" & ad_w & " height=" & ad_h & ">" '212
            adnl = adnl & "<param name=""movie"" value=" & adtitle & ">" '213
            adnl = adnl & "<param name=""quality"" value=""high"">" '214
            adnl = adnl & "<embed src=" & adtitle & " quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=" & ad_w & " height=" & ad_h & "></embed></object>" '215
        End If '216
        adnl = "document.write('" & adnl & "')" '217
    Else '218
        adnl = "<a href=""" & adurl & """ target=""_blank""><img alt="""" src=""blogimages/825ad.gif"" width=""840"" height=""60"" border=""0"" /></a>" '219
        adnl = "document.write('" & adnl & "')" '220
    End If '221
    rs.Close ( ) '222
    bbsadurl = "../ftbbshomead.js" '223
    SaveToFile ( adnl , bbsadurl ) '224
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP ftbbshomead:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP
Function postad(ByRef  ft )
On Error GoTo _AspToAspX_Err
    Dim adtype
    Dim adtitle
    Dim adurl
    Dim ad_h
    Dim ad_w
    Dim adnl
    Dim bbsadurl
    sql = "select top 1 * from " & ft & "ftbbs_ad where adflag=0 and ad_p=3 and (adtype=2 or adtype=3) order by id desc" '227
    rs = New ADODB.Recordset ( ) '228
    rs.Open ( sql , conn , 3 , 1 ) '229
    If Not rs.EOF Then '230
        adtype = AspToAspX_CheckDBNull(rs.Fields ( "adtype" ) .Value) '231
        adtitle = "../" & AspToAspX_CheckDBNull(rs.Fields ( "adtitle" ) .Value) '232
        adurl = AspToAspX_CheckDBNull(rs.Fields ( "adurl" ) .Value) '233
        ad_h = AspToAspX_CheckDBNull(rs.Fields ( "ad_h" ) .Value) '234
        ad_w = AspToAspX_CheckDBNull(rs.Fields ( "ad_w" ) .Value) '235
        If AspToAspX_CheckDBNull ( adtype ) = 2 Then '236
            adnl = "<table align=""right""><tr><td align=""center"" valign=""top""><a href=" & adurl & " target=""_blank""><IMG src=" & adtitle & " width=" & ad_w & " height=" & ad_h & " border=""0""></a></td></tr></table>" '237
        ElseIf AspToAspX_CheckDBNull ( adtype ) = 3 Then '238
            adnl = "<table align=""right""><tr><td align=""center"" valign=""top""><object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=" & ad_w & " height=" & ad_h & ">" '239
            adnl = adnl & "<param name=""movie"" value=" & adtitle & ">" '240
            adnl = adnl & "<param name=""quality"" value=""high"">" '241
            adnl = adnl & "<embed src=" & adtitle & " quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=" & ad_w & " height=" & ad_h & "></embed></object></td></tr></table>" '242
        End If '243
        adnl = "document.write('" & adnl & "')" '244
    Else '245
        adnl = "" '246
        adnl = "document.write('" & adnl & "')" '247
    End If '248
    rs.Close ( ) '249
    bbsadurl = "../postad.js" '250
    SaveToFile ( adnl , bbsadurl ) '251
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP postad:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP
Function indexad(ByRef  ft )
On Error GoTo _AspToAspX_Err
    Dim adtype
    Dim adtitle
    Dim adurl
    Dim ad_h
    Dim ad_w
    Dim adnl
    Dim bbsadurl
    sql = "select top 1 * from " & ft & "ftbbs_ad where adflag=0 and ad_p=4 and (adtype=2 or adtype=3) order by id desc" '254
    rs = New ADODB.Recordset ( ) '255
    rs.Open ( sql , conn , 3 , 1 ) '256
    If Not rs.EOF Then '257
        adtype = AspToAspX_CheckDBNull(rs.Fields ( "adtype" ) .Value) '258
        adtitle = AspToAspX_CheckDBNull(rs.Fields ( "adtitle" ) .Value) '259
        If AspToAspX_CheckDBNull ( InStr ( adtitle , "http://" ) ) > 0 Then '260
            adtitle = AspToAspX_CheckDBNull(rs.Fields ( "adtitle" ) .Value) '261
        End If '262
        adurl = AspToAspX_CheckDBNull(rs.Fields ( "adurl" ) .Value) '263
        ad_h = AspToAspX_CheckDBNull(rs.Fields ( "ad_h" ) .Value) '264
        ad_w = AspToAspX_CheckDBNull(rs.Fields ( "ad_w" ) .Value) '265
        If AspToAspX_CheckDBNull ( adtype ) = 2 Then '266
            adnl = "<a href=" & adurl & " target=""_blank""><img src=" & adtitle & " width=" & ad_w & " height=" & ad_h & " border=""0""></a>" '267
        ElseIf AspToAspX_CheckDBNull ( adtype ) = 3 Then '268
            adnl = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=" & ad_w & " height=" & ad_h & ">" '269
            adnl = adnl & "<param name=""movie"" value=" & adtitle & ">" '270
            adnl = adnl & "<param name=""quality"" value=""high"">" '271
            adnl = adnl & "<embed src=" & adtitle & " quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=" & ad_w & " height=" & ad_h & "></embed></object>" '272
        End If '273
        adnl = "document.write('" & adnl & "')" '274
    Else '275
        adnl = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""600"" height=""60"">" '276
        adnl = adnl & "<param name=""movie"" value=""../flashad/ftbbs600x60.swf"">" '277
        adnl = adnl & "<param name=""quality"" value=""high"">" '278
        adnl = adnl & "<embed src=""../flashad/ftbbs600x60.swf"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""600"" height=""60""></embed></object>" '279
        adnl = "document.write('" & adnl & "')" '280
    End If '281
    rs.Close ( ) '282
    bbsadurl = "../indexad.js" '283
    SaveToFile ( adnl , bbsadurl ) '284
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\ADMIN\DHFUN.ASP indexad:" & Err.Description)
    Resume Next
End Function
#Region "..."
    Public Property conn
        Get
            On Error Resume Next
            conn = AspToAspX_Host_Class_Object.conn
            If Err.Number = 438 Then
                Err.Clear
                conn = _aspx_conn
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.conn = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_conn = value
            End If
        End Set
    End Property
    Public Property sql
        Get
            On Error Resume Next
            sql = AspToAspX_Host_Class_Object.sql
            If Err.Number = 438 Then
                Err.Clear
                sql = _aspx_sql
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.sql = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_sql = value
            End If
        End Set
    End Property
    Public Property rs
        Get
            On Error Resume Next
            rs = AspToAspX_Host_Class_Object.rs
            If Err.Number = 438 Then
                Err.Clear
                rs = _aspx_rs
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.rs = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_rs = value
            End If
        End Set
    End Property
    Public Property ft
        Get
            On Error Resume Next
            ft = AspToAspX_Host_Class_Object.ft
            If Err.Number = 438 Then
                Err.Clear
                ft = _aspx_ft
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.ft = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_ft = value
            End If
        End Set
    End Property
    Public Property i
        Get
            On Error Resume Next
            i = AspToAspX_Host_Class_Object.i
            If Err.Number = 438 Then
                Err.Clear
                i = _aspx_i
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.i = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_i = value
            End If
        End Set
    End Property
    Public Property AspToAspX_Str
        Get
            On Error Resume Next
            AspToAspX_Str = AspToAspX_Host_Class_Object.AspToAspX_Str
            If Err.Number = 438 Then
                Err.Clear
                AspToAspX_Str = _aspx_AspToAspX_Str
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.AspToAspX_Str = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_AspToAspX_Str = value
            End If
        End Set
    End Property
    Public Sub SaveToFile( ByVal strBody,ByVal File )
        AspToAspX_Host_Class_Object.SaveToFile( strBody, File )
    End Sub

#End Region
End Class