Using browscap.ini with VB.Net - asp.net

Since 2013 now (more than 3 years), I have been using http://www.useragentstring.com/ in my main VB.Net project to get browser name/version and OS name/version from user agent string to add statistics to my local web application.
But, recently, in last months, this web site has been unreliable with a lot of down times. So to avoid missing data in my statistics, I searched for a local solution instead of an online one. I found http://browscap.org/ is an old web site (since 1998) that still upload updated user agent information to this day (browscap.ini). It is designed for PHP, but I found a C# implementation there: https://www.gocher.me/C-Sharp-Browscap .
But as a VB.Net developper, I did not find any VB implementation for it. I googled a lot but with no success. Does anyone get one for VB.NET?

I finally get to convert the C# solution to VB.NET with some head scratching.
Public Class CompareByLength
Implements IComparer(Of String)
Private Function Compare(ByVal x As String, ByVal y As String) as Integer _
Implements IComparer(Of String).Compare
If x Is Nothing Then
If y Is Nothing Then
Return 0
Else
Return 1
End If
Else
If y Is Nothing Then
Return -1
Else
Dim retval As Integer = x.Length.CompareTo(y.Length)
If retval <> 0 Then
Return -retval
Else
return -x.CompareTo(y)
End If
End If
End If
End Function
End Class
Public Class BrowsCap
Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" (ByVal lpReturnedString As Byte(), ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileSection Lib "kernel32.dll" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedBuffer As Byte(), ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedBuffer As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private path As String
Private sections As String()
Private Function GetSectionNames() As String()
Dim maxsize As Integer = 500
Do
Dim bytes(maxsize) As Byte
Dim size As Integer = GetPrivateProfileSectionNames(bytes, maxsize, path)
If size < maxsize - 2 Then
Dim Selected As String = Encoding.ASCII.GetString(bytes, 0, size - (IIf(size > 0, 1, 0)))
Return Selected.Split(New Char() {ControlChars.NullChar})
End If
maxsize = maxsize * 2
Loop
End Function
Public Sub IniFileName(ByVal INIPath As String)
path = INIPath
sections = GetSectionNames()
Array.Sort(sections, New CompareByLength())
End Sub
public Function IniReadValue(ByVal Section As String, ByVal Key As String) As String
Dim temp As New StringBuilder(255)
Dim i As Integer = GetPrivateProfileString(Section, Key, "", temp.ToString(), 255, path)
Return temp.ToString()
End Function
Private Function findMatch(ByVal Agent As String) As String
If sections IsNot Nothing Then
For Each SecHead As String In sections
If (SecHead.IndexOf("*", 0) = -1) And (SecHead.IndexOf("?", 0) = -1) And (SecHead = Agent) Then
If IniReadValue(SecHead, "parent") <> "DefaultProperties" Then
Return SecHead
End If
End If
Next
For Each SecHead As String In sections
Try
If (SecHead.IndexOf("*", 0) > -1) Or (SecHead.IndexOf("?", 0) > -1) Then
if Regex.IsMatch(Agent, "^" + Regex.Escape(SecHead).Replace("\*", ".*").Replace("\?", ".") + "$") Then
Return SecHead
End If
End If
Catch ex As Exception
'Console.WriteLine(ex)
End Try
Next
Return "*"
End If
Return ""
End Function
Public Function getValues(ByVal Agent As String) As NameValueCollection
Dim match As String = findMatch(Agent)
Dim col As NameValueCollection = New NameValueCollection()
Do
Dim entries() As string
Dim goon As Boolean = true
Dim maxsize As Integer = 500
While goon
Dim bytes(maxsize) As Byte
Dim size As Integer = GetPrivateProfileSection(match, bytes, maxsize, path)
If size < maxsize - 2
Dim section As String = Encoding.ASCII.GetString(bytes, 0, size - IIf(size > 0, 1, 0))
entries = section.Split(New Char() {ControlChars.NullChar})
goon = False
End If
maxsize = maxsize * 2
End While
match = ""
If entries.Length > 0 Then
For Each entry As String In entries
Dim ent As String() = entry.Split(New Char() {"="C})
If ent(0) = "Parent" Then
match = ent(1)
else if col(ent(0)) is nothing Then
col.Add(ent(0), ent(1))
End If
Next
End If
Loop While match <> ""
Return col
End Function
End Class
And here is how to use it:
Dim dict As Dictionary(Of String, Object) = New Dictionary(Of String, Object)
Dim bc As New BrowsCap
bc.IniFileName(Server.MapPath("/App_Data/lite_asp_browscap.ini"))
Dim Entry As NameValueCollection = bc.getValues(Request.UserAgent)
For Each s As String In Entry.AllKeys
dict.Add(s, Entry(s))
Next
' dict("Browser") will contains browser name like "IE" or "Chrome".
' dict("Version") will contains browser version like "11.0" or "56.0".
' dict("Platform") will contains OS name and version like "Win7".
The only thing left to do is to refresh my browscap.ini (or lite_asp_browscap.ini) sometimes (like once a week).

Related

Cannot register COM DLL with GetDelegateForFunctionPointer

I have an asp.net website and I have to register a vb6 DLL everytime it updates
I figured out how to copy the dll in SYSWOW64 directory and I try to register using that class:
Public Class ComLibrary
<UnmanagedFunctionPointer(CallingConvention.StdCall)>
Private Delegate Function DllRegUnRegAPI() As UInt32
<DllImport("kernel32", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function LoadLibrary(ByVal lpFileName As String) As IntPtr
End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function FreeLibrary(ByVal hModule As IntPtr) As Boolean
End Function
<DllImport("kernel32", CharSet:=CharSet.Ansi, ExactSpelling:=True, SetLastError:=True)>
Private Shared Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
End Function
<DllImport("kernel32.dll")>
Private Shared Function FormatMessage(ByVal dwFlags As Integer, ByVal lpSource As Integer, ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByRef lpBuffer As String, ByVal nSize As Integer, ByVal arguments As Integer) As Integer
End Function
Public Shared Sub Register(ByVal libraryPath As String)
libraryPath = Path.GetFullPath(libraryPath)
Dim hModuleDll = LoadLibrary(libraryPath)
If hModuleDll = IntPtr.Zero Then
Dim [error] = GetLastErrorMessage()
Debug.WriteLine("Unable to load DLL : {0} because of {1}", libraryPath, [error])
Return
End If
Dim pExportedFunction = GetProcAddress(hModuleDll, "DllRegisterServer")
If pExportedFunction = IntPtr.Zero Then
Debug.WriteLine("Unable to get required API from DLL.")
Return
End If
Dim pDelegateRegUnReg = CType((Marshal.GetDelegateForFunctionPointer(pExportedFunction, GetType(DllRegUnRegAPI))), DllRegUnRegAPI)
Dim hResult = pDelegateRegUnReg()
If hResult <> 0 Then
Debug.WriteLine("Cannot register {0}", libraryPath)
Return
End If
FreeLibrary(hModuleDll)
Debug.WriteLine("LogParser.dll registered succesfully")
End Sub
Public Shared Function GetLastErrorMessage() As String
Dim errorCode As Integer = Marshal.GetLastWin32Error()
Const formatMessageAllocateBuffer As Integer = &H100
Const formatMessageIgnoreInserts As Integer = &H200
Const formatMessageFromSystem As Integer = &H1000
Const messageSize As Integer = 255
Dim lpMsgBuf As String = ""
Const dwFlags As Integer = formatMessageAllocateBuffer Or formatMessageFromSystem Or formatMessageIgnoreInserts
Dim retVal As Integer = FormatMessage(dwFlags, 0, errorCode, 0, lpMsgBuf, messageSize, 0)
Return If(retVal = 0, Nothing, lpMsgBuf)
End FunctionEnd Class
But everytime the hresult return me 2147500037 (or 0x80004005) that looks like that the function does not have rights to do that, how can I elevate to admin rights or something else?

Converting a list to an array for a web service

I'm currently trying to convert my searchList in the web app from a list to an array so that it can be consumed in the web method. Right now, I'm using a web reference which only allows arrays to be passed and returned. I'd like to just simply convert the list to an array, but it looks like that won't work. I've tried looking online but each scenario I've found hasn't been similar enough to where I'm able to solve this. Any idea on the best way to do this?
Web App
Protected Function SearchCustomer()
Dim searchList As List(Of prxCustomerWebService1.Customer)
Dim objCustomerWS As New prxCustomerWebService1.CustomerWS
searchList = Cache("CustomerData")
'arr = searchList.ToArray
If (ddlSearchSpecs.Text = "Contains") Then
searchList = objCustomerWS.GetContains(tbSearch.Text, ddlSearchFields.Text, searchList)
ElseIf (ddlSearchSpecs.Text = "Starts With") Then
searchList = objCustomerWS.GetStartsWith(tbSearch.Text, ddlSearchFields.Text, searchList)
Else
searchList = objCustomerWS.GetExact(tbSearch.Text, ddlSearchFields.Text, searchList)
End If
If searchList.Count = 0 Then
lMessage.Text = "No Customers Found"
End If
Return searchList
End Function
Web Method
<WebMethod(description:="Gets customers that contain a specific value")> _
Public Function GetContains(ByVal sStringContains As String, ByVal sPropertyName As String, ByVal oListOfCustomers List(Of Customer))
oListOfCustomers()
Return CustomerFactory.GetContains(sStringContains, sPropertyName, oListOfCustomers)
End Function
Logic
Public Shared Function GetContains(ByVal sStringContains As String, ByVal sPropertyName As String, ByVal oListOfCustomers As List(Of Customer))
Dim oCustomerData As New CustomerData
Dim oNewListOfCustomers As New List(Of Customer)
Dim iIndex As Integer
Dim propertyInfo As PropertyInfo
propertyInfo = GetType(Customer).GetProperty(sPropertyName)
If IsNothing(oListOfCustomers) = False AndAlso oListOfCustomers.Count > 0 Then
Try
For iIndex = 0 To oListOfCustomers.Count - 1
If (propertyInfo.GetValue(oListOfCustomers.Item(iIndex)).ToString.Trim.ToLower.Contains(sStringContains.ToLower) = True) Then
oNewListOfCustomers.Add(oListOfCustomers.Item(iIndex))
End If
Next
Catch ex As Exception
Return True
End Try
End If
Return oNewListOfCustomers
End Function

Microsoft Translator for multiple textbox?

I get problem when use Microsoft Bing translator for show output on 3 labels for different languages.
Here is my code :
Imports System
Imports System.Collections.Generic
Imports System.Web
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Xml.Linq
Public Class AdmAccessToken
Public Property access_token() As String
Get
Return m_access_token
End Get
Set(ByVal value As String)
m_access_token = value
End Set
End Property
Private m_access_token As String
Public Property token_type() As String
Get
Return m_token_type
End Get
Set(ByVal value As String)
m_token_type = value
End Set
End Property
Private m_token_type As String
Public Property expires_in() As String
Get
Return m_expires_in
End Get
Set(ByVal value As String)
m_expires_in = value
End Set
End Property
Private m_expires_in As String
Public Property scope() As String
Get
Return m_scope
End Get
Set(ByVal value As String)
m_scope = value
End Set
End Property
Private m_scope As String
End Class
Partial Class translated
Inherits System.Web.UI.Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs)
'Button1.Click += New EventHandler(Button1_Click1)
End Sub
Protected Sub Button1_Click1(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim clientID As String = "*******"
Dim clientSecret As String = "************"
Dim strTranslatorAccessURI As String = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"
Dim strRequestDetails As String = String.Format("grant_type=client_credentials&client_id={0}&client_secret={1}&scope=http://api.microsofttranslator.com", HttpUtility.UrlEncode(clientID), HttpUtility.UrlEncode(clientSecret))
Dim webRequest As System.Net.WebRequest = System.Net.WebRequest.Create(strTranslatorAccessURI)
webRequest.ContentType = "application/x-www-form-urlencoded"
webRequest.Method = "POST"
Dim bytes As Byte() = System.Text.Encoding.ASCII.GetBytes(strRequestDetails)
webRequest.ContentLength = bytes.Length
Using outputStream As System.IO.Stream = webRequest.GetRequestStream()
outputStream.Write(bytes, 0, bytes.Length)
End Using
Dim webResponse As System.Net.WebResponse = webRequest.GetResponse()
Dim serializer As New System.Runtime.Serialization.Json.DataContractJsonSerializer(GetType(AdmAccessToken))
Dim token As AdmAccessToken = DirectCast(serializer.ReadObject(webResponse.GetResponseStream()), AdmAccessToken)
Dim headerValue As String = "Bearer " + token.access_token
Dim txtToTranslate As String = TextBox1.Text
Dim uri As String = "http://api.microsofttranslator.com/v2/Http.svc/Translate?text=" + System.Web.HttpUtility.UrlEncode(txtToTranslate) + "&from=en&to=es"
Dim translationWebRequest As System.Net.WebRequest = System.Net.WebRequest.Create(uri)
translationWebRequest.Headers.Add("Authorization", headerValue)
Dim response As System.Net.WebResponse = Nothing
response = translationWebRequest.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream()
Dim encode As System.Text.Encoding = System.Text.Encoding.GetEncoding("utf-8")
Dim translatedStream As New System.IO.StreamReader(stream, encode)
Dim xTranslation As New System.Xml.XmlDocument()
xTranslation.LoadXml(translatedStream.ReadToEnd())
Label1.Text = "Your Translation is: " + xTranslation.InnerText
End Sub
End Class
Can anyone give some advice?
I just need to know how I can get translated text to 3 different label language: label 1 for dutch language, label 2 for english language, and label 3 for indonesian language.
The final chunk of code in your example does the translation from English to Spanish. (The part that starts with Dim txtToTranslate...)
You will have to just use that 3 times (put it in a function) with once doing a translation from your target language to Dutch, once to English, once to Indonesian.
The part where the translation is specified is this:
Dim uri As String = "http://api.microsofttranslator.com/v2/Http.svc/Translate?text=" + System.Web.HttpUtility.UrlEncode(txtToTranslate) + "&from=en&to=es"
From=en means 'from English'
To=es means 'to Spanish'
So just amend that for the languages you need...

convert from httppostedfile to htmlinputfile

how do I convert an httppostedfile to an htmlinputfile? I'm working with an old mess of an app and so far have been able to refactor it so it makes a bit of sense, but this particular mess is too tangled to be worth the effort :S.
Thanks, as usual, for the help
relevant code:
collection:
Imports System.IO
Imports System.Web.UI.HtmlControls
Public Class ArchivosCollection
Inherits CollectionBase
Default Public Property Item(ByVal index As Integer) As HtmlInputFile
Get
Return MyBase.List(index)
End Get
Set(ByVal Value As HtmlInputFile)
MyBase.List(index) = Value
End Set
End Property
Public Function Add(ByVal oArchivo As HtmlInputFile) As Integer
Return MyBase.List.Add(oArchivo)
End Function
Public Function getDataSource() As DataTable
Dim dt As New DataTable
Dim oArchivo As HtmlInputFile
Dim fila As DataRow
Dim orden As Integer = 0
dt.Columns.Add("documento", GetType(System.String))
dt.Columns.Add("tipo", GetType(System.String))
For Each oArchivo In list
If Not oArchivo.Disabled Then
fila = dt.NewRow()
fila("documento") = Trim(Path.GetFileName(oArchivo.PostedFile.FileName))
fila("tipo") = Trim(oArchivo.PostedFile.ContentType)
dt.Rows.Add(fila)
End If
Next
Return dt
End Function
Public Function ExisteArchivo(ByVal Nombre As String) As Boolean
For Each oArchivo As HtmlInputFile In list
If Not oArchivo.Disabled Then
If Path.GetFileName(oArchivo.PostedFile.FileName) = Nombre Then
Return True
End If
End If
Next
Return False
End Function
Public Function EliminarArchivo(ByVal Nombre As String) As Boolean
For Each oArchivo As HtmlInputFile In list
If Not oArchivo.Disabled Then
If Path.GetFileName(oArchivo.PostedFile.FileName) = Nombre Then
oArchivo.Disabled = True
Return True
End If
End If
Next
End Function
End Class
old code:
Private Sub btnAgregarDocumento_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAgregarDocumento.Click
Try
If Not (Me.fleDocumento.PostedFile Is Nothing) Then
If Trim(Me.fleDocumento.PostedFile.FileName) = "" Then
Throw New Exception(rm.GetString("errorDebeEscogerUnArchivo"))
End If
If Not Servicios.isValidUploadType(Me.fleDocumento.PostedFile.FileName, ConfigurationManager.AppSettings("Filtros Upload")) Then
Throw New Exception(rm.GetString("errorExtensionNovalida"))
End If
Dim oArchivosOT As ArchivosCollection
If Session("oArchivosOT") Is Nothing Then
oArchivosOT = New ArchivosCollection
Else
oArchivosOT = Session("oArchivosOT")
End If
If oArchivosOT.ExisteArchivo(Path.GetFileName(Me.fleDocumento.PostedFile.FileName)) Then
Throw New Exception(rm.GetString("errorArchivoYaExiste"))
End If
oArchivosOT.Add(Me.fleDocumento)
Me.dgDocumentos.DataSource = oArchivosOT.getDataSource()
Me.dgDocumentos.DataBind()
Session("oArchivosOT") = oArchivosOT
If Request.QueryString("desde") = "proy" Then
ClientScript.RegisterStartupScript(Page.GetType, "msg", "<script>window.opener.document.Form1.refGridDocs.click();</script>")
End If
Else
Throw New Exception(rm.GetString("errorDebeEscogerUnArchivo"))
End If
Catch exc As Exception
ClientScript.RegisterStartupScript(Page.GetType, "msg", Servicios.MsgBox(exc.Message))
End Try
End Sub
new code (partial):
Dim archivos As HttpFileCollection = Request.Files
Dim colArchivos As ArchivosCollection = IIf(Session("oArchivosOT") Is Nothing, New ArchivosCollection(), Session("oArchivosOT"))
Dim i
For i = 0 To archivos.Count
colArchivos.Add(DirectCast(archivos(i), HtmlInputFile))
Next
Session("oArchivosOT") = colArchivos
The PostedFile property of the HtmlInputFile object is a HttpPostedFile object - you can simply access it for each HtmlInputFile.

Cookie being deleted unexpectedly by the application

I am having an issue with a cookie that keeps getting deleted by the application. When you go into the application, if the cookie does not exist, it gets created. This works fine and everything in the cookie is stored correctly.
When I click on a link to go to another page, once everything loads completely, the cookie gets deleted from the file system. Even stranger than that, the values from the cookie remain until the browser is closed. That is the application appears to be retaining the values even though the cookie does not exist on the local file system. The next time you enter the application, the cookie is recreated so any values stored are lost.
Now, I have done some tweaking on the code to see what could be causing it. I found that I am adding the cookie to the Response object any time I make a change to the cookie. The cookie is also being added to the Response object when the page load is completed. My initial thought was that adding the cookie multiple times to the Response object could be causing the issue. I commented out the code in the page load complete event and the cookie hung around until the next postback. Then I put in some logic to keep the application from putting the cookie into the Response object more than once, and then I lost the cookie again at the same point as before.
All of the code for handling cookies is in my "base page" that all pages inherit from. The page that seems to be loosing the cookie is my search page. I am including the code from both of those pages.
BasePage.vb
Public Class BasePage
Inherits Page
#Region "attributes"
Private _cookie As HttpCookie
Private _savedCookie As Boolean
Private Const COOKIE_NAME As String = "KDOELog"
Private Const COOKIE_COLUMNS As String = "cols"
Private Const COOKIE_SEARCH_BRANCH As String = "b"
Private Const COOKIE_SEARCH_COLLECTOR As String = "c"
Private Const COOKIE_SEARCH_CONF_NUMBER As String = "a"
Private Const COOKIE_SEARCH_NA_NUMBER As String = "n"
Private Const COOKIE_SEARCH_CUST_NUMBER As String = "u"
Private Const COOKIE_SEARCH_INV_NUMBER As String = "i"
Private Const COOKIE_SEARCH_CONTRACT As String = "t"
Private Const COOKIE_SEARCH_ORDER_TYPE As String = "y"
Private Const COOKIE_SEARCH_DSR_NUMBER As String = "r"
Private Const COOKIE_SEARCH_DSM_NUMBER As String = "m"
Private Const COOKIE_SEARCH_EXCEPTION As String = "e"
Private Const COOKIE_SEARCH_START_DATE As String = "s"
Private Const COOKIE_SEARCH_END_DATE As String = "d"
Private Const COOKIE_PAGE_INDEX As String = "pg"
Private Const COOKIE_SORT_COLUMN As String = "sc"
Private Const COOKIE_SORT_DIRECTION As String = "sd"
Private Const SESSION_USER As String = "user"
#End Region
#Region "constructor"
Public Sub New()
_savedCookie = False
End Sub
#End Region
#Region "events"
Private Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If IsPostBack = False Then
' determines whether or not to show the link for Node Search
Dim myMaster As Food = DirectCast(Me.Master, Food)
If AuthenticatedUser.IsCorporateAdmin Or AuthenticatedUser.IsBranchAdmin Then
myMaster.ShowNodeItemLink = True
Else
myMaster.ShowNodeItemLink = False
End If
End If
End Sub
Private Sub Page_LoadComplete(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LoadComplete
If _savedCookie = False Then Response.Cookies.Add(_cookie)
End Sub
Private Sub Page_PreInit(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.PreInit
If IsNothing(Request.Cookies(COOKIE_NAME)) Then
_cookie = New HttpCookie(COOKIE_NAME)
_cookie.Expires = New Date(2999, 12, 31)
_cookie.Values.Add(COOKIE_COLUMNS, GetDefaultColumnList())
_cookie.Values.Add(COOKIE_SEARCH_BRANCH, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_COLLECTOR, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_CONF_NUMBER, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_NA_NUMBER, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_CUST_NUMBER, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_INV_NUMBER, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_CONTRACT, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_ORDER_TYPE, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_DSR_NUMBER, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_DSM_NUMBER, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_EXCEPTION, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_START_DATE, String.Empty)
_cookie.Values.Add(COOKIE_SEARCH_END_DATE, String.Empty)
_cookie.Values.Add(COOKIE_PAGE_INDEX, 0)
_cookie.Values.Add(COOKIE_SORT_COLUMN, "eback_datetime")
_cookie.Values.Add(COOKIE_SORT_DIRECTION, SORT_DIRECTION_ASC)
SaveCookie()
Else
_cookie = Request.Cookies(COOKIE_NAME)
End If
If IsNothing(Session(SESSION_USER)) Then Session(SESSION_USER) = New User(Context.User.Identity.Name)
End Sub
#End Region
#Region "methods"
Protected Function GetColumnList() As String()
Return Server.HtmlEncode(_cookie(COOKIE_COLUMNS)).Split(",")
End Function
Private Function GetDefaultColumnList() As String
' set the default list of columns
Dim columnList As New StringBuilder()
columnList.Append(COL_COLLECTOR).Append(",")
columnList.Append(COL_CONF_NUM).Append(",")
columnList.Append(COL_NODE_NUM).Append(",")
columnList.Append(COL_ORDER_TYPE).Append(",")
columnList.Append(COL_CUST_NUM).Append(",")
columnList.Append(COL_ERROR_IND).Append(",")
columnList.Append(COL_DSR_NUM).Append(",")
columnList.Append(COL_DSR_NAME).Append(",")
columnList.Append(COL_DSM_NUM).Append(",")
columnList.Append(COL_CONTRACT).Append(",")
columnList.Append(COL_NA_NUM).Append(",")
columnList.Append(COL_NA_SUB).Append(",")
columnList.Append(COL_INV_NUM).Append(",")
columnList.Append(COL_CONF_DATE).Append(",")
columnList.Append(COL_LINE_ITEMS).Append(",")
columnList.Append(COL_DELV_DATE).Append(",")
columnList.Append(COL_SALES_AMT).Append(",")
columnList.Append(COL_BRANCH)
Return columnList.ToString()
End Function
Protected Function HasSearchValues() As Boolean
Return CBool(_cookie(COOKIE_SEARCH_BRANCH) > String.Empty Or _
_cookie(COOKIE_SEARCH_COLLECTOR) > String.Empty Or _
_cookie(COOKIE_SEARCH_CONF_NUMBER) > String.Empty Or _
_cookie(COOKIE_SEARCH_NA_NUMBER) > String.Empty Or _
_cookie(COOKIE_SEARCH_CUST_NUMBER) > String.Empty Or _
_cookie(COOKIE_SEARCH_INV_NUMBER) > String.Empty Or _
_cookie(COOKIE_SEARCH_CONTRACT) > String.Empty Or _
_cookie(COOKIE_SEARCH_ORDER_TYPE) > String.Empty Or _
_cookie(COOKIE_SEARCH_DSR_NUMBER) > String.Empty Or _
_cookie(COOKIE_SEARCH_DSM_NUMBER) > String.Empty Or _
_cookie(COOKIE_SEARCH_EXCEPTION) > String.Empty Or _
_cookie(COOKIE_SEARCH_START_DATE) > String.Empty Or _
_cookie(COOKIE_SEARCH_END_DATE) > String.Empty)
End Function
Protected Sub ResetSearchValues()
_cookie(COOKIE_SEARCH_BRANCH) = String.Empty
_cookie(COOKIE_SEARCH_COLLECTOR) = String.Empty
_cookie(COOKIE_SEARCH_CONF_NUMBER) = String.Empty
_cookie(COOKIE_SEARCH_NA_NUMBER) = String.Empty
_cookie(COOKIE_SEARCH_CUST_NUMBER) = String.Empty
_cookie(COOKIE_SEARCH_INV_NUMBER) = String.Empty
_cookie(COOKIE_SEARCH_CONTRACT) = String.Empty
_cookie(COOKIE_SEARCH_ORDER_TYPE) = String.Empty
_cookie(COOKIE_SEARCH_DSR_NUMBER) = String.Empty
_cookie(COOKIE_SEARCH_DSM_NUMBER) = String.Empty
_cookie(COOKIE_SEARCH_EXCEPTION) = String.Empty
_cookie(COOKIE_SEARCH_START_DATE) = String.Empty
_cookie(COOKIE_SEARCH_END_DATE) = String.Empty
_cookie(COOKIE_PAGE_INDEX) = 0
_cookie(COOKIE_SORT_COLUMN) = "eback_datetime"
_cookie(COOKIE_SORT_DIRECTION) = SORT_DIRECTION_ASC
SaveCookie()
End Sub
Protected Sub SaveCookie()
If _savedCookie = False Then
Response.Cookies.Add(_cookie)
_savedCookie = True
End If
End Sub
Protected Sub SetColumnList(ByVal ColumnList As String)
_cookie(COOKIE_COLUMNS) = ColumnList
SaveCookie()
End Sub
#End Region
#Region "properties"
Public ReadOnly Property AuthenticatedUser() As User
Get
If IsNothing(Session(SESSION_USER)) Then Session(SESSION_USER) = New User(Context.User.Identity.Name)
Return DirectCast(Session(SESSION_USER), User)
End Get
End Property
Public ReadOnly Property UserName() As String
Get
Return Context.User.Identity.Name
End Get
End Property
Public Property SearchBranch() As String
Get
Return _cookie(COOKIE_SEARCH_BRANCH)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_BRANCH) = value
End Set
End Property
Public Property SearchCollector() As String
Get
Return _cookie(COOKIE_SEARCH_COLLECTOR)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_COLLECTOR) = value
End Set
End Property
Public Property SearchConfirmationNumber() As String
Get
Return _cookie(COOKIE_SEARCH_CONF_NUMBER)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_CONF_NUMBER) = value
End Set
End Property
Public Property SearchNationalAccountNumber() As String
Get
Return _cookie(COOKIE_SEARCH_NA_NUMBER)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_NA_NUMBER) = value
End Set
End Property
Public Property SearchCustomerNumber() As String
Get
Return _cookie(COOKIE_SEARCH_CUST_NUMBER)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_CUST_NUMBER) = value
End Set
End Property
Public Property SearchInvoiceNumber() As String
Get
Return _cookie(COOKIE_SEARCH_INV_NUMBER)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_INV_NUMBER) = value
End Set
End Property
Public Property SearchContract() As String
Get
Return _cookie(COOKIE_SEARCH_CONTRACT)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_CONTRACT) = value
End Set
End Property
Public Property SearchOrderType() As String
Get
Return _cookie(COOKIE_SEARCH_ORDER_TYPE)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_ORDER_TYPE) = value
End Set
End Property
Public Property SearchDsrNumber() As String
Get
Return _cookie(COOKIE_SEARCH_DSR_NUMBER)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_DSR_NUMBER) = value
End Set
End Property
Public Property SearchDsmNumber() As String
Get
Return _cookie(COOKIE_SEARCH_DSM_NUMBER)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_DSM_NUMBER) = value
End Set
End Property
Public Property SearchErrorType() As String
Get
Return _cookie(COOKIE_SEARCH_EXCEPTION)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_EXCEPTION) = value
End Set
End Property
Public Property SearchStartDate() As String
Get
Return _cookie(COOKIE_SEARCH_START_DATE)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_START_DATE) = value
End Set
End Property
Public Property SearchEndDate() As String
Get
Return _cookie(COOKIE_SEARCH_END_DATE)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SEARCH_END_DATE) = value
End Set
End Property
Public Property PageIndex() As String
Get
Return _cookie(COOKIE_PAGE_INDEX)
End Get
Set(ByVal value As String)
_cookie(COOKIE_PAGE_INDEX) = value
End Set
End Property
Public Property SortColumn() As String
Get
Return _cookie(COOKIE_SORT_COLUMN)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SORT_COLUMN) = value
End Set
End Property
Public Property SortDirection() As String
Get
Return _cookie(COOKIE_SORT_DIRECTION)
End Get
Set(ByVal value As String)
_cookie(COOKIE_SORT_DIRECTION) = value
End Set
End Property
#End Region
End Class
Search.aspx.vb
Public Partial Class Search
Inherits BasePage
#Region "attributes"
#End Region
#Region "events"
Private Sub btnColumnSave_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnColumnSave.Click
Dim columns As New StringBuilder
If chkCollector.Checked Then columns.Append(COL_COLLECTOR).Append(",")
If chkAckNumber.Checked Then columns.Append(COL_CONF_NUM).Append(",")
If chkNodeNumber.Checked Then columns.Append(COL_NODE_NUM).Append(",")
If chkOrderType.Checked Then columns.Append(COL_ORDER_TYPE).Append(",")
If chkCustNumber.Checked Then columns.Append(COL_CUST_NUM).Append(",")
If chkCustName.Checked Then columns.Append(COL_CUST_NAME).Append(",")
If chkOrderExceptions.Checked Then columns.Append(COL_ERROR_IND).Append(",")
If chkDsrNumber.Checked Then columns.Append(COL_DSR_NUM).Append(",")
If chkDsrName.Checked Then columns.Append(COL_DSR_NAME).Append(",")
If chkDsmNumber.Checked Then columns.Append(COL_DSM_NUM).Append(",")
If chkDsmName.Checked Then columns.Append(COL_DSM_NAME).Append(",")
If chkContract.Checked Then columns.Append(COL_CONTRACT).Append(",")
If chkNationalAcct.Checked Then columns.Append(COL_NA_NUM).Append(",")
If chkNatAcctSub.Checked Then columns.Append(COL_NA_SUB).Append(",")
If chkInvoiceNumber.Checked Then columns.Append(COL_INV_NUM).Append(",")
If chkAckDateTime.Checked Then columns.Append(COL_CONF_DATE).Append(",")
If chkLineItem.Checked Then columns.Append(COL_LINE_ITEMS).Append(",")
If chkDeliveryDate.Checked Then columns.Append(COL_DELV_DATE).Append(",")
If chkSalesAmount.Checked Then columns.Append(COL_SALES_AMT).Append(",")
If chkBranch.Checked Then columns.Append(COL_BRANCH).Append(",")
' remove the last comma from the list
columns = columns.Remove(columns.Length - 1, 1)
SetColumnList(columns.ToString())
SaveCookie()
ManageGridColumns()
End Sub
Private Sub btnEndDate_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles btnEndDate.Click
calEndDate.Visible = Not calEndDate.Visible
If calEndDate.Visible Then
Try
calEndDate.SelectedDate = Date.Parse(txtEndDate.Text)
Catch
calEndDate.SelectedDate = Now
End Try
End If
modSearch.Show()
End Sub
Private Sub btnSearchReset_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSearchReset.Click
ddlBranch.SelectedIndex = 0
SearchBranch = ddlBranch.SelectedValue
ddlCollectorType.SelectedIndex = 0
SearchCollector = ddlCollectorType.SelectedValue
ddlOrderType.SelectedIndex = 0
SearchOrderType = ddlOrderType.SelectedValue
ddlErrorCode.SelectedIndex = 0
SearchErrorType = ddlErrorCode.SelectedValue
SearchConfirmationNumber = String.Empty
SearchNationalAccountNumber = String.Empty
SearchCustomerNumber = String.Empty
SearchInvoiceNumber = String.Empty
SearchContract = String.Empty
SearchDsrNumber = String.Empty
'SearchDsmNumber = String.Empty
SetDsmInfo()
SearchStartDate = Now.ToShortDateString()
SearchEndDate = Now.ToShortDateString()
SaveCookie()
SetSearchWindow()
modSearch.Show()
End Sub
Private Sub btnSearchSearch_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSearchSearch.Click
SearchBranch = ddlBranch.SelectedValue
SearchCollector = ddlCollectorType.SelectedValue
SearchConfirmationNumber = txtAckNumber.Text
SearchCustomerNumber = txtCustomerNumber.Text
SearchInvoiceNumber = txtInvoiceNumber.Text
SearchDsrNumber = txtDsrNumber.Text
SearchDsmNumber = txtDsmNumber.Text
SearchNationalAccountNumber = txtNationalAccountNumber.Text
SearchContract = txtContract.Text
SearchErrorType = ddlErrorCode.SelectedValue
SearchOrderType = ddlOrderType.SelectedValue
SearchStartDate = txtStartDate.Text
SearchEndDate = txtEndDate.Text
SaveCookie()
PageIndex = 0
dgResults.CurrentPageIndex = 0
BindResults()
End Sub
Private Sub btnStartDate_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles btnStartDate.Click
calStartDate.Visible = Not calStartDate.Visible
If calStartDate.Visible Then
Try
calStartDate.SelectedDate = Date.Parse(txtStartDate.Text)
Catch
calStartDate.SelectedDate = Now
End Try
End If
modSearch.Show()
End Sub
Private Sub calEndDate_SelectionChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles calEndDate.SelectionChanged
txtEndDate.Text = calEndDate.SelectedDate.ToShortDateString()
calEndDate.Visible = False
modSearch.Show()
End Sub
Private Sub calStartDate_SelectionChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles calStartDate.SelectionChanged
txtStartDate.Text = calStartDate.SelectedDate.ToShortDateString()
calStartDate.Visible = False
modSearch.Show()
End Sub
Private Sub dgResults_PageIndexChanged(ByVal source As Object, ByVal e As System.Web.UI.WebControls.DataGridPageChangedEventArgs) Handles dgResults.PageIndexChanged
PageIndex = e.NewPageIndex
dgResults.CurrentPageIndex = e.NewPageIndex
BindResults()
End Sub
Private Sub dgResults_SortCommand(ByVal source As Object, ByVal e As System.Web.UI.WebControls.DataGridSortCommandEventArgs) Handles dgResults.SortCommand
If SortColumn.Equals(e.SortExpression) Then
If SortDirection = SORT_DIRECTION_ASC Then
SortDirection = SORT_DIRECTION_DESC
Else
SortDirection = SORT_DIRECTION_ASC
End If
Else
SortColumn = e.SortExpression
SortDirection = SORT_DIRECTION_ASC
End If
PageIndex = 0
dgResults.CurrentPageIndex = 0
BindResults()
End Sub
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If IsPostBack = False Then
SetDsmInfo()
txtStartDate.Text = Now.ToShortDateString()
txtEndDate.Text = Now.ToShortDateString()
BindBranches()
BindCollectorTypes()
BindTransmissionTypes()
BindErrorCodes()
SetupColumnWindow()
ManageGridColumns()
If HasSearchValues() Then
SetSearchWindow()
dgResults.CurrentPageIndex = CInt(PageIndex)
BindResults()
Else
modSearch.Show()
End If
End If
End Sub
#End Region
#Region "methods"
Private Sub BindBranches()
If AuthenticatedUser.IsCorporateAdmin Then
Dim branches As New BranchCollection
branches.Load()
ddlBranch.DataSource = branches
ddlBranch.DataTextField = "BranchDescription"
ddlBranch.DataValueField = "BranchName"
ddlBranch.DataBind()
Else
Dim myBranch As New Branch(AuthenticatedUser.Division)
ddlBranch.Items.Clear()
ddlBranch.Items.Add(New ListItem(myBranch.BranchDescription, myBranch.BranchName))
ddlBranch.Enabled = False
End If
End Sub
Private Sub BindCollectorTypes()
Dim types As New OrderTypeCollection
types.Load()
ddlCollectorType.DataSource = types
ddlCollectorType.DataTextField = "eb_order_description"
ddlCollectorType.DataValueField = "eb_order_type"
ddlCollectorType.DataBind()
End Sub
Private Sub BindErrorCodes()
Dim codes As New KDOE_Library.BusinessLayer.ErrorTypeCollection
codes.Load()
ddlErrorCode.DataSource = codes
ddlErrorCode.DataTextField = "eb_error_desc"
ddlErrorCode.DataValueField = "eb_error_type"
ddlErrorCode.DataBind()
End Sub
Private Sub BindResults()
Dim results As New ConfirmationHeaderCollection()
results.Search(SearchCollector, SearchConfirmationNumber, SearchBranch, SearchCustomerNumber, SearchInvoiceNumber, _
SearchDsrNumber, SearchDsmNumber, SearchNationalAccountNumber, SearchContract, SearchErrorType, _
SearchOrderType, SearchStartDate, SearchEndDate)
results.SortExpression = TranslateSortExpression(SortColumn)
results.SortDirection = IIf(SortDirection.Equals(SORT_DIRECTION_ASC), _
ConfirmationHeaderCollection.SortOrder.Ascending, _
ConfirmationHeaderCollection.SortOrder.Descending)
results.Sort(results)
dgResults.DataSource = results
dgResults.DataBind()
lblResultCount.Text = String.Format("{0} records found", results.Count.ToString("#,###,###"))
End Sub
Private Sub BindTransmissionTypes()
Dim transTypes As New TransTypeCollection
transTypes.Load()
ddlOrderType.DataSource = transTypes
ddlOrderType.DataTextField = "eb_trans_desc"
ddlOrderType.DataValueField = "eb_trans_type"
ddlOrderType.DataBind()
End Sub
Private Sub HideAllColumns()
For i As Integer = 0 To dgResults.Columns.Count - 1
dgResults.Columns(i).Visible = False
Next
End Sub
Private Sub ManageGridColumns()
HideAllColumns()
Dim columns() As String = GetColumnList()
For i As Integer = 0 To columns.Length - 1
Try
dgResults.Columns(CInt(columns(i))).Visible = True
Catch
' do nothing if an error is detected because it indicates a dirty cookie
End Try
Next
End Sub
Private Sub SetupColumnWindow()
Dim columns() As String = GetColumnList()
For i As Integer = 0 To columns.Length - 1
Try
Select Case CInt(columns(i))
Case COL_COLLECTOR
chkCollector.Checked = True
Case COL_CONF_NUM
chkAckNumber.Checked = True
Case COL_NODE_NUM
chkNodeNumber.Checked = True
Case COL_ORDER_TYPE
chkOrderType.Checked = True
Case COL_CUST_NUM
chkCustNumber.Checked = True
Case COL_CUST_NAME
chkCustName.Checked = True
Case COL_ERROR_IND
chkOrderExceptions.Checked = True
Case COL_DSR_NUM
chkDsrNumber.Checked = True
Case COL_DSR_NAME
chkDsrName.Checked = True
Case COL_DSM_NUM
chkDsmNumber.Checked = True
Case COL_DSM_NAME
chkDsmName.Checked = True
Case COL_CONTRACT
chkContract.Checked = True
Case COL_NA_NUM
chkNationalAcct.Checked = True
Case COL_NA_SUB
chkNatAcctSub.Checked = True
Case COL_INV_NUM
chkInvoiceNumber.Checked = True
Case COL_CONF_DATE
chkAckDateTime.Checked = True
Case COL_LINE_ITEMS
chkLineItem.Checked = True
Case COL_DELV_DATE
chkDeliveryDate.Checked = True
Case COL_SALES_AMT
chkSalesAmount.Checked = True
Case COL_BRANCH
chkBranch.Checked = True
Case Else
' do nothing
End Select
Catch
' do nothing because the entry is not an actual column number
' i.e. the cookie has dirty data
End Try
Next
End Sub
Private Sub SetDsmInfo()
If AuthenticatedUser.IsDsm Then
Dim theService As New DsmService.DsmService
theService.PreAuthenticate = True
theService.Credentials = New System.Net.NetworkCredential("someuser", "somepassword", "somedomain")
Dim myDsm As DsmService.Dsm = theService.GetDsmByName(AuthenticatedUser.FirstName, AuthenticatedUser.LastName)
If IsPostBack Then
SearchDsmNumber = myDsm.DsmNumber
Else
txtDsmNumber.Text = myDsm.DsmNumber
End If
txtDsmNumber.Enabled = False
Else
'txtDsmNumber.Text = String.Empty
SearchDsmNumber = String.Empty
txtDsmNumber.Enabled = True
End If
End Sub
Private Sub SetSearchWindow()
Try
ddlBranch.SelectedValue = SearchBranch
ddlCollectorType.SelectedValue = SearchCollector
txtAckNumber.Text = SearchConfirmationNumber
txtNationalAccountNumber.Text = SearchNationalAccountNumber
txtCustomerNumber.Text = SearchCustomerNumber
txtInvoiceNumber.Text = SearchInvoiceNumber
txtContract.Text = SearchContract
ddlOrderType.SelectedValue = SearchOrderType
txtDsrNumber.Text = SearchDsrNumber
txtDsmNumber.Text = SearchDsmNumber
ddlErrorCode.SelectedValue = SearchErrorType
txtStartDate.Text = SearchStartDate
calStartDate.SelectedDate = CDate(SearchStartDate)
txtEndDate.Text = SearchEndDate
calEndDate.SelectedDate = CDate(SearchEndDate)
Catch
' do nothing because an error would be caused by dirty data from the cookie
End Try
End Sub
Private Function TranslateSortExpression(ByVal SortExpression As String) As ConfirmationHeaderCollection.SortColumn
Dim retVal As ConfirmationHeaderCollection.SortColumn = ConfirmationHeaderCollection.SortColumn.eback_datetime
Select Case SortExpression
Case "ebcollector"
retVal = ConfirmationHeaderCollection.SortColumn.ebcollector
Case "eback"
retVal = ConfirmationHeaderCollection.SortColumn.eback
Case "ebnode"
retVal = ConfirmationHeaderCollection.SortColumn.ebnode
Case "ebordertype"
retVal = ConfirmationHeaderCollection.SortColumn.ebordertype
Case "ebcust"
retVal = ConfirmationHeaderCollection.SortColumn.ebcust
Case "CustomerName"
retVal = ConfirmationHeaderCollection.SortColumn.CustomerName
Case "eberror"
retVal = ConfirmationHeaderCollection.SortColumn.eberror
Case "ebslm"
retVal = ConfirmationHeaderCollection.SortColumn.ebslm
Case "DsrName"
retVal = ConfirmationHeaderCollection.SortColumn.DsrName
Case "DsmNumber"
retVal = ConfirmationHeaderCollection.SortColumn.DsmNumber
Case "DsmName"
retVal = ConfirmationHeaderCollection.SortColumn.DsmName
Case "ebcontract"
retVal = ConfirmationHeaderCollection.SortColumn.ebcontract
Case "ebna"
retVal = ConfirmationHeaderCollection.SortColumn.ebna
Case "ebnasub"
I think that I have found the answer. The cookie hasn't been removed in a while, so this looks like it. I tried several other things trying to find the issue, and I had finally given up on finding the solution by tweaking my code, so I took to the internet. It was on MS's website that I found this little gem.
If you do not set the cookie's expiration, the cookie is created but it is not stored on the user's hard disk. Instead, the cookie is maintained as part of the user's session information. When the user closes the browser, the cookie is discarded. A non-persistent cookie like this is useful for information that needs to be stored for only a short time or that for security reasons should not be written to disk on the client computer. For example, non-persistent cookies are useful if the user is working on a public computer, where you do not want to write the cookie to disk.
http://msdn.microsoft.com/en-us/library/ms178194.aspx
So the issue here is the fact that the cookie has an expiration date when the cookie is initially created. However, reading the cookie from the Request object does not include the expiration date. So, I fixed it by setting the expiration date before adding the cookie back to the Response object.

Resources