I have created a dll in VB.Net that is used in a Visual Foxpro application. Recently I added a few functions to help in sanitizing data and clearing input from a user-control and re-built the project. I am currently using Regasm to register the dll's and this seems to work fine. However when i register the dll, the new functionality does not show, making it seem like one is still using the old, previously registered dll. Is there something i'm not doing right?
Here's an excerpt of the code.
<ClassInterface(ClassInterfaceType.AutoDispatch), ProgId("LPFPasserelle.FicheEtablissement")>
Public Class FicheEtablissement
Private mCreateInstitution As New CreateInstitution
<ComRegisterFunction()>
Public Shared Sub RegisterClass(ByVal key As String)
Dim sb As StringBuilder = New StringBuilder(key)
sb.Replace("HKEY_CLASSES_ROOT\", "")
'// Open the CLSID\{guid} key for write access
Dim k As RegistryKey = Registry.ClassesRoot.OpenSubKey(sb.ToString(), True)
Dim ctrl As RegistryKey = k.CreateSubKey("Control")
ctrl.Close()
'// Next create the CodeBase entry - needed if not string named and GACced.
Dim inprocServer32 As RegistryKey = k.OpenSubKey("InprocServer32", True)
inprocServer32.SetValue("CodeBase", Assembly.GetExecutingAssembly().CodeBase)
inprocServer32.Close()
k.Close()
End Sub
<ComUnregisterFunction()>
Public Shared Sub UnregisterClass(ByVal key As String)
Dim sb As StringBuilder = New StringBuilder(key)
sb.Replace("HKEY_CLASSES_ROOT\", "")
'// Open HKCR\CLSID\{guid} for write access
Dim k As RegistryKey = Registry.ClassesRoot.OpenSubKey(sb.ToString(), True)
'// Delete the 'Control' key, but don't throw an exception if it does not exist
If k Is Nothing Then
Return
End If
k.DeleteSubKey("Control", False)
'// Next open up InprocServer32
Dim inprocServer32 As RegistryKey = k.OpenSubKey("InprocServer32", True)
'// And delete the CodeBase key, again not throwing if missing
inprocServer32.DeleteSubKey("CodeBase", False)
'// Finally close the main key
inprocServer32.Close()
k.Close()
End Sub
The function for sanitizing string data that I added is below.
Function SanitizeStringData(ByVal StringToSanitize As String)
Dim mSanitizedString As String = String.Empty
mSanitizedString = Trim(StringToSanitize)
If Trim(StringToSanitize).Contains("'") Then
mSanitizedString = Trim(StringToSanitize).Replace("'", "''")
End If
Return mSanitizedString
End Function
Not sure about your sanitizing dll/COM issue, but for your sanitize string, I don't know why you are not just using VFP's function STRTRAN()
someString = [What's goin' on]
? STRTRAN( someString, "'", "''" )
will result in
What''s goin'' on
Help on StrTran() function
Another cool one is CHRTRAN() and has a wide range of benefits from stripping invalid characters from strings to a pseudo encryption by replacing every character in a string to something else...
Related
I'm trying to add "file type" and "last modified" to my Listview when adding items in It same as in Explorer, but I don't find what property should be assigned to SubItem. Here is my code:
For Each MyFile As IO.FileInfo In ItemDirectory.GetFiles
Dim lvi As New ListViewItem
lvi.Tag = mFile.FullName
lvi.Text = mFile.Name
lvi.ImageKey = CacheShellIcon(mFile.FullName)
Listview1.Items.Add(lvi)
lvi.SubItems.Add("File type ??")
lvi.SubItems.Add(mFile.LastAccessTime.ToShortDateString & " " & mFile.LastAccessTime.ToShortTimeString) 'This isn't same as last modified ?
Next
If somebody knows how to do It please let me know, I want to have this in my Details view.
The linked answer provides an all-purpose way to get all the extended properties. With 300+ elements in newer Windows versions it is clearly overkill to fetch them all if you are only interested in one or two. This returns just the file type. A better approach might be to pass a "shopping list" of desired property names.
As before, you need to add a reference to Microsoft Shell Controls and Automation or Microsoft Shell Folder View Router based on your OS version.
Imports Shell32
Imports SHDocVw
Partial Friend Class Shell32Methods
Friend Shared Function GetShellFileProperty(filepath As String, index As Int32) As String
Dim shell As New Shell32.Shell
Dim shFolder As Shell32.Folder
shFolder = shell.NameSpace(Path.GetDirectoryName(filepath))
' get shell data for this file, cast to folder item
Dim shFolderItem = DirectCast(shFolder.Items().Item(Path.GetFileName(filepath)),
Shell32.ShellFolderItem)
If shFolderItem IsNot Nothing Then
Return shFolder.GetDetailsOf(shFolderItem, index)
Else
Return String.Empty
End If
End Function
...
End Class
Usage:
Dim lvi As ListViewItem
Dim fileType As String
For Each f As String In Directory.EnumerateFiles("C:\Temp\ShellTest")
fileType = Shell32Methods.GetShellFileProperty(f, 9)
lvi = New ListViewItem
lvi.Text = Path.GetFileName(f)
lvi.SubItems.Add(fileType)
lvFiles.Items.Add(lvi)
Next
Ideally, you'd want to create an Enum for the properties so the code could avoid magic numbers:
fileType = Shell32Methods.GetShellFileProperty(f, Shell32FileProps.FileType)
As noted elsewhere, the index of the ones >260 or so can change depending on the OS version. That could be easily modified to accept an Enum/Int array and return a list of values so as to prevent iterating all 300+ propertied to get one or three.
For filetype you can use lvi.SubItems.Add(MyFile.Extension)
and for the "last modified" date, of course the last modified! :D
lvi.SubItems.Add(MyFile.LastWriteTime.ToShortDateString)
Last write and last access are not the same ;)
I figured out another solution, I think this one is easier, at least for me :
Public Function ExProperty(filepath As String, PropertyItem As Integer)
Dim arrHeaders As New List(Of String)()
Dim shell As New Shell
Dim rFolder As Folder = shell.[NameSpace](Path.GetDirectoryName(filepath))
Dim rFiles As FolderItem = rFolder.ParseName(Path.GetFileName(filepath))
'I needed only File type so I looped to 2 only (2 is the file type in my case - Windows 10 -
' to see all available properties do a loop
' 0 To Short.MaxValue - 1" and then extract whatever property you like)
For i As Integer = 0 To 2
Dim value As String = rFolder.GetDetailsOf(rFiles, i).Trim()
arrHeaders.Add(value)
Next
Dim DesiredProperty As String
DesiredProperty = arrHeaders.Item(PropertyItem)
Return DesiredProperty
End Function
Usage with Listview just simply (this adds File type subitem):
Listview1_Item.SubItems.Add(ExProperty(filepath, 2))
As in all solutions, a reference to Microsoft Shell Controls and Automation must be set.
We have a custom class library that has been built from the ground up that performs a variety of functions that are required for the business model in place. We also use VBA to automate some data insertion from standard Microsoft packages and from SolidWorks.
To date we have basically re-written the code in the VBA application macro's, but now are moving to include the class library into the VBA references. We've registered the class library for COM interop, and made sure that it is COM visible. The file is referencable, we have added the <ClassInterface(ClassInterfaceType.AutoDual)> _ tag above each of the Public Classes, so that intellisense 'works'.
With that said, the problem now arises - when we reference the class library, for this instance let's call it Test_Object, it is picked up and seems to work just fine. So we go ahead and try a small sample to make sure it's using the public functions and returning expected values:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim test As New Test_Object.Formatting
Dim t As String
t = test.extractNumber("abc12g3y45")
Target.Value = t
End Sub
This works as expected, returning 12345 in the selected cell/s.
However, when I try a different class, following the exact same procedure, I get an error (Object variable or With block variable not set). Code is as follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim test As New Test_Object.SQLCalls
Dim t As String
t = test.SQLNumber("SELECT TOP 1 ID from testdb.dbo.TESTTABLE") 'where the string literal in the parentheses is a parameter that is passed.
Target.Value = t
End Sub
This fails on the t = test.SQLNumber line. It also fails on another function within that SQLCalls class, a function that returns the date in SQL format (so it is not anything to do with the connection to the database).
Can anyone assist in what could be causing this error? I've googled for hours to no avail, and am willing to try whatever it takes to get this working.
Cheers.
EDIT: (added in the .SQLNumber() method)
Function SQLNumber(query As String) As Double
Dim tno As Double
Try
Using SQLConnection As SqlConnection = New SqlConnection(Connection_String_Current)
SQLConnection.Open()
SQLCommand = New SqlCommand(query, SQLConnection)
tno = SQLCommand.ExecuteScalar
End Using
Catch ex As System.Exception
MsgBox(ex.Message)
End Try
Return tno
End Function
For comparison, the extractNumber() method:
Function extractNumber(extstr As String) As Double
Dim i As Integer = 1
Dim tempstr As String
Dim extno As String = ""
Do Until i > Len(extstr)
tempstr = Mid(extstr, i, 1)
If tempstr = "0" Or tempstr = "1" Or tempstr = "2" Or tempstr = "3" Or tempstr = "4" Or tempstr = "5" Or tempstr = "6" Or tempstr = "7" Or tempstr = "8" Or tempstr = "9" Or tempstr = "." Then
extno = extno & tempstr
End If
i = i + 1
Loop
If IsNumeric(extno) Then
Return CDbl(extno)
Else
Return 0
End If
End Function
With the help of vba4all, we managed to delve down right to the issue.
When I tried to create a new instance of an object using Dim x as new Test_Object.SQLCalls, I was completely oblivious to the fact that I had not re-entered this crucial line:
<ClassInterface(ClassInterfaceType.None)> _.
Prior to doing this, I had this in my object explorer which has both the ISQLCalls and SQLCalls in the Classes section
But wait, ISQLCalls isn't a class, it's an interface!
By entering the <ClassInterface(ClassInterfaceType.None)> _ back in the SQLCalls class, the object explorer looked a bit better:
And low and behold, I could now create a new instance of the class, and the methods were exposed.
tldr:
I needed to explicitly declare the interface and use <InterfaceType(ComInterfaceType.InterfaceIsDual)> on the interface and <ClassInterface(ClassInterfaceType.None)> on the class.
Many thanks to vba4all, who selflessly devoted their time to assist in this issue.
I'm working on a Timer program, that allows the user to set up a timer for each individual user account on the computer. I'm having some trouble writing the settings to a text file and reading from it. I want to know if it's possible to write it in this fashion --> username; allowedTime; lastedLoggedIn; remainingTime; <-- in one line for each user, and how would I go about doing that? I also wanted to know if it's possible to alter the text file in this way, in the case that there's already an entry for a user, only change the allowedTime, or the remainingTime, kinda just updating the file?
Also I'm also having trouble being able to read from the text file. First of all I can't figure out how to determine if a selected user is in the file or not. Form there, if the user is listed in the file, how can access the rest of the line, like only get the allowedTime of that user, or the remaining time?
I tried a couple of ways, but i just can't get it to do how I'm imaging it, if that makes sense.
here's the code so far:
Public Sub saveUserSetting(ByVal time As Integer)
Dim hash As HashSet(Of String) = New HashSet(Of String)(File.ReadAllLines("Settings.txt"))
Using w As StreamWriter = File.AppendText("Settings.txt")
If Not hash.Contains(selectedUserName.ToString()) Then
w.Write(selectedUserName + "; ")
w.Write(CStr(time) + "; ")
w.WriteLine(DateTime.Now.ToLongDateString() + "; ")
Else
w.Write(CStr(time) + "; ")
w.WriteLine(DateTime.Now.ToLongDateString() + "; ")
End If
End Using
End Sub
Public Sub readUserSettings()
Dim currentUser As String = GetUserName()
Dim r As List(Of String) = New List(Of String)(System.IO.File.ReadLines("Settings.txt"))
'For Each i = 0 to r.lenght - 1
'Next
'check to see if the current user is in the file
MessageBox.Show(r(0).ToString())
If r.Contains(selectedUserName) Then
MessageBox.Show(selectedUserName + " is in the file.")
'Dim allowedTime As Integer
Else
MessageBox.Show("the user is not in the file.")
End If
'if the name is in the file then
'get the allowed time and the date
'if the date is older than the current date return the allowed time
'if the date = the current date then check thhe remaning time and return that
'if the date is ahead of the current date return the reamining and display a messgae that the current date needs to be updated.
End Sub
edit: I just wanted to make sure if I'm doing the serialization right and the same for the deserialization.
this is what i got so far:
Friend userList As New List(Of Users)
Public Sub saveUserSetting()
Using fs As New System.IO.FileStream("Settings.xml", IO.FileMode.OpenOrCreate)
Dim bf As New BinaryFormatter
bf.Serialize(fs, userList)
End Using
End Sub
Public Sub readUserSettings()
Dim currentUser As String = GetUserName()
Dim useList As New List(Of Users)
Using fs As New System.IO.FileStream("Settings.xml", IO.FileMode.OpenOrCreate)
Dim bf As New BinaryFormatter
useList = bf.Deserialize(fs)
End Using
MessageBox.Show(useList(0).ToString)
End Sub
<Serializable>
Class Users
Public userName As String
Public Property allowedTime As Integer
Public Property lastLoggedInDate As String
Public Property remainingTime As Integer
Public Overrides Function ToString() As String
Return String.Format("{0} ({1}, {2}, {3})", userName, allowedTime, lastLoggedInDate, remainingTime)
End Function
End Class
edit 2:
I'm not too familiar with try/catch but would this work instead?
Public Sub readUserSettings()
If System.IO.File.Exists("Settings") Then
Using fs As New System.IO.FileStream("Settings", FileMode.Open, FileAccess.Read)
Dim bf As New BinaryFormatter
userList = bf.Deserialize(fs)
End Using
Else
MessageBox.Show("The setting file doesn't exists.")
End If
End Sub
You have a few typos and such in your code, but it is pretty close for your first try:
Friend userList As New List(Of Users)
Public Sub saveUserSetting()
' NOTE: Using the BINARY formatter will write a binary file, not XML
Using fs As New System.IO.FileStream("Settings.bin", IO.FileMode.OpenOrCreate)
Dim bf As New BinaryFormatter
bf.Serialize(fs, userList)
End Using
End Sub
Public Sub readUserSettings()
' this doesnt seem needed:
Dim currentUser As String = GetUserName()
' do not want the following line - it will create a NEW
' useRlist which exists only in this procedure
' you probably want to deserialize to the useRlist
' declared at the module/class level
' Dim useList As New List(Of Users)
' a) Check if the filename exists and just exit with an empty
' useRlist if not (like for the first time run).
' b) filemode wass wrong - never create here, just read
Using fs As New System.IO.FileStream("Settings.bin",
FileMode.Open, FileAccess.Read)
Dim bf As New BinaryFormatter
' user list is declared above as useRList, no useList
useList = bf.Deserialize(fs)
End Using
' Console.WriteLine is much better for this
MessageBox.Show(useList(0).ToString)
End Sub
<Serializable>
Class Users
' I would make this a property also
Public userName As String
Public Property allowedTime As Integer
Public Property lastLoggedInDate As String
Public Property remainingTime As Integer
Public Overrides Function ToString() As String
Return String.Format("{0} ({1}, {2}, {3})", userName, allowedTime, lastLoggedInDate, remainingTime)
End Function
End Class
ToDo:
a) decide whether you want XML or binary saves. With XML, users can read/edit the file.
b) Use a file path created from Environment.GetFolder(); with a string literal it may end up in 'Program Files' when deployed, and you cannot write there.
c) when reading/loading the useRlist, use something like
FileStream(myUserFile, FileMode.Open, FileAccess.Read)
It wont exist the first time run, so check if it does and just leave the list empty. After that, you just need to open it for reading. For saving use something like:
FileStream(myUserFile, FileMode.OpenOrCreate, FileAccess.Write)
You want to create it and write to it. You might put the Load/Save code inside a Try/Catch so if there are file access issues you can trap and report them, and so you know the list did not get saved or read.
Using a serializer, the entire contents of the list - no matter how long - will get saved with those 3-4 lines of code, and the entire list read back in the 2-3 lines to load/read the file.
I don't have the answer to all your questions however I've been also working on a timer application and just recently started using text file to read and write information. The method I'm using has proven itself fairly easy to use and not very confusing. Here is an extract of my code:
Dim startup As String = "C:\Users\DigiParent\Desktop\Project data\Digitimeinfo.txt"
Dim reader As New System.IO.StreamReader(startup, Encoding.Default)
Dim data As String = reader.ReadToEnd
Dim aryTextFile(6) As String
aryTextFile = data.Split(",")
This will read everything in the text file and in sort separate everything in between the , and store them individual in the array. To put the code back in one line use
Dim LineOfText As String
LineOfText = String.Join(",", aryTextFile)
so you could write someting like this to write your info to a text file:
Dim startup As String = "C:\Users\DigiParent\Desktop\Project data\Digitimeinfo.txt"
Dim objWriter As New System.IO.StreamWriter(startup, False)
Dim aryTextFile(2) As String
aryTextFile(0) = pasword
aryTextFile(1) = user
aryTextFile(2) = remainingtime
LineOfText = String.Join(",", aryTextFile)
objWriter.WriteLine(LineOfText)
objWriter.Close()
and to read it you could use steam reader.
I have replicated the code from the example to collect the result for code coverage from Here except that my code is vb.net
Here is my code
Imports Microsoft.VisualStudio.Coverage.Analysis
Module Module1
Sub Main()
Using info As CoverageInfo = CoverageInfo.CreateFromFile("C:MyFile\data.coverage")
Dim lines As New List(Of BlockLineRange)()
For Each [module] As ICoverageModule In info.Modules
Dim coverageBuffer As Byte() = [module].GetCoverageBuffer(Nothing)
Using reader As ISymbolReader = [module].Symbols.CreateReader()
Dim methodId As UInteger = 0
Dim MethodName As String = ""
Dim undecoratedMethodName As String = ""
Dim ClassName As String = ""
Dim NameSpaceName As String = ""
lines.Clear()
While reader.GetNextMethod(methodId, MethodName, undecoratedMethodName, ClassName, NameSpaceName, lines)
Dim stats As CoverageStatistics = CoverageInfo.GetMethodStatistics(coverageBuffer, lines)
Console.WriteLine("Method {0}{1}{2}{3}{4} has:" & NameSpaceName & ClassName & undecoratedMethodName)
Console.WriteLine(" blocks covered are {0}", stats.BlocksCovered)
End While
End Using
Next
End Using
End Sub
End Module
When I run this on the line for CreateFromFile i get a ImageNotFoundException
Image File "C:\SomeAddress\MyServer\UnitTest.dll" could not be found
I have already as per instructions added the neccessary dlls to my project copied and the other 2 as references.
And yet another tumbleweed moment....
Basically the problem was that folder containing my coverage file also had to contains all the dlls used within that assembely that tests were ran on in order to create that object.
hope this helps you if you ever stumbled over this issuen :)
I'm in the process of writing a little app for our SQL developers to allow them to create labels with TFS for easy code deployment, the trouble is the .ssmssqlproj files are being added to the label when ever i create one. I've added a sub to loop through and unlabel these file but i just will not work. code below
Public Sub UnlabelItem()
Dim returnValue As LabelResult()
Dim labelName As String = "1208-2210"
Dim labelScope As String = "$/"
Dim version As VersionSpec = New LabelVersionSpec(labelName, labelScope)
Dim path As String = "$/FEPI/Database/FEPI/000 Pre Tasks.ssmssqlproj"
Dim recursion As RecursionType = RecursionType.None
Dim itemspec As ItemSpec = New ItemSpec(path, recursion)
returnValue = sourceControl.UnlabelItem(labelName, labelScope, itemspec, version)
End Sub
this is a test Sub just to get it working and this is the error i get
Value of type 'Microsoft.TeamFoundation.VersionControl.Client.ItemSpec' cannot be converted to '1-dimensional array of Microsoft.TeamFoundation.VersionControl.Client.ItemSpec'
HAs anybody had any luck with the unlabel command?
Matt