| @@ -373,8 +373,48 @@ Function IsHtmlPostBody(ByVal text) | |||||
| (InStr(lowerText, "<pre") > 0) | (InStr(lowerText, "<pre") > 0) | ||||
| End Function | 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) | 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 | End Function | ||||
| '------------------------------------------------------------------------------ | '------------------------------------------------------------------------------ | ||||
| @@ -403,7 +443,7 @@ Function CategoryDeleteUrl(ByVal categoryId) | |||||
| End Function | End Function | ||||
| Function PostUrl(ByVal slug) | Function PostUrl(ByVal slug) | ||||
| PostUrl = "/posts/" & Server.URLEncode(NormalizeSlug(slug)) | |||||
| PostUrl = "/posts/" & NormalizeSlug(slug) | |||||
| End Function | End Function | ||||
| Function PostPath(ByVal slug) | Function PostPath(ByVal slug) | ||||
| @@ -504,6 +544,44 @@ Function NormalizeSlug(ByVal slug) | |||||
| NormalizeSlug = current | NormalizeSlug = current | ||||
| End Function | 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 | ' Adapted from Tolerable library | ||||
| @@ -812,6 +890,84 @@ Function GetRawJsonFromRequest() | |||||
| GetRawJsonFromRequest = rawJson | GetRawJsonFromRequest = rawJson | ||||
| End Function | 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) | Function Active(controllerName) | ||||
| On Error Resume Next | 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 | If Replace(Lcase(router.Resolve(Request.ServerVariables("REQUEST_METHOD"), TrimQueryParams(Request.ServerVariables("HTTP_X_ORIGINAL_URL")))(0)),"controller","") = LCase(controllerName) Then | ||||
Powered by TurnKey Linux.