Merge pull request #16 from lvcabral/v4.07

V4.07

Source/Class/PostData.cls

@@ -12,7 +12,7 @@ Attribute VB_Creatable = True
 Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = False
 '*    w.bloggar
-'*    Copyright (C) 2001-2019 Marcelo Lv Cabral <https://lvcabral.com>
+'*    Copyright (C) 2001-2024 Marcelo Lv Cabral <https://lvcabral.com>
 '*
 '*    This program is free software; you can redistribute it and/or modify
 '*    it under the terms of the GNU General Public License as published by
@@ -51,42 +51,45 @@ Private Sub Class_Initialize()
     AllowPings = -1
 End Sub
 
-Public Sub LoadData(ByVal strFilePath As String)
+Public Function LoadData(ByVal strData As String, ByVal bolFile As Boolean) As Boolean
 Dim vValue As Variant
 Dim DOMDocument As DOMDocument
 Dim Param As IXMLDOMNode
 Dim Value As IXMLDOMNode
 Dim objPost As xmlStruct
 Dim vResponse
 On Error Resume Next
-    If FileExists(strFilePath) Then
-        Set DOMDocument = New DOMDocument
-        DOMDocument.Load strFilePath
-        '
-        ' Convert the response into a variant array
-        '
-        Set Param = DOMDocument.selectSingleNode(".//param")
-        If Param Is Nothing Then Exit Sub
-        Set Value = Param.selectSingleNode(".//value")
-        If Value Is Nothing Then Exit Sub
-        ParseValue Value, vResponse
-        Set objPost = vResponse
-        Me.AccountID = objPost.Member("accountID").Value
-        Me.BlogID = objPost.Member("blogID").Value
-        Me.PostID = objPost.Member("postID").Value
-        Me.Title = ConvertHTMLEntities(objPost.Member("textTitle").Value, False)
-        Me.Text = ConvertHTMLEntities(objPost.Member("textBody").Value, False)
-        Me.DateTime = objPost.Member("dateCreated").Value
-        Me.More = ConvertHTMLEntities(objPost.Member("textMore").Value, False)
-        Me.Excerpt = ConvertHTMLEntities(objPost.Member("excerpt").Value, False)
-        Me.Keywords = ConvertHTMLEntities(objPost.Member("keywords").Value, False)
-        Me.AllowComments = objPost.Member("allowComments").Value
-        Me.AllowPings = objPost.Member("allowPings").Value
-        Me.TextFilter = objPost.Member("textFilter").Value
-        Me.TrackBack = objPost.Member("trackBack").Value
-        Me.Categories = ConvertHTMLEntities(objPost.Member("categories").Value, False)
+    Set DOMDocument = New DOMDocument
+    If bolFile And FileExists(strData) Then
+        DOMDocument.Load strData
+    Else
+        DOMDocument.loadXML strData
     End If
-End Sub
+    '
+    ' Convert the response into a variant array
+    '
+    Set Param = DOMDocument.selectSingleNode(".//param")
+    If Param Is Nothing Then Exit Function
+    Set Value = Param.selectSingleNode(".//value")
+    If Value Is Nothing Then Exit Function
+    ParseValue Value, vResponse
+    Set objPost = vResponse
+    Me.AccountID = objPost.Member("accountID").Value
+    Me.BlogID = objPost.Member("blogID").Value
+    Me.PostID = objPost.Member("postID").Value
+    Me.Title = ConvertHTMLEntities(objPost.Member("textTitle").Value, False)
+    Me.Text = ConvertHTMLEntities(objPost.Member("textBody").Value, False)
+    Me.DateTime = objPost.Member("dateCreated").Value
+    Me.More = ConvertHTMLEntities(objPost.Member("textMore").Value, False)
+    Me.Excerpt = ConvertHTMLEntities(objPost.Member("excerpt").Value, False)
+    Me.Keywords = ConvertHTMLEntities(objPost.Member("keywords").Value, False)
+    Me.AllowComments = objPost.Member("allowComments").Value
+    Me.AllowPings = objPost.Member("allowPings").Value
+    Me.TextFilter = objPost.Member("textFilter").Value
+    Me.TrackBack = objPost.Member("trackBack").Value
+    Me.Categories = ConvertHTMLEntities(objPost.Member("categories").Value, False)
+    LoadData = True
+End Function
 
 Public Function SaveData(ByVal strFilePath As String) As Boolean
 On Error Resume Next

Source/Docs/History.txt

@@ -2,6 +2,12 @@ Software....: w.bloggar - Universal XML-RPC Weblog Interface
 File........: wbloggar.exe
 Document....: Log of changes and improvements
 
+*** Release v4.07.0212 *** 26-Jan-2024 *** Fixed Images, Load Files and Categories
+FIXED....: Images with https protocol not showing on preview
+FIXED....: Categories being lost when loading post files
+FIXED....: Blog title with Unicode characters not properly rendered in some screens
+FIXED....: Post files with ASCII character 160 not being loaded
+
 *** Release v4.06.0210 *** 25-Jan-2024 *** More Improvements and Bug Fixes
 ADDED....: Shortcut for "Save as..." is Ctrl+Shift+S
 CHANGED..: Increased number of recent files from 4 to 10

Source/Form/Image.frm

@@ -249,7 +249,7 @@ End Sub
 Private Sub cmdButton_Click(Index As Integer)
 Dim i As Integer
     If Index = 0 Then
-        If Trim(cboImage.Text) = "" Or Trim(cboImage.Text) = "http://" Then
+        If Trim(cboImage.Text) = "" Or Trim(cboImage.Text) = "http://" Or Trim(cboImage.Text) = "https://" Then
             MsgBox GetMsg(msgEnterImage), vbInformation
             cboImage.SetFocus
             cboImage.SelStart = Len(cboImage.Text)

Source/Form/Post.frm

@@ -482,7 +482,7 @@ Begin VB.Form frmPost
                NoFolders       =   0   'False
                Transparent     =   0   'False
                ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
-               Location        =   "http:///"
+               Location        =   ""
             End
          End
          Begin VB.Label lblStatus 
@@ -581,7 +581,7 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 '*    w.bloggar
-'*    Copyright (C) 2001-2019 Marcelo Lv Cabral <https://lvcabral.com>
+'*    Copyright (C) 2001-2024 Marcelo Lv Cabral <https://lvcabral.com>
 '*
 '*    This program is free software; you can redistribute it and/or modify
 '*    it under the terms of the GNU General Public License as published by
@@ -2041,8 +2041,13 @@ Dim strPreview As String, strTemp As String, strCSS As String
             strCSS = gBlog.PreviewCSS
         End If
         'On post preview add head and body tags
-        strPreview = "<html><head><title>Bloggar Preview</title></head><body>" & vbCrLf & _
-                     strCSS & vbCrLf & gBlog.PreviewBody & vbCrLf & _
+        Dim strBody As String
+        strBody = gBlog.PreviewBody
+        If Trim(strBody) = "" Then
+            strBody = "<body>"
+        End If
+        strPreview = "<html><head><title>Bloggar Preview</title>" & vbCrLf & _
+                     strCSS & vbCrLf & "</head>" & vbCrLf & strBody & vbCrLf & _
                      "<table " & gBlog.PreviewWidth & "><tr><td><div " & _
                      gBlog.PreviewAlign & " " & gBlog.PreviewStyle & ">" & vbCrLf & _
                      "%WBTEXT%</div></td></tr></table></body></html>"
@@ -2081,7 +2086,9 @@ Dim lngStart As Long, lngPos As Long
     lngPos = InStr(lngStart, strText, strFind, vbTextCompare)
     Do Until lngPos = 0
         If LCase(Mid(strText, lngPos, Len(strFind) + 8)) <> strFind & """http://" And _
-           LCase(Mid(strText, lngPos, Len(strFind) + 7)) <> strFind & "http://" Then
+           LCase(Mid(strText, lngPos, Len(strFind) + 7)) <> strFind & "http://" And _
+           LCase(Mid(strText, lngPos, Len(strFind) + 9)) <> strFind & """https://" And _
+           LCase(Mid(strText, lngPos, Len(strFind) + 8)) <> strFind & "https://" Then
             'Convert the relative Path to a complete URL
             If Mid(strText, lngPos + Len(strFind), 1) = """" Then
                 If LCase(Mid(strText, lngPos, Len(strFind) + 2)) <> strFind & """/" Then
@@ -2449,7 +2456,10 @@ Dim strPost As String, strTitle As String, strFName As String
                 End If
             End If
         Else 'New xml .post format
-            Call PostData.LoadData(strFile)
+            If Not PostData.LoadData(strPost, False) Then
+                MsgBox "Invalid Post File!", vbExclamation
+                Exit Sub
+            End If
             If PostData.BlogID <> "" And PostData.BlogID <> gBlogs(acbMain.Bands("bndTools").Tools("miBlogs").CBListIndex).BlogID Then
                 If MsgBox(GetMsg(msgPostFileWithID) & vbCrLf & GetMsg(msgLoadAsDraft), vbExclamation + vbYesNo) = vbYes Then
                     PostData.AccountID = -1
@@ -2464,7 +2474,11 @@ Dim strPost As String, strTitle As String, strFName As String
             End If
             If SupportsTitle() Then
                 If SupportsCategory() Then
+                    Dim strCategories As String
+                    'Save categories before clearing cboPostCat position
+                    strCategories = PostData.Categories
                     If cboPostCat.ListCount > 0 Then cboPostCat.ListIndex = 0
+                    PostData.Categories = strCategories
                     Select Case gAccount.GetPostsMethod
                     Case API_B2
                         If cboPostCat.ListCount > 1 Then

Source/Module/API.bas

@@ -64,7 +64,7 @@ Dim strBlogName As String
         Set DOMDocument = objClient.Execute(gAccount.Host, gAccount.Page, strMethod, _
                                             APPKEY, gAccount.User, gAccount.Password)
     End If
-    
+
     objClient.ResponseToVariant DOMDocument, varResponse
     If VarType(varResponse) = vbArray + vbVariant Then
         varStruct = varResponse
@@ -76,14 +76,13 @@ Dim strBlogName As String
             Set objBlog = varStruct(b)
             strBlogName = objBlog.Member("blogName").Value
             If gAccount.UTF8 Then
-                frmPost.acbMain.Bands("bndTools").Tools("miBlogs").CBList.AddItem UTF8_Decode(strBlogName)
-            Else
-                frmPost.acbMain.Bands("bndTools").Tools("miBlogs").CBList.AddItem strBlogName
+                strBlogName = UTF8_Decode(strBlogName)
             End If
+            frmPost.acbMain.Bands("bndTools").Tools("miBlogs").CBList.AddItem strBlogName
             ReDim Preserve gBlogs(b)
             gBlogs(b).URL = objBlog.Member("url").Value
             gBlogs(b).BlogID = objBlog.Member("blogid").Value
-            gBlogs(b).Name = objBlog.Member("blogName").Value
+            gBlogs(b).Name = strBlogName
             On Error Resume Next 'New API
             gBlogs(b).IsAdmin = objBlog.Member("isAdmin").Value
             If Err <> 0 Then gBlogs(b).IsAdmin = True
@@ -155,14 +154,14 @@ Dim varResponse
     If gAccount.PostMethod = API_METAWEBLOG Or _
        gAccount.PostMethod = API_MT Then
         'Process Text
-        If gSettings.AutoConvert Then 'Conversão HTML
+        If gSettings.AutoConvert Then 'Convers�o HTML
             strTitle = ConvertHTMLEntities(strTitle, True)
             strPost = ConvertHTMLEntities(strPost, True)
             strMore = ConvertHTMLEntities(strMore, True)
             strExcerpt = ConvertHTMLEntities(strExcerpt, True)
             strKeywords = ConvertHTMLEntities(strKeywords, True)
         End If
-        If gAccount.UTF8 Or gAccount.UTF8OnPost Then 'Conversão UTF-8
+        If gAccount.UTF8 Or gAccount.UTF8OnPost Then 'Convers�o UTF-8
             strTitle = UTF8_Encode(strTitle)
             strPost = UTF8_Encode(strPost)
             strMore = UTF8_Encode(strMore)

Source/wbloggar.vbp

@@ -68,8 +68,8 @@ HelpContextID="0"
 Description="w.bloggar - Universal Weblog Interface"
 CompatibleMode="0"
 MajorVer=4
-MinorVer=6
-RevisionVer=210
+MinorVer=7
+RevisionVer=213
 AutoIncrementVer=1
 ServerSupportFiles=0
 VersionComments="The best interface between you and your blog."