GitLab example

examples/gitlab/GitLab.bas

@@ -0,0 +1,136 @@
+Attribute VB_Name = "gitlab"
+Private pGitLabClient As WebClient
+Private pToken As String
+
+Private Property Get Token() As String
+    If pToken = "" Then
+        If Credentials.Loaded Then
+            pToken = Credentials.Values("GitLab")("token")
+        Else
+            pToken = InputBox("GitLab Token?")
+        End If
+    End If
+
+    Token = pToken
+End Property
+
+Private Property Get GitLabClient() As WebClient
+    If pGitLabClient Is Nothing Then
+        Set pGitLabClient = New WebClient
+        pGitLabClient.BaseUrl = "https://gitlab.com/api/v4"
+
+        Dim Auth As New TokenAuthenticator
+        Auth.Setup _
+            Header:="PRIVATE-TOKEN", _
+            value:=Token
+        Set pGitLabClient.Authenticator = Auth
+    End If
+
+    Set GitLabClient = pGitLabClient
+End Property
+
+Function GetProjects() As Object
+    'On Error GoTo ErrorHandler
+
+    Dim Request As New WebRequest
+    Dim Response As WebResponse
+    Request.Resource = "/projects?membership=true"
+
+    ' Set the request format (Set {format} segment, content-types, and parse the response)
+    Request.Format = WebFormat.Json
+
+    ' (GET, POST, PUT, DELETE, PATCH)
+    Request.Method = WebMethod.HttpGet
+
+    Set Response = GitLabClient.Execute(Request)
+
+    If Response.StatusCode <> WebStatusCode.Ok Then
+        Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu")
+    Else
+        Set GetProjects = Response.Data
+        'GetIssiues = WebHelpers.ConvertToJson(Response.Data, " ", 2)
+        'MsgBox WebHelpers.ConvertToJson(Response.Data, " ", 2)
+    End If
+
+'ErrorHandler:
+'    MsgBox "The following error occurred: " & Err.Description
+
+End Function
+
+Function GetIssiues(ProjectId As Long, Start As Integer) As Object
+    'On Error GoTo ErrorHandler
+
+    Dim Request As New WebRequest
+    Dim Response As WebResponse
+    Request.Resource = "/issues?project=" & ProjectId & "&page=" & Start & "&per_page=100"
+
+    ' Set the request format (Set {format} segment, content-types, and parse the response)
+    Request.Format = WebFormat.Json
+
+    ' (GET, POST, PUT, DELETE, PATCH)
+    Request.Method = WebMethod.HttpGet
+
+    Set Response = GitLabClient.Execute(Request)
+
+    If Response.StatusCode <> WebStatusCode.Ok Then
+        Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu")
+    Else
+        Set GetIssiues = Response.Data
+        'GetIssiues = WebHelpers.ConvertToJson(Response.Data, " ", 2)
+        'MsgBox WebHelpers.ConvertToJson(Response.Data, " ", 2)
+    End If
+
+'ErrorHandler:
+'    MsgBox "The following error occurred: " & Err.Description
+
+End Function
+
+Function GetEvents(ProjectId As Long) As Object
+    'On Error GoTo ErrorHandler
+
+    Dim Request As New WebRequest
+    Dim Response As WebResponse
+    Request.Resource = "/events?project=" & ProjectId & "&target_type=issue&action=closed&per_page=100"
+
+    ' Set the request format (Set {format} segment, content-types, and parse the response)
+    Request.Format = WebFormat.Json
+
+    ' (GET, POST, PUT, DELETE, PATCH)
+    Request.Method = WebMethod.HttpGet
+
+    Set Response = GitLabClient.Execute(Request)
+
+    If Response.StatusCode <> WebStatusCode.Ok Then
+        Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu")
+    Else
+        Set GetEvents = Response.Data
+    End If
+
+End Function
+
+Function GetNotes(ProjectId As Long, IssueId As Integer) As Object
+    'On Error GoTo ErrorHandler
+
+    Dim Request As New WebRequest
+    Dim Response As WebResponse
+    Request.Resource = "/projects/" & ProjectId & "/issues/" & IssueId & "/notes"
+
+    ' Set the request format (Set {format} segment, content-types, and parse the response)
+    Request.Format = WebFormat.Json
+
+    ' (GET, POST, PUT, DELETE, PATCH)
+    Request.Method = WebMethod.HttpGet
+
+    Set Response = GitLabClient.Execute(Request)
+
+    If Response.StatusCode = WebStatusCode.NotFound Then
+        'GetNotes = Null
+    ElseIf Response.StatusCode <> WebStatusCode.Ok Then
+        Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu")
+    Else
+        Set GetNotes = Response.Data
+    End If
+
+End Function
+
+

examples/gitlab/Module1.bas

@@ -0,0 +1,131 @@
+Attribute VB_Name = "Module1"
+Sub Button1_Click()
+
+    Dim PrevUpdating As Boolean
+    Dim LastIndex As Integer
+
+    PrevUpdating = Application.ScreenUpdating
+    Application.ScreenUpdating = False
+
+    LastIndex = 1
+    GetIssues ActiveSheet.Cells(1, 2), LastIndex
+
+    Application.ScreenUpdating = PrevUpdating
+
+End Sub
+
+Sub Button2_Click()
+
+    Dim PrevUpdating As Boolean
+    Dim LastIndex As Integer
+
+    PrevUpdating = Application.ScreenUpdating
+    Application.ScreenUpdating = False
+
+    LastIndex = 1
+    GetProjects
+
+    Application.ScreenUpdating = PrevUpdating
+
+End Sub
+
+Sub GetIssues(ProjectId As Long, Optional ByRef LastIndex As Integer = 1, Optional LastPage As Integer = 1)
+    Dim Issues As Object
+    Dim Assignee As Object
+    Dim Sheet As Worksheet
+
+    Set Issues = gitlab.GetIssiues(ProjectId, LastPage)
+
+    Set Sheet = Worksheets("issues")
+    If (LastIndex = 1) Then
+        Sheet.UsedRange.Clear
+        Sheet.Cells(1, 1) = "project_id"
+        Sheet.Cells(1, 2) = "id"
+        Sheet.Cells(1, 3) = "iid"
+        Sheet.Cells(1, 4) = "title"
+        Sheet.Cells(1, 5) = "state"
+        Sheet.Cells(1, 6) = "assignee.name"
+        Sheet.Cells(1, 7) = "created_at"
+        Sheet.Cells(1, 8) = "closed_at"
+        LastIndex = LastIndex + 1
+    End If
+    For Each Issue In Issues
+        Sheet.Cells(LastIndex, 1) = ProjectId
+        Sheet.Cells(LastIndex, 2) = Issue("id")
+        Sheet.Cells(LastIndex, 3) = Issue("iid")
+        Sheet.Cells(LastIndex, 4) = Issue("title")
+        Sheet.Cells(LastIndex, 5) = Issue("state")
+        If Not IsNull(Issue("assignee")) Then
+            Set Assignee = Issue("assignee")
+            Sheet.Cells(LastIndex, 6) = Assignee("name")
+        End If
+        Sheet.Cells(LastIndex, 7) = FormatDate(Issue("created_at"))
+        Sheet.Cells(LastIndex, 8) = FormatDate(Issue("closed_at"))
+        LastIndex = LastIndex + 1
+    Next Issue
+    If LastIndex = LastPage * 100 + 2 Then
+        GetIssues ProjectId, LastIndex, LastPage + 1
+    End If
+End Sub
+
+Sub GetProjects()
+    Dim Projects As Object
+    Dim Assignee As Object
+    Dim Sheet As Worksheet
+    Dim LastIndex As Integer
+
+    Set Projects = gitlab.GetProjects()
+
+    Set Sheet = Worksheets("projects")
+    Sheet.UsedRange.Clear
+    Sheet.Cells(1, 1) = "id"
+    Sheet.Cells(1, 2) = "name"
+
+   LastIndex = 2
+    For Each Project In Projects
+        Sheet.Cells(LastIndex, 1) = Project("id")
+        Sheet.Cells(LastIndex, 2) = Project("name")
+        LastIndex = LastIndex + 1
+    Next Project
+End Sub
+
+Sub GetEvents()
+    Dim Events As Object
+    Dim Assignee As Object
+    Dim Sheet As Worksheet
+    Dim i As Integer
+
+    Set Events = gitlab.GetEvents
+
+    Set Sheet = Worksheets("events")
+    Sheet.UsedRange.Clear
+    Sheet.Cells(1, 1) = "issue_id"
+    Sheet.Cells(1, 2) = "action_name"
+    Sheet.Cells(1, 3) = "created_at"
+    i = 2
+    For Each Evnt In Events
+        Sheet.Cells(i, 1) = Evnt("target_id")
+        Sheet.Cells(i, 2) = Evnt("action_name")
+        Sheet.Cells(i, 3) = Evnt("created_at")
+        i = i + 1
+    Next Evnt
+
+End Sub
+
+Function Decode(value As String) As String
+    value = Replace(value, "ş", "s")
+    value = Replace(value, "ı", "i")
+    value = Replace(value, "İ", "I")
+    Decode = value
+End Function
+
+Function FormatDate(value As Variant) As String
+    If IsNull(value) Or IsEmpty(value) Then
+        FormatDate = ""
+    Else
+        FormatDate = Mid(value, 9, 2) & "." & Mid(value, 6, 2) & ". " & Mid(value, 1, 4) & " " & Mid(value, 12, 8)
+    End If
+End Function
+
+
+

examples/gitlab/TokenAuthenticator.bas

@@ -0,0 +1,86 @@
+''
+' Http Token Authenticator v3.0.5
+' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
+'
+' Custom IWebAuthenticator for GitLab Token Authenticator
+'
+' @class TokenAuthenticator
+' @implements IWebAuthenticator v4.*
+' @author [email protected]
+' @license MIT (http://www.opensource.org/licenses/mit-license.php)
+'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+Implements IWebAuthenticator
+Option Explicit
+
+' --------------------------------------------- '
+' Constants and Private Variables
+' --------------------------------------------- '
+
+Private Const web_HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0
+Private Const web_HTTPREQUEST_SETCREDENTIALS_FOR_PROXY = 1
+
+' --------------------------------------------- '
+' Properties
+' --------------------------------------------- '
+
+Public Header As String
+Public value As String
+
+' ============================================= '
+' Public Methods
+' ============================================= '
+
+''
+' Setup
+'
+' @param {String} Header
+' @param {String} Value
+''
+Public Sub Setup(Header As String, value As String)
+    Me.Header = Header
+    Me.value = value
+End Sub
+
+''
+' Hook for taking action before a request is executed
+'
+' @param {WebClient} Client The client that is about to execute the request
+' @param in|out {WebRequest} Request The request about to be executed
+''
+Private Sub IWebAuthenticator_BeforeExecute(ByVal Client As WebClient, ByRef Request As WebRequest)
+    Request.SetHeader Me.Header, Me.value
+End Sub
+
+''
+' Hook for taking action after request has been executed
+'
+' @param {WebClient} Client The client that executed request
+' @param {WebRequest} Request The request that was just executed
+' @param in|out {WebResponse} Response to request
+''
+Private Sub IWebAuthenticator_AfterExecute(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Response As WebResponse)
+    ' e.g. Handle 401 Unauthorized or other issues
+End Sub
+
+''
+' Hook for updating http before send
+'
+' @param {WebClient} Client
+' @param {WebRequest} Request
+' @param in|out {WinHttpRequest} Http
+''
+Private Sub IWebAuthenticator_PrepareHttp(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Http As Object)
+    'Http.SetCredentials Me.Username, Me.Password, web_HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
+End Sub
+
+''
+' Hook for updating cURL before send
+'
+' @param {WebClient} Client
+' @param {WebRequest} Request
+' @param in|out {String} Curl
+''
+Private Sub IWebAuthenticator_PrepareCurl(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Curl As String)
+    ' e.g. Add flags to cURL
+    'Curl = Curl & " --basic --user " & WebHelpers.PrepareTextForShell(Me.Username) & ":" & WebHelpers.PrepareTextForShell(Me.Password)
+End Sub