VB.NET console application to modify iisClientCertificateMappingAuthentication .config file - vb.net

I made a little console application to help me with remapping client certificates to my webserver. However, when I try to run the application it is giving me an error of:
Unhandled exception at 0x00920309 in CertMapping.exe: 0xC0000005: Access violation reading location 0x00000000.
It's a pretty basic console app:
Imports Microsoft.Web.Administration
Module Module1
Sub main(ByVal cmdArgs() As String)
Dim WebSite As String = Nothing
Dim UserName As String = Nothing
Dim Password As String = Nothing
Dim Base64EncodedCertData As String = Nothing
Dim switch As String, arg As String
For Each Str As String In cmdArgs
switch = Split(Str, ":").First
arg = Split(Str, ":").Last
Select Case switch
Case "/Web"
WebSite = arg
Case "/User"
UserName = arg
Case "/Pwd"
Password = arg
Case "/Cert"
If arg = "mySecretCode" Then
Base64EncodedCertData = "ServerCertGoesHere"
Else
Base64EncodedCertData = arg
End If
End Select
Next
Using serverManager As New ServerManager
Dim config As Configuration = serverManager.GetWebConfiguration(WebSite.ToString)
Dim iisClientCertificateMappingAuthenticationSection As ConfigurationSection = config.GetSection("system.webServer/security/authentication/iisClientCertificateMappingAuthentication")
iisClientCertificateMappingAuthenticationSection("enabled") = True
iisClientCertificateMappingAuthenticationSection("oneToOneCertificateMappingsEnabled") = True
Dim oneToOneMappingsCollection As ConfigurationElementCollection = iisClientCertificateMappingAuthenticationSection.GetCollection("oneToOneMappings")
Dim addElement As ConfigurationElement = oneToOneMappingsCollection.CreateElement("add")
addElement.SetMetadata("lockItem", True)
addElement("enabled") = True
addElement("userName") = UserName.ToString
addElement("password") = Password.ToString
addElement("certificate") = Base64EncodedCertData.ToString
oneToOneMappingsCollection.Add(addElement)
Dim accessSection As ConfigurationSection = config.GetSection("system.webServer/security/access", WebSite.ToString)
accessSection("sslFlags") = "Ssl, SslNegotiateCert"
serverManager.CommitChanges()
End Using
End Sub
End Module

Related

how to get windows version for remote computer using code

I'm developing small app using visual studio 2013, VB to scan range of IP addresses in same network
my app will take IP's and return
Ping status (True or False)
Computer Name
MAC address
and all OK
my question is if i need to get remote computer windows (xp or 7 or 8 )
using IP address or computer name how i can do that?
Dim osVer As String
osVer = System.Environment.OSVersion.ToString
Finally I used system management as below
(after importing System.Management)
I used two Functions
first one to connect remote Computer then collect data
Private Function tryConnect(SystemName As String)
Try
Dim ComputerConnection As New System.Management.ConnectionOptions
' to add user name and password
'ComputerConnection.Username = "UserName"
'ComputerConnection.Password = "Password"
With ComputerConnection
.Impersonation = System.Management.ImpersonationLevel.Impersonate
.Authentication = System.Management.AuthenticationLevel.Packet
End With
'connect to WMI
MyMgtScope = New System.Management.ManagementScope("\\" & SystemName & "\root\CIMV2", ComputerConnection)
MyMgtScope.Connect()
Return MyMgtScope.IsConnected
Catch ex As Exception
Return False
End Try
End Function
private sub GetOsdata()
if tryConnect(remoteComputerName) = False then Exit Sub ' or show some message
Dim MyMgtScope As System.Management.ManagementScope
Dim MyObjSearcher As System.Management.ManagementObjectSearcher
Dim MyColl As System.Management.ManagementObjectCollection
Dim MyObj As System.Management.ManagementObject
Dim ComputerOSVersion , ComputerOSServiceBack ,OSbit As String
MyObjSearcher = New System.Management.ManagementObjectSearcher(MyMgtScope.Path.ToString, "Select * FROM Win32_OperatingSystem")
' Execute the query
MyColl = MyObjSearcher.Get
For Each MyObj In MyColl
ComputerOSVersion = MyObj.GetPropertyValue("Caption").ToString
ComputerOSServiceBack = MyObj.GetPropertyValue("ServicePackMajorVersion").ToString
OSbit = MyObj.GetPropertyValue("OSArchitecture").ToString
Next
MyObjSearcher = Nothing
MyColl = Nothing
End Sub
Using wClient As New WebClient
dim myip as string = wClient.DownloadString("http://tools.feron.it/php/ip.php")
End Using
maybe help for find ip easly. good luck

Xpcom error when using AutoJSContext with GeckoFX 29.0 VB.NET

I'm using GeckoFX 29.0 with AutoJSContext and when i launch my app, it gives me the following error :
Xpcom.Initialize must be called before using of any xulrunner/gecko-fx services
I understand that i must initialize Xpcom before calling AutoJS but in my code XPcom(xullrunner) is initialize before the Sub named "GeckoFxError"
Sub New()
InitializeComponent()
Gecko.Xpcom.Initialize(Environment.CurrentDirectory + "/xulrunner")
Gecko.GeckoPreferences.Default("extensions.blocklist.enabled") = False
Timer1.Enabled = True
End Sub
Sub New1()
Dim _memoryService = Xpcom.GetService(Of nsIMemory)("#mozilla.org/xpcom/memory-service;1")
_memoryService.HeapMinimize(False)
End Sub
Private Sub GeckoFXerror(sender As Object, e As Gecko.JavascriptErrorEventArgs) Handles GeckoWebBrowser1.JavascriptError
Dim text As String = "window.alert = function(){};"
Dim text2 As String = "window.confirm = function(){};"
Dim text3 As String = "window.open = function(){};"
Dim text4 As String = "window.prompt = function(){};"
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text, result)
End Using
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text2, result)
End Using
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text3, result)
End Using
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text4, result)
End Using
End Sub
Thanks for your help and i think it's easy to solve but i haven't found any solution in more than one hour
Put your Gecko.Xpcom.Initialize(Environment.CurrentDirectory + "/xulrunner") before calling InitializeComponent() and it should work.

query an exchange distribution list

I'm trying to find some code that I can use in vb.net 4.0 to query the our exchange 2013 server. It will be housed on a web server and that server does not have outlook installed on it. Looks like I need to use EWS to do this but I've tried a lot of code snippets and still have not been able to figure this out. The distribution list i'm trying to query is in the public folders/Office Contacts. I've tried examples that use nesting to go through the public folder seen there is no deep traversal but I'm not doing something right there. I am not posting code because i'm not sure it would help. I was hoping someone has already done this and would give me some nuggest of info to get me started.
The examples I've found do not query the distribution list but rather add to it. It's not that I haven't tried... I've got hundreds of lines of code from different places that I've tried and tried to learn from.. but i'm not getting it done. Anyway.. help would be great.
Sorry about not posting any code.. I actually thought I deleted this post.. but i'll post the code that is now working for me. This code does a query to the public folder and then grabs some of the data about each contact in that contact list.
Public Sub MS()
Dim oTheListS As New List(Of TheList)
Dim service As New ExchangeService(ExchangeVersion.Exchange2010_SP1)
service.Credentials = New WebCredentials("userid", "password")
service.AutodiscoverUrl("email#address")
'Get Public Folder
Dim sf As SearchFilter = New SearchFilter.IsEqualTo(FolderSchema.DisplayName, "Office Contacts")
Dim rrRes As FindFoldersResults = service.FindFolders(WellKnownFolderName.PublicFoldersRoot, sf, New FolderView(1))
Dim OfficeContacts As Folder = rrRes.Folders(0)
'Find the Distribution List
Dim dlSearch As SearchFilter = New SearchFilter.IsEqualTo(ContactGroupSchema.DisplayName, "Merit Board")
Dim ivItemView As New ItemView(1)
Dim fiResults As FindItemsResults(Of Item) = OfficeContacts.FindItems(dlSearch, ivItemView)
If fiResults.Items.Count = 1 Then
'Enumeate Members
Dim cg As ContactGroup = DirectCast(fiResults.Items(0), ContactGroup)
cg.Load()
For Each gm As GroupMember In cg.Members
Dim o As New TheList
o = MS2(gm.AddressInformation.Address)
oTheListS.Add(o)
'Dim o As New TheList
'Dim ncCol As NameResolutionCollection = service.ResolveName(gm.AddressInformation.Address, ResolveNameSearchLocation.ContactsOnly, True)
'With o
' .Name = gm.AddressInformation.Name
' .Email = gm.AddressInformation.Address
'End With
'oTheListS.Add(o)
Next
End If
End Sub
Public Function MS2(pEmail As String) As TheList
Dim o As New TheList
Dim service As New ExchangeService(ExchangeVersion.Exchange2010_SP1)
service.Credentials = New WebCredentials("userid", "password")
service.AutodiscoverUrl("email#address")
Dim sf As SearchFilter = New SearchFilter.IsEqualTo(FolderSchema.DisplayName, "Office Contacts")
Dim rrRes As FindFoldersResults = service.FindFolders(WellKnownFolderName.PublicFoldersRoot, sf, New FolderView(1))
Dim OfficeContacts As Folder = rrRes.Folders(0)
'Find the Distribution List
Dim dlSearch As SearchFilter = New SearchFilter.IsEqualTo(ContactSchema.EmailAddress1, pEmail)
Dim ivItemView As New ItemView(1)
Dim fiResults As FindItemsResults(Of Item) = OfficeContacts.FindItems(dlSearch, ivItemView)
If fiResults.Items.Count = 1 Then
Dim con As Contact = fiResults.Items(0)
'Dim ncCol As NameResolutionCollection = service.ResolveName(gm.AddressInformation.Address, ResolveNameSearchLocation.ContactsOnly, True)
With o
If con.DisplayName IsNot Nothing Then
.Name = con.DisplayName
End If
Dim em As New EmailAddress
If con.EmailAddresses.TryGetValue(EmailAddressKey.EmailAddress1, em) = True Then
.Email = con.EmailAddresses(EmailAddressKey.EmailAddress1).ToString
End If
If con.JobTitle IsNot Nothing Then
.Title = con.JobTitle
End If
Dim phy As New PhysicalAddressEntry
If con.PhysicalAddresses.TryGetValue(PhysicalAddressKey.Business, phy) = True Then
.Address = con.PhysicalAddresses(PhysicalAddressKey.Business)
End If
If con.PhoneNumbers.TryGetValue(PhoneNumberKey.BusinessPhone, String.Empty) = True Then
.PhoneBusiness = con.PhoneNumbers(PhoneNumberKey.BusinessPhone)
End If
If con.PhoneNumbers.TryGetValue(PhoneNumberKey.MobilePhone, String.Empty) = True Then
.PhoneMobile = con.PhoneNumbers(PhoneNumberKey.MobilePhone)
End If
If con.CompanyName IsNot Nothing Then
.Comapny = con.CompanyName
End If
End With
End If
Return o
End Function
Public Class TheList
Public Property Name As String
Public Property Email As String
Public Property PhoneMobile As String
Public Property PhoneBusiness As String
Public Property Comapny As String
Public Property Title As String
Public Property Address As PhysicalAddressEntry
End Class
I just got it working so I haven't started to refine it yet.. but hopefully this will help someone else as I didn't find any code that did this

Convert IHTMLDOMNode to HTMLAnchorElement

In parseing a web page, the following function works fine when I run it locally:
Public Function GetElement(ByVal IHTMLDOMNode As mshtml.IHTMLDOMNode, ByVal InnerText As String) As mshtml.IHTMLElement
Dim objIHTMLAnchorElement As mshtml.HTMLAnchorElementClass
Dim s As String
s = Microsoft.VisualBasic.Information.TypeName(IHTMLDOMNode)
If s = "HTMLAnchorElementClass" Then
t = GetType(mshtml.HTMLAnchorElementClass)
objIHTMLAnchorElement = Marshal.CreateWrapperOfType(IHTMLDOMNode, t)
If objIHTMLAnchorElement.innerText.Trim() = InnerText Then
Return objIHTMLAnchorElement
End If
End if
' code that loks at child nodes and makes a recursive call
When it is deployed at the web host provider however, the same input results in the string s being "HTMLAnchorElement" instead of "HTMLAnchorElementClass".
If I change the code to
Dim objIHTMLAnchorElement As mshtml.HTMLAnchorElement
Dim s As String
s = Microsoft.VisualBasic.Information.TypeName(IHTMLDOMNode)
If s = "HTMLAnchorElement" Then
t = GetType(mshtml.HTMLAnchorElement)
objIHTMLAnchorElement = Marshal.CreateWrapperOfType(IHTMLDOMNode, t)
If objIHTMLAnchorElement.innerText.Trim() = InnerText Then
Return objIHTMLAnchorElement
End If
End if
I get an "The type must be __ComObject or be derived from __ComObject" error
What may be the cause of this behavior and/or what can I do about it?
Without understanding why (someone please shed light on this), the following works:
Dim objIHTMLAnchorElement As mshtml.HTMLAnchorElement
Dim s As String
s = Microsoft.VisualBasic.Information.TypeName(IHTMLDOMNode)
If s = "HTMLAnchorElement" Then
t = GetType(mshtml.HTMLAnchorElementClass)
objIHTMLAnchorElement = Marshal.CreateWrapperOfType(IHTMLDOMNode, t)
If objIHTMLAnchorElement.innerText.Trim() = InnerText Then
Return objIHTMLAnchorElement
End If
End if

Unable to call google api from Azure virtual machine

Public Class Geocode
Public Structure GeocodeResult
Public Latitude As String
Public Longitude As String
Public Result As String
End Structure
Public Shared Function GetGeocode(ByVal Address As String) As GeocodeResult
Dim strLat As String = ""
Dim strLon As String = ""
Dim strResult As String = ""
Dim oXmlDoc As Object
GetGeocode.Latitude = ""
GetGeocode.Longitude = ""
GetGeocode.Result = ""
Try
Dim baseURL As String = "https://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & Address
baseURL = Replace(baseURL, " ", "+")
oXmlDoc = CreateObject("Microsoft.XMLDOM")
With oXmlDoc
.Async = False
If .Load(baseURL) And Not .selectSingleNode("GeocodeResponse/status") Is Nothing Then
GetGeocode.Result = .selectSingleNode("GeocodeResponse/status").Text
If Not .selectSingleNode("GeocodeResponse/result") Is Nothing Then
GetGeocode.Latitude = .selectSingleNode("//location/lat").Text
GetGeocode.Longitude = .selectSingleNode("//location/lng").Text
Return GetGeocode
End If
End If
End With
oXmlDoc = Nothing
Return GetGeocode
Exit Function
Catch ex As Exception
Throw (ex)
End Try
Return GetGeocode
End Function
End Class
Ok so this works fine in production, qa, and localhost until we moved it to an Azure VM. From the VM we can go use a browser to get to the https://maps.google.com/maps/api/geocode/xml?sensor=false&address= URL. but when another page calls the getgeocode function the results are always blank meaning the rest api call failed in some way.
I don't think its the domain key restrictions because a) im not using a key in this call and b) i set my google api key to any domain to test it.
EDIT: I have tried using another service with the same result. It works in dev and on local machines but not on the Azure VMs. What I do not understand is how the REST apis are accessible via the browser, but return nothing when called from code.
Any ideas?
Explicitly creating a web client and loading that into the xml document has fixed this issue for me.
Imports Microsoft.VisualBasic
Imports System.Xml
Imports System.Linq
Imports System.Xml.Linq
Imports System.Net
Imports System.IO
Public Class Geocode
Public Structure GeocodeResult
Public Latitude As String
Public Longitude As String
Public Result As String
End Structure
Public Shared Function GetGeocode(ByVal Address As String) As GeocodeResult
Dim oXmlDoc As Object
GetGeocode.Latitude = ""
GetGeocode.Longitude = ""
GetGeocode.Result = ""
Try
Dim baseURL As String = "https://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & Address
baseURL = Replace(baseURL, " ", "+")
Using WC As New WebClient()
oXmlDoc = CreateObject("Microsoft.XMLDOM")
With oXmlDoc
.Async = False
If .Load(WC.DownloadData(baseURL)) And Not .selectSingleNode("GeocodeResponse/status") Is Nothing Then
GetGeocode.Result = .selectSingleNode("GeocodeResponse/status").Text
If Not .selectSingleNode("GeocodeResponse/result") Is Nothing Then
GetGeocode.Latitude = .selectSingleNode("//location/lat").Text
GetGeocode.Longitude = .selectSingleNode("//location/lng").Text
Return GetGeocode
End If
End If
End With
oXmlDoc = Nothing
End Using
Return GetGeocode
Exit Function
Catch ex As Exception
Throw (ex)
End Try
Return GetGeocode
End Function
End Class