Hope someone can help with the above error.
I have the following code that worked fine with windows xp and a Kodak scanmate 1120
Private Sub BtnScan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnScan.Click
Dim img As WIA.ImageFile = Nothing
Dim wiaDialog As WIA.CommonDialog = New WIA.CommonDialog
Dim wiaScanner As WIA.Device
Dim root As String = "c:\myimages"
Dim IFileName As String = TxtInvoiceNo.Text
Dim WiaCommonDialog As New WIA.CommonDialog
If TxtInvoiceNo.Text = "" Then
'FrmPicDisplay.Show()
MsgBox("Please enter a valid Invoice No." & vbNewLine _
& "Then press scan button to continue.")
TxtInvoiceNo.Select()
ElseIf My.Computer.FileSystem.FileExists(root & IFileName & ".bmp") Then
MsgBox("This filename already exists," & vbNewLine _
& "Please enter a different filename")
TxtInvoiceNo.Text = ""
Else
Ino = TxtInvoiceNo.Text
wiaScanner = wiaDialog.ShowSelectDevice
With wiaScanner.Items(1)
.Properties("6146").Value = 4 '4 is Black-white,gray is 2, color 1 (Color Intent)
.Properties("6147").Value = 200 'dots per inch/horizontal
.Properties("6148").Value = 200 'dots per inch/vertical
.Transfer(wiaFormatTIFF) '("{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}") 'BMP format - This prompts the scan
End With
img = wiaScanner
Dim Item As WIA.Item = TryCast(wiaScanner.Items(1), WIA.Item)
Dim imageBytes As [Byte]() = DirectCast(img.FileData.BinaryData, Byte())
Dim ms As New MemoryStream(imageBytes)
Dim image_1 As Image = Image.FromStream(ms)
img.SaveFile("c:\myimages" & TxtInvoiceNo.Text & ".bmp")
I had to change the pc to windows seven and now the program doesn't work and gives me the above error at the line
img = wiaScanner
From what I have found by searching it sounds like a com exception but I don't really understand where to start looking so any help would be very much appreciated.
Thanks
Gareth
Related
good day!
Tell me how you can quickly ping the entire network?
There is the following code that scans the network.
Public Sub Scan(ByVal subnet As String)
Dim myPing As Ping
Dim reply As PingReply
Dim addr As IPAddress
Dim host As IPHostEntry
Dim active_addr As Integer = 0
ProgressBar1.Maximum = 254
ProgressBar1.Value = 0
ListView1.Items.Clear()
For i As Integer = 1 To 254
Dim subnetn As String = "." & i.ToString()
myPing = New Ping()
reply = myPing.Send(subnet & subnetn, 900)
Label3.ForeColor = Color.Green
Label3.Text = "Scan: " & subnet & subnetn
If reply.Status = IPStatus.Success Then
Try
addr = IPAddress.Parse(subnet & subnetn)
host = Dns.GetHostEntry(addr)
If My.Computer.Network.Ping(host.HostName, 10) Then
ListView1.Items.Add(New ListViewItem(New String() {subnet & subnetn, host.HostName, "True"}))
Else
ListView1.Items.Add(New ListViewItem(New String() {subnet & subnetn, host.HostName, "False"}))
End If
Catch
ListView1.Items.Add(New ListViewItem(New String() {subnet & subnetn, " ", "False"}))
End Try
active_addr += 1
End If
ProgressBar1.Value += 1
Label5.Text = Math.Round((ProgressBar1.Value * 100) / 254, 0, MidpointRounding.AwayFromZero) & " %"
')
ListView1.Items((ListView1.Items.Count - 1)).EnsureVisible()
ListView1.Items((ListView1.Items.Count - 1)).Selected = True
Next i
ListView1.Items(0).Focused = True
ListView1.Items(0).Selected = True
End Sub
But it takes a very long time to scan the network. Tell me, is it possible to do it faster?
And can I add the device's MAC address when scanning the network?
================================================================
Found a solution that quickly scans the network (a given range of ip addresses).
Tell me. how to add to this code to display the hostname and the MAC address? and add a ProgressBar to show the scan percentage.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Ping("192.168.1.28", "175")
End Sub
Private Async Function Ping(startIP As String, endIP As String) As Task
Dim start As IPAddress = IPAddress.Parse(startIP)
Dim bytes = start.GetAddressBytes()
Dim leastSigByte = start.GetAddressBytes().Last
Dim range = endIP - leastSigByte
Dim pingReplyTasks = Enumerable.Range(leastSigByte, range).Select(Function(x)
Dim p = New Ping()
Dim bb = start.GetAddressBytes()
bb(3) = CByte(x)
Dim destIp = New IPAddress(bb)
Dim pingResultTask = p.SendPingAsync(destIp)
Return New With {
Key pingResultTask,
Key .addr = destIp
}
End Function).ToList()
Await Task.WhenAll(pingReplyTasks.Select(Function(x) x.pingResultTask))
For Each pr In pingReplyTasks
Dim tsk = pr.pingResultTask
Dim pingResult = tsk.Result
Dim ip = pr.addr
'
DataGridView1.Rows.Add(ip, pingResult.RoundtripTime, pingResult.Status)
Next pr
End Function
I'm creating a code for the computers at work. I had to make an "Install" program. I didn't know how to do it properly but I found a way to do it.
When I "Install" the program on a other computer I have my USB-stick and copy it to the local disk at the computer.
Now I start the program for the first time at their computer and this code run's
and then I got an error here because Program is not yet divined:
Dim lMateriaalCertificaat As String = System.IO.File.ReadAllText(Program & "Materialen&Certificaten.txt")
Dim Pathproj As String = AppDomain.CurrentDomain.BaseDirectory
Dim Pathfile As String = Pathproj.Replace("bin\Debug\", "Bestanden\Locatie.txt")
Dim Program As String = System.IO.File.ReadAllText(Pathfile)
'Deze bestanden worden aangemaakt en er wordt automatisch een route ingezet.
Dim lMateriaalCertificaat As String = System.IO.File.ReadAllText(Program & "Materialen&Certificaten.txt")
Dim lBibliotheek As String = System.IO.File.ReadAllText(Program & "Bibliotheek.txt")
Dim lExcel_autonummering As String = System.IO.File.ReadAllText(Program & "Excelbestand autonummering.txt")
Dim lLocatie_telbestanden As String = System.IO.File.ReadAllText(Program & "Locatie telbestanden.txt")
Dim lMapnamen As String = System.IO.File.ReadAllText(Program & "Mapnamen.txt")
Dim lOrderschijf As String = System.IO.File.ReadAllText(Program & "Zoek schijf.txt")
Because when the form2_load I do this and then I wan't to divine that string.
Public Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim Locatie_05Kuipers As String
If System.IO.File.ReadAllText(Pathfile) = "" Then
'If System.IO.File.ReadAllText("C:\testing1\testing2\testing7\testing1\testing1\text.txt") = "" Then
Locatie_05Kuipers = InputBox("Vul hier de Locatie waar je start bestanden moeten staan. Bijvoorbeeld: K:\Inventor\Instalprogram\ ")
If System.IO.File.Exists(Pathfile) Then
System.IO.File.Delete(Pathfile)
End If
Dim objStreamWriter As StreamWriter
objStreamWriter = New StreamWriter(Pathfile)
objStreamWriter.WriteLine(Locatie_05Kuipers & "\03 - Locaties")
objStreamWriter.Close()
ButtonInstal.Visible = True
Exit Sub
Else
End If
So how or where do I need to put my strings?
You can save a path in your settings, and every time you need it, you can create the file and put your data in it.
For example:
Dim pathString As String = My.Settings.filePath
Dim fullPath = Path.Combine(pathString, "Locatie.txt")
If Not Directory.Exists(pathString) Then
Directory.CreateDirectory(pathString)
File.Create(fullPath)
Else
If Not File.Exists(pathString) Then
File.Create(fullPath)
Else
Console.WriteLine($"File {fullPath}already exists.")
End If
End If
I am using the below code to get some information on remote computers. Basically, I need to get the OS version (which is working well) and the default program for .pdf files and the default browser. I can get the OS version but the code fails to get the default program association. The Remote Registry is enabled and started but even though I am getting an "access is denied" error message. Any clue guys? Hope you could help me. Thanks
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Const HKEY_LOCAL_MACHINE As String = "80000002"
Const HKEY_current_user1 As String = "80000001"
'Dim remoteRegistryController As New System.ServiceProcess.ServiceController("RemoteRegistry", computerNameTB.Text)
'remoteRegistryController.Start()
Dim osName, pdf, browser As String
Dim options As New ConnectionOptions
options.Impersonation = ImpersonationLevel.Impersonate
options.EnablePrivileges = True
options.Username = "hd_juann"
options.Password = "Diosteamo42="
Dim myScope As New ManagementScope("\\" & computerNameTB.Text & "\root\default", options)
Dim mypath As New ManagementPath("StdRegProv")
Dim mc As New ManagementClass(myScope, mypath, Nothing)
Try
Dim inParams As ManagementBaseObject = mc.GetMethodParameters("GetDWORDValue")
inParams("hDefKey") = UInt32.Parse(HKEY_LOCAL_MACHINE, System.Globalization.NumberStyles.HexNumber) 'RegistryHive.LocalMachine
inParams("sSubKeyName") = "Software\Microsoft\Windows NT\currentVersion"
inParams("sValueName") = "ProductName"
'Dim osName As String
Dim outParams As ManagementBaseObject = mc.InvokeMethod("GetStringValue", inParams, Nothing)
If (outParams("ReturnValue").ToString() = "0") Then
'MessageBox.Show(outParams("sValue").ToString())
osName = outParams("sValue").ToString()
Else
MessageBox.Show("Error retrieving value : " + outParams("ReturnValue").ToString())
End If
'get pdf
Dim inParamsPDF As ManagementBaseObject = mc.GetMethodParameters("GetDWORDValue")
inParamsPDF("hDefKey") = UInt32.Parse(HKEY_current_user1, System.Globalization.NumberStyles.HexNumber) 'RegistryHive.LocalMachine
inParamsPDF("sSubKeyName") = "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.pdf\UserChoice"
inParamsPDF("sValueName") = "ProgId"
'Dim pdf As String
Dim outParamsPDF As ManagementBaseObject = mc.InvokeMethod("GetStringValue", inParamsPDF, Nothing)
If (outParamsPDF("ReturnValue").ToString() = "0") Then
pdf = outParamsPDF("sValue").ToString()
Else
pdf = "No value Set"
End If
'MessageBox.Show(pdf)
'remoteRegistryController.Stop()
'get browser
Dim inParamsBrowser As ManagementBaseObject = mc.GetMethodParameters("GetDWORDValue")
inParamsBrowser("hDefKey") = UInt32.Parse(HKEY_current_user1, System.Globalization.NumberStyles.HexNumber) 'RegistryHive.LocalMachine
inParamsBrowser("sSubKeyName") = "SOFTWARE\Microsoft\Windows\Shell\Associations\URLAssociations\https\UserChoice"
inParamsBrowser("sValueName") = "ProgId"
'Dim browser As String
Dim outParamsBrowser As ManagementBaseObject = mc.InvokeMethod("GetStringValue", inParamsBrowser, Nothing)
If (outParamsBrowser("ReturnValue").ToString() = "0") Then
browser = outParamsBrowser("sValue").ToString()
Else
browser = "No value Set"
End If
MsgBox(osName & " is installed on computer " & computerNameTB.Text & vbCrLf & "PDF Default App: " & pdf & vbCrLf & "Default Browser: " & browser,, "ComputerInfo W10 Upgrade Project")
Catch err As Exception
If osName <> "" Then
MsgBox(osName & " is installed on computer: " & computerNameTB.Text & ". No default program association information could be accessed " & err.Message,, "ComputerInfo W10 Upgrade Project")
Else
MsgBox("It was no possible to query computer: " & computerNameTB.Text,, "ComputerInfo W10 Upgrade Project")
End If
'MsgBox("It was no possible to query computer: " & computerNameTB.Text,, "ComputerInfo W10 Upgrade Project")
End Try
End Sub
eoor
I need to make a loop to look at a lot of mp3 files and getting their naturalDuration property using a mediaElement. The problem is that mediaElement need some time to load every single file and .source property works like async process (I think) because I have to click two times on below code if I want to obtain naturalDuration property. First click I have just 00:00:00 value, second clik give me real value.
Private Sub button_Click(sender As Object, e As RoutedEventArgs) Handles button.Click
mediaElement.Source = New Uri("\\Mac\Home\Desktop\NOVEDADES01\AbrahamMateo-OldSchool.mp3")
textBlock.Text = mediaElement.NaturalDuration.ToString
End Sub
If I try to wait after .Source instruction, the application keeps on loop.
Private Sub button_Click(sender As Object, e As RoutedEventArgs) Handles button.Click
mediaElement.Source = New Uri("\\Mac\Home\Desktop\NOVEDADES01\AbrahamMateo-OldSchool.mp3")
Do
Loop Until mediaElement.NaturalDuration.TimeSpan.TotalSeconds > 0
textBlock.Text = mediaElement.NaturalDuration.ToString
End Sub
I also have try set .source through an async process and wait for mediaOpenend event, but it look like mediaElemento can not end until the first click was ending
How could I get real value of naturalDuration inside one single process or function just after set .source property and without playing the file?
Thanks a lot!!
Ok, late and may be not so elegant but this was my solution for getting duration of a mp3 file. I used MusicProperties Class.
Public Function infoMP3(elfichero As String) As String
Dim salida As String = ""
Dim miTask = Task.Run(Async Function() As Task(Of String)
Dim musicFile As StorageFile = Await StorageFile.GetFileFromPathAsync(elfichero)
Dim FileProperties As StorageItemContentProperties = musicFile.Properties
Dim musicFileProperties As MusicProperties = Await FileProperties.GetMusicPropertiesAsync()
Dim tiempo = musicFileProperties.Duration
Dim horas As String
If tiempo.Hours < 10 Then
horas = "0" & tiempo.Hours.ToString
Else
horas = tiempo.Hours.ToString
End If
Dim minutos As String
If tiempo.Minutes < 10 Then
minutos = "0" & tiempo.Minutes.ToString
Else
minutos = tiempo.Minutes.ToString
End If
Dim segundos As String
If tiempo.Seconds < 10 Then
segundos = "0" & tiempo.Seconds.ToString
Else
segundos = tiempo.Seconds.ToString
End If
Dim autor = musicFileProperties.Artist
Dim titulo = musicFileProperties.Title
Dim presalida As String = "[" & horas & ":" & minutos & ":" & segundos & "];[" & titulo & "];[" & autor & "] " & elfichero
Return presalida
End Function)
miTask.Wait()
salida = miTask.Result
Return salida
End Function
To get access to the files later on Windows 10, you have to save permission for the files and/or folders. Do this when you select them.
...
Dim listToken = Windows.Storage.AccessCache.StorageApplicationPermissions.FutureAccessList.Add(rutaS)
...
where rutaS is an SotorageFolder object.
I have problem with this - I try to send broadcast SMS using AT Commands in my system. After that the SMS content will be stored in my database. My store content SMS function works well. I can store all my SMS content that I send, but the send function just sends message to my first data on my datagridview.
Please help me to deal with this - I posted my code below
Private Sub ButtonKirim_Click(sender As Object, e As EventArgs) Handles ButtonKirim.Click
Dim noPel As String
Dim isiPesan As String = ""
Dim tgl As Date = Now.Date
Dim strReplace(2) As String
Dim strIsi(2) As String
Dim tagBulan As String = "<bulan>"
Dim tagtagihan As String = "<tagihan>"
Dim tagLokasi As String = "<lokasi>"
Dim pesanKirim As String = ""
My.Settings.SettingPesan = RichTextBoxPesan.Text
My.Settings.Save()
'Label4.Text = isiPesan
For pelanggan As Integer = 0 To DataGridViewKirimPesan.RowCount - 1
'mengirim pesan/send message
noPel = DataGridViewKirimPesan.Rows(pelanggan).Cells(3).Value()
strReplace(0) = tagBulan
strReplace(1) = tagtagihan
strReplace(2) = tagLokasi
strIsi(0) = DataGridViewKirimPesan.Rows(pelanggan).Cells(4).Value
strIsi(1) = DataGridViewKirimPesan.Rows(pelanggan).Cells(5).Value
strIsi(2) = DataGridViewKirimPesan.Rows(pelanggan).Cells(6).Value
isiPesan = RichTextBoxPesan.Text
For i As Integer = LBound(strReplace) To UBound(strReplace)
isiPesan = isiPesan.Replace(strReplace(i), strIsi(i))
Next
SendMessage(noPel, isiPesan)
''menyimpan pesan keluar ke sms_terkirim/this query store my content SMS to table
Dim sqlSmsKeluar As String = "INSERT INTO sms_terkirim (`tgl_sms`,`id_pelanggan`, `isi_sms`) VALUES ( NOW()," & DataGridViewKirimPesan.Rows(pelanggan).Cells(0).Value & " , '" & isiPesan & "');"
cudMethod(sqlSmsKeluar)
MsgBox(sqlSmsKeluar)
'ProgressBarKirimPesan.Increment(1)
Next
'MsgBox("Pesan Sukses Terkirim")
' Catch ex As Exception
' MsgBox("Pesan Gagal Terkirim" + ex.Message)
'End Try
' End If
End Sub
and this code is AT Command to send message
Public Sub SendMessage(ByVal NomorPelanggan As String, ByVal IsiPesan As String)
If SerialModem.IsOpen() Then
With SerialModem
.Write("AT" & vbCrLf)
Threading.Thread.Sleep(100)
.Write("AT+CMGF=1" & vbCrLf)
Threading.Thread.Sleep(100)
.Write("AT+CMGS=" & Chr(34) & NomorPelanggan & Chr(34) & vbCrLf)
Threading.Thread.Sleep(100)
.Write(IsiPesan & vbCrLf & Chr(26))
Threading.Thread.Sleep(100)
End With
Else
MsgBox("Modem Belum Tersambung")
End If
End Sub