ASP Classic blog framework - BrainOrdure
Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

282 lignes
10.0KB

  1. <%
  2. Class AdminController_Class
  3. Private m_useLayout
  4. Private m_title
  5. Private Sub Class_Initialize()
  6. m_useLayout = True
  7. m_title = "Admin"
  8. End Sub
  9. Public Property Get useLayout
  10. useLayout = m_useLayout
  11. End Property
  12. Public Property Let useLayout(v)
  13. m_useLayout = v
  14. End Property
  15. Public Property Get Title
  16. Title = m_title
  17. End Property
  18. Public Property Let Title(v)
  19. m_title = v
  20. End Property
  21. '---------------------------------------------------------------
  22. ' Action: Index
  23. '---------------------------------------------------------------
  24. Public Sub Index()
  25. m_title = "Admin Dashboard"
  26. %>
  27. <!--#include file="../views/Admin/index.asp" -->
  28. <%
  29. End Sub
  30. '---------------------------------------------------------------
  31. ' Action: Posts
  32. '---------------------------------------------------------------
  33. Public Sub Posts()
  34. m_title = "Manage Posts"
  35. Dim posts
  36. Set posts = PostsRepository().FindAllWhere(Empty, "CreatedDate DESC", 0, 0)
  37. %>
  38. <!--#include file="../views/Admin/posts.asp" -->
  39. <%
  40. End Sub
  41. '---------------------------------------------------------------
  42. ' Action: Categories
  43. '---------------------------------------------------------------
  44. Public Sub Categories()
  45. m_title = "Manage Categories"
  46. Dim categories
  47. Set categories = CategoriesRepository().FindAll
  48. %>
  49. <!--#include file="../views/Admin/categories.asp" -->
  50. <%
  51. End Sub
  52. '---------------------------------------------------------------
  53. ' Action: AIPrompt
  54. '---------------------------------------------------------------
  55. Public Sub AIPrompt()
  56. m_title = "AI Prompt Settings"
  57. Dim promptTemplate : promptTemplate = GetGenerationPromptTemplate()
  58. %>
  59. <!--#include file="../views/Admin/ai-prompt.asp" -->
  60. <%
  61. End Sub
  62. '---------------------------------------------------------------
  63. ' Action: UpdateAIPrompt
  64. '---------------------------------------------------------------
  65. Public Sub UpdateAIPrompt()
  66. Dim promptTemplate : promptTemplate = Trim(Request.Form("PromptTemplate"))
  67. If Len(promptTemplate) = 0 Then
  68. Flash().AddError "Prompt template cannot be empty."
  69. Response.Redirect "/admin/ai-prompt"
  70. Exit Sub
  71. End If
  72. On Error Resume Next
  73. UpdateAppSetting "AbacusGenerationPrompt", promptTemplate
  74. If Err.Number <> 0 Then
  75. Flash().AddError "Unable to save prompt template: " & Err.Description
  76. Err.Clear
  77. On Error GoTo 0
  78. Response.Redirect "/admin/ai-prompt"
  79. Exit Sub
  80. End If
  81. On Error GoTo 0
  82. Flash().Success = "AI prompt template saved."
  83. Response.Redirect "/admin/ai-prompt"
  84. End Sub
  85. '---------------------------------------------------------------
  86. ' Action: PublishPost
  87. '---------------------------------------------------------------
  88. Public Sub PublishPost(ByVal id)
  89. Dim post
  90. On Error Resume Next
  91. Set post = PostsRepository().FindByID(id)
  92. If Err.Number <> 0 Then
  93. Err.Clear
  94. On Error GoTo 0
  95. Flash().AddError "Post not found."
  96. Response.Redirect "/admin/posts"
  97. Exit Sub
  98. End If
  99. On Error GoTo 0
  100. post.IsPublished = 1
  101. If Not IsDate(post.PublishedDate) Or CDate(post.PublishedDate) <= #1/1/1970# Then
  102. post.PublishedDate = Now()
  103. End If
  104. post.UpdatedDate = Now()
  105. PostsRepository().Update post
  106. Flash().Success = "Post published."
  107. Response.Redirect "/admin/posts"
  108. End Sub
  109. '---------------------------------------------------------------
  110. ' Action: UnpublishPost
  111. '---------------------------------------------------------------
  112. Public Sub UnpublishPost(ByVal id)
  113. Dim post
  114. On Error Resume Next
  115. Set post = PostsRepository().FindByID(id)
  116. If Err.Number <> 0 Then
  117. Err.Clear
  118. On Error GoTo 0
  119. Flash().AddError "Post not found."
  120. Response.Redirect "/admin/posts"
  121. Exit Sub
  122. End If
  123. On Error GoTo 0
  124. post.IsPublished = 0
  125. post.UpdatedDate = Now()
  126. PostsRepository().Update post
  127. Flash().Success = "Post unpublished."
  128. Response.Redirect "/admin/posts"
  129. End Sub
  130. '---------------------------------------------------------------
  131. ' Action: GenerateAIContent
  132. '---------------------------------------------------------------
  133. Public Sub GenerateAIContent(ByVal id)
  134. Dim post
  135. On Error Resume Next
  136. Set post = PostsRepository().FindByID(id)
  137. If Err.Number <> 0 Then
  138. Err.Clear
  139. On Error GoTo 0
  140. Flash().AddError "Post not found."
  141. Response.Redirect "/admin/posts"
  142. Exit Sub
  143. End If
  144. On Error GoTo 0
  145. Dim generatedSummary, generatedBody
  146. On Error Resume Next
  147. GeneratePostContentFromAI post, generatedSummary, generatedBody
  148. If Err.Number <> 0 Then
  149. Flash().AddError "AI content generation failed: " & Err.Description
  150. Err.Clear
  151. On Error GoTo 0
  152. Response.Redirect PostEditUrl(post.PostID)
  153. Exit Sub
  154. End If
  155. On Error GoTo 0
  156. If Len(Trim(generatedSummary)) = 0 Or Len(Trim(generatedBody)) = 0 Then
  157. Flash().AddError "AI content generation returned empty content."
  158. Response.Redirect PostEditUrl(post.PostID)
  159. Exit Sub
  160. End If
  161. post.Summary = generatedSummary
  162. post.Body = generatedBody
  163. post.UpdatedDate = Now()
  164. PostsRepository().Update post
  165. Flash().Success = "AI content generated."
  166. Response.Redirect PostEditUrl(post.PostID)
  167. End Sub
  168. Private Sub GeneratePostContentFromAI(ByRef post, ByRef generatedSummary, ByRef generatedBody)
  169. Dim apiKey : apiKey = Trim(CStr(GetSecureSetting("AbacusApiKey", "ABACUS_API_KEY")))
  170. If Len(apiKey) = 0 Then
  171. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API key is not configured."
  172. End If
  173. Dim baseUrl : baseUrl = Trim(CStr(GetAppSetting("AbacusApiBaseUrl")))
  174. If Len(baseUrl) = 0 Or LCase(baseUrl) = "nothing" Then baseUrl = "https://routellm.abacus.ai/v1"
  175. If Right(baseUrl, 1) = "/" Then baseUrl = Left(baseUrl, Len(baseUrl) - 1)
  176. Dim modelName : modelName = Trim(CStr(GetAppSetting("AbacusModel")))
  177. If Len(modelName) = 0 Or LCase(modelName) = "nothing" Then modelName = "route-llm"
  178. Dim systemPrompt, userPrompt, payload, responseText, parsed, choices, choice, message, content, contentJson
  179. 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."
  180. userPrompt = BuildGenerationPrompt(post)
  181. payload = "{""model"":""" & JsonEscape(modelName) & """,""messages"":[{""role"":""system"",""content"":""" & JsonEscape(systemPrompt) & """},{""role"":""user"",""content"":""" & JsonEscape(userPrompt) & """}],""temperature"":0.7}"
  182. responseText = HttpPostJson(baseUrl & "/chat/completions", apiKey, payload)
  183. Set parsed = json()
  184. parsed.loadJSON responseText
  185. If Not parsed.data.Exists("choices") Then
  186. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include choices."
  187. End If
  188. Set choices = parsed.data.Item("choices")
  189. If choices.Count = 0 Then
  190. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API returned no choices."
  191. End If
  192. Set choice = choices.Item(0)
  193. If Not choice.Exists("message") Then
  194. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include a message."
  195. End If
  196. Set message = choice.Item("message")
  197. If Not message.Exists("content") Then
  198. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include content."
  199. End If
  200. content = Trim(CStr(message.Item("content")))
  201. contentJson = ExtractJsonObject(content)
  202. Set parsed = json()
  203. parsed.loadJSON contentJson
  204. If parsed.data.Exists("summary") Then generatedSummary = Trim(CStr(parsed.data.Item("summary")))
  205. If parsed.data.Exists("body") Then generatedBody = Trim(CStr(parsed.data.Item("body")))
  206. End Sub
  207. Private Function HttpPostJson(ByVal url, ByVal apiKey, ByVal payload)
  208. Dim http
  209. Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
  210. http.setTimeouts 10000, 10000, 10000, 30000
  211. http.open "POST", url, False
  212. http.setRequestHeader "Content-Type", "application/json"
  213. http.setRequestHeader "Authorization", "Bearer " & apiKey
  214. http.send payload
  215. If http.status < 200 Or http.status >= 300 Then
  216. Err.Raise IIf(http.status > 0, http.status, 1), "AdminController.HttpPostJson", "Abacus API returned HTTP " & http.status & ": " & Left(CStr(http.responseText), 500)
  217. End If
  218. HttpPostJson = http.responseText
  219. End Function
  220. Private Function ExtractJsonObject(ByVal text)
  221. Dim startPos, endPos
  222. startPos = InStr(text, "{")
  223. endPos = InStrRev(text, "}")
  224. If startPos > 0 And endPos > startPos Then
  225. ExtractJsonObject = Mid(text, startPos, endPos - startPos + 1)
  226. Else
  227. ExtractJsonObject = text
  228. End If
  229. End Function
  230. End Class
  231. Dim AdminController_Class__Singleton
  232. Function AdminController()
  233. If IsEmpty(AdminController_Class__Singleton) Then
  234. Set AdminController_Class__Singleton = New AdminController_Class
  235. End If
  236. Set AdminController = AdminController_Class__Singleton
  237. End Function
  238. %>

Powered by TurnKey Linux.