Just an example here, how to work with "Winhttp.WinHttpRequest.5.1" against
the official WebAPI of PInterest.
Setup of an empty VB-Project:
- include a reference to vbRichClient5 (to be able to deal with JSON more comfortably)
- Setup an empty Form like shown below
![]()
(Two Labels, Two CommandButtons, two ListBoxes, and one PictureBox, all with their default-names)
To work with the PInterest-API, one needs to get an AccessToken -
and for ones own UserAccount on PInterest this can be accomplished by creating an App first -
and then one can get an AccessToken for that "private Test-App" by using this helper-page:
https://developers.pinterest.com/tools/access_token/?
Once such an AccessToken is successfully retrieved, one can use it together with the Class below
(passing it over into the InitWithToken-Method of that Class):
Into a Class, named cPInterestAPI:
Code:
Option Explicit
Private Const ApiBaseUrl As String = "https://api.pinterest.com/v1/"
Private mAccessToken As String, mUserName As String
Public Sub InitWithToken(AccessToken As String)
mAccessToken = AccessToken
mUserName = Split(GetMyBoards.Prop("data").Item(0).Prop("url"), "/")(3)
End Sub
Public Function GetMyBoards() As cCollection
On Error GoTo 1
Set GetMyBoards = RPC("me/boards/?access_token=" & mAccessToken)
1 If Err Then HandlePinError
End Function
Public Property Get UserName() As String
UserName = mUserName
End Property
Public Function GetBoardPins(BoardName As String) As cCollection
On Error GoTo 1
Set GetBoardPins = RPC("boards/" & mUserName & "/" & BoardName & "/pins/?access_token=" & mAccessToken & "&fields=image,id,note")
1 If Err Then HandlePinError
End Function
Public Function GetPinDetails(PinID As String) As cCollection
On Error GoTo 1
Set GetPinDetails = RPC("pins/" & PinID & "/?access_token=" & mAccessToken & "&fields=image,id,note,board,color,counts,creator")
1 If Err Then HandlePinError
End Function
Public Function DeletePinImage(PinID As String) As cCollection
On Error GoTo 1
Set DeletePinImage = RPC("pins/" & PinID & "/?access_token=" & mAccessToken, "DELETE")
1 If Err Then HandlePinError
End Function
Public Function UploadPinImage(BoardName As String, PinNote As String, ImgBytes() As Byte, Optional ByVal TimeOutSec As Long = 10) As cCollection
On Error GoTo 1
With New_c.JSONObject
.Prop("board") = mUserName & "/" & BoardName
.Prop("note") = PinNote
.Prop("image_base64") = New_c.Crypt.Base64Enc(ImgBytes)
Set UploadPinImage = RPC("pins/?access_token=" & mAccessToken, "POST", .SerializeToJSONUTF8, TimeOutSec)
End With
1 If Err Then HandlePinError
End Function
Public Function DownloadPinImage(ByVal PinID As String) As cCairoSurface
On Error GoTo 1
Dim PinDetails As cCollection, ImgUrl As String
Set PinDetails = GetPinDetails(PinID).Prop("data")
ImgUrl = PinDetails.Prop("image").Prop("original").Prop("url")
With CreateObject("Winhttp.WinHttpRequest.5.1")
.Open "GET", ImgUrl, 0 'synchronous request-mode
.Send
If .Status = 200 Then Set DownloadPinImage = Cairo.CreateSurface(0, 0, , .ResponseBody): Exit Function
If LCase$(Right$(ImgUrl, 4)) = ".jpg" Then
.Open "GET", Left$(ImgUrl, Len(ImgUrl) - 4) & ".png", 0 'fallback from default-jpg to PNG (bug in Pinterest)
.Send
If .Status = 200 Then Set DownloadPinImage = Cairo.CreateSurface(0, 0, , .ResponseBody): Exit Function
Err.Raise vbObjectError, , "Error: http-status=" & .Status & " " & .StatusText & vbCrLf & .ResponseText
End If
End With
1 If Err Then HandlePinError
End Function
'****** End of Public-Interface - what follows are just 2 small Helper-Functions *******
Private Sub HandlePinError()
MsgBox Err.Description 'alternatively, raise an Event here, or log the Message, or whatever
End Sub
'that's the workhorse for the PInterest-WebAPI (returning a JSON-Object as an RC5.cCollection)
Private Function RPC(RelUrl As String, Optional Method As String = "GET", Optional Bytes, Optional ByVal TimeOutSec As Long = 3) As cCollection
With CreateObject("Winhttp.WinHttpRequest.5.1")
.Open Method, ApiBaseUrl & RelUrl, 1 'asynchronous request-mode
If IsMissing(Bytes) Then .Send Else .SetRequestHeader "Content-Type", "application/json": .Send Bytes
If .WaitForResponse(TimeOutSec) Then 'we use the appropriate async-wait-method of WinHttp5.1 (not DoEvents)
Select Case .Status
Case 200, 201: Set RPC = New_c.JSONDecodeToCollection(CStr(.ResponseText))
Case Else: Err.Raise vbObjectError, , "Error: http-status=" & .Status & " " & .StatusText & vbCrLf & .ResponseText
End Select
Else
Err.Raise vbObjectError, , "Error: TimeOut of " & TimeOutSec & " reached."
End If
End With
End Function
The usage of the above Class is demonstrated with the following Form-Code (which one should paste into the Form which was set-up as described further above):
Code:
Option Explicit
Private PinAPI As New cPinterestAPI, i As Long, CurPins As cCollection
Private Sub Form_Load()
Command1.Caption = "Add": Command2.Caption = "Remove"
Label1.AutoSize = True: Label2.AutoSize = True
PinAPI.InitWithToken "... put your own Access-Token here..."
Label1.AutoSize = True: Label1.Caption = "UserName: " & PinAPI.UserName
Dim AuthUsersPublicBoards As cCollection
Set AuthUsersPublicBoards = PinAPI.GetMyBoards.Prop("data")
For i = 0 To AuthUsersPublicBoards.Count - 1
List1.AddItem AuthUsersPublicBoards(i).Prop("name")
Next
End Sub
Private Sub List1_Click()
If List1.ListIndex >= 0 Then UpdatePins List1.Text
End Sub
Private Sub List2_Click()
If List2.ListIndex >= 0 Then DownloadAndRenderPin List1.ListIndex, List2.Text
End Sub
Private Sub Command1_Click()
If List1.ListIndex >= 0 Then
PinAPI.UploadPinImage List1.Text, "SomeNote " & Now, CreateSamplePngImg
UpdatePins List1.Text
End If
If List2.ListCount Then List2.ListIndex = 0
End Sub
Private Sub Command2_Click()
If List2.ListIndex >= 0 Then
Set Picture1.Picture = Nothing
PinAPI.DeletePinImage List2.Text
UpdatePins List1.Text
End If
End Sub
Private Sub UpdatePins(BoardName As String)
Set CurPins = PinAPI.GetBoardPins(BoardName).Prop("data")
List2.Clear
If CurPins Is Nothing Then Exit Sub
For i = 0 To CurPins.Count - 1
List2.AddItem CurPins(i).Prop("id")
Next
End Sub
Private Sub DownloadAndRenderPin(ListIndex As Long, PinID As String)
Label2.Caption = CurPins(ListIndex).Prop("note")
Set Picture1.Picture = PinAPI.DownloadPinImage(PinID).Picture
End Sub
Private Function CreateSamplePngImg() As Byte()
With Cairo.CreateSurface(100, 200).CreateContext '<-- the Pinterest-Minimum-ImageDimensions are 100x200 Pixels
.Paint , Cairo.CreateSolidPatternLng(vbWhite)
.SelectFont "Arial", 16
.DrawText 0, 0, .Surface.Width, .Surface.Height, Format$(Now, "dd\. mmmm yyyy hh:nn:ss"), False, vbCenter, 2, 1
.Surface.WriteContentToPngByteArray CreateSamplePngImg
End With
End Function
Private Sub Form_Terminate()
If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub
Now the Demo can be run, looking like this:
![]()
The Add and Remove-Buttons will add (or remove) dynamically created "plain white PNG-images with the current Date and Time"
(as shown in the PictureBox to the right).
When one does look at the Code of the Public Functions in the cPInterestAPI-Class, there is not really much to it.
Most API-Methods can be implemented in a single Line, once the "RPC-workhorse" exists (which is also not very large codewise).
I'm posting this, because I assume that the recent threads which had this topic, were prematurely closed
(not giving the OP a chance to explain himself) - in my opinion his usage of the WebBrowser-Control or
"plain-Winsock-based requests" were only due to not knowing how to deal with WinHttp 5.1 and the proper
WebAPI of PInterest, which is explained here:
https://developers.pinterest.com/docs/api/overview/
Instead of accusations of "WebScraping" or worse, the more experienced developers here could at least make
an attempt to post links to the WebAPI-pages of the sites in question - and offer assistance in interpreting -
or implementing them... (In my experience, Newbies have simply no clear imagination, what a WebAPI is
or what it means to work against such an animal with a proper Request-Object... instead what they are
going to find per google is in most cases only the "all-too-common-WebBrowser-control", which then in turn
leads to these suspicious looking Code-Snippets they post when questions like "what have you tried so far?" come in...
Olaf
