<% 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: 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: 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 On Error Resume Next GeneratePostContentFromAI post, generatedSummary, generatedBody 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 post.Summary = generatedSummary post.Body = 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) Dim apiKey : apiKey = Trim(CStr(GetAppSetting("AbacusApiKey"))) If Len(apiKey) = 0 Or LCase(apiKey) = "nothing" 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 two keys: summary and body. Summary must be 1 to 2 sentences. Body must be 3 to 5 short paragraphs separated by blank lines. Do not use markdown fences, bullets, or code blocks." userPrompt = "Create blog content for this post title: " & SafeText(post.Title) & vbCrLf & _ "Existing summary: " & SafeText(post.Summary) & vbCrLf & _ "Existing body: " & SafeText(post.Body) & vbCrLf & _ "Keep the title unchanged. Make the content readable and helpful for a general audience." 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"))) 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 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 Private Function SafeText(ByVal value) If IsNull(value) Or IsEmpty(value) Then SafeText = "" Else SafeText = CStr(value) 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 %>