ASP Classic blog framework - BrainOrdure
Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.

256 řádky
9.2KB

  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: PublishPost
  54. '---------------------------------------------------------------
  55. Public Sub PublishPost(ByVal id)
  56. Dim post
  57. On Error Resume Next
  58. Set post = PostsRepository().FindByID(id)
  59. If Err.Number <> 0 Then
  60. Err.Clear
  61. On Error GoTo 0
  62. Flash().AddError "Post not found."
  63. Response.Redirect "/admin/posts"
  64. Exit Sub
  65. End If
  66. On Error GoTo 0
  67. post.IsPublished = 1
  68. If Not IsDate(post.PublishedDate) Or CDate(post.PublishedDate) <= #1/1/1970# Then
  69. post.PublishedDate = Now()
  70. End If
  71. post.UpdatedDate = Now()
  72. PostsRepository().Update post
  73. Flash().Success = "Post published."
  74. Response.Redirect "/admin/posts"
  75. End Sub
  76. '---------------------------------------------------------------
  77. ' Action: UnpublishPost
  78. '---------------------------------------------------------------
  79. Public Sub UnpublishPost(ByVal id)
  80. Dim post
  81. On Error Resume Next
  82. Set post = PostsRepository().FindByID(id)
  83. If Err.Number <> 0 Then
  84. Err.Clear
  85. On Error GoTo 0
  86. Flash().AddError "Post not found."
  87. Response.Redirect "/admin/posts"
  88. Exit Sub
  89. End If
  90. On Error GoTo 0
  91. post.IsPublished = 0
  92. post.UpdatedDate = Now()
  93. PostsRepository().Update post
  94. Flash().Success = "Post unpublished."
  95. Response.Redirect "/admin/posts"
  96. End Sub
  97. '---------------------------------------------------------------
  98. ' Action: GenerateAIContent
  99. '---------------------------------------------------------------
  100. Public Sub GenerateAIContent(ByVal id)
  101. Dim post
  102. On Error Resume Next
  103. Set post = PostsRepository().FindByID(id)
  104. If Err.Number <> 0 Then
  105. Err.Clear
  106. On Error GoTo 0
  107. Flash().AddError "Post not found."
  108. Response.Redirect "/admin/posts"
  109. Exit Sub
  110. End If
  111. On Error GoTo 0
  112. Dim generatedSummary, generatedBody
  113. On Error Resume Next
  114. GeneratePostContentFromAI post, generatedSummary, generatedBody
  115. If Err.Number <> 0 Then
  116. Flash().AddError "AI content generation failed: " & Err.Description
  117. Err.Clear
  118. On Error GoTo 0
  119. Response.Redirect PostEditUrl(post.PostID)
  120. Exit Sub
  121. End If
  122. On Error GoTo 0
  123. If Len(Trim(generatedSummary)) = 0 Or Len(Trim(generatedBody)) = 0 Then
  124. Flash().AddError "AI content generation returned empty content."
  125. Response.Redirect PostEditUrl(post.PostID)
  126. Exit Sub
  127. End If
  128. post.Summary = generatedSummary
  129. post.Body = generatedBody
  130. post.UpdatedDate = Now()
  131. PostsRepository().Update post
  132. Flash().Success = "AI content generated."
  133. Response.Redirect PostEditUrl(post.PostID)
  134. End Sub
  135. Private Sub GeneratePostContentFromAI(ByRef post, ByRef generatedSummary, ByRef generatedBody)
  136. Dim apiKey : apiKey = Trim(CStr(GetSecureSetting("AbacusApiKey", "ABACUS_API_KEY")))
  137. If Len(apiKey) = 0 Then
  138. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API key is not configured."
  139. End If
  140. Dim baseUrl : baseUrl = Trim(CStr(GetAppSetting("AbacusApiBaseUrl")))
  141. If Len(baseUrl) = 0 Or LCase(baseUrl) = "nothing" Then baseUrl = "https://routellm.abacus.ai/v1"
  142. If Right(baseUrl, 1) = "/" Then baseUrl = Left(baseUrl, Len(baseUrl) - 1)
  143. Dim modelName : modelName = Trim(CStr(GetAppSetting("AbacusModel")))
  144. If Len(modelName) = 0 Or LCase(modelName) = "nothing" Then modelName = "route-llm"
  145. Dim systemPrompt, userPrompt, payload, responseText, parsed, choices, choice, message, content, contentJson
  146. 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."
  147. userPrompt = "Create blog content for this post title: " & SafeText(post.Title) & vbCrLf & _
  148. "Existing summary: " & SafeText(post.Summary) & vbCrLf & _
  149. "Existing body: " & SafeText(post.Body) & vbCrLf & _
  150. "Keep the title unchanged. Make the content readable and helpful for a general audience."
  151. payload = "{""model"":""" & JsonEscape(modelName) & """,""messages"":[{""role"":""system"",""content"":""" & JsonEscape(systemPrompt) & """},{""role"":""user"",""content"":""" & JsonEscape(userPrompt) & """}],""temperature"":0.7}"
  152. responseText = HttpPostJson(baseUrl & "/chat/completions", apiKey, payload)
  153. Set parsed = json()
  154. parsed.loadJSON responseText
  155. If Not parsed.data.Exists("choices") Then
  156. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include choices."
  157. End If
  158. Set choices = parsed.data.Item("choices")
  159. If choices.Count = 0 Then
  160. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API returned no choices."
  161. End If
  162. Set choice = choices.Item(0)
  163. If Not choice.Exists("message") Then
  164. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include a message."
  165. End If
  166. Set message = choice.Item("message")
  167. If Not message.Exists("content") Then
  168. Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include content."
  169. End If
  170. content = Trim(CStr(message.Item("content")))
  171. contentJson = ExtractJsonObject(content)
  172. Set parsed = json()
  173. parsed.loadJSON contentJson
  174. If parsed.data.Exists("summary") Then generatedSummary = Trim(CStr(parsed.data.Item("summary")))
  175. If parsed.data.Exists("body") Then generatedBody = Trim(CStr(parsed.data.Item("body")))
  176. End Sub
  177. Private Function HttpPostJson(ByVal url, ByVal apiKey, ByVal payload)
  178. Dim http
  179. Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
  180. http.setTimeouts 10000, 10000, 10000, 30000
  181. http.open "POST", url, False
  182. http.setRequestHeader "Content-Type", "application/json"
  183. http.setRequestHeader "Authorization", "Bearer " & apiKey
  184. http.send payload
  185. If http.status < 200 Or http.status >= 300 Then
  186. Err.Raise IIf(http.status > 0, http.status, 1), "AdminController.HttpPostJson", "Abacus API returned HTTP " & http.status & ": " & Left(CStr(http.responseText), 500)
  187. End If
  188. HttpPostJson = http.responseText
  189. End Function
  190. Private Function ExtractJsonObject(ByVal text)
  191. Dim startPos, endPos
  192. startPos = InStr(text, "{")
  193. endPos = InStrRev(text, "}")
  194. If startPos > 0 And endPos > startPos Then
  195. ExtractJsonObject = Mid(text, startPos, endPos - startPos + 1)
  196. Else
  197. ExtractJsonObject = text
  198. End If
  199. End Function
  200. Private Function SafeText(ByVal value)
  201. If IsNull(value) Or IsEmpty(value) Then
  202. SafeText = ""
  203. Else
  204. SafeText = CStr(value)
  205. End If
  206. End Function
  207. End Class
  208. Dim AdminController_Class__Singleton
  209. Function AdminController()
  210. If IsEmpty(AdminController_Class__Singleton) Then
  211. Set AdminController_Class__Singleton = New AdminController_Class
  212. End If
  213. Set AdminController = AdminController_Class__Singleton
  214. End Function
  215. %>

Powered by TurnKey Linux.