<% Class AdminController_Class Private m_useLayout Private m_title Private Sub Class_Initialize() m_useLayout = True m_title = "Admin" End Sub Public Property Get useLayout useLayout = m_useLayout End Property Public Property Let useLayout(v) m_useLayout = v End Property Public Property Get Title Title = m_title End Property Public Property Let Title(v) m_title = v End Property '--------------------------------------------------------------- ' Action: Index '--------------------------------------------------------------- Public Sub Index() m_title = "Admin Dashboard" %> <% End Sub '--------------------------------------------------------------- ' Action: Posts '--------------------------------------------------------------- Public Sub Posts() m_title = "Manage Posts" Dim posts Set posts = PostsRepository().FindAllWhere(Empty, "CreatedDate DESC", 0, 0) %> <% End Sub '--------------------------------------------------------------- ' Action: Categories '--------------------------------------------------------------- Public Sub Categories() m_title = "Manage Categories" Dim categories Set categories = CategoriesRepository().FindAll %> <% End Sub '--------------------------------------------------------------- ' Action: Comments '--------------------------------------------------------------- Public Sub Comments() m_title = "Manage Comments" Dim comments Set comments = CommentsRepository().Find(Empty, "CreatedDate") %> <% End Sub '--------------------------------------------------------------- ' Action: AIPrompt '--------------------------------------------------------------- Public Sub AIPrompt() m_title = "AI Prompt Settings" Dim promptTemplate : promptTemplate = GetGenerationPromptTemplate() %> <% End Sub '--------------------------------------------------------------- ' Action: UpdateAIPrompt '--------------------------------------------------------------- Public Sub UpdateAIPrompt() Dim promptTemplate : promptTemplate = Trim(Request.Form("PromptTemplate")) If Len(promptTemplate) = 0 Then Flash().AddError "Prompt template cannot be empty." Response.Redirect "/admin/ai-prompt" Exit Sub End If On Error Resume Next UpdateAppSetting "AbacusGenerationPrompt", promptTemplate If Err.Number <> 0 Then Flash().AddError "Unable to save prompt template: " & Err.Description Err.Clear On Error GoTo 0 Response.Redirect "/admin/ai-prompt" Exit Sub End If On Error GoTo 0 Flash().Success = "AI prompt template saved." Response.Redirect "/admin/ai-prompt" End Sub '--------------------------------------------------------------- ' Action: PublishPost '--------------------------------------------------------------- Public Sub PublishPost(ByVal id) Dim post On Error Resume Next Set post = PostsRepository().FindByID(id) If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Flash().AddError "Post not found." Response.Redirect "/admin/posts" Exit Sub End If On Error GoTo 0 post.IsPublished = 1 If Not IsDate(post.PublishedDate) Or CDate(post.PublishedDate) <= #1/1/1970# Then post.PublishedDate = Now() End If post.UpdatedDate = Now() PostsRepository().Update post Flash().Success = "Post published." Response.Redirect "/admin/posts" End Sub '--------------------------------------------------------------- ' Action: UnpublishPost '--------------------------------------------------------------- Public Sub UnpublishPost(ByVal id) Dim post On Error Resume Next Set post = PostsRepository().FindByID(id) If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Flash().AddError "Post not found." Response.Redirect "/admin/posts" Exit Sub End If On Error GoTo 0 post.IsPublished = 0 post.UpdatedDate = Now() PostsRepository().Update post Flash().Success = "Post unpublished." Response.Redirect "/admin/posts" End Sub '--------------------------------------------------------------- ' Action: ApproveComment '--------------------------------------------------------------- Public Sub ApproveComment(ByVal id) UpdateCommentApproval id, 1, "Comment approved." End Sub '--------------------------------------------------------------- ' Action: UnapproveComment '--------------------------------------------------------------- Public Sub UnapproveComment(ByVal id) UpdateCommentApproval id, 0, "Comment unapproved." End Sub '--------------------------------------------------------------- ' Action: DeleteComment '--------------------------------------------------------------- Public Sub DeleteComment(ByVal id) Dim comment On Error Resume Next Set comment = CommentsRepository().FindByID(id) If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Flash().AddError "Comment not found." Response.Redirect "/admin/comments" Exit Sub End If On Error GoTo 0 CommentsRepository().Delete id Flash().Success = "Comment deleted." Response.Redirect "/admin/comments" End Sub '--------------------------------------------------------------- ' Action: GenerateAIContent '--------------------------------------------------------------- Public Sub GenerateAIContent(ByVal id) Dim post On Error Resume Next Set post = PostsRepository().FindByID(id) If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Flash().AddError "Post not found." Response.Redirect "/admin/posts" Exit Sub End If On Error GoTo 0 Dim generatedSummary, generatedBody, generatedImagePrompt, generatedImageHtml On Error Resume Next GeneratePostContentFromAI post, generatedSummary, generatedBody, generatedImagePrompt If Err.Number <> 0 Then Flash().AddError "AI content generation failed: " & Err.Description Err.Clear On Error GoTo 0 Response.Redirect PostEditUrl(post.PostID) Exit Sub End If On Error GoTo 0 If Len(Trim(generatedSummary)) = 0 Or Len(Trim(generatedBody)) = 0 Then Flash().AddError "AI content generation returned empty content." Response.Redirect PostEditUrl(post.PostID) Exit Sub End If generatedImageHtml = BuildGeneratedImageHtml(generatedImagePrompt, post.Title, generatedSummary) post.Summary = generatedSummary post.Body = generatedImageHtml & generatedBody post.UpdatedDate = Now() PostsRepository().Update post Flash().Success = "AI content generated." Response.Redirect PostEditUrl(post.PostID) End Sub Private Sub GeneratePostContentFromAI(ByRef post, ByRef generatedSummary, ByRef generatedBody, ByRef generatedImagePrompt) Dim apiKey : apiKey = Trim(CStr(GetSecureSetting("AbacusApiKey", "ABACUS_API_KEY"))) If Len(apiKey) = 0 Then Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API key is not configured." End If Dim baseUrl : baseUrl = Trim(CStr(GetAppSetting("AbacusApiBaseUrl"))) If Len(baseUrl) = 0 Or LCase(baseUrl) = "nothing" Then baseUrl = "https://routellm.abacus.ai/v1" If Right(baseUrl, 1) = "/" Then baseUrl = Left(baseUrl, Len(baseUrl) - 1) Dim modelName : modelName = Trim(CStr(GetAppSetting("AbacusModel"))) If Len(modelName) = 0 Or LCase(modelName) = "nothing" Then modelName = "route-llm" Dim systemPrompt, userPrompt, payload, responseText, parsed, choices, choice, message, content, contentJson systemPrompt = "You write clear, engaging blog post content for a classic ASP blog. Return only valid JSON with three keys: summary, image_prompt, and body. Summary must be 1 to 2 sentences. image_prompt must be a concise visual description suitable for an AI image generator and should not mention markdown. Body must be 3 to 5 short paragraphs of HTML with simple semantic tags like p, strong, em, ul, ol, and h2. Do not use markdown fences or code blocks." userPrompt = BuildGenerationPrompt(post) & vbCrLf & vbCrLf & _ "Also return an image_prompt field that describes a magazine-style feature image for this post." payload = "{""model"":""" & JsonEscape(modelName) & """,""messages"":[{""role"":""system"",""content"":""" & JsonEscape(systemPrompt) & """},{""role"":""user"",""content"":""" & JsonEscape(userPrompt) & """}],""temperature"":0.7}" responseText = HttpPostJson(baseUrl & "/chat/completions", apiKey, payload) Set parsed = json() parsed.loadJSON responseText If Not parsed.data.Exists("choices") Then Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include choices." End If Set choices = parsed.data.Item("choices") If choices.Count = 0 Then Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API returned no choices." End If Set choice = choices.Item(0) If Not choice.Exists("message") Then Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include a message." End If Set message = choice.Item("message") If Not message.Exists("content") Then Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include content." End If content = Trim(CStr(message.Item("content"))) contentJson = ExtractJsonObject(content) Set parsed = json() parsed.loadJSON contentJson If parsed.data.Exists("summary") Then generatedSummary = Trim(CStr(parsed.data.Item("summary"))) If parsed.data.Exists("body") Then generatedBody = Trim(CStr(parsed.data.Item("body"))) If parsed.data.Exists("image_prompt") Then generatedImagePrompt = Trim(CStr(parsed.data.Item("image_prompt"))) If Len(Trim(generatedImagePrompt)) = 0 And parsed.data.Exists("images") Then generatedImagePrompt = BuildImagePromptFromSuggestions(parsed.data.Item("images")) End If End Sub Private Sub UpdateCommentApproval(ByVal id, ByVal isApproved, ByVal successMessage) Dim comment On Error Resume Next Set comment = CommentsRepository().FindByID(id) If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Flash().AddError "Comment not found." Response.Redirect "/admin/comments" Exit Sub End If On Error GoTo 0 comment.IsApproved = isApproved CommentsRepository().Update comment Flash().Success = successMessage Response.Redirect "/admin/comments" End Sub Private Function HttpPostJson(ByVal url, ByVal apiKey, ByVal payload) Dim http Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0") http.setTimeouts 10000, 10000, 10000, 30000 http.open "POST", url, False http.setRequestHeader "Content-Type", "application/json" http.setRequestHeader "Authorization", "Bearer " & apiKey http.send payload If http.status < 200 Or http.status >= 300 Then Err.Raise IIf(http.status > 0, http.status, 1), "AdminController.HttpPostJson", "Abacus API returned HTTP " & http.status & ": " & Left(CStr(http.responseText), 500) End If HttpPostJson = http.responseText End Function Private Function BuildGeneratedImageHtml(ByVal imagePrompt, ByVal titleText, ByVal summaryText) Dim promptText, altText, imageUrl promptText = Trim(CStr(imagePrompt)) If Len(promptText) = 0 Then BuildGeneratedImageHtml = "" Exit Function End If altText = Trim(CStr(summaryText)) If Len(altText) = 0 Then altText = Trim(CStr(titleText)) If Len(altText) = 0 Then altText = "Feature image" imageUrl = GetOrCreateAiImageUrl(promptText) BuildGeneratedImageHtml = "
" & _ "" & _ "
" End Function Private Function BuildImagePromptFromSuggestions(ByVal imagesData) Dim key, imageItem, textParts, part, candidate candidate = "" On Error Resume Next If TypeName(imagesData) = "Dictionary" Then For Each key In imagesData.Keys Set imageItem = imagesData.Item(key) candidate = "" If TypeName(imageItem) = "Dictionary" Then If imageItem.Exists("search_query") Then candidate = Trim(CStr(imageItem.Item("search_query"))) If Len(candidate) = 0 And imageItem.Exists("caption") Then candidate = Trim(CStr(imageItem.Item("caption"))) If Len(candidate) = 0 And imageItem.Exists("alt_text") Then candidate = Trim(CStr(imageItem.Item("alt_text"))) If Len(candidate) > 0 Then Exit For Else candidate = Trim(CStr(imageItem)) If Len(candidate) > 0 Then Exit For End If Next Else candidate = Trim(CStr(imagesData)) End If On Error GoTo 0 If Len(candidate) = 0 Then BuildImagePromptFromSuggestions = "" Else BuildImagePromptFromSuggestions = candidate End If End Function Private Function ExtractJsonObject(ByVal text) Dim startPos, endPos startPos = InStr(text, "{") endPos = InStrRev(text, "}") If startPos > 0 And endPos > startPos Then ExtractJsonObject = Mid(text, startPos, endPos - startPos + 1) Else ExtractJsonObject = text End If End Function End Class Dim AdminController_Class__Singleton Function AdminController() If IsEmpty(AdminController_Class__Singleton) Then Set AdminController_Class__Singleton = New AdminController_Class End If Set AdminController = AdminController_Class__Singleton End Function %>