瀏覽代碼

Improve BrainOrdure editorial UI

master
nano 4 天之前
父節點
當前提交
3abe0e08b4
共有 1 個文件被更改,包括 158 次插入2 次删除
  1. +158
    -2
      core/helpers.asp

+ 158
- 2
core/helpers.asp 查看文件

@@ -373,8 +373,48 @@ Function IsHtmlPostBody(ByVal text)
(InStr(lowerText, "<pre") > 0)
End Function

Function ExtractFirstImageSrc(ByVal html)
Dim text, imgPos, srcPos, quoteChar, startPos, endPos, fallbackEnd
If IsNull(html) Or IsEmpty(html) Then
ExtractFirstImageSrc = ""
Exit Function
End If

text = CStr(html)
imgPos = InStr(1, text, "<img", vbTextCompare)
If imgPos = 0 Then
ExtractFirstImageSrc = ""
Exit Function
End If

srcPos = InStr(imgPos, text, "src=", vbTextCompare)
If srcPos = 0 Then
ExtractFirstImageSrc = ""
Exit Function
End If

quoteChar = Mid(text, srcPos + 4, 1)
If quoteChar = """" Or quoteChar = "'" Then
startPos = srcPos + 5
endPos = InStr(startPos, text, quoteChar)
If endPos > startPos Then
ExtractFirstImageSrc = Mid(text, startPos, endPos - startPos)
Exit Function
End If
End If

startPos = srcPos + 4
fallbackEnd = InStr(startPos, text, " ")
If fallbackEnd = 0 Then fallbackEnd = InStr(startPos, text, ">")
If fallbackEnd > startPos Then
ExtractFirstImageSrc = Mid(text, startPos, fallbackEnd - startPos)
Else
ExtractFirstImageSrc = ""
End If
End Function

Function AiImageUrl(ByVal prompt)
AiImageUrl = "https://pollinations.ai/p/" & Server.URLEncode(Trim(CStr(prompt)))
AiImageUrl = "/ai-image?prompt=" & Server.URLEncode(Trim(CStr(prompt)))
End Function

'------------------------------------------------------------------------------
@@ -403,7 +443,7 @@ Function CategoryDeleteUrl(ByVal categoryId)
End Function

Function PostUrl(ByVal slug)
PostUrl = "/posts/" & Server.URLEncode(NormalizeSlug(slug))
PostUrl = "/posts/" & NormalizeSlug(slug)
End Function

Function PostPath(ByVal slug)
@@ -504,6 +544,44 @@ Function NormalizeSlug(ByVal slug)
NormalizeSlug = current
End Function

Function EstimateReadTime(ByVal body)
Dim text, re, words, count, minutes
text = ""
If Not (IsNull(body) Or IsEmpty(body)) Then
text = CStr(body)
End If

On Error Resume Next
Set re = Server.CreateObject("VBScript.RegExp")
If Err.Number = 0 Then
re.Global = True
re.IgnoreCase = True
re.Pattern = "<[^>]+>"
text = re.Replace(text, " ")
re.Pattern = "&[a-z0-9#]+;"
text = re.Replace(text, " ")
re.Pattern = "\s+"
text = Trim(re.Replace(text, " "))
Else
Err.Clear
text = Replace(text, vbCrLf, " ")
text = Replace(text, vbCr, " ")
text = Replace(text, vbLf, " ")
End If
On Error GoTo 0

If Len(text) = 0 Then
EstimateReadTime = "1 min read"
Exit Function
End If

words = Split(text, " ")
count = UBound(words) + 1
minutes = CLng((count + 149) / 150)
If minutes < 1 Then minutes = 1
EstimateReadTime = CStr(minutes) & " min read"
End Function


'=======================================================================================================================
' Adapted from Tolerable library
@@ -812,6 +890,84 @@ Function GetRawJsonFromRequest()
GetRawJsonFromRequest = rawJson
End Function

Function EnsureFolderExists(ByVal folderPath)
Dim fso, parentPath
Set fso = Server.CreateObject("Scripting.FileSystemObject")

If Len(Trim(CStr(folderPath))) = 0 Then
EnsureFolderExists = False
Exit Function
End If

If Not fso.FolderExists(folderPath) Then
parentPath = fso.GetParentFolderName(folderPath)
If Len(parentPath) > 0 And Not fso.FolderExists(parentPath) Then
Call EnsureFolderExists(parentPath)
End If
If Not fso.FolderExists(folderPath) Then
fso.CreateFolder folderPath
End If
End If

EnsureFolderExists = True
End Function

Function FileExists(ByVal filePath)
Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
FileExists = fso.FileExists(filePath)
End Function

Function BuildAiImageFileName(ByVal prompt)
Dim slug, stamp
slug = GenerateSlug(prompt)
If Len(slug) = 0 Then slug = "image"
If Len(slug) > 40 Then slug = Left(slug, 40)

stamp = Year(Now()) & Right("0" & Month(Now()), 2) & Right("0" & Day(Now()), 2) & _
Right("0" & Hour(Now()), 2) & Right("0" & Minute(Now()), 2) & Right("0" & Second(Now()), 2)

BuildAiImageFileName = slug & "-" & stamp & ".jpg"
End Function

Function GetOrCreateAiImageUrl(ByVal prompt)
Dim cleanPrompt, folderPath, fileName, filePath, localUrl, remoteUrl, shell, command, exitCode
cleanPrompt = Trim(CStr(prompt))
If Len(cleanPrompt) = 0 Then
GetOrCreateAiImageUrl = ""
Exit Function
End If

folderPath = Server.MapPath("/uploads/ai-images")
Call EnsureFolderExists(folderPath)

fileName = BuildAiImageFileName(cleanPrompt)
filePath = folderPath & "\" & fileName
localUrl = "/uploads/ai-images/" & fileName

If FileExists(filePath) Then
GetOrCreateAiImageUrl = localUrl
Exit Function
End If

remoteUrl = "https://image.pollinations.ai/prompt/" & Server.URLEncode(cleanPrompt)

On Error Resume Next
Set shell = Server.CreateObject("WScript.Shell")
If Err.Number = 0 Then
command = "cmd /c curl.exe -L --fail --silent --show-error --output """ & filePath & """ """ & remoteUrl & """"
exitCode = shell.Run(command, 0, True)
If exitCode = 0 And FileExists(filePath) Then
GetOrCreateAiImageUrl = localUrl
Exit Function
End If
End If
Err.Clear
On Error GoTo 0

GetOrCreateAiImageUrl = remoteUrl
End Function

Function Active(controllerName)
On Error Resume Next
If Replace(Lcase(router.Resolve(Request.ServerVariables("REQUEST_METHOD"), TrimQueryParams(Request.ServerVariables("HTTP_X_ORIGINAL_URL")))(0)),"controller","") = LCase(controllerName) Then


Loading…
取消
儲存

Powered by TurnKey Linux.