From what I have read and tried myself I am starting to think this is not possible; but if you don't don't ask you don't get...
I am making a tool that formats USB sticks for staff at work (it adds branding, instructions, handbooks etc). Whilst doing this I am attempting to store the "serial/Unique identifier" for the device in a database so that should I find a lost memory stick I can find out who the original owner was, even if it has been reformated!
I got this snippet from another answer on SO
Dim driveNames As New List(Of String)
For Each drive As DriveInfo In My.Computer.FileSystem.Drives
Try
Dim fso As Scripting.FileSystemObject
Dim oDrive As Scripting.Drive
fso = CreateObject("Scripting.FileSystemObject")
oDrive = fso.GetDrive(drive.Name)
ListBox1.Items.Add(drive.Name & " " & oDrive.SerialNumber)
Catch ex As Exception
End Try
Next
End Sub
This returns a number, but that changes when the drive is formatted.
I also tried modifying a snippet I got from online (CodeProject) I think.
'Check for valid drive letter argument.
ToolStripStatusLabel1.Text = "Fetching Device Serial ('" & DriveLetter & "' Validating drive letters)"
Dim ValidDriveLetters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If ValidDriveLetters.IndexOf(DriveLetter) <> -1 Then
If DriveLetter.Length = 1 Then
ToolStripStatusLabel1.Text = "Fetching Device Serial ('" & DriveLetter & "' Creating Disk Management Object)"
Dim Disk As New System.Management.ManagementObject("Win32_LogicalDisk.DeviceID=""" & DriveLetter & ":""")
ToolStripStatusLabel1.Text = "Fetching Device Serial ('" & DriveLetter & "' Creating Disk Property)"
Dim DiskProperty As System.Management.PropertyData
For Each DiskProperty In Disk.Properties
ToolStripStatusLabel1.Text = "Fetching Device Serial ('" & DriveLetter & "' Reading " & DiskProperty.Name & ": " & DiskProperty.Value & ")"
'Threading.Thread.Sleep(1000)
If DiskProperty.Name = "VolumeSerialNumber" Then
Return DiskProperty.Value.ToString '.ToString 'Return the volume serial number.
End If
Next DiskProperty
End If
End If
Return Nothing 'Invalid drive letter.
This currently returns the volume serial (best result I could get right now), that obviously changes when the drive is formatted.
I have looked through the property names but I am yet to find something to uniquely identify the drive itself rather than its volumes.
Is there a property that I can read that would be unique to each device? (even the same the manufacturer/model)
OR
Am I going about this the wrong way? I also considered partitioning the USBs with a hidden partition and then storing the volume serial of that. If an end user formats the drive via Explorer they are only going to wipe the visible partition rather than my secret hidden one...but this seems like a workaround rather than an actual solution?
Please note, I am not a VB.net wizard, web is more my thing (I may need some hand holding at times - but I try my best!)
Related
I have a class (too complex to post code), which I think may have a memory leak. However the process workingset and virtual memory size suggest otherwise.
I create and destroy the class like this:
Dim vdt As ValidateDTC
Dim prc As Process = Process.GetCurrentProcess
For I As Integer = 1 To 100
Debug.Print("1:" & "WorkingSet64:" & prc.WorkingSet64.ToString & " VirtualMemorySize64:" & prc.VirtualMemorySize64.ToString)
vdt = New ValidateDTC
Debug.Print("2:" & "WorkingSet64:" & prc.WorkingSet64.ToString & " VirtualMemorySize64:" & prc.VirtualMemorySize64.ToString)
vdt = Nothing
Debug.Print("3:" & "WorkingSet64:" & prc.WorkingSet64.ToString & " VirtualMemorySize64:" & prc.VirtualMemorySize64.ToString)
Next i
Once the class is created for the first time the workingset and virtualmemorysize are the same throughout the test.
My problem is that the debugger "Process Memory" graph climbs throught the test
If I put a break in the loop and snapshot the memory I can see all sorts of numbers increasing.
The class will ultimately be used in threads (via background worker).
Is there a problem, or not.
All;
I have a bit of code I've written that opens a design blueprint when I scan a bar code. It works well enough, but I'd like to open a new instance of the design software (Solidworks) and have the print display in the new instance. Right now, no matter how many Solidworks instances I have open, the print will only open in the first instance started.
The line commented out below is the line that works, just not in the right instance. The line below that is what I'd expect to work, but it returns a 'file not found' even though the path to solidworks and the print path are both correct.
Any explanation as to why this isn't working would be much appreciated as I'm obviously very new at this...and have no idea what I'm doing.
Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click
Try
Dim barcode As String = tb_barcode.Text
Dim filename As String = tb_barcode.Text
'Add File Extension to end of path
Dim ext As String = ".SLDDRW"
'Split job number from detail number in barcode textbox
barcode = Split(tb_barcode.Text, ".")(0)
filename = Split(tb_barcode.Text, ".")(1)
'- This works, just in primary instance
'System.Diagnostics.Process.Start("G:\Fixtures\" & barcode & "\Details\" & barcode & " DET " & filename & ext)
'- This does not work
System.Diagnostics.Process.Start("'C:\Program files\Solidworks Corp\Solidwork\SLDWORKS.exe' 'G:\Fixtures\" & barcode & "\Details\" & barcode & " DET " & filename & ext + "'")
Catch
MessageBox.Show("File Not Found")
End Try
End Sub
Sorry for naive approach but shouldn't there be a comma in Process.Start between 2 arguments?
Start(String, String)
Starts a process resource by specifying the name of an application and a set of command-line arguments, and associates the resource with a new Process component. docs
Why don't you use the Application.ExecutablePath.That returns the Application's path with its full name. Then your code should be
System.Diagnostics.Process.Start(Application.Executablepath, "G:\Fixtures\" & barcode & "\Details\" & barcode & " DET " & filename & ext + "'")
Also make sure that the second string argument is a valid path.
so im learning to use socket and thread things in the networking software. so far, the software (which is not created by me) is able to chat in multiple group, but i'm tasked to allow user to code whisper feature. However, im stuck in the coding area, which im sure will work if the "if" function work inside "for each" function, anyhow here is my code mainly
Private clientCollection As New Hashtable()
Private usernameCollection As New Hashtable()
clientCollection.Add(clientID, CData)
usernameCollection.Add(clientID, username)
oh and before i forgot, the code above and below is on the server form page
on the client side, i write the code:
writer.write("PMG" & vbnewline & txtReceiverUsername & Message)
then next is the checking part on the server reading the message:
ElseIf message.Substring(0, 3) = "PMG" Then
'filter the message, check who to send to
Dim newMessage As String = message.Substring(3)
Dim messagearray As String() = newMessage.Split(vbNewLine)
Dim receiver As String = messagearray(1)
'0 = "", 1 = receiver, 2 = message
as i write before, clientcollection contain (clientID , connection data*) and usernamecollection contain (clientID, username). In my case, i only have the username data, and i need to trace it until the connection data on clientcollection hash table.
'find realid from usernamecollection, then loop clientcollection
Dim clientKey As String = 0
For Each de As DictionaryEntry In usernameCollection
'''''
'this if part Is Not working
If de.Value Is receiver Then
clientKey = de.Key
End If
'''''
Next de
'match objKey with clientcollection key
For Each dec As DictionaryEntry In clientCollection
If dec.Key = clientKey Then
Dim clients As ClientData = dec.Value
If clients.structSocket.Connected Then
clients.structWriter.Write("PMG" & messagearray(2))
End If
End If
Next dec
End If
so, how do i know that the if part is the wrong one? simply i tried these code before the "next de" code
For Each client As ClientData In clientCollection.Values
If client.structSocket.Connected Then
client.structWriter.Write("PMG" & "receiver:" & messagearray(1))
client.structWriter.Write("PMG" & "loop username: " & de.Value)
client.structWriter.Write("PMG" & "loop key: " & de.Key)
client.structWriter.Write("PMG" & "receiver key:" & clientKey)
End If
Next
the code allow me to check the de.key and de.value. they were correct, however the only thing that did not work is the code inside the "if" area.
Can anyone suggest other code maybe beside "if de.key = receiver"? I've also tried using the if de.key.equal(receiver) and it did not work too
first of all: Sorry for the not so clear title. I didn't know a better way to descripe my question.
I'm building a application that has to save user-specified data to a sdcard on a plc.
I already found out how to connect to that plc but am still working on the saving part.
For the testing i just used:
ds.WriteXml("C:\" & DateTimePicker1.Text & ".xml")
I think it's possible to change it to \192.168.2.16\SDcard\filename but that's not very flexible.
What i would like to have is the ability to take the value from a combobox and use that as the ip adress.
What is the best way to do this? as i don't think it's a simpe thing like making the savepad
(\" & comboIP.selectedvalue & "\Sdcard\" & DateTimePicker1.Text & ".xml") Unfortunately, the SD card is still on it's way so i can't test it yet..
Thanks in advance!
ds.WriteXml("C:\" & comboIP.Text & "\SDCard\" & DateTimePicker1.Text & ".xml")
That works just fine.
You don't really need the SDCard in hand to test this out.
You can simply create temporary variables before the WriteXML function call, set a breakpoint on them, and ensure that they are the correct values beforehand.
e.g.:
Dim sSelectedIP As String = comboIP.Text
Dim sDateTimePicker As String = DateTimePicker1.Text
Dim sCompleteDirectory As String = "C:\" & sSelectedIP & "\SDCard"
If My.Computer.FileSystem.DirectoryExists(sCompleteDirectory) = False Then
My.Computer.FileSystem.CreateDirectory(sCompleteDirectory)
End If
ds.WriteXml(sCompleteDirectory & "\" & sDateTimePicker & ".xml")
I've started to run into some concurrency issues with my databases. I have roughly ten different aacdb files in a shared location on our office network. One of these databases is kind of the 'master' database. It is split into backend and front end. The backend of this databases holds common tables such as users/passwords, employees, departments, etc etc.
Yesterday, I made two databases purely for input. They each have a single form bound to a table in 'data entry' mode, with record locks set to 'edited record.' They also link to some of the same tables shared by other databases. This is where I started to run into (likely?) concurrency issues for the first time.
People have been reporting odd behavior (forms not opening, etc) in the 'master' database. This was tested a bit and only happens when users are also in the linked data-entry only databases.
There are still less than ten current users across all of the databases at a given time.
Would drop down selections hold a lock on a table, preventing certain forms from opening?
AFAIK, dropdowns are just queried when the form is loaded.
Any ideas?
I had fits with this issue, trying to have several users share the same front end from a network share. Things would just...not work. Then when I went back it was impossible to dupilcate the failures. I decided to have the application installed on the local machines, but this had version control issues, especially since I had several different front ends running at the same time for different projects. There were updaters out there but they either cost money or I couldnt see the code and didnt trust them. I came up with this as a solution and have been using it since Access 2003.
This is a seperate ACCESS database, you have to lock it down just like you would any front end.
This launcher works for the four access front ends that I am running right now. There are two table that you have to setup on the network.
TABLE NAME: RunTimeTracking
FIELD: RTTID : AutoNumber
FIELD: RTTComputerName : Text
FIELD: RTTLoginTime : Date/Time
TABLE NAME: VersionControlTable
FIELD: VCTID : AutoNumber
FIELD: VCTVersion : Number
FIELD: VCTSourceLoc : Text
FIELD: VCTDest : Text
FIELD: VCTDateVer : Date/Time
The RunTimeTracking table works to prevent the user from starting the actual application without using the launcher. When the launcher runs it inserts a entry into the table with the computer name. When the application runs it looks for that entry, if it doesnt see it. It warns and dumps.
In the version control table put the location of the most up to date app, the location on the local machine where you want the applicaiton to be stored.
If you have more than one program that you are controlling, then increment VCTVersion entry and reference it in your code in the launcher.
strSQL = "SELECT * FROM VersionControlTable WHERE VCTVersion = 200"
When the launcher runs it checks the CREATED datestamp on the local file to the one on the network, if they are different, it copies. If not, it runs.
Private Sub Form_Load()
DoCmd.ShowToolbar "Ribbon", acToolbarNo
DoCmd.ShowToolbar "Status Bar", acToolbarNo
DoCmd.Maximize
Form.TimerInterval = 2000
End Sub
Private Sub Form_Timer()
runDataCheck
End Sub
Private Sub runDataCheck()
' This is the launcher program. This program is designed to check for
' Version information and upload and download the new version automaticaly.
' Place entry into the Run Time Tracking Table. This will be used by the Main Application to verify that
' The application was launched by the Launcher and not run straight from the desktop
'First, retrieve the name of the computer from the Environment.
Dim strCompName As String
strCompName = Environ("computername")
' Now, delete all entries on the tracking table that have this computer name associated with it.
' Later we will try to add a trigger that archives the logins.
Dim strSQL As String
strSQL = "DELETE FROM RunTimeTracking WHERE RTTComputerName = '" & strCompName & "'"
adoSQLexec (strSQL)
' Now, add and entry into the table
strSQL = "INSERT INTO RunTimeTracking (RTTComputerName,RTTLoginTime) VALUES ('" & strCompName & "','" & Now() & "')"
adoSQLexec (strSQL)
' First, retrieve the parameters from the Version Control File and put them into variables that we can use.
Dim strSource As String
Dim strDest As String
Dim dateVer As Date
Dim rs As New ADODB.Recordset
'LBLSplashLabel.Caption = "Checking Version Information...."
strSQL = "SELECT * FROM VersionControlTable WHERE VCTVersion = 200"
With rs
rs.Open strSQL, CurrentProject.Connection
End With
strSource = rs.Fields("VCTSourceLoc").Value
strDest = rs.Fields("VCTDest").Value
dateVer = rs.Fields("VCTDateVer").Value
Set rs = Nothing
' Next. See if the folders on both the local drive and the source drive exists.
Dim binLocal As Boolean
Dim binNet As Boolean
Dim binDirectoryLocal As Boolean
'Debug.Print strSource
' First check to see if the network file exists.
binNet = FileExists(strSource)
If binNet = False Then
MsgBox ("The network source files are missing. Please contact Maintenance!")
Application.Quit (acQuitSaveNone)
End If
' Get the timestamp from the network version since it exists.
Dim fileNet As File
Dim fileLocal As File
Dim fileNetObject As New FileSystemObject
Set fileNet = fileNetObject.GetFile(strSource)
Debug.Print strSource
Debug.Print "Created Date : " & fileNet.DateCreated
Dim strDirName As String
Dim intFind As Integer
' Check to see if the Local file Exists.
binLocal = FileExists(strDest)
If binLocal = False Then
'There is no local file. Check to see if the directory exists
' Get the directory name
intFind = (InStrRev(strDest, "\", , vbTextCompare))
strDirName = (Left(strDest, intFind - 1))
Debug.Print "Directory Name: " & strDirName
binDirectoryLocal = FolderExists(strDirName)
If binDirectoryLocal = False Then
'There is no local directory. Create one
MkDir (strDirName)
' LBLSplashLabel.Caption = "Copying Files...."
'Copy the source file to the directory.
FileCopy strSource, strDest
'Since we have no copied the latest version over, no need to continue. Open the main app
OpenMaintApp (strDest)
Else
' No need to create the directory, simply copy the file.
'Copy the source file to the directory.
' LBLSplashLabel.Caption = "Copying Files...."
FileCopy strSource, strDest
'Since we have no copied the latest version over, no need to continue. Open the main app
OpenMaintApp (strDest)
End If
End If
'Now we know that the file is in the directory, now we need to check its version.
'Get the last modified date from the file.
Set fileLocal = fileNetObject.GetFile(strDest)
Debug.Print "Last Modified Date : " & fileLocal.DateCreated
'Do the version check
If fileLocal.DateCreated <> fileNet.DateCreated Then
' LBLSplashLabel.Caption = "Copying Files...."
'Copy the source file to the directory.
FileCopy strSource, strDest
'Since we have no copied the latest version over, no need to continue. Open the main app
OpenMaintApp (strDest)
Else
OpenMaintApp (strDest)
End If
OpenMaintApp (strDest)
End Sub
Private Sub OpenMaintApp(strAppName As String)
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase (strAppName)
accapp.Visible = True
DoCmd.Quit acQuitSaveNone
End Sub