Page redirected too many times ASP.NET - authentication

Dear StackOverflow community,
I am still new with ASP.NET and playing have been playing around and I've encountered an error to authenticate my login where it shows up an error like "Page redirected too many times" and it happen something that are keep looping and I can't figure it out after 2 days.
I've implemented my login using header.acsx so it can be a global authentication to all page.
Here is the code of head.vb:
If String.IsNullOrEmpty(Session(GetSessionKey("UserName"))) Then
Dim userName As String = HttpContext.Current.User.Identity.Name.Split("\")(1)
SessionInitialiser(userName)
End If
Response.Redirect("~/EventRegistration.aspx")
Page_Load function:
Dim adserv As New ActiveDirectory()
Dim userDetails As WebServiceUserPrincipal = adserv.Getuser(userName)
Dim userGroups As String() = adserv.GetUserGroups(userName)
Dim _dt As New DataTable
_dt.Columns.Add("Group")
For Each item As String In userGroups
Dim _row As DataRow = _dt.NewRow()
_row("Group") = item
_dt.Rows.Add(_row)
Next
Session(GetSessionKey("FullName")) = userDetails.DisplayName
Session(GetSessionKey("Groups")) = _dt
Session(GetSessionKey("UserName")) = userName
Session(GetSessionKey("Switch")) = "OK"
Dim filter_auditGroup As String = ConfigurationSettings.AppSettings("FILTER_GROUP")
Dim _adt As New DataTable
_adt.Columns.Add("Group")
For Each item As String In userGroups
If (item = filter_auditGroup) Then
Dim _row As DataRow = _adt.NewRow()
_row("Group") = item
_adt.Rows.Add(_row)
End If
Next
'If _adt.Rows.Count > 0 Then
' Session(GetSessionKey("AuditGroups")) = _adt
'End If
End Sub
Check Access Function
If Not IsPostBack Then
Dim arr As Array = Request.Url.AbsolutePath.Split("/")
Dim page As String = arr(arr.Length - 1).ToString().Split(".")(0) '-- Ballot.aspx, remove .aspx and get Ballot only
Dim signOut As New List(Of String)
signOut.Add("SwitchUser")
signOut.Add("SignOut")
If (Not signOut.Contains(page, StringComparer.OrdinalIgnoreCase)) Then
If (String.IsNullOrEmpty(Session(GetSessionKey("UserName")))) Then
Response.Redirect("~/Default.aspx")
Else
Dim group As DataTable = Session(GetSessionKey("Groups"))
'Dim auditGroup As DataTable = Session(GetSessionKey("AuditGroups"))
Dim adminPage As New List(Of String)
adminPage.Add("BallotProcess")
adminPage.Add("CodeTablePage")
adminPage.Add("MaintainBallotItem")
adminPage.Add("MaintainCodeItem")
adminPage.Add("MaintainItemDetail")
If (adminPage.Contains(page, StringComparer.OrdinalIgnoreCase) And Not CheckAdmin(group)) Then
Response.Redirect("~/EventRegistration.aspx")
End If
'If (page.Equals("AuditPage", StringComparison.OrdinalIgnoreCase) And Not CheckAudit(group)) Then
' Response.Redirect("~/default.aspx")
'End If
End If
End If
End If
Check Admin Function
Private Function CheckAdmin(ByVal group As DataTable) As Boolean
Dim i As Integer
If Not IsNothing(group) Then
For i = 0 To group.Rows.Count - 1
If group.Rows(i)(0) = ConfigurationSettings.AppSettings("FILTER_GROUP") Then
CheckAdmin = True
Session(GetSessionKey("EventAdmin")) = 1
Exit Function
End If
Next
End If
End Function

I have found my answer through countless of debug and all I need to fix this code is just move the Response.Redirect("~/EventRegistration.aspx") into the If Else statement above. This is because when the if else statement execute to get the identity, after its if else statement the value will be Nothing, then it redirect to the page while the page will try to get the identity and it execute again the if else countless of times..
If String.IsNullOrEmpty(Session(GetSessionKey("UserName"))) Then
Dim userName As String = HttpContext.Current.User.Identity.Name.Split("\")(1)
SessionInitialiser(userName)
Response.Redirect("~/EventRegistration.aspx")
End If

Related

How to loop through text boxes and verify if there are duplicate values?

I'm trying to setup a function that sends a mail to a defined list of recipients.
Each recipient is fetched from a textbox. The problem is that I want to identify if there are any duplicate values and exclude them when sending the email.
As an example, if textbox1 has the same value as textbox2, don't include textbox1 value in the recipients list.
I've tried with the following sub
Private Sub CheckDuplicates()
Dim x As Long
Dim y As Long
Dim User() As TextBox = {Mail_user1, Mail_user2, Mail_user3, Mail_user4, Mail_user5, Mail_user6, Mail_user7, Mail_user8, Mail_user9, Mail_user10, Mail_user11, Mail_user12, Mail_user13, Mail_user14, Mail_user15, Mail_user16, Mail_user17, Mail_user18, Mail_user19, Mail_user20, Mail_user21, Mail_user22, Mail_user23, Mail_user24, Mail_user25, Mail_user26, Mail_user27, Mail_user28, Mail_user29, Mail_user30}
For x = 1 To 30 - 1
For y = x + 1 To 30
If User(x).Text = User(y).Text Then
User(y).Text = ""
End If
Next
Next
End Sub
The issue is that I get the following error when I want to send the mail:
Index was outside the bounds of the array.
And the mail sub looks like this:
Public Function AddRecipients(mail As outlook.MailItem) As Boolean
Dim retValue As Boolean = False
Dim recipients As outlook.Recipients = Nothing
Dim recipientTo As outlook.Recipient = Nothing
Dim recipientCC As outlook.Recipient = Nothing
Dim recipientBCC As outlook.Recipient = Nothing
Try
recipients = mail.Recipients
' check if there are any recipients and remove them
While recipients.Count > 0
recipients.Remove(1)
End While
' new recipients list
CheckDuplicates()
'------------------CC section---------------------------
recipientCC = recipients.Add("someemail#test.com")
recipientCC.Type = outlook.OlMailRecipientType.olCC
'hidden recipients section
' recipientBCC = recipients.Add("")
' recipientBCC.Type = outlook.OlMailRecipientType.olBCC
retValue = recipients.ResolveAll()
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
Finally
If Not IsNothing(recipientBCC) Then Marshal.ReleaseComObject(recipientBCC)
If Not IsNothing(recipientCC) Then Marshal.ReleaseComObject(recipientCC)
If Not IsNothing(recipientTo) Then Marshal.ReleaseComObject(recipientTo)
If Not IsNothing(recipients) Then Marshal.ReleaseComObject(recipients)
End Try
Return retValue
End Function
Private Sub MailTime()
Dim OTmail As outlook.MailItem
Dim AppOutlook As New outlook.Application
Try
OTmail = AppOutlook.CreateItem(outlook.OlItemType.olMailItem)
'add users from AddRecipients
AddRecipients(OTmail)
OTmail.Subject = "Test OT mail"
OTmail.Body = "Test Ot mail"
OTmail.BodyFormat = outlook.OlBodyFormat.olFormatHTML
OTmail.Display()
Catch ex As Exception
MessageBox.Show("Could not send, resolve the errors !")
MessageBox.Show(ex.ToString)
Finally
OTmail = Nothing
AppOutlook = Nothing
End Try
End Sub
This will loop through all the TextBoxes and get a Distinct list for you.
Private Function uniqueRecipients() As List(Of String)
Dim recipients As List(Of String) = New List(Of String)
For Each ctrl As TextBox In Me.Controls.OfType(Of TextBox)
recipients.Add(ctrl.Text)
Next
Return recipients.Distinct.ToList
End Function
Private Sub Button26_Click(sender As Object, e As EventArgs) Handles Button26.Click
Try
Dim myRecips As List(Of String) = uniqueRecipients()
Dim oneLine As String = Strings.Join(myRecips.Where(Function(s) Not String.IsNullOrEmpty(s)).ToArray(), ";")
'send mail
Catch ex As Exception
MessageBox.Show(String.Concat("An error occurred: ", ex.Message))
End Try
End Sub
Use right tool type for the job - HashSet(Of String), Enumerable.ToHashSet Method
Private Function GenerateMailRecipientsFrom(textboxes As IEnumerable(Of TextBox)) As String
Dim uniqueRecipients = textboxes.
Select(Function(textbox) textbox.Text).
Where(Function(text) String.IsNullOrWhiteSpace(text) = False).
ToHashSet()
Return String.Join(";", uniqueRecipients)
End Function
HashSet accepts only unique values.
Then use a collection of all textboxes on the form
Dim mailTo As String = GenerateMailRecipientsFrom(Me.Controls.OfType(Of TextBox))
When you have predefined collection of textboxes you can still use the same method
Dim userMailTextBoxes As textBox() = { Mail_user1, Mail_user2, .. }
Dim mailTo As String = GenerateMailRecipientsFrom(userMailTextBoxes)
Nice one ! #Fabrio thanks for the code and explanation. As a side note, I have tried to load the unique values into a listbox and then insert them into outlook email while using this method:
Dim x As Long
For x = 0 To ListBox1.Items.Count - 1
If ListBox1.Items.Item(x) <> "" Then
recipientTo = recipients.Add(ListBox1.Items.Item(x))
recipientTo.Type = outlook.OlMailRecipientType.olTo
End If
Next
Worked like a charm :)

VB.NET SetAttribute in WebBrowser doens't work

I did some research previously, but all the answers do not work.
The "value" attribute exists in the element but does not appear in the webBrowser, nor in the input.
This is my code until then, I need the webBrowser to read an html file, then load your answers or values ​​from your inputs from a database.
PS:
My application is built in real time, there is no webbrowser control on the screen, it is created shortly after reading the html file and only then it is placed inside a panel.
Dim webBrowser As WebBrowser = New WebBrowser
Dim _doc As HtmlDocument
Dim htmlPath As String = "C:\ePrimeCare\Platis\Debug\Protocolos\" +
nomeProtocolo + "_" + idSistema.ToString() + ".html"
webBrowser.ScriptErrorsSuppressed = True
webBrowser.Navigate(htmlPath)
_doc = webBrowser.Document.OpenNew(False)
'webBrowser.DocumentText = IO.File.ReadAllText(htmlPath).ToString()
'webBrowser.Document.OpenNew(False)
'RetornaRespostasAnteriores(idSistema, idFicha, nomeProtocolo, _doc, Convert.ToDateTime(dtVisita))
_doc.Title = nomeProtocolo
_doc.Write(IO.File.ReadAllText(htmlPath).ToString())
Dim carregaRespostas As CarregarRespostaProtocoloHTML = New CarregarRespostaProtocoloHTML
Dim respostas As DataTable = carregaRespostas.BuscarRespostasProtocoloAnterior(idFicha, idSistema, dtVisita)
Dim idopcaoitem As String = 0
Dim idsetitem As String = 0
Dim value As DataRow()
Dim strArr As String()
For Each element As HtmlElement In _doc.GetElementsByTagName("input")
Dim type As String = element.GetAttribute("type")
Select Case type
Case "text"
strArr = element.GetAttribute("id").Split("_") 'For get the two ids
idopcaoitem = strArr(0)
value = respostas.Select(("IDOPCAOITEM = " + idopcaoitem.ToString()))
If value.Length > 0 Then
element.SetAttribute("value", value(0)(2).ToString())'Here i try to set the value, but does not work
End If
Case "radio"
Debug.WriteLine("Input de radio")
Case "checkbox"
Debug.WriteLine("Input de checkbox")
Case "hidden"
Debug.WriteLine("Input de hidden")
Case Else
Debug.WriteLine("Outro input")
End Select
Next
_doc.Write(IO.File.ReadAllText(htmlPath).ToString())
webBrowser.Refresh(WebBrowserRefreshOption.Completely)
webBrowser.Dock = Dock.Fill
pnlMain.Controls.Add(webBrowser)
All your document rewriting and the refresh you do at the end will overwrite any changes you made to it.
'Either of these will revert the document back to its original state.
_doc.Write(IO.File.ReadAllText(htmlPath).ToString())
webBrowser.Refresh(WebBrowserRefreshOption.Completely)
You don't even need to call _doc.Write() as WebBrowser1.Navigate(htmlPath) will work just as fine.
New code:
Dim webBrowser As New WebBrowser 'Shorthand statement.
Dim _doc As HtmlDocument
Dim htmlPath As String = "C:\ePrimeCare\Platis\Debug\Protocolos\" +
nomeProtocolo + "_" + idSistema.ToString() + ".html"
webBrowser.ScriptErrorsSuppressed = True
webBrowser.Navigate(htmlPath)
_doc = webBrowser.Document 'Removed OpenNew().
_doc.Title = nomeProtocolo
Dim carregaRespostas As New CarregarRespostaProtocoloHTML 'Another shorthand statement.
Dim respostas As DataTable = carregaRespostas.BuscarRespostasProtocoloAnterior(idFicha, idSistema, dtVisita)
(...your variables...)
For Each element As HtmlElement In _doc.GetElementsByTagName("input")
(...your code...)
Next
'(Removed _doc.Write() and Refresh() since they will undo all changes)
webBrowser.Dock = Dock.Fill
pnlMain.Controls.Add(webBrowser)

Affiliate Window API passing columns to Service Causes Application Crash (VB.net)

This generates a crash, and I have no idea why?
I have very little experience using SOAP/WSDL and I think this may be why I have no idea how to even start to debug this.
Sub Main()
Dim service As AWIN.ApiService = New AWIN.ApiService
Dim columns As AWIN.getProductList
Dim AWresults() As AWIN.Product
Dim response As New AWIN.getProductListResponse
Dim total As Integer
Dim activerefine As AWIN.RefineByGroup
Dim refine As AWIN.RefineByGroup
Const token As String = "xxy"
Dim UA As AWIN.UserAuthentication = New AWIN.UserAuthentication
With UA
.sApiKey = token
End With
service.UserAuthenticationValue = UA
columns = New AWIN.getProductList
Dim stringsofthings As String() = {"sId", "iCategoryId", "iMerchantId", "sMerchantProductId", "iAdult", "bHotpick", _
"iUpc", "iEan", "sMpn", "iIsbn", "sName", "sDescription", "sSpecification", _
"sPromotion", "sBrand", "sModel", "sAwDeepLink", "sAwThumbUrl", "sAwImageUrl", _
"sMerchantThumbUrl", "sMerchantImageUrl", "sDeliveryTime", "fPrice", "sCurrency", _
"fStorePrice", "fRrpPrice", "fDeliveryCost", "bWebOffer", "bPreOrder", "sWarranty"}
columns.sColumnToReturn = stringsofthings
response = service.getProductList(columns)
For c = 0 To UBound(response.oProduct)
ReDim Preserve AWresults(c)
AWresults(c) = New AWIN.Product
AWresults(c) = response.oProduct(c)
Console.WriteLine(AWresults.ToString)
Next
Console.ReadLine()
End Sub

Listbox formatting VB

I would like to format my listbox so that the output becomes something like this.
This is method, not in the main form tho:
Public Function GetSeatInfoStrings(ByVal choice As DisplayOptions,
ByRef strSeatInfoStrings As String()) As Integer
Dim count As Integer = GetNumOfSeats(choice)
If (count <= 0) Then
Return 0
End If
strSeatInfoStrings = New String(count - 1) {}
Dim StrReservation As String = ""
strSeatInfoStrings = New String(count - 1) {}
Dim i As Integer = 0 'counter for return array
'is the element corresponding with the index empty
For index As Integer = 0 To m_totNumOfSeats - 1
Dim strName As String = ""
Dim reserved As Boolean = Not String.IsNullOrEmpty(m_nameList(index))
'if the criteria below are not met, skip to add info in the array
If (choice = DisplayOptions.AllSeats) Or
(reserved And choice = DisplayOptions.ReservedSeats) Or
((Not reserved) And (choice = DisplayOptions.VacantSeats)) Then
If (reserved) Then
StrReservation = "Reserved"
strName = m_nameList(index)
Else
StrReservation = "Vacant"
strName = "..........."
End If
strSeatInfoStrings(i) = String.Format("{0,4} {1,-8} {2, -20} {3,10:f2}",
index + 1, StrReservation, strName, m_priceList(index))
i += 1
End If
Next
Return count
End Function
I don't know how to format the listbox as the strSeatInfoStrings(i) in the main form.
My listbox
This is what I've done
Private Sub UpdateGUI()
'Clear the listbox and make it ready for new data.
ReservationList.Items.Clear()
'size of array is determined in the callee method
Dim seatInfoStrings As String() = Nothing
Dim calcOption As DisplayOptions = DirectCast(cmbDisplayOptions.SelectedIndex, DisplayOptions)
Dim count As Integer = m_seatMngr.GetSeatInfoStrings(calcOption, seatInfoStrings)
If count > 0 Then
ReservationList.Items.AddRange(seatInfoStrings)
Else
ReservationList.Items.Add("Nothing to display!")
End If
Found the error! I forgot to call the UpdateGUI() in the IntializeGUI().

vb.net select random folder name

Dose anybody know how I can select an existing random directory name (C:\ drive) using vb.net and store its location in a variable.
I had to googel this one but seem to only be able to find example in relation to files, not folders
Try this out, hope this will suits your requirement,
'----------------- Global Variables
Dim xCnter = 0
Dim xRndNo = 0
Dim xSubdirectory As String
Private Sub Basement()
Dim xGenerator As System.Random = New System.Random()
xRndNo = xGenerator.Next(1, 100)
AssignRndDirectory("C:\")
msgbox(subdirectory)
End Sub
Private Sub AssignRndDirectory(xPath as string)
For Each subdirectory In Directory.GetDirectories(xPath)
if xCnter = xRndNo then Exit sub
xCnter += 1
call AssignRndDirectory(subdirectory)
Next
End Sub
[Note: This code is not tested with IDE, Tell me if anything cause errors.]
EDIT: TESTED WITH IDE
Dim xCnter = 0
Dim xRndNo = 0
Dim xSubdirectory As String
Private Sub Basement()
Dim xGenerator As System.Random = New System.Random()
xRndNo = xGenerator.Next(1, 100)
AssignRndDirectory("C:\")
MsgBox(xSubdirectory)
xCnter = 0
End Sub
Private Sub AssignRndDirectory(ByVal xPath As String)
Try
For Each Subdirectory In Directory.GetDirectories(xPath)
If xCnter = xRndNo Then Exit Sub
xSubdirectory = Subdirectory
xCnter += 1
Call AssignRndDirectory(Subdirectory)
Next
Catch ex As Exception
Exit Sub
End Try
End Sub
Just make a list of directories, and select a random item from it.
Dim rnd As New Random()
Dim path As String = "C:\"
Dim dir = New DirectoryInfo(path)
Dim subDirs = dir.GetDirectories()
Dim randomDir = subdirs(rnd.[Next](subDirs.Length))
Or, if you prefer Linq, the last line can be:
Dim randomDirectory = subdirs.Skip(rnd.[Next](subdirs.Length)).First()