0 Replies - 302 Views - Last Post: 26 October 2014 - 08:30 AM Rate Topic: -----

#1 malbordio  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 2
  • Joined: 26-October 14

Performing some cosmetic changes on a HTA form based on vbscript

Posted 26 October 2014 - 08:30 AM

Hi all,

I have a working vbscript form with some parts based on hta code. The form is intended to open a incident in a ticketing tool. This is now working as expected but I still need to do some adjustments:

- can the password field be masked while typing a password?
- can the Descrição field (description) size become increased?
- is there a way to add a background image to the script and insert a logo on the top?

I think this can be changed on the hta part of the script but I tried to apply some modifications, changing the code as it if was in html or css, etc, so far without success.

Below is the code. Any clue? Thank you very much.

- can the password field be masked while typing a password?
- can the Descrição field (description) size become increased?
- is there a way to add a background image to the script and insert a logo on the top?

Option Explicit
Dim gServiceNowUser, gServiceNowPass

Const gServiceNowURL = "https://snow.service-now.com/" 
  
' Prepare ticket values dictionary 
Dim oParams, bAccepted 
Set oParams = CreateObject("Scripting.Dictionary") 
With oParams 
.Add "O seu username", "" ' "Caption", "Default Text"
.Add "A sua password", ""
.Add "Utilizador Afectado", ""
.Add "Categoria (Insira uma classificação geral)", ""
.Add "Sub-Categoria (Insira a aplicação/recurso associada à categoria)", ""
.Add "Tipo/Sintoma (Insira a dificuldade verificada)", ""
.Add "Suporte/Fornecedor (Equipa a atribuir incidente)", ""
.Add "Assunto (Insira um tópico para este incidente)", ""
.Add "Descrição (Descreva detalhadamente a sua situação)", ""
End With 
  
' Show `Get Ticket Values` form 
GetParams "Controlo de Serviço: Novo Incidente", "Enter your values", oParams, bAccepted, 550, 550 
If Not bAccepted Then 
WScript.Quit 
End If 
  
' Specify the ticket values 
Dim wsInsertIncident : Set wsInsertIncident = New ServiceNowDirectWS 
wsInsertIncident.SetMethod "incident", "insert" 
gServiceNowUser = oParams("O seu username")
gServiceNowPass = oParams("A sua password")
wsInsertIncident.SetValue "caller_id", oParams("Utilizador Afectado") 
wsInsertIncident.SetValue "u_category", oParams("Categoria (Insira uma classificação geral)") 
wsInsertIncident.SetValue "u_subcategory", oParams("Sub-Categoria (Insira a aplicação/recurso associada à categoria)") 
wsInsertIncident.SetValue "u_product_type", oParams("Tipo/Sintoma (Insira a dificuldade verificada)") 
wsInsertIncident.SetValue "assignment_group", oParams("Suporte/Fornecedor (Equipa a atribuir incidente)") 
wsInsertIncident.SetValue "short_description", oParams("Assunto (Insira um tópico para este incidente)") 
wsInsertIncident.SetValue "description", oParams("Descrição (Descreva detalhadamente a sua situação)") 
  
' Perform the insert and check the status 
If Not wsInsertIncident.Post Then 
WScript.Echo "Error=" & wsInsertIncident.Status 
WScript.Echo wsInsertIncident.StatusText 
WScript.Quit 
End If 
  
  
Class ServiceNowDirectWS 
' Use this class to call ServiceNow Direct Web Services functions 
' For documentation on the Direct WS API see: 
' http://wiki.servicenow.co..._Service_API_Functions 
  
Dim sEndpointURL, sTableName, sMethod, sResponsePath 
Dim oWSRequest, oWSRequestDoc, oWSResponseDoc 
Dim oWSRequestEnvelope, oWSRequestBody, oWSRequestOperation 
  
Public Sub SetMethod (tableName, method) 
' This function must be called BEFORE Post to initialize the class 
' method must be "insert", "update", "getKeys", "get" or "getRecords" 
sTableName = tableName 
sMethod = method 
sResponsePath = "/soap:Envelope/soap:Body/" & sMethod & "Response/" 
sEndpointURL = gServiceNowURL & sTableName & ".do?SOAP" 
If (sMethod = "get" Or sMethod = "getRecords") Then 
sEndpointURL = sEndpointURL & "&displayvalue=all" 
End If 
Set oWSRequest = CreateObject("MSXML2.XMLHTTP") 
Set oWSRequestDoc = CreateObject("MSXML2.DOMDocument") 
Set oWSRequestEnvelope = oWSRequestDoc.createElement("soap:Envelope") 
oWSRequestEnvelope.setAttribute "xmlns:soap", _ 
"http://schemas.xmlsoap.org/soap/envelope/" 
Set oWSRequestBody = oWSRequestDoc.createElement("soap:Body") 
Set oWSRequestOperation = oWSRequestDoc.createElement("tns:" & sMethod) 
oWSRequestOperation.setAttribute "xmlns:tns", _ 
"http://www.service-now.com/" & sTableName 
oWSRequestDoc.appendChild oWSRequestEnvelope 
oWSRequestEnvelope.appendChild oWSRequestBody 
oWSRequestBody.appendChild oWSRequestOperation 
End Sub 
  
Public Function Post 
' This function does the actual Web Services call 
' It returns True if the call is successful and False if there is an error 
oWSRequest.open "POST", sEndpointURL, False, gServiceNowUser, gServiceNowPass 
oWSRequest.setRequestHeader "Content-Type", "text/xml" 
oWSRequest.send oWSRequestDoc.xml 
If oWSRequest.status = 200 Then 
Set oWSResponseDoc = CreateObject("MSXML2.DOMDocument") 
oWSResponseDoc.loadXML oWSRequest.responseText 
oWSResponseDoc.setProperty "SelectionLanguage", "XPath" 
oWSResponseDoc.setProperty "SelectionNamespaces", _ 
"xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'" 
Post = True 
Else 
Set oWSResponseDoc = Nothing 
Post = False 
End if 
End Function 
  
Public Function Status 
' If Post returns False then call this function to obtain the HTTP status code 
Status = oWSRequest.status 
End Function 
  
Public Function StatusText 
' If Post returns False then call this function for the error text 
StatusText = oWSRequest.statusText 
End Function 
  
Public Sub SetValue(fieldname, fieldvalue) 
' This function must be called BEFORE Post 
Dim oChild 
Set oChild = oWSRequestDoc.createElement(fieldname) 
oChild.appendChild(oWSRequestDoc.createTextNode(fieldvalue)) 
oWSRequestOperation.appendChild(oChild) 
End Sub 
  
Public Function GetValue(fieldname) 
' This function must be called AFTER Post 
' If method is "insert" then it can be used to obtain the sys_id of the inserted record 
' If method is "get" then it can be used to obtain any field from the record 
GetValue = oWSResponseDoc.selectSingleNode(sResponsePath & fieldname).text 
End Function 
  
Public Function GetRowCount 
' This function may be called after Post if the method is "getRecords" 
' It returns the number of records in the result set 
Dim sResultsPath, oNodeset 
sResultsPath = sResponsePath & "getRecordsResult" 
Set oNodeSet = oWSResponseDoc.selectNodes(sResultsPath) 
getRowCount = oNodeSet.length 
End Function 
  
Public Function GetRowValue(rownum, fieldname) 
' This function may be called after Post if the method is "getRecords" 
' It returns a single field from a single record 
Dim sRowPath, sFieldPath 
sRowPath = sResponsePath & "getRecordsResult[" & rownum & "]/" 
sFieldPath = sRowPath & fieldname 
GetRowValue = oWSResponseDoc.selectSingleNode(sFieldPath).text 
End Function 
  
End Class 
  
Sub GetParams(sTitle, sPrompt, oParams, bAccepted, iWidth, iHeight) 
Dim oWnd, sContent, aKeys, i 
sContent = "<div style='font: 8pt tahoma;'>" 
aKeys = oParams.Keys 
For i = 0 To oParams.Count - 1 
sContent = sContent & "<span style='margin: 4px;'>" & HtmlSafe(aKeys(i)) & "</span><br>" 
sContent = sContent & "<input id=textbox" & i & " value='" & HtmlSafe(oParams.Item(aKeys(i))) & "' type='textbox' style='font: 8pt tahoma; width: 100%; margin: 4px;'/><br>" 
Next 
sContent = sContent & "<br><input onclick='window.accepted=true;' type='button' value='Criar' style='font: 8pt tahoma; width: 75px; height: 21px; float: right; margin-right: 20px;'/></div>" 
Set oWnd = CreateWindow() 
With oWnd 
With .Document 
.Title = sTitle 
.Body.Style.Background = "buttonface" 
.Body.InnerHtml = sContent 
End With 
.ResizeTo iWidth, iHeight 
.MoveTo CInt((.Screen.AvailWidth - iWidth) / 2), CInt((.Screen.AvailHeight - iHeight) / 2) 
End With 
oWnd.ExecScript "var accepted=false;" 
On Error Resume Next 
Do 
bAccepted = oWnd.Accepted 
If bAccepted Then Exit Do 
If Err.Number <> 0 Then 
bAccepted = False 
Exit Sub 
End If 
WScript.Sleep 10 
Loop 
For i = 0 To oParams.Count - 1 
oParams(aKeys(i)) = oWnd.document.GetElementById("textbox" & i).Value 
Next 
oWnd.Close 
End Sub 
  
Function HtmlSafe(sText) 
HtmlSafe = Replace(Replace(Replace(Replace(sText, "&", "&amp;"), "<", "&lt;"), ">", "&gt;"), vbCrLf, "<br>") 
End Function 
  
Function CreateWindow() 
' source http://forum.script-codin...c.php?pid=75356#p75356 
Dim sSignature, oShellWnd, oProc 
sSignature = Left(CreateObject("Scriptlet.TypeLib").Guid, 38) 
Set oProc = CreateObject("WScript.Shell").Exec("mshta ""about:<html><head><script>moveTo(-32000,-32000);document.title=' '</script><hta:application id=app border=thick minimizebutton=no maximizebutton=no scroll=no showintaskbar=yes contextmenu=no selection=no innerborder=no icon=""""/><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head></html>""") 
Do 
If oProc.Status > 0 Then 
Set CreateWindow = Nothing 
Exit Function 
End If 
For Each oShellWnd In CreateObject("Shell.Application").Windows 
On Error Resume Next 
Set CreateWindow = oShellWnd.GetProperty(sSignature) 
If Err.Number = 0 Then Exit Function 
On Error Goto 0 
Next 
Loop 
End Function 



Thank you so much!

Is This A Good Question/Topic? 0
  • +

Page 1 of 1