Visual basic and modules - vb.net

Im writing a application in visual basic to tell the user about their pc.
All this is in a module
Imports Microsoft.VisualBasic.Devices
Imports System.Management
Imports System.Net
Imports System.IO
Imports System.Windows.Forms
Imports System.Deployment.Application
Module ComputerSpecModule
Public Enum infotypes
ProcesserName
VideocardName
VideocardMem
End Enum
Public Function getinfo(ByVal infotype As infotypes) As String
Dim info As New ComputerInfo : Dim value, vganame, vgamem, proc As String
Dim searcher As New Management.ManagementObjectSearcher( _
"root\CIMV2", "Select * FROM Win32_VideoController")
Dim searcher1 As New Management.ManagementObjectSearcher( _
"Select * FROM Win32_Processor")
If infotype = infotypes.ProcesserName Then
For Each queryObject As ManagementObject In searcher1.Get
proc = queryObject.GetPropertyValue("Name").ToString
Next
value = proc
ElseIf infotype = infotypes.VideocardName Then
For Each queryObject As ManagementObject In searcher.Get
vganame = queryObject.GetPropertyValue("Name").ToString
Next
value = vganame
ElseIf infotype = infotypes.VideocardMem Then
For Each queryObject As ManagementObject In searcher.Get
vgamem = queryObject.GetPropertyValue("AdapterRAM").ToString
Next
value = Math.Round((((CDbl(Convert.ToDouble(Val(vgamem))) / 1024)) / 1024), 2) & " MB"
End If
Return value
End Function
Public oAddr As System.Net.IPAddress 'gets the ipv4 add
Public sAddr As String
Public EmailStarterMessage As String = "This message was sent by SpecMee. SpecMee is a light weight application designed to allow the users to find out the specifications of their machines. Please download this application free at http://www.wilson18.com/projects/SpecMee/" + _
Environment.NewLine + _
"" + _
Environment.NewLine + _
"" + _
Environment.NewLine + _
""
'PC SPEC CONTENT
Public ComputerName As String = (My.Computer.Name.ToString)
Public myOS As String = (My.Computer.Info.OSFullName)
Public Processor As String = (getinfo(infotypes.ProcesserName))
Public HDD As String = (Format((My.Computer.FileSystem.Drives.Item(0).TotalSize.ToString / 1024) / 1024 / 1024, "###,###,##0 GB"))
Public RAM As String = (Format((My.Computer.Info.TotalPhysicalMemory / 1024) / 1024 / 1024, "###,###,##0 GB"))
Public VideoCard As String = (getinfo(infotypes.VideocardName))
Public VideoCardMemory As String = (getinfo(infotypes.VideocardMem))
Public Function Resolution() As String
Dim intx As Integer = Screen.PrimaryScreen.Bounds.Width
Dim inty As Integer = Screen.PrimaryScreen.Bounds.Height
Return intx & " x " & inty
End Function
Public Function InternalIPAddress()
With System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName())
oAddr = New System.Net.IPAddress(.AddressList(0).Address)
InternalIPAddress = oAddr.ToString
End With
End Function
Public Function ExternalIPAddress() As String
Dim uri_val As New Uri("http://www.wilson18.com/projects/SpecMee/curip.php")
Dim request As HttpWebRequest = HttpWebRequest.Create(uri_val)
request.Method = WebRequestMethods.Http.Get
Dim response As HttpWebResponse = request.GetResponse()
Dim reader As New StreamReader(response.GetResponseStream())
Dim myip As String = reader.ReadToEnd()
response.Close()
Return myip
End Function
Public EmailContent As String = ("Computer Name: " & ComputerName & Environment.NewLine & "Operating System: " & myOS & Environment.NewLine & "Processor: " & Processor & Environment.NewLine & "Hard Drive Size : " & HDD & Environment.NewLine & "RAM: " & RAM & Environment.NewLine & "Graphics Card: " & VideoCard & Environment.NewLine & "Graphics Onboard Memory: " & VideoCardMemory & Environment.NewLine & "Resolution: " & Resolution() & Environment.NewLine & "Internal IP Address: " & InternalIPAddress() & Environment.NewLine & "External IP Address: " & ExternalIPAddress() & Environment.NewLine)
End Module
The problem I am having is that if one of the things in the module fails such as if the users graphics card does not have any onboard memory then it will fail.This is causing everything else to fail aswell...
I am very new to visual basic so ifyou could please excuse me if I have made any stupidly obvious errors and any suggestions are welcome
Thanks in advance.

Place the parts that can fail in a Try-Catch-statement
Public VideoCardMemory As String = getinfo(infotypes.VideocardMem)
Public Function getinfo(ByVal infotype As infotypes) As String
Try
...
value = ...
...
Catch
value = "Cannot be accessed!"
End Try
Return value
End Function

Related

wmi. Find out the model and size of the hard drive

Good day!
There is the following function, with which I display information from certain wmi classes.
Private Function GetDetails(ByVal pcname As String, ByVal ClassName As String, ByVal Selection As String) As String
Dim tmpstr As String = ""
Dim myScope As New ManagementScope("\\" & pcname & "\root\cimv2")
Dim oQuery As New SelectQuery("SELECT * FROM " & ClassName)
Dim oResults As New ManagementObjectSearcher(myScope, oQuery)
For Each queryObj As ManagementObject In oResults.Get()
Try
tmpstr = queryObj(Selection)
Catch ex As Exception
tmpstr = ""
MsgBox(ex.Message)
End Try
Next
Return tmpstr
End Function
That's how I use it.
Dim HardDriveName As String = GetDetails(PC, "Win32_DiskDrive", "Caption")
Dim HardDriveSize As String = GetDetails(PC, "Win32_DiskDrive", "Size")
The problem arises in the fact that several hard drives can be installed on a PC. Tell me how to display information on all hard drives?
I understand that you need to use a loop. But I don't understand how to do it. Thanks for the help.
I found this solution for myself:
Private Sub HardInfo(ByVal pcname As String)
Dim myScope As New ManagementScope("\\" & pcname & "\root\cimv2")
Dim oQuery As New SelectQuery("SELECT * FROM Win32_DiskDrive")
Dim searcher As New ManagementObjectSearcher(myScope, oQuery)
Dim i As Integer
For Each drive As ManagementObject In searcher.Get()
i += 1
MsgBox("Hard # " & i, drive("Caption") & "(" & Reformat_TB_GB_MB(drive("Size")) & ")")
Next drive
End Sub
' Reformat as TB, GB or MB (if needed)
Private Function Reformat_TB_GB_MB(ByRef Value As Long)
If Len(Value.ToString) > 12 Then ' Reformat if TB
Return Format(Value / 1024 / 1024 / 1024 / 1024, "##0.00 TB")
ElseIf Len(Value.ToString) > 9 Then ' Reformat if GB
Return Format(Value / 1024 / 1024 / 1024, "###,##0.00 GB")
ElseIf Len(Value.ToString) > 6 Then ' Reformat if MB
Return Format(Value / 1024 / 1024, "###,###,##0.00 MB")
ElseIf Len(Value.ToString) > 3 Then ' Reformat if KB
Return Format(Value / 1024, "###,###,###,##0.00 KB")
Else
Return Format(Value, "###,###,###,###,##0.00 Bytes")
End If
End Function

Chrome DevTools SetTimeZoneOverRideCommand cannot change system time

I have problem using Chrome DevTools SetTimeZoneOverrideCommand according to IP timezone.
But when I check in Whoer.net still shows is system time.
In here have 3 problem:
I using in selenium proxy is Rotate Proxy so is that posiible maintain same proxy by usin other function to check IP?
SetTimeZoneOverride cannot change spoof my system same as IP timezone time.
In Whoer.net is that possible change that DNS route
Imports System
Imports System.IO
Imports System.Text.RegularExpressions
Imports OpenQA.Selenium
Imports OpenQA.Selenium.Chrome
Imports Zu.ChromeDevTools
Module Program
Sub Main(args As String())
Console.WriteLine("Current IP: " & GetCurrentIP())
Dim browser_option As New ChromeOptions
Dim NewUAC As String = Random_UAC()
browser_option.AddArgument("user-agent=" & NewUAC)
browser_option.AddArgument("--window-size=800,600")
browser_option.AddArgument("--incognito")
browser_option.AddArgument("--disable-infobars")
browser_option.AddArgument("--disable-blink-features=AutomationControlled")
Dim Proxy As New Proxy With {
.Kind = ProxyKind.Manual,
.IsAutoDetect = False,
.HttpProxy = "p.webshare.io:9999",
.SslProxy = "p.webshare.io:9999"}
browser_option.Proxy = Proxy
Dim driverService = ChromeDriverService.CreateDefaultService
driverService.HideCommandPromptWindow = True
Dim browser As New ChromeDriver(driverService, browser_option)
browser.Navigate.GoToUrl("https://whoer.net")
Dim CurrentIP As String
Dim sHTML As String = browser.PageSource
CurrentIP = Mid(sHTML, sHTML.IndexOf("<strong data-clipboard-target=" & Chr(34) & ".your-ip" & Chr(34) & " class=" & Chr(34) & "your-ip" & Chr(34) & ">") + 59, 20)
CurrentIP = Regex.Match(CurrentIP, "\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b").ToString
Threading.Thread.Sleep(5000)
Console.WriteLine("Changed IP: " & CurrentIP)
Console.WriteLine("Current Loc: " & Get_TimeZone_GeoLocation(CurrentIP))
Dim CurrentGeo() As String
CurrentGeo = Get_TimeZone_GeoLocation(CurrentIP).Split(",")
Dim ChromeGeoLocation As New Zu.ChromeDevTools.Emulation.SetGeolocationOverrideCommand
ChromeGeoLocation.Latitude = CurrentGeo(0)
ChromeGeoLocation.Longitude = CurrentGeo(1)
ChromeGeoLocation.Accuracy = 1
Dim ChromeTimeZone As New Zu.ChromeDevTools.Emulation.SetTimezoneOverrideCommand
ChromeTimeZone.TimezoneId = CurrentGeo(2)
browser.Navigate.GoToUrl("https://whoer.net")
End Sub
Function GetCurrentIP() As String
Dim DetectAddress As String = "https://whoer.net"
Dim CurrentIP As String
Dim objHttpRequest As System.Net.HttpWebRequest
Dim objHttpResponse As System.Net.HttpWebResponse
Dim objProxy As New System.Net.WebProxy
objHttpRequest = System.Net.HttpWebRequest.Create(DetectAddress)
objHttpResponse = objHttpRequest.GetResponse
Dim objStrmReader As New StreamReader(objHttpResponse.GetResponseStream)
Dim sHTML As String
sHTML = objStrmReader.ReadToEnd()
CurrentIP = Mid(sHTML, sHTML.IndexOf("<strong data-clipboard-target=" & Chr(34) & ".your-ip" & Chr(34) & " class=" & Chr(34) & "your-ip" & Chr(34) & ">") + 59, 20)
CurrentIP = Regex.Match(CurrentIP, "\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b").ToString
Return CurrentIP
End Function
Function Get_TimeZone_GeoLocation(ByVal CurrentIP As String) As String
Dim DetectAddress As String = "http://ip-api.com/csv/" & CurrentIP
Dim CurrentLocation As String
Dim objHttpRequest As System.Net.HttpWebRequest
Dim objHttpResponse As System.Net.HttpWebResponse
objHttpRequest = System.Net.HttpWebRequest.Create(DetectAddress)
objHttpResponse = objHttpRequest.GetResponse
Dim objStrmReader As New StreamReader(objHttpResponse.GetResponseStream)
Dim sHTML As String
sHTML = objStrmReader.ReadToEnd()
Dim sHTML_Item() As String
sHTML_Item = sHTML.Split(",")
CurrentLocation = sHTML_Item.Length
Dim latitude, longitude, timezone As String
latitude = sHTML_Item(7)
longitude = sHTML_Item(8)
timezone = sHTML_Item(9)
CurrentLocation = latitude & "," & longitude & "," & timezone
Return CurrentLocation
End Function
Function Random_UAC() As String
Dim strUACs As String = IO.File.ReadAllText("UAC_List.txt")
Dim strUAC_Split As String()
strUAC_Split = strUACs.Split(vbCrLf)
Dim n As Integer = strUAC_Split.Length
Dim RandomUAC As Integer
RandomUAC = Math.Ceiling(Rnd() * n) - 1
'Console.WriteLine(RandomUAC & " - " & strUAC_Split(RandomUAC))
Return strUAC_Split(RandomUAC)
End Function
End Module

Email a table using VB.Net

I need to send an email with a table that has variable values in each cell. I can do this using any method (html via email, an excel/word table, etc.). The only hitch is due to the restrictions of the Emailer program and System.Net.Mail import, it has to be a string.
Here's what I have so far:
Imports DelayEmailer.DelayTrackerWs
Imports System.Configuration
Public Class DelayEmailer
Public Shared Sub Main()
Dim ws As New DelayTrackerWs.DelayUploader
Dim delays As DelayTrackerWs.Delay()
Dim emailer As New Emailer()
Dim delaystring As String
delays = ws.SearchDelaysDate(DelayTrackerWs.AreaEnum.QT, DelayTrackerWs.UnitEnum.QT, Now.AddDays(-1), Now)
delaystring = "Delays" & vbNewLine
delaystring &= "Facilty Start Time Status Category Reason Comment"
For i = 0 To delays.Length - 1
delaystring &= vbNewLine & delays(i).Facility & " "
delaystring &= FormatDateTime(delays(i).DelayStartDateTime, DateFormat.ShortDate) & " "
delaystring &= FormatDateTime(delays(i).DelayStartDateTime, DateFormat.ShortTime) & " "
'delaystring &= delays(i).DelayDuration & " "
delaystring &= delays(i).Status & " "
delaystring &= delays(i).CategoryCode & " "
delaystring &= delays(i).ReasonCode & " "
delaystring &= delays(i).Comment
Next
emailer.Send(ConfigurationManager.AppSettings("EmailList"), "delays", delaystring)
End Sub
As you can see, I currently have just a bunch of concatenated strings that line up if the values of each delays(i) are the same. The other problem is that this needs to be easily viewable via mobile devices and with the strings, it wraps and gets really unreadable. A table here should fix this.
You can send html email from .NET using MailMessage and SmtpClient classes, create an email template as string and set MailMessage's IsBodyHtml property to true:
Dim strHeader As String = "<table><tbody>"
Dim strFooter As String = "</tbody></table>"
Dim sbContent As New StringBuilder()
For i As Integer = 1 To rows
sbContent.Append("<tr>")
For j As Integer = 1 To cols
sbContent.Append(String.Format("<td>{0}</td>", YOUR_TD_VALUE_STRING))
Next j
sbContent.Append("</tr>");
Next i
Dim emailTemplate As String = strHeader & sbContent.ToString() & strFooter
...

parallel.foreach is hanging my application

I have a List(of MyCustomObject). This List is the DataSource for TreeView.
Now, all of collected objects must be updated on periodicaly Rising Timer1_Timer event. To update I'm using Parallel.ForEach. This works fine in test app, but final application hangs after adding code for calculations, and random number of relults may absent. Please help to fix it.
Imports System.Threading.Tasks
Imports Telerik.WinControls.UI
Imports System.ComponentModel
Imports System.Threading
Imports Accessibility
Public Class Form1
Dim WithEvents bw As New BackgroundWorker
Private Sub Button6_Click(sender As System.Object, e As System.EventArgs) Handles Button6.Click
Upadte(rt.Nodes.Cast(Of RadTreeNode)())
End Sub
Private Shared Sub Upadte(Of T)(source As IEnumerable(Of T))
Parallel.ForEach(source, New ParallelOptions With {.TaskScheduler = TaskScheduler.FromCurrentSynchronizationContext, .MaxDegreeOfParallelism = 5}, AddressOf zUpdate)
End Sub
' Following fragment is a simple example. Real code is more difficult. It includes Network requests, WQL queries e.t.c.
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Private Shared Sub zUpdate(Of T)(node As T)
Dim item = TryCast(node, RadTreeNode)
If item Is Nothing Then
Return
End If
Dim n_node As New RadTreeNode("_" & item.Name)
n_node.Nodes.Add("Hardware")
Dim tf As Form = Control.FromHandle(Form1.Handle)
tf.BeginInvoke(New Action(Function() InlineAssignHelper(item, n_node)))
End Sub
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Private Shared Function InlineAssignHelper(ByRef target As RadTreeNode, ByVal value As RadTreeNode) As RadTreeNode
target.Nodes.Add(value.Clone)
Return target
End Function
End Class
Greate idea! I'll check it. By the way, there's no any secret in full code. It's just much more than 1st example. Here is the copy of complete sub zUpdate without some typical queries, which working fine in STA:
Private Shared Sub zUpdate(Of T)(anode As T)
Dim searcher As New ManagementObjectSearcher
Dim tt_node As RadTreeNode = TryCast(anode, RadTreeNode)
If tt_node Is Nothing Then
Return
End If
Dim t_node As String = tt_node.Name
Dim n_node As New RadTreeNode With {.Name = "_" & t_node, .Text = "_" & t_node}
Dim opt As New ConnectionOptions
opt.Authentication = AuthenticationLevel.PacketPrivacy
opt.EnablePrivileges = True
opt.Impersonation = ImpersonationLevel.Impersonate
opt.Username = CredentialCache.DefaultNetworkCredentials.UserName
opt.Password = CredentialCache.DefaultNetworkCredentials.Password
opt.Authority = "ntlmdomain:" & CredentialCache.DefaultNetworkCredentials.Domain
Dim scope As New ManagementScope("\\" & t_node & "\ROOT\CIMV2", opt)
Dim query As New ObjectQuery
If My.Computer.Network.Ping(t_node, 10) = False Then
Return
GoTo 1
End If
scope.Connect()
If Not scope.IsConnected Then
Return
GoTo 1
End If
'Summary
query.QueryString = "SELECT * FROM Win32_ComputerSystem"
searcher.Scope = scope
searcher.Query = query
n_node.Nodes.Add("Summary")
For Each queryobj As ManagementObject In searcher.Get
With n_node.Nodes("Summary")
.Nodes.Add("Name", "Name:" & queryobj("Name"), 6)
.Nodes.Add("Domain", "Domain:" & queryobj("Domain"), 6)
.Nodes.Add("Manufacturer", "Manufacturer:" & queryobj("Manufacturer"), 6)
.Nodes.Add("Model", "Model:" & queryobj("Model"), 6)
.Nodes.Add("NumberOfLogicalProcessors", "NumberOfLogicalProcessors:" & queryobj("NumberOfLogicalProcessors").ToString, 6)
.Nodes.Add("NumberOfProcessors", "NumberOfProcessors:" & queryobj("NumberOfProcessors").ToString, 6)
.Nodes.Add("TotalPhysicalMemory", "TotalPhysicalMemory:" & queryobj("TotalPhysicalMemory").ToString, 6)
.Nodes.Add("UserName", "UserName:" & queryobj("UserName"), 6)
.Nodes.Add("Workgroup", "Workgroup:" & queryobj("Workgroup"), 6)
End With
Next
'LogicalDisk
query.QueryString = "SELECT * FROM Win32_LogicalDisk"
searcher.Query = query
n_node.Nodes.Add("Hardware")
With n_node.Nodes("Hardware")
.Nodes.Add("LogicalDisks")
With .Nodes("LogicalDisks")
For Each queryobj As ManagementObject In searcher.Get
.Nodes.Add("Name", "Name" & ": " & queryobj("Name"), 6)
With .Nodes("Name")
.Nodes.Add("Description", "Description: " & queryobj("Description"), 6)
.Nodes.Add("DriveType", "DriveType: " & queryobj("DriveType"), 6)
.Nodes.Add("Size", "Size: " & queryobj("Size").ToString, 6)
.Nodes.Add("FreeSpace", "FreeSpace: " & queryobj("FreeSpace"), 6)
.Nodes.Add("VolumeName", "VolumeName: " & queryobj("VolumeName"), 6)
.Nodes.Add("VolumeSerialNumber", "VolumeSerialNumber: " & queryobj("VolumeSerialNumber"), 6)
End With
Next
End With
'network adapters
query.QueryString = "SELECT * FROM Win32_NetworkAdapterConfiguration"
searcher.Query = query
.Nodes.Add("NetworkAdapters")
With .Nodes("NetworkAdapters")
For Each queryobj As ManagementObject In searcher.Get
.Nodes.Add(CStr(queryobj("Description")))
With .Nodes(CStr(queryobj("Description")))
.Nodes.Add("DHCPServer", "DHCPServer: " & queryobj("DHCPServer"), 6)
.Nodes.Add("DNSDomain", "DNSDomain: " & queryobj("DNSDomain"), 6)
.Nodes.Add("DNSHostName", "DNSHostName: " & queryobj("DNSHostName"), 6)
.Nodes.Add("MACAddress", "MACAddress: " & queryobj("MACAddress"), 6)
.Nodes.Add("SettingID", "SettingID: " & queryobj("SettingID"), 6)
End With
Next
End With
End With
'software
query.QueryString = "SELECT * FROM Win32_Product"
searcher.Query = query
n_node.Nodes.Add("Software")
With n_node.Nodes("Software")
For Each queryobj As ManagementObject In searcher.Get
.Nodes.Add(queryobj("Name"))
With .Nodes(queryobj("Name"))
.Nodes.Add("InstallDate", "InstallDate: " & queryobj("InstallDate"), 6)
.Nodes.Add("IdentifyingNumber", "IdentifyingNumber: " & queryobj("IdentifyingNumber"), 6)
End With
Next
End With
Dim tf As Form = Control.FromHandle(Form2.Handle)
tf.BeginInvoke(New Action(Function() InlineAssignHelper(tt_node, n_node)))
1:
If Not searcher Is Nothing Then
searcher.Dispose()
scope = Nothing
End If
End Sub
Private Shared Function InlineAssignHelper(ByRef target As RadTreeNode, ByVal value1 As RadTreeNode) As RadTreeNode
Dim t_str As String = Now.Date.ToString & Now.TimeOfDay.ToString
target.Nodes.Add(t_str)
target.Nodes(t_str).Nodes.Add(value1.Clone)
Return target
End Function
This works fine in test app, but final application hangs after adding
code for calculations, and random number of results may absent.
I suspect this means that your problem may lay in the code that you are not showing us.
The most likely candidate is that the code in your real zupdate method is accessing some sort of shared resource that is deadlocking.

Poll a directory looking for files with a certain extension

I'm writing a script to look in a directory, read the file name and use a part of the file name to run a SQL query to amend a DB, then copy the files to a new location and delete the original.
Once this is done it sends an email confirmation to a predefined email address.
I have the majority in place but am not able to Poll a Dir and process all files that may be there. Im new to this VB.net stuff and to get the other stuff working iv just named it at the beginning.
Any help would be greatly appreciated.
Dim fileName As String = "C:\temp\Input\VBTEST1.success"
Dim pathname As String = "C:\temp\Input\"
Dim result As String
Dim sourceDir As String = "C:\temp\Input\"
Dim processedDir As String = "C:\temp\Input\Processed\"
Dim fList As String() = Directory.GetFiles(sourceDir, "*.success")
Dim sqlCommand As SqlCommand
Public Sub Main()
result = Path.GetFileName(fileName)
Console.WriteLine("GetFileName('{0}') returns '{1}'", fileName, result)
Dim betacell As String = result
betacell = (result.Remove(7, 8))
Dim connection As New SqlConnection(My.Settings.connectionString)
connection.Open()
Dim updateTransaction As SqlTransaction = connection.BeginTransaction()
Dim sqlQ As String = "UPDATE " & My.Settings.JobTb & " SET Status = '10' WHERE JobNumber ='" & betacell & "'"
sqlCommand = New SqlCommand(sqlQ, connection, updateTransaction)
sqlCommand.ExecuteNonQuery()
updateTransaction.Commit()
connection.Close()
SendEmail(My.Settings.emailUsers, "EMAIL TEXT")
Call MoveFiles()
End Sub
I'm all chuffed now as iv also managed to make it look for all files with a .success extension. Now it processes all files and not the one named in the code.
Module Module1
Dim sourceDir As String = My.Settings.watchPath
Dim processedDir As String = My.Settings.processedPath
Private loggerName As String = "EmailReleases"
Public Sub log(ex As Exception)
Console.WriteLine("Error: " & ex.ToString)
End Sub
Public Sub log(ByVal s As String)
Console.WriteLine(DateTime.Now.ToString & " [" & loggerName & "] " & s)
End Sub
Public Sub Main()
Dim inputFiles As String() = Directory.GetFiles(sourceDir, "*.success")
log("Starting processing of .success files in '" & sourceDir & "' ... ")
If (inputFiles.Length > 0) Then
Dim connection As New SqlConnection(My.Settings.connectionString)
connection.Open()
For Each fileName As String In inputFiles
Dim sqlCommand As SqlCommand
Dim fFile As New FileInfo(fileName)
log(" Processing " & fFile.Name)
Dim betacell As String = fFile.Name.Substring(0, fFile.Name.Length - 8)
'Update Status on Database with the use of the Betacell
Dim updateTransaction As SqlTransaction = connection.BeginTransaction()
Dim sqlQ As String = "UPDATE " & My.Settings.JobTb & " SET Status = '10' WHERE JobNumber ='" & betacell & "'"
sqlCommand = New SqlCommand(sqlQ, connection, updateTransaction)
Dim result = sqlCommand.ExecuteNonQuery()
'Email COnfirmation
SendEmail(My.Settings.emailUsers, "EMAIL TEXT")
If (result > 0) Then
'Move the file
fFile.MoveTo(processedDir & fFile.Name)
updateTransaction.Commit() ' make sure to commit only in case moving the file is OK
Else
log("ERROR - Betacell '" & betacell & "' not found in database!")
updateTransaction.Rollback()
End If
Rather than polling a folder (i.e. checking every n seconds whether it has new files) it's much more efficient to have the operating system notify you of changes in that folder. You can do this by creating a FileSystemWatcher. There is an example on MSDN.
However, if you did want to poll a folder, it's actually nice and easy - just wrap the following code in a Timer. Please note I normally code in C#, so apologies if the syntax is not 100%...
Imports System.IO
....
For Each file as String in Directory.GetFiles("C:\SomeFolder")
DoSomethingWithFile (file)
Next