Wynalazkowo - eksperymenty małe i duże

Omnitracker

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