diff --git a/examples/gitlab/GitLab.bas b/examples/gitlab/GitLab.bas new file mode 100644 index 00000000..09ec6c05 --- /dev/null +++ b/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 + + diff --git a/examples/gitlab/Module1.bas b/examples/gitlab/Module1.bas new file mode 100644 index 00000000..08fda1e8 --- /dev/null +++ b/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 + + + diff --git a/examples/gitlab/TokenAuthenticator.bas b/examples/gitlab/TokenAuthenticator.bas new file mode 100644 index 00000000..8b0e6657 --- /dev/null +++ b/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 mkysoft@gmail.com +' @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 diff --git a/gitlab.xlsm b/gitlab.xlsm new file mode 100644 index 00000000..4c9524cf Binary files /dev/null and b/gitlab.xlsm differ