In the following method I am trying to add a dynamic member to an expando object but it throws an exception:
public member not found for expand object
Private Sub GetAckValues()
Try
Dim ack_duration As String = String.Empty
Dim ack_by_user_fkid As String = String.Empty
Dim ack_time As String = String.Empty
ack_duration = txtdefaultack.Text
ack_by_user_fkid = Convert.ToString(Session("user_code"))
Dim Ack_Detail As Object = New ExpandoObject()
Ack_Detail.ack_duration = ack_duration
Ack_Detail.ack_by_user_fkid = ack_by_user_fkid
receiptObject.StatusObject = Ack_Detail
Catch ex As Exception
logger.Error("Enter JobRequest form done by :" & LoggedinUserId, ex)
End Try
End Sub
Should this:
Ack_Detail.ack_duration = Ack_Detail.ack_duration
actually be this:
Ack_Detail.ack_duration = ack_duration
Related
Firstly, I'm quite new to this so be gentle!
I am trying to create a class/object in VB.net for use in vba. I have used Gary Whitcher's code from the bottom of this post:
Sample vb.net code to upload file to Amazon S3 storage
I have created a class in Visual Studio and managed to get it to output a TLB file which i can import to VBA in Excel.
I can then use the object in VBA to create a new folder in the S3 storage system however I am running into problems when using the 'AddFileToFolder' method.
I have had to edit Gary's code a little to get it to compile in VS, the edited version is below.
Imports Amazon.S3
Imports Amazon.S3.Model
Imports Amazon
Imports Amazon.S3.Util
Imports System.Collections.ObjectModel
Imports System.IO
Public Class aws_s3
Const AWS_ACCESS_KEY As String = "AccessKey" 'is set to MY actual key
Const AWS_SECRET_KEY As String = "SecretKey" 'is set to MY actual key
Private Property s3Client As IAmazonS3
Sub New()
Try
s3Client = New AmazonS3Client(AWS_ACCESS_KEY, AWS_SECRET_KEY, RegionEndpoint.USEast1)
Catch ex As Exception
End Try
End Sub
Public Function CreateFolder(bucketName As String, folderName() As String) As String
Dim returnval As String = ""
Try
Try
Dim folderKey As String = ""
If Not AmazonS3Util.DoesS3BucketExist(s3Client, bucketName) Then
returnval = "Bucket does not exist"
Else
For i = 0 To folderName.Length - 1
folderKey += folderName(i) & "/"
Next
' folderKey = folderKey & "/" 'end the folder name with "/"
Dim request As PutObjectRequest = New PutObjectRequest()
request.BucketName = bucketName
request.StorageClass = S3StorageClass.Standard
request.ServerSideEncryptionMethod = ServerSideEncryptionMethod.None
' request.CannedACL = S3CannedACL.BucketOwnerFullControl
request.Key = folderKey
request.ContentBody = String.Empty
s3Client.PutObject(request)
End If
Catch ex As Exception
returnval = ex.Message
End Try
Catch ex As AmazonS3Exception
returnval = ex.Message
End Try
Return returnval
End Function
Public Function AddFileToFolder(FileName As String, bucketName As String, folderName As String) As String
Dim returnval As String = ""
Try
Try
If Not AmazonS3Util.DoesS3BucketExist(s3Client, bucketName) Then
Dim fname() As String = folderName.Split("/")
CreateFolder(bucketName, fname)
Else
Dim path As String = FileName
Dim file As FileInfo = New FileInfo(path)
Dim key As String = String.Format("{0}/{1}", folderName, file.Name)
Dim por As PutObjectRequest = New PutObjectRequest()
por.BucketName = bucketName
por.StorageClass = S3StorageClass.Standard
por.ServerSideEncryptionMethod = ServerSideEncryptionMethod.None
por.CannedACL = S3CannedACL.PublicRead
por.Key = key
por.InputStream = file.OpenRead()
s3Client.PutObject(por)
End If
Catch ex As Exception
returnval = ex.Message
End Try
Catch ex As AmazonS3Exception
returnval = ex.Message
End Try
Return returnval & " dll"
End Function
End Class
Using VBA, I have created the above object and can successfully execute CreateFolder but when executing addfiletofolder i get the error "Class does not support automation or does not support expected interface"
the VBA code looks like this:
Dim aws As AWS_S3
Dim Result As String
Dim UploadFile As String
UploadFile = "C:\Zipped Builds\Hinchley Legion.zip"
Set aws = New AWS_S3
Dim fld(1) As String
fld(0) = "folder"
fld(1) = "subfolder"
Result = aws.CreateFolder("nsmcustomercontent", fld)
If Result <> "" Then GoTo errHandle
Result = aws.AddFileToFolder(UploadFile, "nsmcustomercontent", fld)
If Result <> "" Then GoTo errHandle
Exit Sub
errHandle:
MsgBox Result
End Sub
I'm guessing from the fact that CreateFolder works fine but AddFileToFolder doesn't, there is a problem in the class as created in VS, missing a dependancy or something?
Thanks Anu6is, that was indeed the problem. The author of the class had wrote the following for usage which had thrown me off:
ADD FILE TO FOLDER
Dim fld(1) As String
fld(0) = <foldername>
fld(1) = <subfoldername>
'List each sub folder as an element in array
Dim rtrn As String = aws.AddFileToFolder(<local file name>,<bucketname>, fld)
I need to get better at reading VB.Net i think! Many thanks for your quick reply, much appreciated.
We use Kaspersky Security Center to manage AV on all our domain computers. I was looking for an external way to move computers to different groups and change the comments we give them in the Kaspersky Security Center. Kaspersky gave me some links to check out but I have no idea where to start on this. I was looking to code this in a VB.Net Windows Form Application.
My question is how do i convert or make the below jscript work in a VB.net Windows form. I'm going to have a sql table loaded with the Kaspersky Host ID, Comment and GroupID. once a day i want to iterate down through that sql table and only update the computers that need changes made wither to their comment or group. (the sql part i already have written)
Here is what im Aiming for:
Dim reader3 As SqlDataReader
Dim strconnection3 As String
strconnection3 = data_source_all 'defined globally
Dim SqlConnection3 As New SqlConnection(strconnection3)
Dim cmd3 As New SqlCommand
cmd3.CommandText = "SELECT kaspersky_hostid, kaspersky_comment, pc_info_comment, kaspersky_groupid FROM pc_info where (pc_status = 'active')"
cmd3.CommandType = CommandType.Text
cmd3.Connection = SqlConnection3
SqlConnection3.Open()
reader3 = cmd3.ExecuteReader()
If reader3.HasRows Then
While reader3.Read()
If reader3(1).ToString = reader3(2).ToString Then
Else
Update_Host_Comment(reader3(0).ToString,reader3(2).ToString)
End If
End While
SqlConnection3.Close()
SqlConnection3.Dispose()
cmd3.Dispose()
Else
End If
Public Sub Update_Host_Comment(ByVal hostid As String, ByVal comment As String)
'Converted JScript
'var oHosts = new ActiveXObject("klakaut.KlAkHosts");
'oHosts.AdmServer = AcquireAdServerProxy();
'var strHostName = hostid; //name of the host to change attributes
'//Fill container with attributes to change
'var oProps = new ActiveXObject("klakaut.KlAkParams");
'oProps.Item("KLHST_WKS_COMMENT") = comment; //Change Comment
'oHosts.UpdateHost(strHostName, oProps);
End Sub
Link1: https://support.kaspersky.com/9291
Link2: https://support.kaspersky.com/2810
below is the JScript i want to run with vb.net:
function AcquireAdServerProxy()
{
var oSrvConnectionProps = new ActiveXObject("klakaut.KlAkParams");
oSrvConnectionProps.Add("Address", "localhost:13291");
oSrvConnectionProps.Add("UseSSL", true);
var oAdmServer = new ActiveXObject("klakaut.KlAkProxy");
oAdmServer.Connect(oSrvConnectionProps);
return oAdmServer;
};
function Update_Host_Comment(hostid,comment)
{
var oHosts = new ActiveXObject("klakaut.KlAkHosts");
oHosts.AdmServer = AcquireAdServerProxy();
var strHostName = hostid; //name of the host to change attributes
//Fill container with attributes to change
var oProps = new ActiveXObject("klakaut.KlAkParams");
oProps.Item("KLHST_WKS_COMMENT") = comment; //Change Comment
oHosts.UpdateHost(strHostName, oProps);
};
function Update_Host_Group(hostid,groupid)
{
var oHosts = new ActiveXObject("klakaut.KlAkHosts");
oHosts.AdmServer = AcquireAdServerProxy();
var strHostName = hostid; //name of the host to change attributes
//Fill container with attributes to change
var oProps = new ActiveXObject("klakaut.KlAkParams");
oProps.Item("KLHST_WKS_GROUPID") = groupid; //Change group
oHosts.UpdateHost(strHostName, oProps);
};
//Calling Functions
Update_Host_Comment("SomeHostID","Some Comment Text");
Update_Host_Group("SomeHostID","Some GroupID");
06/04/18 Edit: Here is the code i tried:
Public Function AcquireAdServerProxy()
Try
Dim oSrvConnectionProps = CreateObject("klakaut.KlAkParams")
oSrvConnectionProps.Add("Address", "localhost:13291")
oSrvConnectionProps.Add("UseSSL", True)
Dim oAdmServer = CreateObject("klakaut.KlAkProxy")
oAdmServer.Connect(oSrvConnectionProps)
Return oAdmServer
Catch ex As Exception
MsgBox(ex.ToString)
Return False
End Try
End Function
Public Function Update_Host_Comment(ByVal hostid As String, ByVal comment As String) As Boolean
Try
Dim ohosts = CreateObject("klakaut.KlAkHosts")
ohosts.AdmServer = AcquireAdServerProxy()
Dim strHostName = hostid
'Fill container with attributes to change
Dim oProps = CreateObject("klakaut.KlAkParams")
oProps.Item("KLHST_WKS_COMMENT") = comment
ohosts.UpdateHost(strHostName, oProps)
Return True
Catch ex As Exception
MsgBox(ex.ToString)
Return False
End Try
End Function
Public Function Update_Host_Group(ByVal hostid As String, ByVal groupid As Integer) As Boolean
Try
Dim ohosts = CreateObject("klakaut.KlAkHosts")
ohosts.AdmServer = AcquireAdServerProxy()
Dim strHostName = hostid
'Fill container with attributes to change
Dim oProps = CreateObject("klakaut.KlAkParams")
oProps.Item("KLHST_WKS_GROUPID") = groupid
ohosts.UpdateHost(strHostName, oProps)
Return True
Catch ex As Exception
MsgBox(ex.ToString)
Return False
End Try
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Label4.Text = "Processing ..."
Label4.Update()
Try
If TextBox1.Text <> Nothing Then
If TextBox2.Text <> Nothing Then
If Update_Host_Comment(TextBox1.Text, TextBox2.Text.ToUpper) Then
Label4.Text = "Comment Updated"
Label4.Update()
Else
Label4.Text = "Comment Update Error"
Label4.Update()
End If
Else
End If
If TextBox3.Text <> Nothing And IsNumeric(TextBox3.Text) Then
If Update_Host_Group(TextBox1.Text, TextBox3.Text) Then
Label4.Text = Label4.Text & " / Group Updated"
Label4.Update()
Else
Label4.Text = Label4.Text & " / Group Update Error"
Label4.Update()
End If
Else
End If
End If
Catch ex As Exception
Label4.Text = "Error"
Label4.Update()
End Try
End Sub
End Class
This is the error i get when i run it:
System.Runtime.InteropServices.COMException (0xE0FF04FD): Transport level error while connecting to http://localhost:13291: failed to resolve address at Microsoft.VisualBasic.CompilerServices.LateBinding.InternalLateCall(Object o, Type objType, String name, Object[] args, String[] paramnames, Boolean[] CopyBack, Boolean IgnoreReturn) at Microsoft.VisualBasic.CompilerServices.NewLateBinding.LateCall(Object Instance, Type Type, String MemberName, Object[] Arguments, String[] ArgumentNames, Type[] TypeArguments, Boolean[] CopyBack, Boolean IgnoreReturn) at kaspersky_api.Form1.AcquireAdServerProxy()
I can not get VB.net connect to a mongodb replicaset - it throws exceptions
dim mongo as MongoDBClient
dim mgDB as MongoDatabase
dim mgcol as MongoCollection(of Bob)
public class Bob
public property ID as ObjectID
public property Name as string
end class
sub Main()
try
mongo = New MongoClient("mongodb://ip:port,ip:port,ip:port/?replicaSet=Bob")
mgDB = mongo.GetDatabase("test")
mscol = mgDB.Collection(of Bob)("test.me")
mgDB.GetCollection("test.me").Find(MongoDB.Driver.Builders.Query.Exists("id"))
catch ex as Exception
console.writeline(ex)
end try
end sub
I don't know how I'm supposed to query via VB .Net?
I got this to work
Dim _client As IMongoClient
Dim _db As IMongoDatabase
Sub Main()
System.Console.WriteLine("Hi, Bob!!")
Try
_client = New MongoClient("mongodb://mongoone:27020,mongotwo:27021,mongothree:27020/?replicaSet=Bob")
_db = _client.GetDatabase("Test")
Dim mgCol = _db.GetCollection(Of Bob)("test.me")
Dim mybob As Bob
mybob = New Bob
mybob.Name = "Sam6"
mybob.ID = ObjectId.GenerateNewId
'mgCol.InsertOne(mybob)
getSomedata().Wait()
'getDataByFilterExtists().Wait()
'getMetaCardSpectrum().Wait()
getMetaCardSpectrumObj().Wait()
Catch ex As Exception
Console.WriteLine(ex)
End Try
End Sub
I try to obtain a certificate with LDAP, but i have an exception
System.Runtime.InteropServices.COMException(0x80072030): There is no such object on the server at System
My code :
Dim ldapUrl = "LDAP://annuaire.sesam-vitale.fr/cn=amo_pj.test#test.rss.fr,ou=AC-FACTURATION,ou=AC-SESAM-VITALE-2034,o=sesam-vitale,c=fr?userCertificate;binary"
Dim de As DirectoryEntry = New DirectoryEntry(ldapUrl)
de.AuthenticationType = AuthenticationTypes.None
Dim dsearch As DirectorySearcher = New DirectorySearcher(de)
dsearch.Filter = "(objectClass=*)"
Dim rs As SearchResult = dsearch.FindOne()
I have this exception at last line. I have no idea and need your help.
Thank you
(sorry for my english)
EDIT
I resolve my problem :
Public Function certificatLDAP() As X509Certificate2
Dim certificat As X509Certificate2 = Nothing
Dim ldapconn As LdapConnection = New LdapConnection(New LdapDirectoryIdentifier("annuaire.sesam-vitale.fr"))
Try
ldapconn.AuthType = AuthType.Anonymous
ldapconn.SessionOptions.ProtocolVersion = 3
Dim attribut(1) As String
attribut(0) = "userCertificate;binary"
Dim request As SearchRequest = New SearchRequest("cn=amo_pj.test#test.rss.fr,ou=AC-FACTURATION,ou=AC-SESAM-VITALE-2034,o=sesam-vitale,c=fr", "(ObjectClass=*)", Protocols.SearchScope.Base, attribut)
Dim reponse As SearchResponse = CType(ldapconn.SendRequest(request), SearchResponse)
For Each test As SearchResultEntry In reponse.Entries
For Each toto As DictionaryEntry In test.Attributes
Dim tata As DirectoryAttribute = toto.Value
Dim tutu As Byte() = tata(0)
Return New X509Certificate2(tutu)
Next
Next
Catch ex As Exception
Throw ex
Finally
ldapconn.Dispose()
End Try
Return certificat
End Function
At the moment I am using VB.Net.
I build my string, post it out and then parse the results.
Parsing Example for XML
Dim xml As New MWXMLDocument()
Dim sReason As String = "Unknown"
Try
xml.LoadXml(sresult)
If xml.SelectSimpleNode("AcceptedLead").InnerText = "true" Then
app.Outcome.RedirectURL = xml.SelectSimpleNode("result/redirecturl").InnerText
AcceptLead()
Return True
End If
sReason = xml.SelectSimpleNode("Reason").InnerText
Catch ex As Exception
sReason = "Error: " & ex.Message
End Try
DeclineLead(sReason)
Return False
End Function
How would I parse a result sent back in JSON, here is an example of the result I want to parse in using VB : Can i not just get the data from the string and parse as normal XML.
{"RedirectUrl":"www.test.com","Commission":5.0000,"Status":"accepted"}
You can use the JSON.NET Library
Example in C#:
var result = JsonConvert.DeserializeObject<RootObject>(string json);
The RootObject should be your own class.
You could use the .Net built in JavaScriptSerialiser
First add a reference to System.Web.Extensions and then
Imports System.Web.Script.Serialization
Followed by...
Dim sExampleJSON As String = "{""RedirectUrl"":""www.test.com"",""Commission"":5.0000,""Status"":""accepted""}"
Dim MySerializer As JavaScriptSerializer = New JavaScriptSerializer()
Dim MyDictionary As Dictionary(Of String, Object) = MySerializer.Deserialize(Of Dictionary(Of String, Object))(sExampleJSON)
If MyDictionary.ContainsKey("RedirectUrl") Then
Console.WriteLine(MyDictionary("RedirectUrl"))
End If
in global.asax.cs
using System.Data.Entity;
namespace RpManticSolAPI
{
public class WebApiApplication : System.Web.HttpApplication
{
protected void Application_Start()
{
GlobalConfiguration.Configure(WebApiConfig.Register);
GlobalConfiguration.Configuration.Formatters.JsonFormatter.SerializerSettings.ReferenceLoopHandling = Newtonsoft.Json.ReferenceLoopHandling.Ignore;
GlobalConfiguration.Configuration.Formatters.Remove(GlobalConfiguration.Configuration.Formatters.XmlFormatter);
}
}
}
The complete Answer
sResult = sResult.Replace("""", String.Empty)
If sResult.Contains("Status:accepted") Then
Dim parts = sResult.Replace("{", String.Empty).Replace("}", String.Empty).Split(",")
For i As Int16 = 0 To parts.Length - 1
If parts(i).StartsWith("RedirectUrl") Then
app.Outcome.RedirectURL = parts(i).Substring(12)
End If
If parts(i).StartsWith("Commission") Then
lendertier.LenderComm = CDec(parts(i).Substring(11))
End If
If parts(i).StartsWith("ApplicationRef") Then
app.Outcome.LenderReference = parts(i).Substring(15)
End If
Next
AcceptLead()
Return True
End If
If sResult.Contains("Reason:Duplicate") Then
sReason = "Duplicate"
ElseIf sResult.Contains("{Error:invalid credentials") Then
sReason = "Error: Invalid credentials"
ElseIf sResult.Contains("ValidationErrors:") Then
sReason = "Invalid call:" + sResult.Replace("ValidationErrors:", String.Empty).Replace(",Status:rejected", String.Empty)
Else
sReason = "Rejected"
End If
DeclineLead(sReason)
Return False