publicfun.aspx.vb

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

' ***************************************************
' *        本程序由AspToAspX风火轮0.99转换生成      *
' *        http://Www.AspToAspX.Cn                  *
' *        Q Q :  139227536                         *
' *        QQ群:  17152722                          *
' *        MSN :  [e-mail]        *
' *        EMail  [e-mail]              *
' ***************************************************
Imports Microsoft.VisualBasic
Imports System.Web
Imports System.Math
Imports System.Web.SessionState


Public Class _INC_PUBLICFUN

    Public AspToAspX_Host_Class_Object As Object

Public Const fso = "Scripting.FileSystemObject"
Dim _aspx_conn,_aspx_sql,_aspx_rs,_aspx_AspToAspX_Str,_aspx_ft,_aspx_tyname1,_aspx_tyvalue1,_aspx_tyname2,_aspx_tyvalue2,_aspx_wzrep,_aspx_wzpage,_aspx_wzcount,_aspx_userid,_aspx_tyname,_aspx_filename,_aspx_myFolder,_aspx_MypicFile,_aspx_nl,_aspx_pagenum
#Region "..."
    Public Sub AspToAspX_InitIncludeFiles()
    End Sub

    Public Sub AspToAspX_UnloadIncludeFiles()
    End Sub

#End Region
    Public Sub AspToAspX_Page_Init()
    On Error GoTo _AspToAspX_Err
    Response.Write ( vbCrLf )

        Exit Sub
    _AspToAspX_Err:
        AspToAspX_WriteLog ("publicfun_aspx Page_Init:" & Err.Description)
        Resume Next
        End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Public Function makefolder(ByRef  Folder,ByRef fso )
On Error GoTo _AspToAspX_Err
    Dim fileStreamObj
    myFolder = Server.MapPath ( Folder ) '10
    fileStreamObj = CreateObject ( fso ) '11
    If AspToAspX_CheckDBNull ( fileStreamObj.FolderExists ( myFolder ) ) = False Then '12
        fileStreamObj.CreateFolder ( myFolder ) '13
    End If '14
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP makefolder:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Public Function DelFile(ByRef  FileName,ByRef fso )
On Error GoTo _AspToAspX_Err
    mypicFile = Server.MapPath ( FileName ) '18
    fso = CreateObject ( fso ) '19
    If AspToAspX_CheckDBNull ( fso.FileExists ( mypicFile ) ) = True Then '20
        fso.DeleteFile ( mypicFile ) '21
    End If '22
    fso = Nothing '23
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP DelFile:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Public Function makehtml(ByRef  htmlurlname,ByRef fso,ByRef nl )
On Error GoTo _AspToAspX_Err
    SaveToFile ( nl , htmlurlname ) '27
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP makehtml:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function GetFolderSize(ByRef  FolderName,ByRef fso )
On Error GoTo _AspToAspX_Err
    Dim f
    myFolder = Server.MapPath ( FolderName ) '32
    fso = CreateObject ( fso ) '33
    If AspToAspX_CheckDBNull ( fso.FolderExists ( myFolder ) ) = True Then '34
        f = fso.GetFolder ( myFolder ) '35
        GetFolderSize = f.Size '36
    Else '37
        GetFolderSize = - 1 '38
    End If '39
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP GetFolderSize:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function ClearHTMLCode(ByRef  StrCode )
On Error GoTo _AspToAspX_Err
    Dim AspToAspX_Str
    AspToAspX_Str = New VBScript_RegExp_55.RegExp '44
    AspToAspX_Object.Str.Pattern = "<[^>]*>" '45
    AspToAspX_Object.Str.Global = true '46
    ClearHTMLCode = AspToAspX_Object.Str.Replace ( StrCode , "" ) '47
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP ClearHTMLCode:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function pagination(ByRef  pagecount,ByRef userid )
On Error GoTo _AspToAspX_Err
    Dim wzpage
    Dim wzpagecount
    Dim pagenum
    If AspToAspX_Len ( ( Request.QueryString ( "page" ) ) ) < > 0 Then '52
        wzpage = AspToAspX_CInt ( ( Request.QueryString ( "page" ) ) ) '53
    Else '54
        wzpage = 1 '55
    End If '56
    If AspToAspX_CheckDBNull ( wzpage ) < = 0 Then
wzpage = 1
End If
   '57
        pagenum = ( wzpage \ 10 ) * 10 + 1 '58
    If AspToAspX_CheckDBNull ( wzpage Mod 10 ) = 0 Then
pagenum = ( wzpage \ 10 ) * 10 - 9
End If
   '59
        If AspToAspX_CheckDBNull ( wzpage ) > 10 Then '60
            Response.Write ( "<font face=""webdings"">" ) '61
            Response.Write ( "<a href=""?page=1&userid=" & userid & """ title=""首页"">9</a> " ) '62
            Response.Write ( "<a href=""?page=" & pagenum - 1 & "&userid=" & userid & """ title=""前十页"">7</a> " ) '63
            Response.Write ( "</font>" ) '64
        End If '65
        For pagenum = pagenum To Val ( pagenum ) + 9 '66
            If AspToAspX_CheckDBNull ( pagenum ) = wzpage Then '67
                Response.Write ( "<font color=""#ff0000"">" ) '68
                Response.Write ( " [" & pagenum & "] " ) '69
                Response.Write ( "</font>" ) '70
            Else '71
                Response.Write ( " <a href=""?page=" & pagenum & "&userid=" & userid & """>" ) '72
                Response.Write ( "[" & pagenum & "]" ) '73
                Response.Write ( "</a> " ) '74
            End If '75
        If AspToAspX_CheckDBNull ( pagenum ) > = pagecount Then
Exit For
End If
   '76
        Next '77
        If AspToAspX_CheckDBNull ( wzpage ) < = ( pagecount - ( pagecount Mod 10 ) ) Then '78
            Response.Write ( "<font face=""webdings"">" ) '79
            Response.Write ( "<a href=""?page=" & pagenum & "&userid=" & userid & """  title=""后十页"">8</a> " ) '80
            Response.Write ( "<a href=""?page=" & pagecount & "&userid=" & userid & """  title=""末页"">:</a> " ) '81
            Response.Write ( "</font>" ) '82
        End If '83
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP pagination:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function SearchPage(ByRef  pagecount,ByRef tyname1,ByRef tyvalue1,ByRef tyname2,ByRef tyvalue2 )
On Error GoTo _AspToAspX_Err
    Dim wzpage
    Dim wzpagecount
    Dim pagenum
    If AspToAspX_Len ( ( Request.QueryString ( "page" ) ) ) < > 0 Then '88
        wzpage = AspToAspX_CInt ( ( Request.QueryString ( "page" ) ) ) '89
    Else '90
        wzpage = 1 '91
    End If '92
    If AspToAspX_CheckDBNull ( wzpage ) < = 0 Then
wzpage = 1
End If
   '93
        pagenum = ( wzpage \ 10 ) * 10 + 1 '94
    If AspToAspX_CheckDBNull ( wzpage Mod 10 ) = 0 Then
pagenum = ( wzpage \ 10 ) * 10 - 9
End If
   '95
        Response.Write ( "<table border=""0"" cellspacing=""0"" cellpadding=""0""><tr>" & vbCrLf ) '96
        Response.Write ( "<td width=""2""></td><td class=""intd"" title=""主题数"">&nbsp;" & wzcount & "&nbsp;</td>" & vbCrLf ) '97
        Response.Write ( "<td width=""2""></td><td class=""intd"" title=""当前页/总页数"">&nbsp;" & wzpage & "/" & pagecount & "&nbsp;</td>" & vbCrLf ) '98
        Response.Write ( "<td width=""2""></td><td class=""intd"" title=""每页主题数"">&nbsp;" & wzrep & "&nbsp;></td>" & vbCrLf ) '99
        If AspToAspX_CheckDBNull ( wzpage ) > 10 Then '100
            Response.Write ( "<td class=""outtd""><a href=""?page=1&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """ title=""首页""><img src=""images/first.gif"" border=""0""></a></td><td width=""2""></td>" & vbCrLf ) '101
            Response.Write ( "<td class=""outtd""><a href=""?page=" & pagenum - 1 & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """ title=""前十页""><img src=""images/previous.gif"" border=""0""></a></td>" & vbCrLf ) '102
        End If '103
        For pagenum = pagenum To Val ( pagenum ) + 9 '104
            If AspToAspX_CheckDBNull ( pagenum ) = wzpage Then '105
                Response.Write ( "<td width=""2""></td><td class=""intd"" title=""当前页"">" & pagenum & "</td>" & vbCrLf ) '106
            Else '107
                Response.Write ( " <td width=""2""></td><td class=""outtd"" onmouseover=""this.className='intd';"" onmouseout=""this.className='outtd';"">" ) '108
                Response.Write ( " <a href=""?page=" & pagenum & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """><div style=""width:100%"">" & pagenum & "</div></a></td>" & vbCrLf ) '109
            End If '110
        If AspToAspX_CheckDBNull ( pagenum ) > = pagecount Then
Exit For
End If
   '111
        Next '112
        If AspToAspX_CheckDBNull ( wzpage ) < = ( pagecount - ( pagecount Mod 10 ) ) Then '113
            Response.Write ( "<td width=""2""></td><td class=""outtd"" onmouseover=""this.className='outtd';"" onmouseout=""this.className='outtd';""><a href=""?page=" & pagenum & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """  title=""后十页""><img src=""images/next.gif"" border=""0""></a></td> " & vbCrLf ) '114
            Response.Write ( "<td width=""2""></td><td class=""outtd"" onmouseover=""this.className='outtd';"" onmouseout=""this.className='outtd';""><a href=""?page=" & pagecount & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """  title=""末页""><img src=""images/last.gif"" border=""0""></a></td>" & vbCrLf ) '115
        End If '116
        Response.Write ( " <td width=""2""></td><td><input class=""inputpage"" name=""page"" type=""text"" size=""3"" onKeyDown=""if(event.keyCode==13) {window.location='?" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & "&page='+this.value; return false;}""></td>" & vbCrLf ) '117
        Response.Write ( "</tr></table>" & vbCrLf ) '118
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP SearchPage:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function pagenar(ByRef  pagecount,ByRef userid,ByRef tyname,ByRef tyvalue )
On Error GoTo _AspToAspX_Err
    Dim wzpage
    Dim wzpagecount
    Dim pagenum
    If AspToAspX_Len ( ( Request.QueryString ( "page" ) ) ) < > 0 Then '123
        wzpage = AspToAspX_CInt ( ( Request.QueryString ( "page" ) ) ) '124
    Else '125
        wzpage = 1 '126
    End If '127
    If AspToAspX_CheckDBNull ( wzpage ) < = 0 Then
wzpage = 1
End If
   '128
        pagenum = ( wzpage \ 10 ) * 10 + 1 '129
    If AspToAspX_CheckDBNull ( wzpage Mod 10 ) = 0 Then
pagenum = ( wzpage \ 10 ) * 10 - 9
End If
   '130
        If AspToAspX_CheckDBNull ( wzpage ) > 10 Then '131
            Response.Write ( "<font face=""webdings"">" ) '132
            Response.Write ( "<a href=""?page=1&userid=" & userid & "&" & tyname & "=" & tyvalue & """ title=""首页"">9</a> " ) '133
            Response.Write ( "<a href=""?page=" & pagenum - 1 & "&userid=" & userid & "&" & tyname & "=" & tyvalue & """ title=""前十页"">7</a> " ) '134
            Response.Write ( "</font>" ) '135
        End If '136
        For pagenum = pagenum To Val ( pagenum ) + 9 '137
            If AspToAspX_CheckDBNull ( pagenum ) = wzpage Then '138
                Response.Write ( "<font color=""#ff0000"">" ) '139
                Response.Write ( " [" & pagenum & "] " ) '140
                Response.Write ( "</font>" ) '141
            Else '142
                Response.Write ( " <a href=""?page=" & pagenum & "&userid=" & userid & "&" & tyname & "=" & tyvalue & """>" ) '143
                Response.Write ( "[" & pagenum & "]" ) '144
                Response.Write ( "</a> " ) '145
            End If '146
        If AspToAspX_CheckDBNull ( pagenum ) > = pagecount Then
Exit For
End If
   '147
        Next '148
        If AspToAspX_CheckDBNull ( wzpage ) < = ( pagecount - ( pagecount Mod 10 ) ) Then '149
            Response.Write ( "<font face=""webdings"">" ) '150
            Response.Write ( "<a href=""?page=" & pagenum & "&userid=" & userid & "&" & tyname & "=" & tyvalue & """  title=""后十页"">8</a> " ) '151
            Response.Write ( "<a href=""?page=" & pagecount & "&userid=" & userid & "&" & tyname & "=" & tyvalue & """  title=""末页"">:</a> " ) '152
            Response.Write ( "</font>" ) '153
        End If '154
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP pagenar:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function FtbbsPage(ByRef  pagecount,ByRef tyname1,ByRef tyvalue1,ByRef tyname2,ByRef tyvalue2 )
On Error GoTo _AspToAspX_Err
    Dim wzpage
    Dim wzpagecount
    Dim pagenum
    If AspToAspX_Len ( ( Request.QueryString ( "page" ) ) ) < > 0 Then '159
        wzpage = AspToAspX_CInt ( ( Request.QueryString ( "page" ) ) ) '160
    Else '161
        wzpage = 1 '162
    End If '163
    If AspToAspX_CheckDBNull ( wzpage ) < = 0 Then
wzpage = 1
End If
   '164
        pagenum = ( wzpage \ 10 ) * 10 + 1 '165
    If AspToAspX_CheckDBNull ( wzpage Mod 10 ) = 0 Then
pagenum = ( wzpage \ 10 ) * 10 - 9
End If
   '166
        If AspToAspX_CheckDBNull ( wzpage ) > 10 Then '167
            Response.Write ( "<font face=""webdings"">" ) '168
            Response.Write ( "<a href=""?page=1&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """ title=""首页"">9</a> " ) '169
            Response.Write ( "<a href=""?page=" & pagenum - 1 & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """ title=""前十页"">7</a> " ) '170
            Response.Write ( "</font>" ) '171
        End If '172
        For pagenum = pagenum To Val ( pagenum ) + 9 '173
            If AspToAspX_CheckDBNull ( pagenum ) = wzpage Then '174
                Response.Write ( "<font color=""#ff0000"">" ) '175
                Response.Write ( " [" & pagenum & "] " ) '176
                Response.Write ( "</font>" ) '177
            Else '178
                Response.Write ( " <a href=""?page=" & pagenum & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """>" ) '179
                Response.Write ( "[" & pagenum & "]" ) '180
                Response.Write ( "</a> " ) '181
            End If '182
        If AspToAspX_CheckDBNull ( pagenum ) > = pagecount Then
Exit For
End If
   '183
        Next '184
        If AspToAspX_CheckDBNull ( wzpage ) < = ( pagecount - ( pagecount Mod 10 ) ) Then '185
            Response.Write ( "<font face=""webdings"">" ) '186
            Response.Write ( "<a href=""?page=" & pagenum & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """  title=""后十页"">8</a> " ) '187
            Response.Write ( "<a href=""?page=" & pagecount & "&" & tyname1 & "=" & tyvalue1 & "&" & tyname2 & "=" & tyvalue2 & """  title=""末页"">:</a> " ) '188
            Response.Write ( "</font>" ) '189
        End If '190
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP FtbbsPage:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP
Function makeadjs(ByRef  ft )
On Error GoTo _AspToAspX_Err
    Dim adjsmb
    Dim adjsmb1
    Dim adjsmbx
    Dim sql
    Dim adnum
    sql = "select * from " & ft & "ftbbs_ad where adflag=0 and adtype=0 order by id desc" '195
    rs = New ADODB.Recordset ( ) '196
    rs.Open ( sql , conn , 3 , 1 ) '197
    If Not rs.EOF Then '198
        adjsmb1 = "adshu = " & rs.RecordCount & vbCrLf '199
        adjsmb1 = adjsmb1 + "FtbbsAds = new Array();" & vbCrLf '200
        adjsmbx = "" '201
        For adnum = 1 To Val ( rs.RecordCount ) '202
            adjsmbx = adjsmbx + "FtbbsAds[" & adnum & "] = ""[广告]<font color=" & AspToAspX_CheckDBNull(rs.Fields ( "adcolor" ) .Value) & "><a href=" & AspToAspX_CheckDBNull(rs.Fields ( "adurl" ) .Value) & " target='_blank'>" & AspToAspX_CheckDBNull(rs.Fields ( "adtitle" ) .Value) & "</a></font>"";" & vbCrLf '203
            adjsmb = adjsmbx '204
            rs.MoveNext ( ) '205
        Next '206
        adjsmb = adjsmb + "ad = parseInt(Math.random() * adshu + 1);" & vbCrLf '207
        adjsmb = adjsmb + "document.write(FtbbsAds[ad]);" & vbCrLf '208
        makehtml ( "../ad.js" , fso , adjsmb1 & adjsmb ) '209
    End If '210
    rs.Close ( ) '211
    rs = Nothing '212
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\PUBLICFUN.ASP makeadjs:" & Err.Description)
    Resume Next
End Function
#Region "..."
    Public Property conn
        Get
            On Error Resume Next