sending bulk sms to group using vb.net - vb.net

I connected recently to SMS provider API using vb.net
I have created a group table and inserted all numbers in this group and then reach each row and send trigger the API to process sending.
The sms is not reached to all group members, its only delivered successfully to the first mobile number in the group.
How to solve this problem ? I think I have to set a delay between each sending and i did with no use. my code is below :
Function GetGroupsMobileNumbers() As ArrayList
Dim MobileNumbersArrayList As New ArrayList
For Each Contact As FilsPayComponent.ContactAddress In FilsPayComponent.ContactAddress.GetAllContactAddressByGroupId(ddlGroup.SelectedValue)
MobileNumbersArrayList.Add(Contact.Mobile)
Next
Return MobileNumbersArrayList
End Function
Protected Sub btnSend_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSend.Click
If ddlGroup.SelectedValue = 0 Then
lbResult.Text = "No groups selected"
Exit Sub
End If
Dim MobileNumbersArrayList As ArrayList
MobileNumbersArrayList = GetGroupsMobileNumbers()
If MobileNumbersArrayList.Count = 0 Then
lbResult.Text = "Group doesnt contain numbers"
Exit Sub
End If
Dim TotalNo As Integer = FilsPayComponent.ContactAddress.AddressContactsCount(ddlGroup.SelectedValue)
If MobileNumbersArrayList.Count * messagecount.Value <= FilsPayComponent.SmSUser.GetSmSUserByUserId(Context.User.Identity.Name).Balance Then
Dim txtMsg As String
Dim smstype As Integer
If hidUnicode.Value <> "1" Then
txtMsg = txtMessage.Text
smstype = 1
Else
txtMsg = ConvertTextToUnicode(txtMessage.Text)
smstype = 2
End If
Dim x As Integer
'For Each Contact As FilsPayComponent.ContactAddress In FilsPayComponent.ContactAddress.GetAllContactAddressByGroupId(ddlGroup.SelectedValue)
For Each Contact In MobileNumbersArrayList.ToArray
Dim toMobile As String = Contact.Mobile
If toMobile.Length > 10 Then
Dim ExecArrayList As ArrayList
ExecArrayList = SendSMS(toMobile, txtMsg, smstype)
'-- give the excution more time
If ExecArrayList.Count < 1 Then
Threading.Thread.Sleep(1000)
End If
'-- give the excution more time
If ExecArrayList.Count < 1 Then
Threading.Thread.Sleep(1000)
End If
'-- give the excution more time
If ExecArrayList.Count < 1 Then
Threading.Thread.Sleep(1000)
End If
x = x + 1
' lbresult.Text = "Sent Successfully"
End If
Next
FilsPayComponent.SmSUser.RemoveSmsCredit(Context.User.Identity.Name, messagecount.Value * x)
Dim NewsmsarchiveItem As New FilsPayComponent.smsarchive
NewsmsarchiveItem.FromMobile = txtSenderID.Text
NewsmsarchiveItem.ToMobile = "0"
NewsmsarchiveItem.GroupId = ddlGroup.SelectedValue
NewsmsarchiveItem.DateSent = DateTime.Now
NewsmsarchiveItem.Msg = txtMessage.Text
NewsmsarchiveItem.GroupCount = x
NewsmsarchiveItem.Optional1 = Context.User.Identity.Name
NewsmsarchiveItem.Optional2 = "1"
NewsmsarchiveItem.MessageNo = messagecount.Value
Try
NewsmsarchiveItem.Addsmsarchive()
lbResult.Text = "Message sent successfully"
btnSend.Visible = False
Catch ex As Exception
lbResult.Text = ex.Message
End Try
Else
lbResult.Text = "Not enough credit, please refill "
End If
End Sub
Sub SendSMS(ByVal toMobile As String, ByVal txtMsg As String, ByVal smstype As Integer)
Dim hwReq As HttpWebRequest
Dim hwRes As HttpWebResponse
Dim smsUser As String = "xxxxxx"
Dim smsPassword As String = "xxxxxx"
Dim smsSender As String = "xxxxxx"
Dim strPostData As String = String.Format("username={0}&password={1}&destination={2}&message={3}&type={4}&dlr=1&source={5}", Server.UrlEncode(smsUser), Server.UrlEncode(smsPassword), Server.UrlEncode(toMobile), Server.UrlEncode(txtMsg), Server.UrlEncode(smstype), Server.UrlEncode(smsSender))
Dim strResult As String = ""
Try
hwReq = DirectCast(WebRequest.Create("http://xxxxx:8080/bulksms/bulksms?"), HttpWebRequest)
hwReq.Method = "POST"
hwReq.ContentType = "application/x-www-form-urlencoded"
hwReq.ContentLength = strPostData.Length
Dim arrByteData As Byte() = ASCIIEncoding.ASCII.GetBytes(strPostData)
hwReq.GetRequestStream().Write(arrByteData, 0, arrByteData.Length)
hwRes = DirectCast(hwReq.GetResponse(), HttpWebResponse)
If hwRes.StatusCode = HttpStatusCode.OK Then
Dim srdrResponse As New StreamReader(hwRes.GetResponseStream(), Encoding.UTF8)
Dim strResponse As String = srdrResponse.ReadToEnd().Trim()
Select Case strResponse
Case "01"
strResult = "success"
Exit Select
Case Else
strResult = "Error: " + strResponse
Exit Select
End Select
End If
Catch wex As WebException
strResult = "Error, " + wex.Message
Catch ex As Exception
strResult = "Error, " + ex.Message
Finally
hwReq = Nothing
hwRes = Nothing
End Try
End Sub

If function GetGroupsMobileNumbers() does not return an array list of numbers (as Strings)
then comment out. MobileNumbersArrayList = GetGroupsMobileNumbers()
then use the commented out code below (with three of your own tel. numbers) to set it for testing.
Private Sub btnSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSend.Click
If ddlGroup.SelectedValue = 0 Then
lbResult.Text = "No groups selected"
Exit Sub
End If
Dim MobileNumbersArrayList As New ArrayList
MobileNumbersArrayList = GetGroupsMobileNumbers()
'MobileNumbersArrayList.Add("07702123456")
'MobileNumbersArrayList.Add("07702123457")
'MobileNumbersArrayList.Add("07702123458")
If MobileNumbersArrayList.Count = 0 Then
lbResult.Text = "Group doesnt contain numbers"
Exit Sub
End If
Dim TotalNo As Integer = FilsPayComponent.ContactAddress.AddressContactsCount(ddlGroup.SelectedValue)
If MobileNumbersArrayList.Count * messagecount.Value <= FilsPayComponent.SmSUser.GetSmSUserByUserId(Context.User.Identity.Name).Balance Then
Dim txtMsg As String
Dim smstype As Integer
If hidUnicode.Value <> "1" Then
txtMsg = txtMessage.Text
smstype = 1
Else
txtMsg = ConvertTextToUnicode(txtMessage.Text)
smstype = 2
End If
Dim x As Integer
For Each Contact In MobileNumbersArrayList
If Contact.Length > 10 Then
SendSMS(Contact, txtMsg, smstype)
x = x + 1
End If
Next
FilsPayComponent.SmSUser.RemoveSmsCredit(Context.User.Identity.Name, messagecount.Value * x)
Dim NewsmsarchiveItem As New FilsPayComponent.smsarchive
NewsmsarchiveItem.FromMobile = txtSenderID.Text
NewsmsarchiveItem.ToMobile = "0"
NewsmsarchiveItem.GroupId = ddlGroup.SelectedValue
NewsmsarchiveItem.DateSent = DateTime.Now
NewsmsarchiveItem.Msg = txtMessage.Text
NewsmsarchiveItem.GroupCount = x
NewsmsarchiveItem.Optional1 = Context.User.Identity.Name
NewsmsarchiveItem.Optional2 = "1"
NewsmsarchiveItem.MessageNo = messagecount.Value
Try
NewsmsarchiveItem.Addsmsarchive()
lbResult.Text = "Message sent successfully"
btnSend.Visible = False
Catch ex As Exception
lbResult.Text = ex.Message
End Try
Else
lbResult.Text = "Not enough credit, please refill "
End If
End Sub
This btnSend sub should work if the rest of your code is okay. Note your line.
Dim TotalNo As Integer = FilsPayComponent.ContactAddress.AddressContactsCount(ddlGroup.SelectedValue)
Doesn't appear to do anything.
If you need to set a delay you would be better off turning SendSMS into a function that returns a sent confirmation to your btnSend loop. Most texting APIs can handle lists of numbers rather than waiting for a response for each text message. Afterall they only get added to a queue at their end.

Related

Get YouTube channel data using Google YouTube Data API in VB.NET

I'd like to get channel data using the YouTube Data API in a VB.NET application. I can't find any kind of documentation, everything is in .NET and Google documentation is way too cryptic for me.
I used to get these data using URL request, but I'd like to do it more... programmatically!
I added Google.Apis.YouTube.v3 Nuget, but can't figure how to set credential and retrieve data.
There is a VB .NET ResumableUpload example in this GITHUB repository that contains some code that should help you get started.
This is some sample code that retrieves all of the videos in the "Uploads" PlayList for the logged on channel.
Imports Google.Apis.YouTube.v3
Imports Google.Apis.YouTube.v3.Data
...
...
Dim strUploadsListId As String = ""
Try
bOK = False
Dim objChannelListRequest As ChannelsResource.ListRequest = objYouTubeService.Channels.List("contentDetails")
objChannelListRequest.Mine = True
Dim objChannelListResponse As ChannelListResponse = objChannelListRequest.Execute
Dim objChannel As Channel
For Each objChannel In objChannelListResponse.Items
strUploadsListId = objChannel.ContentDetails.RelatedPlaylists.Uploads ' The Uploads PlayList
Debug.WriteLine("PlayList ID=" & strUploadsListId)
Next
bOK = True
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "ChannelListRequest")
End Try
If bOK Then
Dim objNextPageToken As String = ""
While Not objNextPageToken Is Nothing
Dim objPlayListItemRequest As PlaylistItemsResource.ListRequest = objYouTubeService.PlaylistItems.List("contentDetails")
Dim objPlayListItemsListResponse As PlaylistItemListResponse = Nothing
objPlayListItemRequest.PlaylistId = strUploadsListId
objPlayListItemRequest.MaxResults = 50
objPlayListItemRequest.PageToken = objNextPageToken
Try
bOK = False
objPLayListItemsListResponse = objPlayListItemRequest.Execute
bOK = True
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "PlayListRequest")
End Try
If bOK Then
Dim objPlayListItem As PlaylistItem
Dim strVideoIds As New StringBuilder("") With {.Capacity = objPLayListItemsListResponse.Items.Count * 16}
For Each objPlayListItem In objPlayListItemsListResponse.Items
strVideoIds.Append(objPlayListItem.ContentDetails.VideoId)
strVideoIds.Append(",")
Next
strVideoIds.Remove(strVideoIds.Length - 1, 1) ' Remove Last Character (Extra comma)
Dim objListRequest As VideosResource.ListRequest
Dim objVideoListResponse As VideoListResponse = Nothing
Try
bOK = False
objListRequest = New VideosResource.ListRequest(objYouTubeService, "id,snippet,recordingDetails,status,contentDetails") With {.Id = strVideoIds.ToString}
Debug.WriteLine("IDs to retrieve: " & strVideoIds.ToString)
objVideoListResponse = objListRequest.Execute
bOK = True
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "ListRequest")
End Try
If bOK Then
For Each objVideo As Video In objVideoListResponse.Items
Dim TheTitle as string = objVideo.Snippet.Title
Dim Embeddable as boolean = objVideo.Status.Embeddable
Dim dtRecorded as date - Nothing
If (Not objVideo.RecordingDetails Is Nothing) AndAlso (Not objVideo.RecordingDetails.RecordingDate Is Nothing) Then
dtRecorded = CDate(objVideo.RecordingDetails.RecordingDate)
End If
Dim Duration As Date = GetDuration(objVideo.ContentDetails.Duration)
Dim Category As string = objVideo.Snippet.CategoryId
Dim PrivacyStatus As string = objVideo.Status.PrivacyStatus
Dim Description as string = objVideo.Snippet.Description AndAlso
'
'
Next
End If
End If
objNextPageToken = objPlayListItemsListResponse.NextPageToken
End While
End If
'_______________________________________________________
Friend Function GetDuration(ByVal Duration As String) As Date ' Only an elapsed time value
' Format returned from YouTube: PT#H#M#S or PT#M#S or PT#S
GetDuration = EMPTYDATE
If Duration IsNot Nothing Then
If Duration.StartsWith("PT") Then
Dim x As Integer = 2
Dim y As Integer = x
Dim Hours As Integer = 0
Dim Minutes As Integer = 0
Dim Seconds As Integer = 0
Do
While y < Duration.Length AndAlso IsNumeric(Duration.Substring(y, 1))
y += 1
End While
If y < Duration.Length Then
Select Case Duration.Substring(y, 1)
Case "H"
Hours = CInt(Duration.Substring(x, y - x))
Case "M"
Minutes = CInt(Duration.Substring(x, y - x))
Case "S"
Seconds = CInt(Duration.Substring(x, y - x))
End Select
End If
x = y + 1
y = x
Loop Until x >= Duration.Length
GetDuration = CDate("01/01/1900 " & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00"))
End If
End If
End Function
I did it, thanks to Mike Meinz and th Visual Studio debugging tools
Here the code to get some channels (not necessary yours) data using YouTube Data API in a VB.NET:
Dim youtube_api_key As String = "Your_Key"
Dim youtube_api_application_name As String = "Your_Project_Name_In_the_Google_Developper_Console"
Dim youtube_initialiser As New Google.Apis.Services.BaseClientService.Initializer()
youtube_initialiser.ApiKey = youtube_api_key
youtube_initialiser.ApplicationName = youtube_api_application_name
Dim youtube_service As Google.Apis.YouTube.v3.YouTubeService = New YouTubeService(youtube_initialiser)
Dim objChannelListRequest As ChannelsResource.ListRequest = youtube_service.Channels.List("id,snippet,statistics")
objChannelListRequest.Id = youtube_channel
Dim objChannelListResponse As ChannelListResponse = objChannelListRequest.Execute()
Debug.Print(objChannelListResponse.Items(0).Snippet.Description)
Debug.Print(objChannelListResponse.Items(0).Statistics.SubscriberCount)
Debug.Print(objChannelListResponse.Items(0).Statistics.VideoCount)
Debug.Print(objChannelListResponse.Items(0).Statistics.ViewCount)

VB service export SQL to CSV

I have created a service that is supposed to pass data from SQL to CSV, by creating a CSV file. It has no errors, but i run it and nothing happens.
1) Is there something I am missing?
2) If it works, and i want to convert to txt file, is it enough to change the "CSV" to "txt" parts?
My code:
#Region "Export SQL TO CSV"
Public Shared Function WriteCSV(ByVal input As String) As String
Try
If (input Is Nothing) Then
Return String.Empty
End If
Dim containsQuote As Boolean = False
Dim containsComma As Boolean = False
Dim len As Integer = input.Length
Dim i As Integer = 0
Do While ((i < len) _
AndAlso ((containsComma = False) _
OrElse (containsQuote = False)))
Dim ch As Char = input(i)
If (ch = Microsoft.VisualBasic.ChrW(34)) Then
containsQuote = True
ElseIf (ch = Microsoft.VisualBasic.ChrW(44)) Then
containsComma = True
End If
i = (i + 1)
Loop
If (containsQuote AndAlso containsComma) Then
input = input.Replace("""", """""")
End If
If (containsComma) Then
Return """" & input & """"
Else
Return input
End If
Catch ex As Exception
Throw
End Try
End Function
Private Sub ExtoCsv(ByVal sender As Object, ByVal e As EventArgs)
Dim sb As StringBuilder = New StringBuilder
Using db As Database.RecordSet = admin.Database.OpenRecordsetReadOnly("select USERID, NAME1 from usertable WHERE I_ID=2")
Dim userid As String = db("USERID").Value
Dim name1 As String = db("NAME1").Value
For i As Integer = 1 To db.RecordCount
sb.Append(WriteCSV(userid + "," + name1 + ","))
sb.AppendLine()
db.MoveNext()
Next
End Using
File.WriteAllText("C:\Users\user1\Desktop\ex1.csv", sb.ToString)
If (Not System.IO.Directory.Exists("C:\Users\user1\Desktop\ex1")) Then
System.IO.Directory.CreateDirectory("C:\Users\user1\Desktop\ex1")
End If
End Sub
#End Region

Find and highlight the max value in from multiple column in VB.net

Hi i need anyone to help me,
I need to highlight the highest value from multiple column in table
For Ex:-
I have try out some coding..
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
UIUtility = New UIUtility()
Dim dtStartProcessTime As DateTime
Dim dtEndProcessTime As DateTime
Dim dtStartQueryTime As DateTime
Dim dtEndQueryTime As DateTime
Dim tsQueryTime As TimeSpan
Dim tsProcessTime As TimeSpan
Dim strCassList As String = ""
Dim dtDefectInfo As New DataTable
Dim dtDefectList As New DataTable
Dim dtResult As New DataTable
Dim dtSelectDefectInfo As New DataTable
Dim strCass_id As String = ""
Dim dtDisplay As New DataTable
Try
dtStartProcessTime = Now
Me.Title = "Shipping Cassettes List"
Dim sEvent_date As String = Request.QueryString("Event_date").Trim()
Dim sRecipe As String = Request.QueryString("recipe").Trim()
Dim sOperation As String = Request.QueryString("operation").Trim()
Dim sEquipment As String = Request.QueryString("equipment").Trim()
lblStatus.Text = "Event_date:" + sEvent_date + _
"<br>Recipe:" + sRecipe + _
"<br>Operation:" + sOperation + _
"<br>Equipment:" + sEquipment + _
"<br><br>"
Dim dtCass As DataTable
Dim drNew As DataRow
Dim SelectDefectInfo As DataRow()
dtStartQueryTime = Now
dtCass = UIUtility.RetrieveShipCassette(sEvent_date, sRecipe, sOperation, sEquipment)
If dtCass.Rows.Count > 0 Then
strCassList = UIUtility.ReturnStringFromdt(dtCass, "shipping_cass_id")
dtDefectInfo = UIUtility.RetrieveDefectInfo(strCassList)
dtDefectList = UIUtility.dtView(dtDefectInfo, "defect")
dtResult.Columns.Add("cass_id", Type.GetType("System.String"))
For i = 0 To dtDefectList.Rows.Count - 1
If Not (dtDefectList.Rows(i).Item("defect").ToString().Equals("NON")) Then
dtResult.Columns.Add(dtDefectList.Rows(i).Item("defect"), Type.GetType("System.Int32")).DefaultValue = 0
End If
Next
For i = 0 To dtCass.Rows.Count - 1
drNew = dtResult.NewRow
strCass_id = dtCass.Rows(i).Item("shipping_cass_id")
drNew("cass_id") = dtCass.Rows(i).Item("cass_id")
SelectDefectInfo = dtDefectInfo.Select("dest_cass_id = '" + strCass_id + "'")
dtSelectDefectInfo = New DataTable
If SelectDefectInfo.Count > 0 Then
dtSelectDefectInfo = SelectDefectInfo.CopyToDataTable
For j = 0 To dtSelectDefectInfo.Rows.Count - 1
If Not (dtSelectDefectInfo.Rows(j).Item("defect").ToString().Trim().Equals("NON")) Then
drNew(dtSelectDefectInfo.Rows(j).Item("defect").ToString()) = dtSelectDefectInfo.Rows(j).Item("defect_count").ToString()
End If
Next
End If
dtResult.Rows.Add(drNew)
Next
End If
dtEndQueryTime = Now
tsQueryTime = dtEndQueryTime.Subtract(dtStartQueryTime)
'For i As Integer = 0 To dtCass.Rows.Count - 1
' drDisplay = dtDisplay.NewRow
' drDisplay("cass_id") = dtCass.Rows(i)("cass_id").ToString()
' dtDisplay.Rows.Add(drDisplay)
' 'dtCass.Rows(i).Item(
'Next
'e.Row.BorderWidth = 2
dgSummary.DataSource = Nothing
dgSummary.DataSource = dtResult
dgSummary.DataBind()
lblStatus.Text += "Total " + dtResult.Rows.Count.ToString + " rows of data found."
dtEndProcessTime = Now
tsProcessTime = dtEndProcessTime.Subtract(dtStartProcessTime)
lblProcessingTime.Text = "Processing Time: " + tsProcessTime.TotalSeconds.ToString + " Secs (Query Time: " + tsQueryTime.TotalSeconds.ToString + " Secs)"
For Each r As GridViewRow In dtResult.Rows()
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Text, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Text = max Then
r.Cells(i).BackColor = Drawing.Color.Orange
Exit For
End If
Next
Next
Catch ex As Exception
lblMessage.Text = "An error occured:" + ex.Message + " Please contact your administrator."
MyLog.WriteToLog(Me.GetType().Name(), System.Reflection.MethodInfo.GetCurrentMethod().Name, "Exception occured." & vbCrLf & "Error Message:" & ex.Message & vbCrLf & " StackTrace:" & ex.StackTrace)
End Try
End Sub
Protected Sub dgSummary_RowDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles dgSummary.RowDataBound
Dim cass_id As String = ""
'Dim dtResult As New DataTable
'Dim DataGridView1 As New DataTable
Dim dtCass As New DataTable
If e.Row.RowType = DataControlRowType.DataRow Then
cass_id = e.Row.Cells(0).Text.Trim
If Not e.Row.Cells(0).Text.Trim.Equals("") Then
e.Row.Cells(0).Attributes.Add("Title", "Click and view the cassette details")
e.Row.Cells(0).Attributes("onmouseover") = "this.style.color='DodgerBlue';this.style.cursor='hand';"
e.Row.Cells(0).Attributes("onmouseout") = "this.style.color='Black';"
e.Row.Cells(0).Attributes("onClick") = _
String.Format("window.open('{0}','_blank','scrollbars=yes,status=yes,location=yes,toolbar=yes,menubar=yes,resizable=Yes')", _
ResolveUrl(System.Configuration.ConfigurationManager.AppSettings("SFEHReportLink_SSL") + cass_id))
e.Row.Cells(0).Style("cursor") = "pointer"
End If
End Sub
Maybe theres any coding that more easier than this since i have 17items
Thank you so much for you guys help.
After i add the new code, i got this error,
new error
maybe this example can help you
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
For Each r As DataGridViewRow In DataGridView1.Rows
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Value, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Value = max Then
r.Cells(i).Style.BackColor = Color.Orange
Exit For
End If
Next
Next
End Sub

String comparison not working for array of strings

cfg file to start, this is the file:
http://pastebin.com/mE3Y3wiq
What I am doing is looking for a class, once found I store the data for THAT class in a listbox, so ex: if I'm looking for "Fixing", I will store each line in a listbox that is after "{Fixing}" until we hit the next class OR the end of the file (for Fixing we would stop at "{Pillars}")
Here is my code:
Private Sub tvList_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles tvList.AfterSelect
Dim cfgData() As String
' Dim lstData As New ListBox()
lstData.Items.Clear()
If rbnInch.Checked Then
cfgData = File.ReadAllLines("C:\Library\Common\PARAM-NG\Dbs\Mould\Dme_I\Dme_I.cfg")
Else
cfgData = File.ReadAllLines("C:\Library\Common\PARAM-NG\Dbs\Mould\Dme\Dme.cfg")
End If
Dim classID As Short = tvList.SelectedNode.Index
Dim classType As String = tvList.Nodes.Item(classID).Text
Try
For i As Short = 0 To cfgData.Count - 1
If cfgData(i).Contains("{" & classType & "}") Or cfgData(i).Contains("{" & classType.Replace(" ", "") & "}") Then
i += 1
Do
lstData.Items.Add(cfgData(i))
i += 1
If cfgData(i).Contains(tvList.Nodes.Item(tvList.SelectedNode.Index + 1).Text.Replace(" ", "")) Or cfgData(i).Contains(tvList.Nodes.Item(tvList.SelectedNode.Index + 1).Text) Or cfgData(i).ToString() Is vbNullString Then
Exit Do
End If
Loop
End If
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Right now I am only getting the first line in my listbox and that's it. Need help on collecting the data I need and then stopping at the next class or end of file (end of file for the last class since there is no class after it that will mark my exit)
This has been extracted from the question and posted on the OP's behalf.
I solved it myself.
Private Sub tvList_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles tvList.AfterSelect
Dim cfgData() As String
' Dim lstData As New ListBox()
lstData.Items.Clear()
If rbnInch.Checked Then
cfgData = File.ReadAllLines("C:\Library\Common\PARAM-NG\Dbs\Mould\Dme_I\Dme_I.cfg")
Else
cfgData = File.ReadAllLines("C:\Library\Common\PARAM-NG\Dbs\Mould\Dme\Dme.cfg")
End If
Dim classID As Short = tvList.SelectedNode.Index
Dim classType As String = tvList.Nodes.Item(classID).Text
Try
For i As Short = 0 To cfgData.Count - 1
If cfgData(i).Contains("{" & classType) Or cfgData(i).Contains("{" & classType.Replace(" ", "")) Then
i += 1
Do
If tvList.SelectedNode.Index + 1 >= tvList.Nodes.Count Then
If i >= cfgData.Count - 1 Then
lstData.Items.Add(cfgData(i))
Exit Do
ElseIf cfgData(i) = vbNullString Then
lstData.Items.Add(cfgData(i))
i += 1
ElseIf cfgData(i).Substring(0, 1).Contains("{") Then
Exit Do
Else
lstData.Items.Add(cfgData(i))
i += 1
End If
ElseIf i >= cfgData.Count - 1 Then
lstData.Items.Add(cfgData(i))
Exit Do
ElseIf cfgData(i) = vbNullString Then
lstData.Items.Add(cfgData(i))
i += 1
ElseIf cfgData(i).Substring(0, 1).Contains("{") Then
Exit Do
Else
lstData.Items.Add(cfgData(i))
i += 1
End If
Loop
End If
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub

Creating a DataGridView Programatically and add clickable cells

Evening
I am struggling to achieve what I have set out todo! In a nutshell I am working with the Google Drive API to create an app in VB.net that allows you to view / download files etc.
Basically I am planning on using a couple of different api's for the different cloud provider s I have. The stage I have got to is that I have my collection of files and there various properties in a list. On load I am checking to see if a google account has been added to my program and if so creating a new tabpage on a tabcontrol, I then create the datagridview and add it to the collection on the new tab page. This works fine and displays all my data as is.
What I am trying to achieve is adding a clickable link to my download column instead of displaying the url. I have been trying to manipulate the code found here C# DataGridViewLinkCell Display after converting it to vb.net. This is basically what I have ended up with:
If My.Settings.GoogleClientID <> "" Then
Dim GD As New Properties.GDrive
GD.APIClientID = My.Settings.GoogleClientID
GD.APIClientSecret = My.Settings.GoogleClientSecret
clsDrive.GD = GD
clsDrive.GetSpace()
clsDrive.RefreshFiles()
Dim GoogleDriveTab As New TabPage
GoogleDriveTab.Text = "Google Drive"
tc_CloudManager.TabPages.Add(GoogleDriveTab)
Dim GoogleDriveDGV As New DataGridView
GoogleDriveDGV.Name = "GoogleDriveDGV"
GoogleDriveDGV.Dock = DockStyle.Fill
GoogleDriveDGV.Columns.Add("FileTitle", "File Title")
GoogleDriveDGV.Columns.Add("FileExtension", "File Extension")
GoogleDriveDGV.Columns.Add("FileSize", "File Size")
Dim dgvlc As New DataGridViewLinkColumn()
dgvlc.ActiveLinkColor = Color.Blue
dgvlc.HeaderText = "Download"
GoogleDriveDGV.Columns.Add(dgvlc)
GoogleDriveDGV.RowHeadersVisible = False
Dim c As New customcolumn()
GoogleDriveDGV.Columns.Add(c)
For i As Integer = 0 To GoogleDriveDGV.Columns.Count - 1
GoogleDriveDGV.Columns(i).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
Next
Try
For Each DriveFile In GD.DriveFiles
Dim row As DataGridViewRow = DirectCast(GoogleDriveDGV.Rows(0).Clone, DataGridViewRow)
Dim title As String = DriveFile.Title
If title.Length > 60 Then
title = title.Substring(0, 60)
End If
Dim fs As Integer = DriveFile.FileSize
Dim fsf As String
If fs > 1048576 Then
fsf = Math.Round(fs / 1048576, 2) & " MB"
Else
fsf = fs & " Bytes"
End If
Dim fe As String
If DriveFile.FileExtension = "" Then
fe = "Folder"
Else
fe = DriveFile.FileExtension
End If
row.Cells(0).Value = title
row.Cells(1).Value = fe
row.Cells(2).Value = fsf
row.Cells(3).Value = "Download File"
DirectCast(GoogleDriveDGV.Columns(3), customcolumn).urls.Add(3, DriveFile.DownloadUrl)
Next
Catch ex As Exception
MsgBox(ex.ToString)
End Try
GoogleDriveTab.Controls.Add(GoogleDriveDGV)
End If
End Sub
Class customcolumn
Inherits System.Windows.Forms.DataGridViewLinkColumn
Public urls As New Dictionary(Of Integer, String)()
End Class
Private Sub GoogleDriveDGV_CellContentClick(ByVal sender As Object, ByVal e As DataGridViewCellEventArgs)
For Each url As KeyValuePair(Of Integer, String) In DirectCast(GoogleDriveDGV.Columns(e.ColumnIndex), customcolumn).urls
If url.Key = e.RowIndex Then
Process.Start(url.Value)
Exit For
End If
Next
End Sub
I have two problems that I cant figure out:
1) GoogleDriveDGV is not declared here : For Each url As KeyValuePair(Of Integer, String) In DirectCast(GoogleDriveDGV.Columns(e.ColumnIndex), customcolumn).urls
2) If I comment out the GoogleDriveDGV_CellContentClick sub and just try to populate the datagridview I get System.InvalidCastException: Unable to cast object of type 'System.Windows.Forms.DataGridViewLinkColumn' to type 'customcolumn' here DirectCast(GoogleDriveDGV.Columns(3), customcolumn).urls.Add(3, DriveFile.DownloadUrl)
Can anyone let me know if what I am trying to achieve is possible and any hints?
Update!!!
I now have this:
If My.Settings.GoogleClientID <> "" Then
Dim GD As New Properties.GDrive
GD.APIClientID = My.Settings.GoogleClientID
GD.APIClientSecret = My.Settings.GoogleClientSecret
clsDrive.GD = GD
clsDrive.GetSpace()
clsDrive.RefreshFiles()
Dim GoogleDriveTab As New TabPage
GoogleDriveTab.Text = "Google Drive"
tc_CloudManager.TabPages.Add(GoogleDriveTab)
Dim GoogleDriveDGV As New DataGridView
GoogleDriveDGV.Name = "GoogleDriveDGV"
GoogleDriveDGV.Dock = DockStyle.Fill
GoogleDriveDGV.Columns.Add("FileTitle", "File Title")
GoogleDriveDGV.Columns.Add("FileExtension", "File Extension")
GoogleDriveDGV.Columns.Add("FileSize", "File Size")
Dim c As New customcolumn()
GoogleDriveDGV.Columns.Add(c)
GoogleDriveDGV.RowHeadersVisible = False
For i As Integer = 0 To GoogleDriveDGV.Columns.Count - 1
GoogleDriveDGV.Columns(i).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
Next
Dim trow As Integer = 0
Try
For Each DriveFile In GD.DriveFiles
Dim row As DataGridViewRow = DirectCast(GoogleDriveDGV.Rows(0).Clone, DataGridViewRow)
Dim title As String = DriveFile.Title
If title.Length > 60 Then
title = title.Substring(0, 60)
End If
Dim fs As Integer = DriveFile.FileSize
Dim fsf As String
If fs > 1048576 Then
fsf = Math.Round(fs / 1048576, 2) & " MB"
Else
fsf = fs & " Bytes"
End If
Dim fe As String
If DriveFile.FileExtension = "" Then
fe = "Folder"
Else
fe = DriveFile.FileExtension
End If
row.Cells(0).Value = title
row.Cells(1).Value = fe
row.Cells(2).Value = fsf
row.Cells(3).Value = "Download"
DirectCast(GoogleDriveDGV.Columns(3), customcolumn).urls.Add(trow, DriveFile.DownloadUrl)
GoogleDriveDGV.Rows.Add(row)
trow = trow + 1
Next
Catch ex As Exception
MsgBox(ex.ToString)
End Try
GoogleDriveTab.Controls.Add(GoogleDriveDGV)
End If
End Sub
Class customcolumn
Inherits System.Windows.Forms.DataGridViewLinkColumn
Public urls As New Dictionary(Of Integer, String)()
End Class
'Private Sub GoogleDriveDGV_CellContentClick(ByVal sender As Object, ByVal e As DataGridViewCellEventArgs)
' For Each url As KeyValuePair(Of Integer, String) In DirectCast(GoogleDriveDGV.Columns(e.ColumnIndex), customcolumn).urls
' If url.Key = e.RowIndex Then
' Process.Start(url.Value)
' Exit For
' End If
' Next
'End Sub
Which is almost there, I now have the datagridview filled with the items and a download link, just cant work out how to solve issue 1 above :-(
Would you believe it I worked it out :-)
Basically I needed to add a handler.
Full code:
Private Sub CloudManager_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
If My.Settings.GoogleClientID <> "" Then
Dim GD As New Properties.GDrive
GD.APIClientID = My.Settings.GoogleClientID
GD.APIClientSecret = My.Settings.GoogleClientSecret
clsDrive.GD = GD
clsDrive.GetSpace()
clsDrive.RefreshFiles()
Dim GoogleDriveTab As New TabPage
GoogleDriveTab.Text = "Google Drive"
tc_CloudManager.TabPages.Add(GoogleDriveTab)
Dim GoogleDriveDGV As New DataGridView
GoogleDriveDGV.Name = "GoogleDriveDGV"
GoogleDriveDGV.Dock = DockStyle.Fill
GoogleDriveDGV.Columns.Add("FileTitle", "File Title")
GoogleDriveDGV.Columns.Add("FileExtension", "File Extension")
GoogleDriveDGV.Columns.Add("FileSize", "File Size")
Dim c As New customcolumn()
GoogleDriveDGV.Columns.Add(c)
AddHandler GoogleDriveDGV.CellContentClick, AddressOf GoogleDriveDGV_CellContentClick
GoogleDriveDGV.RowHeadersVisible = False
For i As Integer = 0 To GoogleDriveDGV.Columns.Count - 1
GoogleDriveDGV.Columns(i).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
Next
Dim trow As Integer = 0
Try
For Each DriveFile In GD.DriveFiles
Dim row As DataGridViewRow = DirectCast(GoogleDriveDGV.Rows(0).Clone, DataGridViewRow)
Dim title As String = DriveFile.Title
If title.Length > 60 Then
title = title.Substring(0, 60)
End If
Dim fs As Integer = DriveFile.FileSize
Dim fsf As String
If fs > 1048576 Then
fsf = Math.Round(fs / 1048576, 2) & " MB"
Else
fsf = fs & " Bytes"
End If
Dim fe As String
If DriveFile.FileExtension = "" Then
fe = "Folder"
Else
fe = DriveFile.FileExtension
End If
row.Cells(0).Value = title
row.Cells(1).Value = fe
row.Cells(2).Value = fsf
row.Cells(3).Value = "Download"
DirectCast(GoogleDriveDGV.Columns(3), customcolumn).urls.Add(trow, DriveFile.DownloadUrl)
GoogleDriveDGV.Rows.Add(row)
trow = trow + 1
Next
Catch ex As Exception
MsgBox(ex.ToString)
End Try
GoogleDriveTab.Controls.Add(GoogleDriveDGV)
End If
End Sub
Class customcolumn
Inherits System.Windows.Forms.DataGridViewLinkColumn
Public urls As New Dictionary(Of Integer, String)()
End Class
Private Sub GoogleDriveDGV_CellContentClick(ByVal sender As Object, ByVal e As DataGridViewCellEventArgs)
For Each url As KeyValuePair(Of Integer, String) In DirectCast(sender.Columns(e.ColumnIndex), customcolumn).urls
If url.Key = e.RowIndex Then
Process.Start(url.Value)
Exit For
End If
Next
End Sub
End Class