Excluding Deleted Records from returned Set using VFPOLEDB provider for FOXPRO database - vb.net

VS 2010, VB.NET, WINFORMS. In my app i have a need to import foxpro database tables and exclude the deleted records. The problem is that FOXPRO tables keep deleted items inside the same table. I have tried using DELETED=NO in the connection string but vb throws
"Format of the initialization string does not conform to the OLE DB specification."
My function is as follows:
Dim _DBConn1 As String = "provider=vfpoledb.1; Data Source = " & file1 & ";DELETED=NO"
Dim _DBConn2 As String = "provider=vfpoledb.1; Data Source = " & file2 & ";DELETED=NO"
Dim _DBConn3 As String = "provider=vfpoledb.1; Data Source = " & file3 & ";DELETED=NO"
Dim _DBConn4 As String = "provider=vfpoledb.1; Data Source = " & file4 & ";DELETED=NO"
Using _connection As New OleDbConnection(_DBConn1)
Dim _savedId As String = String.Empty
_connection.Open()
Using _command As New OleDbCommand("SELECT * FROM " & _fileName1 & "", _connection)
Using _reader2 As OleDbDataReader = _command.ExecuteReader
While _reader2.Read
counter += 1
End While
y = 100 / counter
Dim x As String = String.Empty
End Using
Using _reader As OleDbDataReader = _command.ExecuteReader
While _reader.Read
Dim _letter As Integer = Nothing
Dim _name As String = String.Empty
Dim _content As String = String.Empty
Dim _copies As Integer = Nothing
Dim _type As Integer = Nothing
Dim _fee As Decimal = Nothing
_letter = _reader.Item(0)
_name = _reader.Item(1)
_content = _reader.Item(2)
_copies = _reader.Item(3)
_type = _reader.Item(4)
_fee = _reader.Item(5)
_UpdateLetters(_letter, _name, _content, _copies, _type, _fee)
_progress += y
Dim d As Integer = Convert.ToInt16((Convert.ToString(y).Split(".")(0)))
ProgressBar1.Increment(d)
End While
End Using
End Using
_connection.Close()
End Using
Using _connection As New OleDbConnection(_DBConn2)
Dim _savedId As String = String.Empty
_connection.Open()
Using _command As New OleDbCommand("SELECT * FROM " & _fileName2 & "", _connection)
Using _reader2 As OleDbDataReader = _command.ExecuteReader
While _reader2.Read
counter += 1
End While
y = 100 / counter
Dim x As String = String.Empty
End Using
Using _reader As OleDbDataReader = _command.ExecuteReader
While _reader.Read
Dim _unit As String = String.Empty
Dim _Size As String = String.Empty
Dim _contractDate As String = String.Empty
Dim _deposit As Decimal = Nothing
Dim _Tfirst As String = String.Empty
Dim _Tlast As String = String.Empty
Dim _optional As String = String.Empty
Dim _address1 As String = String.Empty
Dim _address2 As String = String.Empty
Dim _city As String = String.Empty
Dim _st As String = String.Empty
Dim _zip As String = String.Empty
Dim _hphone As String = String.Empty
Dim _drLicense As String = String.Empty
Dim _employer As String = String.Empty
Dim _wphone As String = String.Empty
Dim _bname As String = String.Empty
Dim _baddress1 As String = String.Empty
Dim _baddress2 As String = String.Empty
Dim _bCity As String = String.Empty
Dim _bState As String = String.Empty
Dim _bZip As String = String.Empty
Dim _bPhone As String = String.Empty
Dim _contact_Name As String = String.Empty
Dim _contact_Address1 As String = String.Empty
Dim _contact_Address2 As String = String.Empty
Dim _contact_City As String = String.Empty
Dim _contact_State As String = String.Empty
Dim _contact_zip As String = String.Empty
Dim _contact_phone As String = String.Empty
Dim _balance As Decimal = Nothing
Dim _lastPaymentDate As String = String.Empty
Dim _lastPayAmount As Decimal = Nothing
Dim _memo As String = String.Empty
Dim _lateFee As Decimal = Nothing
Dim _email As String = String.Empty
_unit = _reader.Item(0)
_Size = _reader.Item(1)
_contractDate = _reader.Item(2)
_deposit = _reader.Item(3)
_Tfirst = _reader.Item(4)
_Tlast = _reader.Item(5)
_optional = _reader.Item(6)
_address1 = _reader.Item(7)
_address2 = _reader.Item(8)
_city = _reader.Item(9)
_st = _reader.Item(10)
_zip = _reader.Item(11)
_hphone = _reader.Item(12)
_drLicense = _reader.Item(13)
_employer = _reader.Item(15)
_wphone = _reader.Item(16)
_bname = _reader.Item(17)
_baddress1 = _reader.Item(18)
_baddress2 = _reader.Item(19)
_bCity = _reader.Item(20)
_bState = _reader.Item(21)
_bZip = _reader.Item(22)
_bPhone = _reader.Item(23)
_contact_Name = _reader.Item(24)
_contact_Address1 = _reader.Item(25)
_contact_Address2 = _reader.Item(26)
_contact_City = _reader.Item(27)
_contact_State = _reader.Item(28)
_contact_zip = _reader.Item(29)
_contact_phone = _reader.Item(30)
_balance = _reader.Item(32)
_lastPaymentDate = _reader.Item(33)
_lastPayAmount = _reader.Item(34)
_memo = _reader.Item(46)
_lateFee = _reader.Item(49)
_email = _reader.Item(50)
_UpdateTenent(_unit, _Size, _contractDate, _deposit, _Tfirst, _Tlast, _optional, _address1, _address2, _city, _st, _zip, _hphone, _drLicense, _employer, _wphone, _bname, _baddress1, _baddress2, _bCity, _bState, _bZip, _bPhone, _contact_Name, _contact_Address1, _contact_Address2, _contact_City, _contact_State, _contact_zip, _contact_phone, _balance, _lastPaymentDate, _lastPayAmount, _memo, _lateFee, _email)
_progress += y
Dim d As Integer = Convert.ToInt16((Convert.ToString(y).Split(".")(0)))
ProgressBar2.Increment(d)
End While
End Using
End Using
_connection.Close()
End Using
Any ideas how my Connection string is wrong? Google results pointed me in the direction of DELETED=NO but its throwing that exception error now that I have added it..

The VfpOleDb provider excludes deleted records by default. So your connection string doesn't need to include the deleted setting. If you wanted to include delete records... you would include "deleted=false" in the connection string.

Related

VB.Net signedXml "Invalid character in a Base-64 string"

I'm getting an error everytime I try to upload a XML file to an specific server.
It returns "Invalid character in a Base-64 string". Here the code I'm using to sign:
Public Sub Assinar03(ByVal strArqXMLAssinar As String, ByVal strUri As String, ByVal x509Certificado As X509Certificate2, ByVal strArqXMLAssinado As String)
Dim SR As StreamReader = Nothing
SR = File.OpenText(strArqXMLAssinar)
Dim vXMLString As String = SR.ReadToEnd()
SR.Close()
Dim _xnome As String = String.Empty
Dim _serial As String = String.Empty
If x509Certificado IsNot Nothing Then
_xnome = x509Certificado.Subject.ToString()
_serial = x509Certificado.SerialNumber
End If
Dim _X509Cert As New X509Certificate2()
Dim store As New X509Store("MY", StoreLocation.CurrentUser)
store.Open(OpenFlags.[ReadOnly] Or OpenFlags.OpenExistingOnly)
Dim collection As X509Certificate2Collection = DirectCast(store.Certificates, X509Certificate2Collection)
Dim collection1 As X509Certificate2Collection = DirectCast(collection.Find(X509FindType.FindBySerialNumber, _serial, False), X509Certificate2Collection)
If collection1.Count > 0 Then
_X509Cert = Nothing
For i As Integer = 0 To collection1.Count - 1
If DateTime.Now < collection1(i).NotAfter OrElse Not _X509Cert Is Nothing AndAlso _X509Cert.NotAfter < collection1(i).NotAfter Then
_X509Cert = collection1(i)
End If
Next
If _X509Cert Is Nothing Then _X509Cert = collection1(0)
Dim doc As New XmlDocument()
doc.PreserveWhitespace = False
doc.LoadXml(vXMLString)
Dim qtdeRefUri As Integer = doc.GetElementsByTagName(strUri).Count
Dim reference As New Reference()
Dim keyInfo As New KeyInfo()
Dim signedXml As New SignedXml(doc)
signedXml.SigningKey = _X509Cert.PrivateKey
Dim _Uri As XmlAttributeCollection = doc.GetElementsByTagName(strUri).Item(0).Attributes
For Each _atributo As XmlAttribute In _Uri
If _atributo.Name.ToLower.Trim = "Id".ToLower.Trim Then
reference.Uri = "#" + _atributo.InnerText
End If
Next
If reference.Uri Is Nothing Then reference.Uri = ""
reference.DigestMethod = SignedXml.XmlDsigSHA1Url
'--------------------------------------------------
Dim env As New XmlDsigEnvelopedSignatureTransform()
env.Algorithm = "http://www.w3.org/2000/09/xmldsig#enveloped-signature"
reference.AddTransform(env)
'--------------------------
Dim c14 As New XmlDsigC14NTransform(False)
c14.Algorithm = "http://www.w3.org/TR/2001/REC-xml-c14n-20010315"
reference.AddTransform(c14)
'--------------------------
signedXml.AddReference(reference)
keyInfo.AddClause(New KeyInfoX509Data(_X509Cert))
'--------------------------
signedXml.KeyInfo = keyInfo
signedXml.ComputeSignature()
'--
Dim xmlDigitalSignature As XmlElement = signedXml.GetXml()
doc.DocumentElement.AppendChild(doc.ImportNode(xmlDigitalSignature, True))
XMLDoc = New XmlDocument()
XMLDoc.PreserveWhitespace = False
XMLDoc = doc
Me.vXMLStringAssinado = XMLDoc.OuterXml
'-----------
Dim SW_2 As StreamWriter = File.CreateText(strArqXMLAssinado)
SW_2.Write(Me.vXMLStringAssinado)
SW_2.Close()
'-----------
End If
SR.Close()
End Sub
Is there something else I should add to the code?
The manual tells me to follow the instructions from https://www.w3.org/TR/xmldsig-core/
Turns out it was a line break when saving the document. I set the .PreserveWhitespace property to true before saving the .xml file and not it seems to be working.

How to get a constructor for a Public class to run

I have a Public class with a Public Shared Dictionary in vb.net. The constructor does not seem to be running. I have a breakpoint in the constructor which does not break. Also when I make a database update, the new values do not show up in the dictionary.
Public Class SkywalkerPolicy
Public Shared CustomPolicies As Dictionary(Of String, String)
Shared Sub New()
CustomPolicies = New Dictionary(Of String, String)
Dim bvin As String = String.Empty
Dim title As String = String.Empty
Dim poldescr As String = String.Empty
Dim dtResult As New DataTable("Result")
dtResult.Locale = System.Globalization.CultureInfo.InvariantCulture
Dim request As New DataRequest
request.Command = "sky_PolicyDictionary_s"
request.CommandType = CommandType.StoredProcedure
request.Transactional = False
Dim result As DataSet
result = SqlDataHelper.ExecuteDataSet(request)
If Not result Is Nothing Then
If result.Tables.Count() > 0 Then
dtResult = result.Tables(0)
For Each row In dtResult.AsEnumerable
bvin = row.Item(1)
title = row.Item(0)
poldescr = row.Item(2)
If CustomPolicies.ContainsKey(title) Then
CustomPolicies(title) += poldescr
Else
CustomPolicies.Add(title, poldescr)
End If
Next
End If
End If
End Sub
End Class
When I access the dictionary, any changes I've made to the data do not show up.
Dim pol As String = SkywalkerPolicy.CustomPolicies("Orders and Shipping Details")
Does anyone have any suggestions as to how I can get the constructor to work?
Or should I have an additional Sub which duplicates initializing the dictionary before I use it?
Thanks
I have a workaround with an Update routine which I call just before accessing the dictionary. But I am still unclear why I can't step through the constructor. So if anyone can answer the original question, I would appreciate an update. Thank you.
Public Class SkywalkerPolicy
Public Shared CustomPolicies As Dictionary(Of String, String)
Shared Sub New()
CustomPolicies = New Dictionary(Of String, String)
Dim bvin As String = String.Empty
Dim title As String = String.Empty
Dim poldescr As String = String.Empty
Dim dtResult As New DataTable("Result")
dtResult.Locale = System.Globalization.CultureInfo.InvariantCulture
Dim request As New DataRequest
request.Command = "sky_PolicyDictionary_s"
request.CommandType = CommandType.StoredProcedure
request.Transactional = False
Dim result As DataSet
result = SqlDataHelper.ExecuteDataSet(request)
If Not result Is Nothing Then
If result.Tables.Count() > 0 Then
dtResult = result.Tables(0)
For Each row In dtResult.AsEnumerable
bvin = row.Item(1)
title = row.Item(0)
poldescr = row.Item(2)
If CustomPolicies.ContainsKey(title) Then
CustomPolicies(title) += poldescr
Else
CustomPolicies.Add(title, poldescr)
End If
Next
End If
End If
End Sub
Public Shared Sub UpdateDictionary()
CustomPolicies.Clear()
Dim bvin As String = String.Empty
Dim title As String = String.Empty
Dim poldescr As String = String.Empty
Dim dtResult As New DataTable("Result")
dtResult.Locale = System.Globalization.CultureInfo.InvariantCulture
Dim request As New DataRequest
request.Command = "sky_PolicyDictionary_s"
request.CommandType = CommandType.StoredProcedure
request.Transactional = False
Dim result As DataSet
result = SqlDataHelper.ExecuteDataSet(request)
If Not result Is Nothing Then
If result.Tables.Count() > 0 Then
dtResult = result.Tables(0)
For Each row In dtResult.AsEnumerable
bvin = row.Item(1)
title = row.Item(0)
poldescr = row.Item(2)
If CustomPolicies.ContainsKey(title) Then
CustomPolicies(title) += poldescr
Else
CustomPolicies.Add(title, poldescr)
End If
Next
End If
End If
End Sub
End Class

Can't get attributes from AD using vb.net

I use below code to get first name, last name, email, and department from AD using VB.Net 1.1
Public Shared Function GetAttribute(ByVal username As String, ByVal pwd As String) As UserInfo
Dim objUserInfo As New UserInfo
Dim ObjFirstName As String = ""
Dim ObjLastName As String = String.Empty
Dim ObjEmail As String = ""
Dim objDepartment As String = ""
Dim Success As Boolean = False
Dim LDAPAddress As String = ConfigurationSettings.AppSettings.Get("LDAPAddress")
Dim Entry As New System.DirectoryServices.DirectoryEntry(LDAPAddress, username, pwd)
Dim Searcher As New System.DirectoryServices.DirectorySearcher(Entry)
Searcher.SearchScope = DirectoryServices.SearchScope.OneLevel
Dim Filter As String = "(samAccountName=" & username & ")"
Dim findUser As DirectorySearcher = New DirectorySearcher(Entry, Filter)
Dim results As SearchResultCollection = findUser.FindAll
Try
Dim Resultsx As System.DirectoryServices.SearchResult = Searcher.FindOne
Success = Not (Resultsx Is Nothing)
findUser.PropertiesToLoad.Add("name")
Dim name As String = DirectCast(Resultsx.Properties(name)(0), String)
Dim de As System.DirectoryServices.DirectoryEntry = Resultsx.GetDirectoryEntry()
Dim gg = de.Properties.PropertyNames()
For Each Onn As String In gg
Dim str As String = String.Format("{0}", Onn)
Next
Try
ObjFirstName = de.Properties("GivenName").Value.ToString()
ObjEmail = de.Properties("mail").Value.ToString()
ObjLastName = de.Properties("sn").Value.ToString()
objDepartment = de.Properties("department").Value.ToString()
Catch ex As Exception
ObjFirstName = de.Properties("DisplayName").Value.ToString()
End Try
But I can't get those attributes. in
Dim str As String = String.Format("{0}", Onn)
there are only 15 attributes, and there are no firstname, lastname, email, and department. What am I doing wrong?
Your code, though old-fashioned, looks fine on first sight. If you insist to continue with your code, I'll have a look later.
In the meantime, this code should fit your situation:
Dim user As DirectoryEntry = New DirectoryEntry("UserDN")
Dim src As DirectorySearcher = New DirectorySearcher(user, "(&(objectClass=user)(objectCategory=Person))")
src.PropertiesToLoad.Add("sn")
src.PropertiesToLoad.Add("givenName")
src.PropertiesToLoad.Add("mail")
src.PropertiesToLoad.Add("department")
Dim res As SearchResult = src.FindOne
Console.WriteLine(res.Properties("sn")(0))
Console.WriteLine(res.Properties("givenName")(0))
Console.WriteLine(res.Properties("mail")(0))
Console.WriteLine(res.Properties("department")(0))
Console.ReadLine()

How to change value of /GrpPwd/ Cell in all Rows?

I need to perform this SQL Query:
UPDATE Resurses SET GrpPwd = #GrpPwd1 WHERE Resurs = #Resurs1
For all rows in my Access Database using VB.NET
How can i do it?
I use this code but id doesn't work:
Password Generator:
Dim charset As String = nalf
Dim r As New Random()
Dim lenPass As Integer = r.Next(minLength, maxLength)
Dim str As String = String.Empty
For i As Integer = 0 To lenPass - 1
str += charset(r.Next(0, charset.Length))
Next
Return str
End Function
Update rows
If DataGridView1.CurrentRow.Cells(3).Value = "Yes" Then
nres = DataGridView1.CurrentRow.Cells(0).Value
nalf = DataGridView1.CurrentRow.Cells(6).Value
nsym = DataGridView1.CurrentRow.Cells(1).Value
Dim parol1 As String
Dim pwd As String = pass99(nsym, nsym) '
parol1 = pwd
Dim cmd As New OleDbCommand()
Dim Conn As New OleDb.OleDbConnection("Provider=Microsoft.ACE.oledb.12.0; Data source=" + bpath)
cmd.Connection = Conn
Conn.Open()
For i As Integer = 0 To k - 1
cmd.CommandText = String.Format("UPDATE Resurses SET GrpPwd = #GrpPwd1{0} WHERE Resurs = #Resurs1{0};", i)
cmd.Parameters.Add(String.Format("#GrpPwd1{0}", i), OleDbType.WChar).Value = parol1
cmd.Parameters.Add(String.Format("#Resurs1{0}", i), OleDbType.Integer).Value = nres
Next
cmd.ExecuteNonQuery()
Conn.Close()
MsgBox("All rows are updated!")
End If
f

Add a Parameter Value in SSRS

I have a report already setup on the ReportServer. And its subscription as well. What I'm trying to do is add the ParameterValue "CC" and some email addresses then send the email out. It doesn't seem to work.
My code:
Dim emailReader As SqlDataReader = selCount.ExecuteReader
Dim emailsTest As List(Of String) = New List(Of String)
emailsTest.Add("test1#pen.com")
emailsTest.Add("test2#pen.com")
emailsTest.Add("test3#pen.com")
emailsTest.Add("test4#pen.com")
If emailReader.HasRows() Then 'checks to see if there any quotes in query
For Each subscrp As rs.Subscription In subscr
Dim allValues = subscrp.DeliverySettings.ParameterValues
Dim allValuesList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = allValues.ToList()
Dim CCParameter As ReportTriggerTemplate1.rs.ParameterValue = New ReportTriggerTemplate1.rs.ParameterValue()
CCParameter.Name = "CC"
CCParameter.Value = String.Empty
allValuesList.Add(CCParameter)
Dim toValue = CType(allValuesList.Item(7), ReportTriggerTemplate1.rs.ParameterValue)
For Each testEmail As String In emailsTest
Dim ownerEmail As String = testEmail
If toValue.Value.Contains(ownerEmail) Then
'skip
ElseIf toValue.Value = String.Empty Then
toValue.Value += ownerEmail
Else
toValue.Value += "; " & ownerEmail
End If
Next
subscrp.DeliverySettings.ParameterValues = allValuesList.ToArray()
Dim hello As String = "hi"
tr.FireEvent(EventType, subscrp.SubscriptionID) 'forces subscription to be sent
Next
What I'm adding to toValue.Value doesn't seem to be adding to the report's CC subscription field at all. So what am I missing?
http://msdn.microsoft.com/en-us/library/ms154020%28v=SQL.100%29.aspx
http://msdn.microsoft.com/en-us/library/reportservice2005.reportingservice2005.getsubscriptionproperties.aspx
http://msdn.microsoft.com/en-us/library/reportservice2005.reportingservice2005.setsubscriptionproperties%28v=SQL.105%29.aspx
Try
tr = New rs.ReportingService2005
Dim extSettings As ExtensionSettings = Nothing
Dim desc As String = Nothing
Dim active As ActiveState = Nothing
Dim status As String = Nothing
Dim matchData As String = Nothing
Dim values As ParameterValue() = Nothing
Dim extensionParams As ParameterValueOrFieldReference() = Nothing
Dim mainLogin As System.Net.NetworkCredential = New System.Net.NetworkCredential("ADUser", "Password", "NetworkName")
If mainLogin Is Nothing Then
tr.Credentials = System.Net.CredentialCache.DefaultCredentials
Else
tr.Credentials = mainLogin
End If
'skip to relevant code
For Each subscrp As rs.Subscription In subscr
Dim allValues = subscrp.DeliverySettings.ParameterValues
Dim allValuesList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = allValues.ToList()
If CType(allValuesList.Item(0), ReportTriggerTemplate1.rs.ParameterValue).Value = "test#pen.com" Then
Dim subsID = subscrp.SubscriptionID
'important code just below
tr.GetSubscriptionProperties(subsID, extSettings, desc, active, status, EventType, matchData, extensionParams)
''''add change to CC here
Dim extSettingsList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = extSettings.ParameterValues.ToList()
If CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Name = "CC" Then
If CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value = String.Empty Then
CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value = emailsTest.Item(0) & ";" & emailsTest.Item(1)
Else
CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value += ";" & emailsTest.Item(0) & ";" & emailsTest.Item(1)
End If
Else
Dim CCParameter As ReportTriggerTemplate1.rs.ParameterValue = New ReportTriggerTemplate1.rs.ParameterValue()
CCParameter.Name = "CC"
CCParameter.Value = emailsTest.Item(0) & ";" & emailsTest.Item(1)
extSettingsList.Insert(1, CCParameter)
extSettings.ParameterValues = extSettingsList.ToArray
End If
'important code just below
tr.SetSubscriptionProperties(subsID, extSettings, desc, EventType, matchData, extensionParams)
tr.FireEvent(EventType, subscrp.SubscriptionID) 'forces subscription to be sent
Else
End If
Next