📄 functions_format_post.asp
字号:
'Get the start and end in the message of the author who is being coded
lngStartPos = InStr(1, strMessage, "[CODE]", 1) + 6
lngEndPos = InStr(lngStartPos, strMessage, "[/CODE]", 1)
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'If there is something returned get message to code block
If lngEndPos > lngStartPos Then
'Get the message to be coded
strCodeMessage = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Format the message
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, vbTab, " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, chr(9), " ", 1, -1, 1)
'strCodeMessage = Replace(strCodeMessage, Chr(10), "<br />", 1, -1, 1)
'Build the HTML for the displying of the coded message
strBuildCodeBlock = "<table width=""95%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & "<tr><td class=""bold"">" & strTxtCode & ":<br>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " <table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""0"" bgcolor=""" & strTableQuoteBorderColour & """>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " <tr>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " <td><table width=""100%"" border=""0"" cellpadding=""2"" cellspacing=""0"" bgcolor=""" & strTableQuoteColour & """>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " <tr>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " <td class=""text"" style=""font-family: Courier New, Courier, mono;"">" & strCodeMessage & "</td>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " </tr>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " </table></td>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " </tr>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & " </table></td>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & "</tr>"
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & "</table>"
End If
'Get the start and end position in the start and end position in the message of the code block
lngStartPos = InStr(1, strMessage, "[CODE]", 1)
lngEndPos = InStr(lngStartPos, strMessage, "[/CODE]", 1) + 7
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Get the original code to be replaced in the message
strOriginalCodeBlock = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Replace the code codes in the message with the new formated code block
If strBuildCodeBlock <> "" Then
strMessage = Replace(strMessage, strOriginalCodeBlock, strBuildCodeBlock, 1, -1, 1)
Else
strMessage = Replace(strMessage, strOriginalCodeBlock, Replace(strOriginalCodeBlock, "[", "[", 1, -1, 1), 1, -1, 1)
End If
Loop
'Return the function
formatCode = strMessage
End Function
'******************************************
'*** Format Flash File Support ***
'******************************************
'This function formats falsh codes
Function formatFlash(ByVal strMessage)
'Declare variables
Dim lngStartPos 'Holds search start postions
Dim lngEndPos 'Holds end start postions
Dim saryFlashAttributes 'Holds the features of the input flash file
Dim intAttrbuteLoop 'Holds the attribute loop counter
Dim strFlashWidth 'Holds the string value of the width of the Flash file
Dim intFlashWidth 'Holds the interger value of the width of the flash file
Dim strFlashHeight 'Holds the string value of the height of the Flash file
Dim intFlashHeight 'Holds the interger value of the height of the flash file
Dim strBuildFlashLink 'Holds the converted BBcode for the flash file
Dim strTempFlashMsg 'Tempoary store for the BBcode
Dim strFlashLink 'Holds the link to the flash file
'Loop through all the codes in the message and convert them to formated flash links
Do While InStr(1, strMessage, "[FLASH", 1) > 0 AND InStr(1, strMessage, "[/FLASH]", 1) > 0
'Initiliase variables
intFlashWidth = 50
intFlashHeight = 50
strFlashLink = ""
strBuildFlashLink = ""
strTempFlashMsg = ""
'Get the Flash BBcode from the message
lngStartPos = InStr(1, strMessage, "[FLASH", 1)
lngEndPos = InStr(lngStartPos, strMessage, "[/FLASH]", 1) + 8
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Get the original Flash BBcode from the message
strTempFlashMsg = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Get the start and end in the message of the attributes of the Flash file
lngStartPos = InStr(1, strTempFlashMsg, "[FLASH", 1) + 6
lngEndPos = InStr(lngStartPos, strTempFlashMsg, "]", 1)
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned get the details (eg. dimensions) of the flash file
If strTempFlashMsg <> "" Then
'Place any attributes for the flash file in an array
saryFlashAttributes = Split(Trim(Mid(strTempFlashMsg, lngStartPos, lngEndPos-lngStartPos)), " ")
'Get the dimensions of the Flash file
'Loop through the array of atrributes that are for the falsh file to get the dimentions
For intAttrbuteLoop = 0 To UBound(saryFlashAttributes)
'If this is the width attribute then read in the width dimention
If InStr(1, saryFlashAttributes(intAttrbuteLoop), "WIDTH=", 1) Then
'Get the width dimention
strFlashWidth = Replace(saryFlashAttributes(intAttrbuteLoop), "WIDTH=", "", 1, -1, 1)
'Make sure we are left with a numeric number if so convert to an interger and place in an interger variable
If isNumeric(strFlashWidth) Then intFlashWidth = CInt(strFlashWidth)
End If
'If this is the height attribute then read in the height dimention
If InStr(1, saryFlashAttributes(intAttrbuteLoop), "HEIGHT=", 1) Then
'Get the height dimention
strFlashHeight = Replace(saryFlashAttributes(intAttrbuteLoop), "HEIGHT=", "", 1, -1, 1)
'Make sure we are left with a numeric number if so convert to an interger and place in an interger variable
If isNumeric(strFlashHeight) Then intFlashHeight = CInt(strFlashHeight)
End If
Next
'Get the link to the flash file
lngStartPos = InStr(1, strTempFlashMsg, "]", 1) + 1
lngEndPos = InStr(lngStartPos, strTempFlashMsg, "[/FLASH]", 1)
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 8
'Read in the code to be converted into a hyperlink from the message
strFlashLink = Trim(Mid(strTempFlashMsg, lngStartPos, (lngEndPos - lngStartPos)))
'Build the HTML for the displying of the flash file
If strFlashLink <> "" Then
strBuildFlashLink = "<embed src=""" & strFlashLink & """"
strBuildFlashLink = strBuildFlashLink & " quality=high width=" & intFlashWidth & " height=" & intFlashHeight & " type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash""></embed>"
End If
End If
'Replace the flash codes in the message with the new formated flash link
If strBuildFlashLink <> "" Then
strMessage = Replace(strMessage, strTempFlashMsg, strBuildFlashLink, 1, -1, 1)
Else
strMessage = Replace(strMessage, strTempFlashMsg, Replace(strTempFlashMsg, "[", "[", 1, -1, 1), 1, -1, 1)
End If
Loop
'Return the function
formatFlash = strMessage
End Function
'******************************************
'*** Display edit author ***
'******************************************
Function editedXMLParser(ByVal strMessage)
'Declare variables
Dim strEditedAuthor 'Holds the name of the author who is editing the post
Dim dtmEditedDate 'Holds the date the post was edited
Dim lngStartPos 'Holds search start postions
Dim lngEndPos 'Holds end start postions
'Get the start and end in the message of the author who edit the post
lngStartPos = InStr(1, strMessage, "<editID>", 1) + 8
lngEndPos = InStr(1, strMessage, "</editID>", 1)
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned get the authors name
strEditedAuthor = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Get the start and end in the message of the date the message was edited
lngStartPos = InStr(1, strMessage, "<editDate>", 1) + 10
lngEndPos = InStr(1, strMessage, "</editDate>", 1)
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned get the date the message was edited
dtmEditedDate = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Get the start and end position in the string of the XML to remove
lngStartPos = InStr(1, strMessage, "<edited>", 1)
lngEndPos = InStr(1, strMessage, "</edited>", 1) + 9
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned strip the XML from the message
strMessage = Replace(strMessage, Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos)), "", 1, -1, 1)
'Place the name of the person who edited the post
If strEditedAuthor <> "" Then
'If there is a date and time display the autrher dat and time the post was edited
If IsDate(dtmEditedDate) Then
dtmEditedDate = CDate(dtmEditedDate)
editedXMLParser = strMessage & "<span class=""smText""><br /><br />" & strTxtEditBy & " " & strEditedAuthor & " - " & DateFormat(dtmEditedDate, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmEditedDate, saryDateTimeData) & "</span>"
'Just display the author name who edited the post
Else
editedXMLParser = strMessage & "<span class=""smText""><br /><br />" & strTxtEditBy & " " & strEditedAuthor & "</span>"
End If
End If
End Function
'******************************************
'*** Convert Post to Text Function ***
'******************************************
'Function to romove icons and colurs to just leave plain text
Function ConvertToText(ByVal strMessage)
Dim strTempMessage 'Temporary word hold for e-mail and url words
Dim strMessageLink 'Holds the new mesage link that needs converting back into code
Dim lngStartPos 'Holds the start position for a link
Dim lngEndPos 'Holds the end position for a word
Dim intLoop 'Loop counter
'Remove hyperlinks
strMessage = Replace(strMessage, " target=""_blank""", "", 1, -1, 1)
'Loop through the message till all or any hyperlinks are turned into back into froum codes
Do While InStr(1, strMessage, "<a href=""", 1) > 0 AND InStr(1, strMessage, "</a>", 1) > 0
'Find the start position in the message of the HTML hyperlink
lngStartPos = InStr(1, strMessage, "<a href=""", 1)
'Find the position in the message for the </a> closing code
lngEndPos = InStr(lngStartPos, strMessage, "</a>", 1) + 4
'Make sure the end position is not in error
If lngEndPos - lngStartPos =< 9 Then lngEndPos = lngStartPos + 9
'Read in the code to be converted back into forum codes from the message
strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))
'Place the message link into the tempoary message variable
strTempMessage = strMessageLink
'Format the HTML hyperlink back into forum codes
If InStr(1, strTempMessage, "src=""", 1) Then
strTempMessage = Replace(strTempMessage, "<a href=""", " ", 1, -1, 1)
strTempMessage = Replace(strTempMessage, "</a>", " ", 1, -1, 1)
Else
strTempMessage = Replace(strTempMessage, "<a href=""", " <font color='#0000FF'>", 1, -1, 1)
strTempMessage = Replace(strTempMessage, "</a>", " ", 1, -1, 1)
strTempMessage = Replace(strTempMessage, """>", "</font> - ", 1, -1, 1)
End If
'Place the new fromatted codes into the message string body
strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)
Loop
'Get any that may slip through (don't look as good but still has the same effect)
strMessage = Replace(strMessage, "<a href= """, "", 1, -1, 1)
strMessage = Replace(strMessage, "<a href='", "", 1, -1, 1)
strMessage = Replace(strMessage, "</a>", "", 1, -1, 1)
'Return the message with the icons and text colours removed
ConvertToText = strMessage
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -