📄 touxianfun.aspx.vb
字号:
' ***************************************************
' * 本程序由AspToAspX风火轮0.99转换生成 *
' * http://Www.AspToAspX.Cn *
' * Q Q : 139227536 *
' * QQ群: 17152722 *
' * MSN : gzliangjianhua@hotmail.com *
' * EMail AspToDll@vip.163.com *
' ***************************************************
Imports Microsoft.VisualBasic
Imports System.Web
Imports System.Math
Imports System.Web.SessionState
Public Class _TOUXIANFUN
Public AspToAspX_Host_Class_Object As Object
Dim _aspx_conn,_aspx_FileName,_aspx_url,_aspx_sql,_aspx_rs,_aspx_AspToAspX_Str,_aspx_ft,_aspx_cookiesname,_aspx_clubuser_id,_aspx_title,_aspx_jingyuan,_aspx_touxian,_aspx_jibie,_aspx_flag,_aspx_postuser,_aspx_topvalue
#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 ("touxianfun_aspx Page_Init:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function touxianvalue(ByRef jingyuan,ByRef ft )
On Error GoTo _AspToAspX_Err
Dim smt
sql = "SELECT * FROM " & ft & "ftbbs_touxian where xiao<" & jingyuan & " and da>" & jingyuan & "" '3
smt = New ADODB.Recordset ( ) '4
smt.Open ( sql , conn , 3 , 1 ) '5
If Not smt.EOF Then '6
touxian = AspToAspX_CheckDBNull(smt.Fields ( "nick" ) .Value) '7
Else '8
touxian = "土人" '9
End If '10
smt.Close ( ) '11
touxianvalue = touxian '12
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP touxianvalue:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function jibievalue(ByRef jingyuan,ByRef ft )
On Error GoTo _AspToAspX_Err
Dim sm
sql = "SELECT * FROM " & ft & "ftbbs_touxian where xiao<" & jingyuan & " and da>=" & jingyuan & "" '16
sm = New ADODB.Recordset ( ) '17
sm.Open ( sql , conn , 3 , 1 ) '18
If Not sm.EOF Then '19
jibie = "<img src=../" & AspToAspX_CheckDBNull(sm.Fields ( "classx" ) .Value) & " width=63 height=10>" '20
Else '21
jibie = "<img src=../userheadimg/class1.gif width=63 height=10>" '22
End If '23
sm.Close ( ) '24
jibievalue = jibie '25
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP jibievalue:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function jingyuantoqs(ByRef clubuser_id,ByRef topvalue,ByRef ft )
On Error GoTo _AspToAspX_Err
Dim toqs
If Not AspToAspX_CheckIsNumeric ( clubuser_id ) Then '29
Response.Write ( "用户ID错误" ) '30
Response.End ( ) '31
End If '32
sql = "select jingyuan from " & ft & "clubuser where clubuser_id=" & clubuser_id '33
rs = New ADODB.Recordset ( ) '34
rs.Open ( sql , conn , 1 , 1 ) '35
If Not rs.EOF Then '36
jingyuan = AspToAspX_CheckDBNull(rs.Fields ( "jingyuan" ) .Value) '37
Else '38
jingyuan = 0 '39
End If '40
rs.Close ( ) '41
If AspToAspX_CheckDBNull ( AspToAspX_CheckExpression ( jingyuan ) - AspToAspX_CheckExpression ( topvalue ) ) > 0 Then '42
toqs = 1 '43
If AspToAspX_CheckDBNull ( topvalue ) = 0 Then
toqs = 0
End If
'44
Else '45
toqs = 0 '46
End If '48
jingyuantoqs = toqs '49
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP jingyuantoqs:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function imgtourl(ByRef url,ByRef imgpath )
On Error GoTo _AspToAspX_Err
Dim Jpeg
If IsObjInstalled ( "Persits.Jpeg" ) Then '54
Jpeg = CreateObject ( "Persits.Jpeg" ) '55
Jpeg.RegKey = "48958-77556-02411" '56
Jpeg.Open ( Server.MapPath ( imgpath ) ) '57
Jpeg.Canvas.Font.Size = 25 '58
Jpeg.Canvas.Font.ShadowColor = &H000000 '59
Jpeg.Canvas.Font.ShadowXoffset = 1 '60
Jpeg.Canvas.Font.ShadowYoffset = 1 '62
Jpeg.Canvas.Font.Color = &HFFFFFF '64
Jpeg.Canvas.Font.Family = "Courier New" '65
Jpeg.Canvas.Font.Bold = True '66
Jpeg.Canvas.Print ( 10 , 10 , url ) '67
Jpeg.Canvas.Pen.Color = &Hffffff '68
Jpeg.Canvas.Pen.Width = 0 '69
Jpeg.Canvas.Brush.Solid = False '70
Jpeg.Canvas.Bar ( 0 , 0 , Jpeg.Width , Jpeg.Height ) '71
Jpeg.Save ( Server.MapPath ( imgpath ) ) '72
Else '73
Response.Write ( "你的系统不支持水印组件,请先<a href=http://www.ftbbs.cn/soft/AspJpeg.rar>下载</a>安装!" ) '74
Response.End ( ) '75
End If '76
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP imgtourl:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function imgtologo(ByRef imgpath )
On Error GoTo _AspToAspX_Err
Dim Jpeg
Dim Logo
If IsObjInstalled ( "Persits.Jpeg" ) Then '82
Jpeg = CreateObject ( "Persits.Jpeg" ) '83
Jpeg.RegKey = "48958-77556-02411" '84
Jpeg.Open ( Server.MapPath ( imgpath ) ) '85
Logo = CreateObject ( "Persits.Jpeg" ) '87
Logo.RegKey = "48958-77556-02411" '88
Logo.Open ( Server.MapPath ( "images/tmlogo.gif" ) ) '89
Jpeg.DrawImage ( Jpeg.width - 112 , Jpeg.height - 50 , Logo , 0.3 , &HFFFFFF ) '90
Jpeg.Save ( Server.MapPath ( imgpath ) ) '91
Else '92
Response.Write ( "你的系统不支持水印组件,请先<a href=http://www.ftbbs.cn/soft/AspJpeg.rar>下载</a>安装!" ) '93
Response.End ( ) '94
End If '95
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP imgtologo:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function mktohtm(ByRef filename,ByRef filecontent )
On Error GoTo _AspToAspX_Err
SaveToFile ( filecontent , filename ) '100
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP mktohtm:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP
Function sendsms(ByRef sender,ByRef accepter,ByRef filename,ByRef title,ByRef flag,ByRef ft )
On Error GoTo _AspToAspX_Err
Dim msginfo
Dim smscontent
If AspToAspX_CheckDBNull ( flag ) = 1 Then '104
msginfo = "[系统短信]您发表的主题被" & cookiesname & "执行编辑操作" '105
smscontent = "主题->[url=" & filename & "]" & title & "[/url]<br>操作理由: 发贴不规范或内容与版块类别不相符,有疑问请阅读版规，谢谢配合!" '106
ElseIf AspToAspX_CheckDBNull ( flag ) = 2 Then '107
msginfo = "[系统短信]您发表的主题被" & cookiesname & "执行置顶操作" '108
smscontent = "主题->[url=" & filename & "]" & title & "[/url]<br>操作理由: 你发的贴符合置顶贴的要求，现已被置顶,谢谢配合!" '109
ElseIf AspToAspX_CheckDBNull ( flag ) = 3 Then '110
msginfo = "[系统短信]您发表的主题被" & cookiesname & "执行推荐操作" '111
smscontent = "主题->[url=" & filename & "]" & title & "[/url]<br>操作理由: 你发的贴符合推荐贴的要求，现已被推荐,谢谢配合!" '112
ElseIf AspToAspX_CheckDBNull ( flag ) = 4 Then '113
msginfo = "[系统短信]您发表的主题被" & cookiesname & "执行精华操作" '114
smscontent = "主题->[url=" & filename & "]" & title & "[/url]<br>操作理由: 你发的贴符合精华贴的要求，现已被设为精华贴,谢谢配合!" '115
ElseIf AspToAspX_CheckDBNull ( flag ) = 5 Then '116
msginfo = "[系统短信]您发表的主题被" & cookiesname & "执行删除操作" '117
smscontent = "主题->" & title & "<br>操作理由: 你发的贴被确认为广告贴或不良贴，现已被删除,谢谢配合!" '118
End If '119
AspToAspX_Str = "insert into " & ft & "sms(title,content,accepter,bbssystem,IsNew) values('" & msginfo & "','" & smscontent & "','" & postuser & "',2,1)" '120
conn.Execute ( AspToAspX_Str ) '121
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\TOUXIANFUN.ASP sendsms:" & 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 FileName
Get
On Error Resume Next
FileName = AspToAspX_Host_Class_Object.FileName
If Err.Number = 438 Then
Err.Clear
FileName = _aspx_FileName
End If
End Get
Set(ByVal value)
On Error Resume Next
AspToAspX_Host_Class_Object.FileName = value
If Err.Number = 438 Then
Err.Clear
_aspx_FileName = value
End If
End Set
End Property
Public Property url
Get
On Error Resume Next
url = AspToAspX_Host_Class_Object.url
If Err.Number = 438 Then
Err.Clear
url = _aspx_url
End If
End Get
Set(ByVal value)
On Error Resume Next
AspToAspX_Host_Class_Object.url = value
If Err.Number = 438 Then
Err.Clear
_aspx_url = value
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -