Omnitracker – eksport danych do REST API

Dzisiaj zaprezentuję jak w prosty sposób, używając jedynie podstawowych wiadomości o protokole HTTP zaimplementować tworzenie issue w JIRZE przy użyciu Visual Basic Script w Omnitrackerze.

Skrypt ten powinien być używany w formularzach po naciśnięciu przycisku.

Kilka informacji o REST API można znaleźć tutaj :

krótka definicja

http://www.moseleians.co.uk/wp-content/uploads/cmdm/9632/1422444257_api-restowe-whitepaper.pdf

encyklopedyczny opis

https://en.wikipedia.org/wiki/Representational_state_transfer

– tutorial

http://www.restapitutorial.com/

’funkcja do kodowania ciagu znakow w Base64

Function Base64Encode(sText)
 Dim oXML, oNode
 Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
 Set oNode = oXML.createElement("base64")
 oNode.DataType = "bin.base64"
 oNode.nodeTypedValue = Stream_StringToBinary(sText)
 Base64Encode = oNode.Text
 Set oNode = Nothing
 Set oXML = Nothing
 End Function

'Stream_StringToBinary Function
 '2003 Antonin Foller, http://www.motobit.com
 'Text - string parameter To convert To binary data
 Function Stream_StringToBinary(Text)
 Const adTypeText = 2
 Const adTypeBinary = 1

'Create Stream object
 Dim BinaryStream 'As New Stream
 Set BinaryStream = CreateObject("ADODB.Stream")

'Specify stream type - we want To save text/string data.
 BinaryStream.Type = adTypeText

'Specify charset For the source text (unicode) data.
 BinaryStream.Charset = "us-ascii"

'Open the stream And write text/string data To the object
 BinaryStream.Open
 BinaryStream.WriteText Text

'Change stream type To binary
 BinaryStream.Position = 0
 BinaryStream.Type = adTypeBinary

'Ignore first two bytes - sign of
 BinaryStream.Position = 0

'Open the stream And get binary data from the object
 Stream_StringToBinary = BinaryStream.Read

Set BinaryStream = Nothing
 End Function

'Stream_BinaryToString Function
 '2003 Antonin Foller, http://www.motobit.com
 'Binary - VT_UI1 | VT_ARRAY data To convert To a string
 Function Stream_BinaryToString(Binary)
 Const adTypeText = 2
 Const adTypeBinary = 1

'Create Stream object
 Dim BinaryStream 'As New Stream
 Set BinaryStream = CreateObject("ADODB.Stream")

'Specify stream type - we want To save text/string data.
 BinaryStream.Type = adTypeBinary

'Open the stream And write text/string data To the object
 BinaryStream.Open
 BinaryStream.Write Binary

'Change stream type To binary
 BinaryStream.Position = 0
 BinaryStream.Type = adTypeText

'Specify charset For the source text (unicode) data.
 BinaryStream.Charset = "us-ascii"

'Open the stream And get binary data from the object
 Stream_BinaryToString = BinaryStream.ReadText
 Set BinaryStream = Nothing
 End Function

'M.Grzesko - 20150923 - conversion of String in ASCII to binary data
 Function Stream_StringToBinary2(Text)
 Const adTypeText = 2
 Const adTypeBinary = 1

'Create Stream object
 Dim BinaryStream 'As New Stream
 Set BinaryStream = CreateObject("ADODB.Stream")

'Specify stream type - we want To save text/string data.
 BinaryStream.Type = adTypeText

'Specify charset For the source text ASCII data.
 BinaryStream.Charset = "ASCII"

'Open the stream And write text/string data To the object
 BinaryStream.Open
 BinaryStream.WriteText Text

'Change stream type To binary
 BinaryStream.Position = 0
 BinaryStream.Type = adTypeBinary

'Ignore first two bytes - sign of
 BinaryStream.Position = 0

'Open the stream And get binary data from the object
 Stream_StringToBinary2 = BinaryStream.Read

Set BinaryStream = Nothing
 End Function

'send data to restAPI
 Set restReq = CreateObject ("WinHttp.WinHttpRequest.5.1")
 Dim username,passwd,url_find_issue,url

restReq.open "GET", url_find_issue,false
 restReq.setRequestHeader "Content-Type", "application/json"
 restReq.setRequestHeader "User-Agent", "xxxxx" 'to avoid XRF check error
 restReq.SetRequestHeader "Authorization", "Basic " + Base64Encode(username + ":" + passwd)
 restReq.Option(4) = 256 + 512 + 4096 + 8192 'ignore invalid SSL certificates

On Error Resume Next
 restReq.send
 If not Err.Number = 0 Then
 GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & Err.Description
 MsgBox(GetDataFromURL&" URL="&url_find_issue)
 else

if (restReq.status = 200) then 'already exists in JIRA
 Set myRegExp = New RegExp
 myRegExp.IgnoreCase = True
 myRegExp.Global = False
 myRegExp.Pattern = ".*""maxResults"":50,""total"":([0-9]*).*"

Set matches = myRegExp.Execute(restReq.responseText)

total=0
 For Each myMatch in matches
 total=myMatch.SubMatches(0)
 Next

if total > 0 then
 edt_ExportResults.Text=edt_ExportResults.Text&req.UserFields("Number").Value&" has already existed in JIRA"&vbCrLf
 else
 'create new issue
 restReq.open "POST", url,false
 restReq.setRequestHeader "Content-Type", "application/json"
 restReq.setRequestHeader "User-Agent", "xxxxx" 'to avoid XRF check error
 restReq.SetRequestHeader "Authorization", "Basic " + Base64Encode(username + ":" + passwd)

restReq.Option(4) = 256 + 512 + 4096 + 8192 'ignore invalid SSL certificates

'strJSON should be filled in here with proper content as described in JIRA API
 restReq.send strJSON

'Msgbox(strJSON)
 if (restReq.status = 201) then
 edt_ExportResults.Text=edt_ExportResults.Text&req.UserFields("Number").Value&" sent successfully"&vbCrLf
 else
 edt_ExportResults.Text=edt_ExportResults.Text+"ERROR:"+req.UserFields("Number").Value+" was not sent successfully (status="+restReq.status+")"+vbCrLf
 edt_ExportResults.Text=edt_ExportResults.Text+restReq.responseText+vbCrLf
 edt_ExportResults.Text=edt_ExportResults.Text+strJSON
 end if
 'create new issue-end
 end if

Set restReq= Nothing

Dodaj komentarz

Twój adres e-mail nie zostanie opublikowany.