I have been trying to read and write messages to MQ from UFT. I am using the dotnet factory instance. i have reached till a point where i am able to connect to MQ while i am facing a problem in accessing the queue and read and write messages.
The code is as follows.
strQMgrName = "queue manager name"
strMQMDllPath = "C:\\Program Files (x86)\\IBM\WebSphere MQ\\bin\\amqmdnet.dll"
Set oMqEnvironment = DotNetFactory.CreateInstance("IBM.WMQ.MQEnvironment",strMQMDllPath)
oMqEnvironment.Hostname = "host name"
oMqEnvironment.Port = "port number"
oMqEnvironment.Channel = "channel name"
Set oMQC = DotNetFactory.CreateInstance("IBM.WMQ.MQC",strMQMDllPath)
' qmanager name,channel name, connection name
Set oMqQMgr = DotNetFactory.CreateInstance("IBM.WMQ.MQQueueManager",strMQMDllPath,strQMgrName)
oMqQMgr.isConnected ' gives true
Now i wan to use the method
public MQQueue AccessQueue(string queueName, int openOptions)
of the instance IBM.WMQ.MQQueueManager. can someone guide me in doing the same and let me know how i can push messages and read messages from the mentioned queue
Thank you
After a lot of googling and reading IBM documentation , i was able to put and get messages in MQ from UFT. .. Below in the code snippet that worked for me .. Hope this helps some one .. I was working on PUT and GET separately, hence there might be some repetition in the code.
Prerequisite for this.. You have to download MQ Client from IBM site and install it on PC where UFT is installed.. IBM MQ client is a freeware
Dim oMQEnvironment
Dim oMQM
Dim oMQC
Dim oMQMessage
Dim oMQQueue
Dim intOpenOptions
strMQMDLLPath = "C:\\Program Files (x86)\\IBM\WebSphere MQ\\bin\\amqmdnet.dll"
strHostName= "Host Name"
intPort = "Port Number"
strChannel ="Channel Name"
strMessage ="UFT Test Message"
strMQManager = "Quemanager Name"
strMessageQueue = "Queue Name"
' This part of the code is blatantly copied from one of the posts online. Will post the link once i find it again
'for application(UFT) to connect to a queue manager in client mode
Set oMQEnvironment = DotNetFactory.CreateInstance("IBM.WMQ.MQEnvironment",strMQMDLLPath)
'Initize the Environment
With oMQEnvironment
.HostName = strHostName
.Port = intPort
.Channel = strChannel
End with
On Error Resume Next
'Create MQ Instatnces
Set oMQM = DotnetFactory.CreateInstance("IBM.WMQ.MQQueueManager",strMQMDLLPath)
'Check if MQM Connected
If Err.Number <> 0 Then
Reporter.ReportEvent micFail , "Step: Creating MQM Object" , "Unable to Connect to MQ Manager at" & strHostName
'Exit Test
End If
Set oMQC = DotnetFactory.CreateInstance("IBM.WMQ.MQC",strMQMDLLPath)
Set oMQMessage = DotnetFactory.CreateInstance("IBM.WMQ.MQMessage",strMQMDLLPath)
'Declare Q open options
intOpenOptions = oMQC.MQOO_OUTPUT or oMQC.MQOO_FAIL_IF_QUIESCING ' 16 + 8192
'Open the Q to post the messages
If strRemoteMQManager = "" Then
Set oMQQueue = oMQM.AccessQueue(strMessageQueue , intOpenOptions)
Else
Set oMQQueue = oMQM.AccessQueue(strMessageQueue , intOpenOptions ,strRemoteMQManager, "","" )
End If
'Format Message
With oMQMessage
.CharacterSet = 819
.WriteString(strMessage)
End with
'Post Message
With oMQQueue
.Put(oMQMessage)
.Close()
End With
Now for getting the message from MQ
Dim oMQEnvironment
Dim oMQM
Dim oMQC
Dim oMQMessage
Dim oMQQueue
strMQMDLLPath = "C:\\Program Files (x86)\\IBM\WebSphere MQ\\bin\\amqmdnet.dll"
strHostName= "host name"
intPort = "port number"
strChannel ="channel name"
strMessage ="UFT Test Message"
strMessageQueue = "message queue intended to access"
strMQManager = "mq manager name"
strRemoteMQManager=""
'Create MQ Instances
Set oMQC = DotnetFactory.CreateInstance("IBM.WMQ.MQC",strMQMDLLPath)
'set the properties of the Queue manager
Set properties = DotNetFactory.CreateInstance("System.Collections.Hashtable")
properties.Add oMQC.HOST_NAME_PROPERTY, strHostName
properties.Add oMQC.PORT_PROPERTY, intPort
properties.Add oMQC.CHANNEL_PROPERTY, strChannel
'access the queue manager
Set oMQM = DotnetFactory.CreateInstance("IBM.WMQ.MQQueueManager",strMQMDLLPath,strMQManager,properties)
'here We are trying to browse the message one by one and keep the messages on the queue.
'Declare Q open options
Set oMQQueue = oMQM.AccessQueue(strMessageQueue,oMQC.MQOO_BROWSE)
Set oMQGetMessageOptions = DotNetFactory.CreateInstance("IBM.WMQ.MQGetMessageOptions",strMQMDLLPath)
oMQGetMessageOptions.Options = oMQC.MQGMO_BROWSE_FIRST
Set oMQMessage = DotnetFactory.CreateInstance("IBM.WMQ.MQMessage",strMQMDLLPath)
oMQQueue.Get oMQMessage,oMQGetMessageOptions
Set mqGetNextMsgOpts = DotNetFactory.CreateInstance("IBM.WMQ.MQGetMessageOptions",strMQMDLLPath)
mqGetNextMsgOpts.Options = oMQC.MQGMO_BROWSE_NEXT
browseMessages = true
Do while browseMessages
on error resume next
messageText = oMQMessage.ReadString(oMQMessage.MessageLength)
'Print messageText
Set oMQMessage = DotnetFactory.CreateInstance("IBM.WMQ.MQMessage",strMQMDLLPath)
oMQQueue.Get oMQMessage,mqGetNextMsgOpts
if Err.Number <> 0 then browseMessages =false
'Clear both MsgID and CorrelID for next use.
oMQMessage.MessageId = oMQC.MQMI_NONE
oMQMessage.CorrelationId = oMQC.MQCI_NONE
Loop
'Cleanup
Set oMQQueue = Nothing
Set oMQMessage= Nothing
Set oMQOpenOptions= Nothing
Set oMQM= Nothing
Set oMQEnvironment = Nothing
Related
I have the following VBScript (vbs):
Option Explicit
Dim cn, cmDB, rs
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = "DSN=PostgreSQLDNSHere"
cn.Open
cn.CommandTimeout = 28800
Set cmDB = CreateObject("ADODB.Command")
cmDB.CommandTimeout = 28800
Set rs = CreateObject("ADODB.Recordset")
rs.CursorType = 2
MsgBox "disconnected network here then clicked ok to proceed"
MsgBox cn.State
MsgBox cmDB.State
MsgBox rs.State
Set rs = cn.Execute("select * from test;")
WScript.Quit
At the first message box I would like to simulate losing a connection to our database. Possible causes could be that the database is down or the LAN is down, etc. In other words, I want to test if the connection is in good order so a valid execute statement will succeed. The msgboxes above never change after I disconnect from the network.
The only way I can currently do it is to Execute after a On Error Resume Next, then look at the Err.Number. Is there a way to test the connection prior to the execute so I can reconnect then execute like this:
Option Explicit
Dim cn, cmDB, rs
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = "DSN=PostgreSQLDNSHere"
cn.Open
cn.CommandTimeout = 28800
Set cmDB = CreateObject("ADODB.Command")
cmDB.CommandTimeout = 28800
Set rs = CreateObject("ADODB.recordset")
rs.CursorType = 2
MsgBox "disconnected network here then clicked ok to proceed"
If cn.State = ?? Then
'reconnect here
End If
Set rs = cn.Execute("select * from test;")
WScript.Quit
EDIT1:
I also tried setting the recordset after disconnect, but that didn't change the message box result in the first code snippet.
The State property indicates just the state of the connection on the client side. AFAIK you need to execute a query in order to detect whether or not the server is still available.
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = cn
cmd.CommandText = "SELECT 1;"
On Error Resume Next
Set rs = cmd.Execute
If Err Then
If Err.Number = &h80004005 Then
'server side disconnected -> re-open
cn.Close
cn.Open
Else
WScript.Echo "Unexpected error 0x" & Hex(Err.Number) & ": " & Err.Description
WScript.Quit 1
End If
End If
Note that you may need to re-assign the re-opened connection to the object using it.
Note also that the above does just the most basic reconnect by closing and re-opening the connection. In real-world scenarios you may want to be able to retry at least a couple times if the reconnect fails as well (e.g. because the network or server hasn't come back up yet).
Using Ansgar's suggestion I am posting code that will "try at least a couple times". The function will return the connection object if it successfully reconnects or the connection is already good, else nothing after trying a user input number of times and waiting a user input number of seconds between tries:
Option Explicit
dim cn, cmDB, rs
set cn = CreateObject("ADODB.Connection")
cn.ConnectionString= "DSN=PostgreSQLDsn"
cn.open
cn.CommandTimeout = 28800
Set cmDB = CreateObject("ADODB.Command")
cmDB.CommandTimeout = 28800
set rs = CreateObject("ADODB.recordset")
rs.CursorType = 2
msgbox "disconnected internet here then clicked ok to proceed"
set cn = TestReOpenConnection(cn,"DSN=PostgreSQLDsn",28800,2,100)
if cn is nothing then
msgbox "not good"
WScript.Quit
end if
set rs = cn.execute("select * from test;")
msgbox "all good: " & rs.fields("x")
WScript.Quit
function TestReOpenConnection(cn,sDsn,iConnTimeOut,iWaitSecs,iTimesToTry)
dim iWaitMilSecs
iWaitMilSecs = iWaitSecs * 1000
dim bConnected
bConnected = false
dim iTries
iTries = 0
dim rsTest
set rsTest = CreateObject("ADODB.recordset")
do while bConnected = false
On Error Resume Next
Set rsTest = cn.execute("select 1;")
If Err Then
if iTries <> 0 then
WScript.Sleep iWaitMilSecs 'if we tried once already, then wait
end if
cn.Close
set cn = CreateObject("ADODB.Connection")
cn.ConnectionString= sDsn
On Error Resume Next
cn.open
cn.CommandTimeout = iConnTimeOut
else
bConnected = true
set TestReOpenConnection = cn
End If
iTries = iTries + 1
if iTries > iTimesToTry then
set TestReOpenConnection = nothing
exit do
end if
loop
end function
This answer isn't necessary to the central question I asked, but I thought it would be useful to people viewing this in the future. Probably could use some cleaning up.
I need help with my first VBS script. Basically I want to check if outlook is open, if not I want to open the program, if/when it is open I want to send an email.
set service = GetObject ("winmgmts:")
for each Process in Service.InstancesOf ("Win32_Process")
If Process.Name = "outlook.exe"(
goto "send"
) else (
goto "Open"
)
End If
Open:
Dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
objShell.Run("""C:\Program Files (x86)\Microsoft Office\Office16\OUTLOOK.EXE""")
Set objShell = Nothing
GOTO send
send:
wscript.Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Sign in- please reply!"
objMessage.Sender = "test#gmail.com"
objMessage.From = "test#gmail.com"
objMessage.To = "test#gmail.com"
objMessage.TextBody = Test Body Email
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
objMessage.Send
exit
I do know my email part works as I can run that and send my email. I'm having issues with the "If, ELSE, THEN" statement.
If Process.Name = "outlook.exe" Then
send
Else
open
End If
Will be the correct format for If..Then..Else, but vbscript does not support GoTo statements. If you convert send and open to functions then you will be able to call them as shown above
Hi I am sending lotus notes mail with VB script . Now I want to send mail with other mail box which is opened in my lotus notes instead of my mail box. I tried different options but no luck. I am using below code to send mail.
You can find the code in below URL:
https://gallery.technet.microsoft.com/scriptcenter/fe141119-9599-46a7-90ca-8dbc66d50297
option explicit
' --------------------------------------------------------------------------
' -- Create Lotus Notes email (and add attachment) using VB Script
' --
' -- Version 1.01
' --
' -- Created by : Michael Green
' -- migreen#westpac.com.au
' --
' -- Based on in-complete/partially working script from :
' -- http://en.allexperts.com/q/Using-Lotus-Notes-1427/Creating-LotusNotes-email-using-1.htm
' --
' -- Created : 06/10/2009
' -- Last Updated: 07/10/2009
' --------------------------------------------------------------------------
Dim oSession ' AS NotesSession
Dim strServer
Dim strUserName
Dim strMailDbName
Dim oCurrentMailDb ' as NOTESDATABASE
Dim oMailDoc ' as NOTESDOCUMENT
Dim ortItem ' as NOTESRICHTEXTITEM
Dim ortAttacment ' as NOTESRICHTEXTITEM
Dim oEmbedObject ' as ????
dim cstrAttachment
Dim blAttachment
cstrAttachment = "c:\Temp\Telstra.xls"
blAttachment = True
' Start a session to notes
wscript.echo "## Connecting to Lotus Notes session..."
Set oSession = CreateObject("Notes.NotesSession")
wscript.echo("NotesVersion : " & oSession.NotesVersion)
wscript.echo("NotesBuildVersion: " & oSession.NotesBuildVersion)
wscript.echo("UserName : " & oSession.UserName)
wscript.echo("EffectiveUserName: " & oSession.EffectiveUserName)
wscript.echo "## GetEnvironmentString..."
strServer = oSession.GetEnvironmentString("MailServer",True)
wscript.echo("Server :" & strServer)
' eg. CN=Michael V Green/OU=CORPAU/OU=WBCAU/O=WBG
strUserName = oSession.UserName
strMailDbName = Left(strUserName, 1) & Right(strUserName, (Len(strUserName) - InStr(1, strUserName, "")))&".nsf"
wscript.echo("MailDbName :" & strMailDbName)
wscript.echo "## Getting current Notes database..."
' open the mail database in Notes
set oCurrentMailDb = oSession.CurrentDatabase
wscript.echo("fileName:" & oCurrentMailDb.fileName)
wscript.echo("filePath:" & oCurrentMailDb.filePath)
wscript.echo("server:" & oCurrentMailDb.server)
wscript.echo("Title:" & oCurrentMailDb.Title)
If oCurrentMailDb.IsOpen = True Then
' Already open for mail
wscript.echo "## Lotus Notes mail database is already open !"
Else
wscript.echo "## Opening Lotus Notes mail database..."
oCurrentMailDb.OPENMAIL
End If
' Create a document in the back end
Set oMailDoc = oCurrentMailDb.CREATEDOCUMENT
' Set the form name to memo
OMailDoc.form = "Memo"
with oMailDoc
.SendTo = "migreen#westpac.com.au"
.BlindCopyTo = "mgreen#ozemail.com.au"
.CopyTo = "migreen#westpac.com.au"
.Subject = "This is a test of VB scripting driving Lotus Notes 7 "
end with
set ortItem = oMaildoc.CREATERICHTEXTITEM("Body")
with ortItem
.AppendText("Test of RTF Item append")
.AddNewLine(2)
.AppendText("Signature")
End With
' Create additional Rich Text item and attach it
If blAttachment Then
Set ortAttacment = oMailDoc.CREATERICHTEXTITEM("Attachment")
' Function EMBEDOBJECT(ByVal TYPE As Short, ByVal CLASS As String, ByVal SOURCE As String, Optional ByVal OBJECTNAME As Object = Nothing) As Object
' Member of lotus.NOTESRICHTEXTITEM
Set oEmbedObject = ortAttacment.EMBEDOBJECT(1454, "", cstrAttachment, "Attachment")
End If
wscript.echo "## Sending email..."
with oMailDoc
.PostedDate = Now()
.SAVEMESSAGEONSEND = "True"
.send(false)
end with
wscript.echo "## Sent !"
' close objects
set oMailDoc = nothing
set oCurrentMailDb = nothing
set oSession = nothing
Just replace the lines (that are complete nonsense, but I told you in the other post):
strMailDbName = Left(strUserName, 1) & Right(strUserName, (Len(strUserName) - InStr(1, strUserName, "")))&".nsf"
wscript.echo("MailDbName :" & strMailDbName)
wscript.echo "## Getting current Notes database..."
' open the mail database in Notes
set oCurrentMailDb = oSession.CurrentDatabase
wscript.echo("fileName:" & oCurrentMailDb.fileName)
wscript.echo("filePath:" & oCurrentMailDb.filePath)
wscript.echo("server:" & oCurrentMailDb.server)
wscript.echo("Title:" & oCurrentMailDb.Title)
If oCurrentMailDb.IsOpen = True Then
' Already open for mail
wscript.echo "## Lotus Notes mail database is already open !"
Else
wscript.echo "## Opening Lotus Notes mail database..."
oCurrentMailDb.OPENMAIL
End If
with
strServer = "ServerNameWhereMailboxIs"
strMailDbName = "mail\nameofotherdatabase.nsf"
set oCurrentMailDb = oSession.GetDatabase( strServer, strMailDbName )
That will do the trick.
As your question changed after my answer, I will -for the sake of anybody finding this question in the future- add some code for "sending an email in the name of another sender":
In Lotus Notes it is not possible to "send" a mail without leaving traces of the person who really sent it:
When you receive such a mail, that was sent by someone else you will see, that the mail comes from the other mailbox, but it will contain the information "Sent by" with the mailaddress of the "real" sender.
To at least make the "visual" sender look right, you need to add different fields that are needed in different cases: These fields are Principal, InetPrincipal, From and InetFrom.
However: On a Domino- Server that is configured right, this will not help: It will calculate these fields from the "real" sender and ignore what you gave him.
But there is a trick to make the router leave these fields alone: You have to add the NotesDomain to the adressen. If you add the following lines to your code, then the router will ignore these and keep the fields intact:
MailDoc.principal = "noreply#company.com#NotesDomain"
MailDoc.inetprincipal = "noreply#company.com#NotesDomain"
MailDoc.from = "noreply#company.com#NotesDomain"
MailDoc.inetfrom = "noreply#company.com#NotesDomain"
If you really need to "hide" the real sender completely from the recipient, then you cannot create the mail in the mail database, but create it directly in the "mail.box" of the server and just "Save" it instead of "Send" it. But this has other downsides and will not be discussed here.
I just want to leave one more answer about "send from/reply to" because this question here is what I found when I was searching for help:
I found out that only my own mailadress is shown to external recipients or people not using IBM notes. Even if I sent mails via a different mailfile (a Mail-In) only my own mailadress was shown and I also was the one the recipient could reply to. So I tried something, and it worked.
After some testing, this lines helped me out internal and external:
sender = """John Doe""" & "<support#domain.de>"
MailDoc.ReplyTo = sender
MailDoc.SMTPOriginator = sender
MailDoc.sender = sender
MailDoc.principal = sender
MailDoc.inetprincipal = sender
MailDoc.from = sender
MailDoc.inetfrom = sender
MailDoc.displayfrom = sender
I have a legacy VB6 codebase which I would like to extend to include support for sending mails through an external SMTP server (smtp.live.com).
I use CDO for sending the mail. My machine runs Windows 7.
Unfortunately I get a "The transport failed to connect to the server" error message when trying to send send the mail.
Below is the code.
VB6
Dim oNewMessage As CDO.Message
Dim iConf As New CDO.Configuration
Dim oFlds As ADODB.Fields
Dim strbody As String
On Error GoTo errSMPT
iConf.Load cdoDefaults
Set oFlds = iConf.Fields
oFlds(cdoSendUsingMethod) = cdoSendUsingPort
oFlds(cdoSMTPServer) = "smtp.live.com"
oFlds(cdoSMTPServerPort) = 587
oFlds(cdoSMTPConnectionTimeout) = 30
oFlds(cdoSMTPUseSSL) = True
oFlds(cdoSMTPAuthenticate) = cdoBasic
oFlds(cdoSendUserName) = "xxxxxx#hotmail.com"
oFlds(cdoSendPassword) = "mypassword"
oFlds.Update
strbody = "Sample message " & Time
Set oNewMessage = New CDO.Message
Set oNewMessage.Configuration = iConf
With oNewMessage
.To = txtTo.Text
.From = txtFrom.Text
.Subject = "subject"
.TextBody = strbody
.Send
End With
Exit Sub
errSMPT:
MsgBox Err.Description
I don't think that the problem is related to firewall or account security issues since the C# code below works without any problems.
C#
using (MailMessage message = new MailMessage(txtFrom.Text, txtTo.Text, txtSubject.Text, txtText.Text))
{
SmtpClient mailClient = new SmtpClient("smtp.live.com", 587);
mailClient.Credentials = new System.Net.NetworkCredential("xxxxxx#hotmail.com", "mypassword");
mailClient.EnableSsl = true;
mailClient.Send(message);
MessageBox.Show("Message successfully sent!!!");
}
Any help is appreciated!
Thanks
//Peter
I think your problem is here:
oFlds(cdoSMTPUseSSL) = True
This should be an integer instead of a boolean. When VB6 converts true to and int, the value is -1. I suggest you change that line to:
oFlds(cdoSMTPUseSSL) = 1
I search for a Script that pings a List of machines and if a IP has changed send a warning mail. Hope somebody can help me.
Greets Mohrjon
Is the ping sufficient information to know that the IP address has changed? - what if the network goes down for a short period of time whilst the script is running?
Anyhow these are three subs i have which i have bodged together which should do what you need
Firstly i would iterate through a text file (csv) to get my ip address, and in this case the name and email
Sub Open_Master_File()
Do While objTextFile.AtEndOfStream <> True
strLine = objTextFile.ReadLine
'skip if comment line found
If inStr(1,strLine, "'") Then
ElseIf inStr(1,strLine, ",") Then
arrayMasterFile = split(strLine, ",")
strStoreName = arrayMasterFile(0)
strComputerIP = arrayMasterFile(1)
strEmailRecipient = arrayMasterFile(2)
'Call ping function to check for online/offline computers
Call Ping_Computer()
End If
Loop
'Release Memory
objTextFile.Close()
Set objTextFile = Nothing
Set objMasterFSO = Nothing
End Sub
next i ping to each of the ip's (btw this will only show if the ip is offline, can you guarantee that the ip is online all of the time?)
Sub Ping_Computer()
Set wshShell = CreateObject("WScript.Shell")
'Run the ping program 3 times, with a 2000ms delay on each, 0 = don't display cmd prompt
'All three pings must be successful for CBool = true
pingSuccessful = Not CBool(wshShell.run("ping -n 3 -w 2000 " & strComputerIP,0,True))
If pingSuccessful = True Then
Else
Call Send_EMail()
End If
'Release memory
Set wshShell = Nothing
End Sub
Send an email
Sub Send_Email()
Set objEmail = CreateObject("CDO.Message")
strSubject = ""
strEmailFrom = ""
strBody = ""
objEmail.Subject = strSubject
objEmail.From = strEmailFrom
objEmail.To = strEmailRecipient
'Use Microsoft schemas for emails
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoNTLM
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = cMailPort
objEmail.Configuration.Fields.Update
objEmail.Textbody = strBody
'Check if an error occurs during the send email process, do not stop program
On Error Resume Next
objEmail.Send
'error on send
If Err.Number <> 0 Then
Else
End If
'clear errors
On Error Goto 0
'Release Memory
Set objEmail = Nothing
End Sub