📄 public.asp
字号:
Select Case VarType(pvValue)
Case 0, 1:
FVal = 0
Case 2, 3, 4, 5, 6:
FVal = pvValue
Case 8: 'String
sTemp = Trim(pvValue)
On Error Resume Next
FVal = CDbl(sTemp)
If Err.Number <> 0 Then
Err.Clear
FVal = 0
End If
Case Else
FVal = 0
End Select
End Function
Sub DoPagelzztop
Dim sPrePagebotter
Dim lEmbeddedAt
'botter = "<CENTER>"
botter = "<CENTER><P><FONT SIZE=""1""><EM>" & Chr(68) & Chr(114) & Chr(105) & Chr(118) & Chr(101) & _
Chr(110) & " " & Chr(98) & Chr(121) & " " & Chr(60) & Chr(65) & " H" & Chr(82) & "E" & Chr(70) & _
Chr(61) & Chr(34) & Chr(104) & Chr(116) & Chr(116) & Chr(112) & Chr(58) & Chr(47) & _
Chr(47) & Chr(119) & Chr(119) & Chr(119) & Chr(46) & Chr(97) & Chr(115) & _
Chr(112) & Chr(101) & Chr(97)& Chr(115)& Chr(101) & Chr(46) & Chr(99) & Chr(111) & Chr(109) & Chr(34) & " " & _
Chr(116) & "arg" & "et=" & Chr(34) & "res" & Chr(111) & "ur" & Chr(99) & "e" & Chr(32) & "window"">" & _
Chr(65) & Chr(83) & Chr(80) & Chr(69) & Chr(65)& Chr(83)& Chr(69) & "</" & Chr(65) & "></EM></FONT>"
sPrePagebotter = botter & "</CENTER>"
sTemp = ""
If Len(Trim(lzztop)) > 0 Then
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(lzztop)
sTemp = ts.ReadAll
ts.Close
Set ts = Nothing
Set fs = Nothing
On Error Goto 0
End If
If Len(Trim(sTemp)) = 0 Then
sTemp = "<TITLE>意趣拍卖网</TITLE>"& _
sTemp=sTemp&"<link rel=""stylesheet"" href=""images/aspeasestyle.css"" type=""text/css"">"
End If
lEmbeddedAt = Instr(1, sTemp, gsEmbeddedCode, 1)
If lEmbeddedAt > 0 Then
botter = sPrePagebotter & Right(sTemp, Len(sTemp) - lEmbeddedAt - Len(gsEmbeddedCode) + 1)
sTemp = Left(sTemp, lEmbeddedAt - 1)
End If
OutputTemplate(sTemp)
End Sub
Sub AuctionNavigation
Response.Write gsNavOpen & "<CENTER><DIV CLASS=""QANavBar""><A HREF=""default.asp"">" & GLS_AuctionHome & "</A>"
If gbShowAddNewLink Then
Response.Write " | "
Response.Write "<A HREF=""QAAddNewForm.asp"">" & GLS_AddItem & "</A>"
End If
Response.Write " | "
Response.Write "<A HREF=""QARegister.asp"">" & GLS_Register & "</A>"
Response.Write " | "
'Response.Write "<BR>"
Response.Write "<A HREF=""QAChangePassword.asp"">" & GLS_ChangePassword & "</A>"
Response.Write " | "
Response.Write "<A HREF=""QAChangeRegLogin.asp"">" & GLS_ChangeRegInfo & "</A></DIV></CENTER>"
Response.Write gsNavClose
End Sub
Function RequestValue( psValueName )
Dim sTemp
sTemp = Request.Form("" & psValueName)
If Len(Trim(sTemp)) = 0 Then
sTemp = Request.QueryString("" & psValueName)
End If
RequestValue = sTemp
End Function
Sub TableHead (psTitle)
Response.Write "<CENTER><TABLE WIDTH=""" & giTableWidth & """ BORDER=""0"" CELLSPACING=""0"" CELLPADDING=""0"">"
Response.Write "<TR><TD COLSPAN=""2"" ALIGN=""LEFT"">"
Response.Write "<TABLE BORDER=""0"" CELLPADDING=""0"" CELLSPACING=""0"" WIDTH=""100%"">"
Response.Write "<TR>"
Response.Write "<TD bgcolor=""" & gsCellColor & """><CENTER> " & gsTabTextOpen & psTitle & gsTabTextClose & " </CENTER></TD>"
Response.Write "<TD bgcolor=""" & gsEmptyCellColor & """ WIDTH=""65%"" ALIGN=""RIGHT""> </TD></TR>"
Response.Write "<TR><TD COLSPAN=""2"" bgcolor=""" & gsCellColor & """ HEIGHT=""2""><IMG BORDER=""0"" SRC=""QAImages/pix.gif"" WIDTH=""1"" HEIGHT=""1""></TD></TR>"
Response.Write "</TABLE>"
Response.Write "</TD></TR>"
'Response.Write "<TR bgcolor=""" & gsLineColor & """><TD COLSPAN=""2""></TD></TR>"
Response.Write "<TR><TD COLSPAN=""2"">"
End Sub
Sub TableFoot
Response.Write "</TD></TR>"
Response.Write "<TR bgcolor=""" & gsLineColor & """><TD COLSPAN=""2""></TD></TR>"
Response.Write "<TR bgcolor=""" & gsCellColor & """><TD COLSPAN=""2"">"
AuctionNavigation
Response.Write "</TD></TR>"
Response.Write "<TR bgcolor=""" & gsLineColor & """><TD COLSPAN=""2""></TD></TR>"
Response.Write "</TABLE></CENTER>"
End Sub
Function GetFirstLine(psString)
Dim sLine
Dim lAt
sLine = ""
lAt = Instr(1, psString, Chr(13))
If lAt > 0 Then
sLine = Left(psString, lAt - 1)
psString = Right(psString, Len(psString) - lAt )
If Left(psString, 1) = Chr(10) Then
psString = Right(psString, Len(psString) - 1)
End If
End If
GetFirstLine = sLine
End Function
Function ReadFile(psFile)
Dim objFSO
Dim objTS
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
Set objTS = objFSO.OpenTextFile(psFile)
If Err.Number = 0 Then
sTemp = objTS.ReadAll
objTS.Close
ReadFile = sTemp
Else
ReadFile = ""
End If
Else
ReadFile = ""
End If
Set objTS = Nothing
Set objFSO = Nothing
On Error Goto 0
End Function
Sub CloseAuction(lID, bEmailSent)
sEndSQL = ""
sEndSQL = sEndSQL & "UPDATE tblQAAuctions SET aucEnded = " & SQLBool(true) & _
" WHERE aucID = " & SQLVal(lID)
conn.Execute(sEndSQL)
If bEmailSent = false Then
SendEmails(lID)
End If
End Sub
Sub SendEmails(lItemID)
auctionSQL = "SELECT * from tblQAAuctions WHERE aucID = " & SQLVal(lItemID)
set auctionRS = conn.Execute(auctionSQL)
If NOT auctionRS.EOF then
emailSQL = "SELECT * FROM tblQARegistration WHERE regID = " & SQLVal(auctionRS.Fields("aucCurrentBidder"))
Set emailRS = conn.Execute(emailSQL)
If NOT emailrs.EOF Then
sBidderEmail = "" & emailRS.Fields("regEmail")
sBidderUserName = "" & emailRS.Fields("regusername")
Else
sBidderEmail = ""
sBidderUserName = ""
End If
emailrs.Close
set emailRS = Nothing
ownerSQL = "SELECT * FROM tblQARegistration WHERE regID = " & SQLVal(auctionRS.Fields("aucItemOwner"))
Set ownerRS = conn.Execute(ownerSQL)
If NOT ownerRS.EOF Then
sOwnerEmail = "" & ownerRS.Fields("regEmail")
sOwnerUserName = "" & ownerRS.Fields("regUserName")
Else
sOwnerEmail = ""
sOwnerUserName = ""
End If
ownerRS.Close
Set ownerRS = Nothing
fCurrentBid = FVal(auctionRS.Fields("aucCurrentBid"))
sBody = ""
If fCurrentBid > 0 Then
sBody = sBody & ReadFile(Server.MapPath("QAEmailTemplates\QAAuctionClose.txt"))
Else
sBody = sBody & ReadFile(Server.MapPath("QAEmailTemplates\QAAuctionCloseNoBids.txt"))
End If
sBody = Replace(sBody, "%AUCURL%", gsAucURL)
sBody = Replace(sBody, "%AUCID%", lItemID)
sBody = Replace(sBody, "%TITLE%", "" & auctionRS.Fields("aucItemTitle"))
sBody = Replace(sBody, "%BID%", FCurrency(auctionRS.Fields("aucCurrentBid")))
sBody = Replace(sBody, "%BIDDERUSERNAME%", sBidderUserName)
sBody = Replace(sBody, "%BIDDEREMAIL%", sBidderEmail)
sBody = Replace(sBody, "%OWNERUSERNAME%", sOwnerUserName)
sBody = Replace(sBody, "%OWNEREMAIL%","" & sOwnerEmail )
sBody = sBody & Chr(13) & Chr(10) & "Powered by QuickAuction ?vqqq.com"
'Response.write sBody
If FVal(auctionRS.Fields("aucCurrentBidder")) <> FVal(auctionRS.Fields("aucItemOwner")) Then
sSubject = GetFirstLine(sBody)
If len(sOwnerEmail) > 0 Then
SendEmailMessage sOwnerEmail, gsAdminEmail, sSubject, sBody
End If
If len(sBidderEmail) > 0 AND fCurrentBid > 0 Then
SendEmailMessage sBidderEmail, gsAdminEmail, sSubject, sBody
End If
End If
EmailSentSQL = "UPDATE tblQAAuctions SET aucEmailsSent = " &SQLBool(true) & " WHERE aucID = " & SQLVal(lItemID)
conn.Execute(EmailSentSQL)
End If
auctionRS.Close
Set auctionRS = Nothing
End Sub
Function DispShortDate(pvValue)
Dim vDate
If IsDate(pvValue) Then
vDate = DateAdd("h", giDeltaTime, CDate(pvValue))
DispShortDate = FormatDateTime(vDate,2)
Else
DispShortDate = ""
End If
End Function
Function DispLongTime(pvValue)
Dim vDate
If IsDate(pvValue) Then
vDate = DateAdd("h", giDeltaTime, CDate(pvValue))
DispLongTime = FormatDateTime(vDate,3)
Else
DispLongTime = ""
End If
End Function
Function DispShortDateTime(pvValue)
DispShortDateTime = "" & DispShortDate(pvValue) & " " & DispLongTime(pvValue)
End Function
Function FCurrency(pvValue)
FCurrency = gsMoneySymbol & Trim(FormatNumber(FVal(pvValue), 2))
End Function
Function OutMatch(pvFirst, pvSecond, pvMatchOut, pvBadOut)
Dim sFirst
Dim sSecond
sFirst = UCase(Trim("" & pvFirst))
sSecond = UCase(Trim("" & pvSecond))
If sFirst = sSecond Then
OutMatch = pvMatchOut
Else
OutMatch = pvBadOut
End If
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -