# Types of inner joins
* 1 Equi-join
1 Natural join
* 2 Cross join
# Outer joins
* 1 Left outer join
* 2 Right outer join
* 3 Full outer join
http://en.wikipedia.org/wiki/Join_(SQL)
Friday, 28 September 2007
Tuesday, 25 September 2007
file read/write
'get data from file(hard disc) and return as byte array
Public Function GetFileData() As Byte()
Try
Dim fsReader As New IO.FileStream(m_sFilePath, IO.FileMode.Open)
Dim data() As Byte = New Byte(fsReader.Length) {}
fsReader.Read(data, 0, fsReader.Length)
fsReader.Close()
Return data
Catch
Throw
End Try
End Function
'Write to file with byte array
Public Sub WriteFile(ByVal Data As Byte())
'Save file to disk (throw exception if exists already and OverwriteIfExists=False)
Dim sUploadPath As String = Workspace.FileStoreLocation.ToString()
m_sFilePath = System.IO.Path.Combine(sUploadPath, m_sFileName)
'Create an output File and write Data in to this
Dim stOutputStream As Stream = System.IO.File.Create(Filepath)
stOutputStream.Write(Data, 0, Data.Length)
stOutputStream.Close() 'Close stream
End Sub
'Delete file
Public Sub DeleteFile()
System.IO.File.Delete(m_sFilePath)
End Sub
'get file from URL(Web) , return byte array
Public Function GetURLData(ByVal URL As String) As Byte()
Dim Req As HttpWebRequest
Dim SourceStream As System.IO.Stream
Dim Response As HttpWebResponse
'create a web request to the URL
Req = HttpWebRequest.Create(URL)
'get a response from web site
Response = Req.GetResponse()
'Source stream with requested document
SourceStream = Response.GetResponseStream()
'SourceStream has no ReadAll, so we must read data block-by-block
'Temporary Buffer and block size
Dim Buffer(4096) As Byte, BlockSize As Integer
'Memory stream to store data
Dim TempStream As New MemoryStream
Do
BlockSize = SourceStream.Read(Buffer, 0, 4096)
If BlockSize > 0 Then TempStream.Write(Buffer, 0, BlockSize)
Loop While BlockSize > 0
'return the document binary data
Return TempStream.ToArray()
End Function
Public Function GetFileData() As Byte()
Try
Dim fsReader As New IO.FileStream(m_sFilePath, IO.FileMode.Open)
Dim data() As Byte = New Byte(fsReader.Length) {}
fsReader.Read(data, 0, fsReader.Length)
fsReader.Close()
Return data
Catch
Throw
End Try
End Function
'Write to file with byte array
Public Sub WriteFile(ByVal Data As Byte())
'Save file to disk (throw exception if exists already and OverwriteIfExists=False)
Dim sUploadPath As String = Workspace.FileStoreLocation.ToString()
m_sFilePath = System.IO.Path.Combine(sUploadPath, m_sFileName)
'Create an output File and write Data in to this
Dim stOutputStream As Stream = System.IO.File.Create(Filepath)
stOutputStream.Write(Data, 0, Data.Length)
stOutputStream.Close() 'Close stream
End Sub
'Delete file
Public Sub DeleteFile()
System.IO.File.Delete(m_sFilePath)
End Sub
'get file from URL(Web) , return byte array
Public Function GetURLData(ByVal URL As String) As Byte()
Dim Req As HttpWebRequest
Dim SourceStream As System.IO.Stream
Dim Response As HttpWebResponse
'create a web request to the URL
Req = HttpWebRequest.Create(URL)
'get a response from web site
Response = Req.GetResponse()
'Source stream with requested document
SourceStream = Response.GetResponseStream()
'SourceStream has no ReadAll, so we must read data block-by-block
'Temporary Buffer and block size
Dim Buffer(4096) As Byte, BlockSize As Integer
'Memory stream to store data
Dim TempStream As New MemoryStream
Do
BlockSize = SourceStream.Read(Buffer, 0, 4096)
If BlockSize > 0 Then TempStream.Write(Buffer, 0, BlockSize)
Loop While BlockSize > 0
'return the document binary data
Return TempStream.ToArray()
End Function
Upload file using FileUpload
check the link:
http://www.codeproject.com/useritems/ASPNET20FileUpload.asp
Sub UploadButton_Click(ByVal sender As Object, ByVal e As System.EventArgs)
' Before attempting to save the file, verify
' that the FileUpload control contains a file.
If (FileUpload1.HasFile) Then
' Call a helper method routine to save the file.
SaveFile(FileUpload1.PostedFile)
Else
' Notify the user that a file was not uploaded.
UploadStatusLabel.Text = "You did not specify a file to upload."
End If
End Sub
Sub SaveFile(ByVal file As HttpPostedFile)
' Specify the path to save the uploaded file to.
Dim savePath As String = "c:\temp\uploads\"
' Get the name of the file to upload.
Dim fileName As String = FileUpload1.FileName
' Create the path and file name to check for duplicates.
Dim pathToCheck As String = savePath + fileName
' Create a temporary file name to use for checking duplicates.
Dim tempfileName As String
' Check to see if a file already exists with the
' same name as the file to upload.
If (System.IO.File.Exists(pathToCheck)) Then
Dim counter As Integer = 2
While (System.IO.File.Exists(pathToCheck))
' If a file with this name already exists,
' prefix the filename with a number.
tempfileName = counter.ToString() + fileName
pathToCheck = savePath + tempfileName
counter = counter + 1
End While
fileName = tempfileName
' Notify the user that the file name was changed.
UploadStatusLabel.Text = "A file with the same name already exists." + "
" + _
"Your file was saved as " + fileName
Else
' Notify the user that the file was saved successfully.
UploadStatusLabel.Text = "Your file was uploaded successfully."
End If
' Append the name of the file to upload to the path.
savePath += fileName
' Call the SaveAs method to save the uploaded
' file to the specified directory.
FileUpload1.SaveAs(savePath)
End Sub
http://www.codeproject.com/useritems/ASPNET20FileUpload.asp
Sub UploadButton_Click(ByVal sender As Object, ByVal e As System.EventArgs)
' Before attempting to save the file, verify
' that the FileUpload control contains a file.
If (FileUpload1.HasFile) Then
' Call a helper method routine to save the file.
SaveFile(FileUpload1.PostedFile)
Else
' Notify the user that a file was not uploaded.
UploadStatusLabel.Text = "You did not specify a file to upload."
End If
End Sub
Sub SaveFile(ByVal file As HttpPostedFile)
' Specify the path to save the uploaded file to.
Dim savePath As String = "c:\temp\uploads\"
' Get the name of the file to upload.
Dim fileName As String = FileUpload1.FileName
' Create the path and file name to check for duplicates.
Dim pathToCheck As String = savePath + fileName
' Create a temporary file name to use for checking duplicates.
Dim tempfileName As String
' Check to see if a file already exists with the
' same name as the file to upload.
If (System.IO.File.Exists(pathToCheck)) Then
Dim counter As Integer = 2
While (System.IO.File.Exists(pathToCheck))
' If a file with this name already exists,
' prefix the filename with a number.
tempfileName = counter.ToString() + fileName
pathToCheck = savePath + tempfileName
counter = counter + 1
End While
fileName = tempfileName
' Notify the user that the file name was changed.
UploadStatusLabel.Text = "A file with the same name already exists." + "
" + _
"Your file was saved as " + fileName
Else
' Notify the user that the file was saved successfully.
UploadStatusLabel.Text = "Your file was uploaded successfully."
End If
' Append the name of the file to upload to the path.
savePath += fileName
' Call the SaveAs method to save the uploaded
' file to the specified directory.
FileUpload1.SaveAs(savePath)
End Sub
Storing Uploaded Files in a Database or in the File System
Link
http://imar.spaanjaars.com/QuickDocId.aspx?quickdoc=414
http://imar.spaanjaars.com/QuickDocId.aspx?quickdoc=414
sendmail
1. Add reference to System.Web.dll
Project > Add Reference... > .NET > System.Web.dll > Select > OK
2. should have smtpserver.
3. use the below code to send email.
Public Shared Sub SendMail(strFrom as String, strTo as String, strCC as String,
strSubject as String, strBody as String, strAttachments as String, strSMTPServer as String)
'send the email
Try
Dim insMail As New MailMessage()
With insMail
.From = strFrom
.To = strTo
.Subject = strSubject
.Body = strBody
.Cc = strCC
If Not strAttachments.Equals(String.Empty) Then
Dim strFile As String
Dim strAttach() As String = strAttachments.Split(";")
For Each strFile In strAttach
.Attachments.Add(New MailAttachment(strFile.Trim()))
Next
End If
End With
If Not strSMTPServer.Equals(String.Empty) Then
SmtpMail.SmtpServer = strSMTPServer
End If
SmtpMail.Send(insMail)
Catch e As Exception
Console.WriteLine(e.Message)
End Try
End Sub
Project > Add Reference... > .NET > System.Web.dll > Select > OK
2. should have smtpserver.
3. use the below code to send email.
Public Shared Sub SendMail(strFrom as String, strTo as String, strCC as String,
strSubject as String, strBody as String, strAttachments as String, strSMTPServer as String)
'send the email
Try
Dim insMail As New MailMessage()
With insMail
.From = strFrom
.To = strTo
.Subject = strSubject
.Body = strBody
.Cc = strCC
If Not strAttachments.Equals(String.Empty) Then
Dim strFile As String
Dim strAttach() As String = strAttachments.Split(";")
For Each strFile In strAttach
.Attachments.Add(New MailAttachment(strFile.Trim()))
Next
End If
End With
If Not strSMTPServer.Equals(String.Empty) Then
SmtpMail.SmtpServer = strSMTPServer
End If
SmtpMail.Send(insMail)
Catch e As Exception
Console.WriteLine(e.Message)
End Try
End Sub
Create, read, write and delete event logs in VB.NET
In .NET the EventLog class from the System.Diagnostics namespace lets you read from existing logs, write entries to logs, create or delete event sources, delete logs, and respond to log entries. This can be useful when errors occur within your code. This code shows how to use the EventLog class.
Imports System.Diagnostics
Dim aLog As EventLog
Dim myLog As New EventLog
Dim aEventLogList() As EventLog
Dim aLogEntry As EventLogEntry
Dim aLogEntries As EventLogEntryCollection
'
' Create a new log.
'
If Not EventLog.SourceExists("MyNewSource") Then
EventLog.CreateEventSource("MyNewSource", "MyNewLog")
End If
'
' Add an event to fire when an entry is written.
'
AddHandler myLog.EntryWritten, AddressOf OnEntryWritten
With myLog
.Source = "MyNewSource"
.Log = "MyNewLog"
.EnableRaisingEvents = True
'
' Write a few entries.
'
.WriteEntry("Writing Error entry to event log", EventLogEntryType.Error)
.WriteEntry("Writing Information entry to event", EventLogEntryType.Information)
.WriteEntry("Writing Warning entry to event", EventLogEntryType.Warning)
'
' Output all events in the new log.
'
aLogEntries = .Entries()
For Each aLogEntry In aLogEntries
With aLogEntry
Console.WriteLine( _
"Source: {0}" & vbCrLf & _
"Category: {1}" & vbCrLf & _
"Message: {2}" & vbCrLf & _
"EntryType: {3}" & vbCrLf & _
"EventID: {4}" & vbCrLf & _
"UserName: {5}", _
.Source, .Category, .Message, .EntryType, .EventID, .UserName)
End With
Next
'
' Delete your new log.
'
.Clear()
.Delete("MyNewLog")
'
' Output the names of all logs on the system.
'
aEventLogList = .GetEventLogs()
For Each aLog In aEventLogList
Console.WriteLine("Log name: " & aLog.LogDisplayName)
Next
End With
Public Sub OnEntryWritten(ByVal source As Object, ByVal e As EntryWrittenEventArgs)
Console.WriteLine(("Written: " + e.Entry.Message))
End Sub
Imports System.Diagnostics
Dim aLog As EventLog
Dim myLog As New EventLog
Dim aEventLogList() As EventLog
Dim aLogEntry As EventLogEntry
Dim aLogEntries As EventLogEntryCollection
'
' Create a new log.
'
If Not EventLog.SourceExists("MyNewSource") Then
EventLog.CreateEventSource("MyNewSource", "MyNewLog")
End If
'
' Add an event to fire when an entry is written.
'
AddHandler myLog.EntryWritten, AddressOf OnEntryWritten
With myLog
.Source = "MyNewSource"
.Log = "MyNewLog"
.EnableRaisingEvents = True
'
' Write a few entries.
'
.WriteEntry("Writing Error entry to event log", EventLogEntryType.Error)
.WriteEntry("Writing Information entry to event", EventLogEntryType.Information)
.WriteEntry("Writing Warning entry to event", EventLogEntryType.Warning)
'
' Output all events in the new log.
'
aLogEntries = .Entries()
For Each aLogEntry In aLogEntries
With aLogEntry
Console.WriteLine( _
"Source: {0}" & vbCrLf & _
"Category: {1}" & vbCrLf & _
"Message: {2}" & vbCrLf & _
"EntryType: {3}" & vbCrLf & _
"EventID: {4}" & vbCrLf & _
"UserName: {5}", _
.Source, .Category, .Message, .EntryType, .EventID, .UserName)
End With
Next
'
' Delete your new log.
'
.Clear()
.Delete("MyNewLog")
'
' Output the names of all logs on the system.
'
aEventLogList = .GetEventLogs()
For Each aLog In aEventLogList
Console.WriteLine("Log name: " & aLog.LogDisplayName)
Next
End With
Public Sub OnEntryWritten(ByVal source As Object, ByVal e As EntryWrittenEventArgs)
Console.WriteLine(("Written: " + e.Entry.Message))
End Sub
Using the Visual Studio .NET 2003 Debugger with ASP.NET Applications
the link goes here
http://msdn2.microsoft.com/en-us/library/aa290100(VS.71).aspx
http://msdn2.microsoft.com/en-us/library/aa290100(VS.71).aspx
Creating a Data Access Layer VS2005
Part1: http://www.asp.net/learn/data-access/tutorial-01-vb.aspx
Part2: http://msdn2.microsoft.com/en-us/library/aa581778.aspx
Part2: http://msdn2.microsoft.com/en-us/library/aa581778.aspx
ASP.NET Products, Freeware and Shareware
The link:
http://www.deitel.com/ResourceCenters/Programming/ASPNET/ASPNETProductsFreewareandShareware/tabid/371/Default.aspx
http://www.deitel.com/ResourceCenters/Programming/ASPNET/ASPNETProductsFreewareandShareware/tabid/371/Default.aspx
Using IIS with VS 2005 and the new Web Project system
How does IIS map applications and sites
good article available at: http://weblogs.asp.net/scottgu/archive/2005/08/23/423409.aspx
good article available at: http://weblogs.asp.net/scottgu/archive/2005/08/23/423409.aspx
Extract data from Websites.
I was'nt knowing that this can be done until I got the requirement to do this job.
good example for login in to rediff is here http://www.codeproject.com/useritems/kirangoka.asp
My code:
Imports mshtml
Imports System.Xml
Imports System.IO
Imports System.Data
Imports System.Data.SqlClient
Public Class getInspectorDetails
Const conStr As String = "Data Source=myservername1;Initial Catalog=Aslam_Test;User Id=sa; Password=mypass;"
'Dim conStrPostCode As String = "Data Source=myservername1;Initial Catalog=Common;User Id=sa; Password=mypassword2;"
Dim conn As SqlConnection = New SqlConnection(conStr)
Dim IntroducerName As String = ""
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
On Error Resume Next
Dim CertNum As String
Dim dr As SqlDataReader
If conn.State = ConnectionState.Closed Then
With conn
.Open()
End With
End If
Dim cmd As New SqlCommand
Dim sqlStr As String
cmd.Connection = conn
sqlStr = "Select distinct(Accreditation_Certification_Number) FROM [Aslam_Test].[dbo].[AssessorInspector]"
Accreditation_Certification_Number FROM InspectorDetails)"
sqlStr = sqlStr + " order by [Accreditation_Certification_Number]"
cmd.CommandText = sqlStr
cmd.CommandType = CommandType.Text
dr = cmd.ExecuteReader()
While dr.Read()
CloseAll()
CertNum = dr("Accreditation_Certification_Number")
Dim wbBrowser As New SHDocVw.InternetExplorer
'wbBrowser.Visible = True
wbBrowser.Visible = False
wbBrowser.Navigate("https://www.hcrregister.com/FindAssessorInspector", Nothing, Nothing, Nothing, Nothing)
Do
Loop Until Not wbBrowser.Busy
SearchForInspectorByCertNum(wbBrowser, CertNum)
ClickInspectorName(wbBrowser)
ReadAndRecordInspectorDetails(IntroducerName, CertNum)
wbBrowser.Quit()
wbBrowser = Nothing
End While
dr.Close()
dr = Nothing
cmd = Nothing
conn.Close()
conn = Nothing
MsgBox("Updated Database from HCR")
End Sub
Public Sub SearchForInspectorByCertNum(ByRef wbBrowser As SHDocVw.InternetExplorer, ByVal CertNum As String)
Dim HTMLDoc As mshtml.HTMLDocument
Do
Loop Until Not wbBrowser.Busy
HTMLDoc = wbBrowser.Document
Dim iHTMLCol As IHTMLElementCollection
Dim iHTMLEle As IHTMLElement
Dim str As String
iHTMLCol = HTMLDoc.getElementsByTagName("input")
' Type the user name in the username text box
For Each iHTMLEle In iHTMLCol
If Not iHTMLEle.getAttribute("name") Is Nothing Then
str = iHTMLEle.getAttribute("name").ToString
If str = "hiCertNumber" Then
iHTMLEle.setAttribute("value", CertNum)
Exit For
End If
End If
Next
' Press the submit button
For Each iHTMLEle In iHTMLCol
If Trim(iHTMLEle.outerHTML) = "" Then
iHTMLEle.click()
Exit For
End If
Next
Do
Loop Until Not wbBrowser.Busy
End Sub
'click on inspector link
Public Sub ClickInspectorName(ByRef wbBrowser As SHDocVw.InternetExplorer)
Dim HTMLDoc As mshtml.HTMLDocument
Do
Loop Until Not wbBrowser.Busy
HTMLDoc = wbBrowser.Document
Dim iHTMLCol As IHTMLElementCollection
iHTMLCol = HTMLDoc.links
iHTMLCol.item(13).click() 'click on link
IntroducerName = iHTMLCol.item(13).innerhtml
Do
Loop Until Not wbBrowser.Busy
End Sub
Public Sub ReadAndRecordInspectorDetails(ByVal name As String, ByVal CertNum As String)
On Error Resume Next
Dim wbBrowser As New SHDocVw.InternetExplorer
Dim winds As New SHDocVw.ShellWindows()
System.Threading.Thread.Sleep(2500)
Dim noIE As Boolean = False
For Each ie As SHDocVw.InternetExplorer In winds
If ie.MenuBar = False Then
'If ie.LocationURL = "https://www.hcrregister.com/FindAssessorInspector" And CInt(ie.Height) = 583 And CInt(ie.Width) = 512 Then
wbBrowser = ie
noIE = True
Exit For
'Else
' ie.Quit()
End If
Next
If noIE = True Then
Dim HTMLDoc As mshtml.HTMLDocument
Do
Loop Until Not wbBrowser.Busy
HTMLDoc = wbBrowser.Document
Dim iHTMLCol As IHTMLElementCollection 'for rows
Dim cell As IHTMLElement
iHTMLCol = HTMLDoc.getElementsByTagName("tr")
Dim i As HTMLTableRow
Dim iCountRow As Integer
Dim Inspectors(,) As String
ReDim Inspectors(iHTMLCol.length - 1, 4)
Dim tmpArr() As String
For Each i In iHTMLCol
cell = i.cells.item(0)
If Not i.cells.item(1) Is Nothing Then
If cell.innerText Is Nothing Then
Inspectors(iCountRow, 0) = ""
Else
tmpArr = cell.innerText.Split(". ")
Inspectors(iCountRow, 0) = Trim(tmpArr(tmpArr.Length - 1))
End If
cell = i.cells.item(1)
If cell.innerText Is Nothing Then
Inspectors(iCountRow, 1) = ""
Else
Inspectors(iCountRow, 1) = cell.innerText
End If
iCountRow = iCountRow + 1
End If
Next
If iCountRow > 0 Then
Dim connNew As SqlConnection = New SqlConnection(conStr)
If connNew.State = ConnectionState.Closed Then
With connNew
.Open()
End With
End If
Dim cmdInspectorInsert As New SqlCommand
cmdInspectorInsert.Connection = connNew
cmdInspectorInsert.CommandType = CommandType.StoredProcedure
cmdInspectorInsert.CommandText = "sp_InspectorDetails_save"
cmdInspectorInsert.Parameters.Clear()
cmdInspectorInsert.Parameters.Add("Name", SqlDbType.VarChar).Value = name
cmdInspectorInsert.Parameters.Add("Accreditation_Certification_Number", SqlDbType.VarChar).Value = Inspectors(0, 1)
cmdInspectorInsert.Parameters.Add("Status", SqlDbType.VarChar).Value = Inspectors(1, 1)
cmdInspectorInsert.Parameters.Add("Accreditation_Certification_Date", SqlDbType.DateTime).Value = Inspectors(2, 1)
cmdInspectorInsert.Parameters.Add("CompanyName", SqlDbType.VarChar).Value = Inspectors(3, 1)
cmdInspectorInsert.Parameters.Add("PostcodeCoverage", SqlDbType.VarChar).Value = Inspectors(4, 1)
cmdInspectorInsert.Parameters.Add("Qualifications", SqlDbType.VarChar).Value = Inspectors(5, 1)
cmdInspectorInsert.Parameters.Add("Specialisms", SqlDbType.VarChar).Value = Inspectors(6, 1)
cmdInspectorInsert.Parameters.Add("AddressLine1", SqlDbType.VarChar).Value = Inspectors(7, 1)
cmdInspectorInsert.Parameters.Add("AddressLine2", SqlDbType.VarChar).Value = Inspectors(8, 1)
cmdInspectorInsert.Parameters.Add("AddressLine3", SqlDbType.VarChar).Value = Inspectors(9, 1)
cmdInspectorInsert.Parameters.Add("PostTown", SqlDbType.VarChar).Value = Inspectors(10, 1)
cmdInspectorInsert.Parameters.Add("postcode", SqlDbType.VarChar).Value = Inspectors(11, 1)
cmdInspectorInsert.Parameters.Add("Website", SqlDbType.VarChar).Value = Inspectors(12, 1)
cmdInspectorInsert.Parameters.Add("Email", SqlDbType.VarChar).Value = Inspectors(13, 1)
cmdInspectorInsert.Parameters.Add("Telephone", SqlDbType.VarChar).Value = Inspectors(14, 1)
cmdInspectorInsert.Parameters.Add("Fax", SqlDbType.VarChar).Value = Inspectors(15, 1)
cmdInspectorInsert.ExecuteNonQuery()
cmdInspectorInsert = Nothing
connNew.Close()
connNew = Nothing
End If
Do
Loop Until Not wbBrowser.Busy
wbBrowser.Quit()
wbBrowser = Nothing
End If
End Sub
Public Sub CloseAll()
'Dim wbBrowser As New SHDocVw.InternetExplorer
'Dim winds As New SHDocVw.ShellWindows()
'For Each ie As SHDocVw.InternetExplorer In winds
' If ie.MenuBar = False Then
' ie.Quit()
' End If
'Next
End Sub
End Class
good example for login in to rediff is here http://www.codeproject.com/useritems/kirangoka.asp
My code:
Imports mshtml
Imports System.Xml
Imports System.IO
Imports System.Data
Imports System.Data.SqlClient
Public Class getInspectorDetails
Const conStr As String = "Data Source=myservername1;Initial Catalog=Aslam_Test;User Id=sa; Password=mypass;"
'Dim conStrPostCode As String = "Data Source=myservername1;Initial Catalog=Common;User Id=sa; Password=mypassword2;"
Dim conn As SqlConnection = New SqlConnection(conStr)
Dim IntroducerName As String = ""
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
On Error Resume Next
Dim CertNum As String
Dim dr As SqlDataReader
If conn.State = ConnectionState.Closed Then
With conn
.Open()
End With
End If
Dim cmd As New SqlCommand
Dim sqlStr As String
cmd.Connection = conn
sqlStr = "Select distinct(Accreditation_Certification_Number) FROM [Aslam_Test].[dbo].[AssessorInspector]"
Accreditation_Certification_Number FROM InspectorDetails)"
sqlStr = sqlStr + " order by [Accreditation_Certification_Number]"
cmd.CommandText = sqlStr
cmd.CommandType = CommandType.Text
dr = cmd.ExecuteReader()
While dr.Read()
CloseAll()
CertNum = dr("Accreditation_Certification_Number")
Dim wbBrowser As New SHDocVw.InternetExplorer
'wbBrowser.Visible = True
wbBrowser.Visible = False
wbBrowser.Navigate("https://www.hcrregister.com/FindAssessorInspector", Nothing, Nothing, Nothing, Nothing)
Do
Loop Until Not wbBrowser.Busy
SearchForInspectorByCertNum(wbBrowser, CertNum)
ClickInspectorName(wbBrowser)
ReadAndRecordInspectorDetails(IntroducerName, CertNum)
wbBrowser.Quit()
wbBrowser = Nothing
End While
dr.Close()
dr = Nothing
cmd = Nothing
conn.Close()
conn = Nothing
MsgBox("Updated Database from HCR")
End Sub
Public Sub SearchForInspectorByCertNum(ByRef wbBrowser As SHDocVw.InternetExplorer, ByVal CertNum As String)
Dim HTMLDoc As mshtml.HTMLDocument
Do
Loop Until Not wbBrowser.Busy
HTMLDoc = wbBrowser.Document
Dim iHTMLCol As IHTMLElementCollection
Dim iHTMLEle As IHTMLElement
Dim str As String
iHTMLCol = HTMLDoc.getElementsByTagName("input")
' Type the user name in the username text box
For Each iHTMLEle In iHTMLCol
If Not iHTMLEle.getAttribute("name") Is Nothing Then
str = iHTMLEle.getAttribute("name").ToString
If str = "hiCertNumber" Then
iHTMLEle.setAttribute("value", CertNum)
Exit For
End If
End If
Next
' Press the submit button
For Each iHTMLEle In iHTMLCol
If Trim(iHTMLEle.outerHTML) = "" Then
iHTMLEle.click()
Exit For
End If
Next
Do
Loop Until Not wbBrowser.Busy
End Sub
'click on inspector link
Public Sub ClickInspectorName(ByRef wbBrowser As SHDocVw.InternetExplorer)
Dim HTMLDoc As mshtml.HTMLDocument
Do
Loop Until Not wbBrowser.Busy
HTMLDoc = wbBrowser.Document
Dim iHTMLCol As IHTMLElementCollection
iHTMLCol = HTMLDoc.links
iHTMLCol.item(13).click() 'click on link
IntroducerName = iHTMLCol.item(13).innerhtml
Do
Loop Until Not wbBrowser.Busy
End Sub
Public Sub ReadAndRecordInspectorDetails(ByVal name As String, ByVal CertNum As String)
On Error Resume Next
Dim wbBrowser As New SHDocVw.InternetExplorer
Dim winds As New SHDocVw.ShellWindows()
System.Threading.Thread.Sleep(2500)
Dim noIE As Boolean = False
For Each ie As SHDocVw.InternetExplorer In winds
If ie.MenuBar = False Then
'If ie.LocationURL = "https://www.hcrregister.com/FindAssessorInspector" And CInt(ie.Height) = 583 And CInt(ie.Width) = 512 Then
wbBrowser = ie
noIE = True
Exit For
'Else
' ie.Quit()
End If
Next
If noIE = True Then
Dim HTMLDoc As mshtml.HTMLDocument
Do
Loop Until Not wbBrowser.Busy
HTMLDoc = wbBrowser.Document
Dim iHTMLCol As IHTMLElementCollection 'for rows
Dim cell As IHTMLElement
iHTMLCol = HTMLDoc.getElementsByTagName("tr")
Dim i As HTMLTableRow
Dim iCountRow As Integer
Dim Inspectors(,) As String
ReDim Inspectors(iHTMLCol.length - 1, 4)
Dim tmpArr() As String
For Each i In iHTMLCol
cell = i.cells.item(0)
If Not i.cells.item(1) Is Nothing Then
If cell.innerText Is Nothing Then
Inspectors(iCountRow, 0) = ""
Else
tmpArr = cell.innerText.Split(". ")
Inspectors(iCountRow, 0) = Trim(tmpArr(tmpArr.Length - 1))
End If
cell = i.cells.item(1)
If cell.innerText Is Nothing Then
Inspectors(iCountRow, 1) = ""
Else
Inspectors(iCountRow, 1) = cell.innerText
End If
iCountRow = iCountRow + 1
End If
Next
If iCountRow > 0 Then
Dim connNew As SqlConnection = New SqlConnection(conStr)
If connNew.State = ConnectionState.Closed Then
With connNew
.Open()
End With
End If
Dim cmdInspectorInsert As New SqlCommand
cmdInspectorInsert.Connection = connNew
cmdInspectorInsert.CommandType = CommandType.StoredProcedure
cmdInspectorInsert.CommandText = "sp_InspectorDetails_save"
cmdInspectorInsert.Parameters.Clear()
cmdInspectorInsert.Parameters.Add("Name", SqlDbType.VarChar).Value = name
cmdInspectorInsert.Parameters.Add("Accreditation_Certification_Number", SqlDbType.VarChar).Value = Inspectors(0, 1)
cmdInspectorInsert.Parameters.Add("Status", SqlDbType.VarChar).Value = Inspectors(1, 1)
cmdInspectorInsert.Parameters.Add("Accreditation_Certification_Date", SqlDbType.DateTime).Value = Inspectors(2, 1)
cmdInspectorInsert.Parameters.Add("CompanyName", SqlDbType.VarChar).Value = Inspectors(3, 1)
cmdInspectorInsert.Parameters.Add("PostcodeCoverage", SqlDbType.VarChar).Value = Inspectors(4, 1)
cmdInspectorInsert.Parameters.Add("Qualifications", SqlDbType.VarChar).Value = Inspectors(5, 1)
cmdInspectorInsert.Parameters.Add("Specialisms", SqlDbType.VarChar).Value = Inspectors(6, 1)
cmdInspectorInsert.Parameters.Add("AddressLine1", SqlDbType.VarChar).Value = Inspectors(7, 1)
cmdInspectorInsert.Parameters.Add("AddressLine2", SqlDbType.VarChar).Value = Inspectors(8, 1)
cmdInspectorInsert.Parameters.Add("AddressLine3", SqlDbType.VarChar).Value = Inspectors(9, 1)
cmdInspectorInsert.Parameters.Add("PostTown", SqlDbType.VarChar).Value = Inspectors(10, 1)
cmdInspectorInsert.Parameters.Add("postcode", SqlDbType.VarChar).Value = Inspectors(11, 1)
cmdInspectorInsert.Parameters.Add("Website", SqlDbType.VarChar).Value = Inspectors(12, 1)
cmdInspectorInsert.Parameters.Add("Email", SqlDbType.VarChar).Value = Inspectors(13, 1)
cmdInspectorInsert.Parameters.Add("Telephone", SqlDbType.VarChar).Value = Inspectors(14, 1)
cmdInspectorInsert.Parameters.Add("Fax", SqlDbType.VarChar).Value = Inspectors(15, 1)
cmdInspectorInsert.ExecuteNonQuery()
cmdInspectorInsert = Nothing
connNew.Close()
connNew = Nothing
End If
Do
Loop Until Not wbBrowser.Busy
wbBrowser.Quit()
wbBrowser = Nothing
End If
End Sub
Public Sub CloseAll()
'Dim wbBrowser As New SHDocVw.InternetExplorer
'Dim winds As New SHDocVw.ShellWindows()
'For Each ie As SHDocVw.InternetExplorer In winds
' If ie.MenuBar = False Then
' ie.Quit()
' End If
'Next
End Sub
End Class
Encryption/Decryption with Base64
Copied from http://addressof.com/blog/archive/2004/10/19/997.aspx
Private Function TripleDESEncode(ByVal value As String, ByVal key As String) As String
Dim des As New Security.Cryptography.TripleDESCryptoServiceProvider
des.IV = New Byte(7) {}
Dim pdb As New Security.Cryptography.PasswordDeriveBytes(key, New Byte(-1) {})
des.Key = pdb.CryptDeriveKey("RC2", "MD5", 128, New Byte(7) {})
Dim ms As New IO.MemoryStream((value.Length * 2) - 1)
Dim encStream As New Security.Cryptography.CryptoStream(ms, des.CreateEncryptor(), Security.Cryptography.CryptoStreamMode.Write)
Dim plainBytes As Byte() = Text.Encoding.UTF8.GetBytes(value)
encStream.Write(plainBytes, 0, plainBytes.Length)
encStream.FlushFinalBlock()
Dim encryptedBytes(CInt(ms.Length - 1)) As Byte
ms.Position = 0
ms.Read(encryptedBytes, 0, CInt(ms.Length))
encStream.Close()
Return Convert.ToBase64String(encryptedBytes)
End Function
Public Function TripleDESDecode(ByVal value As String, ByVal key As String) As String
Dim des As New Security.Cryptography.TripleDESCryptoServiceProvider
des.IV = New Byte(7) {}
Dim pdb As New Security.Cryptography.PasswordDeriveBytes(key, New Byte(-1) {})
des.Key = pdb.CryptDeriveKey("RC2", "MD5", 128, New Byte(7) {})
Dim encryptedBytes As Byte() = Convert.FromBase64String(value)
Dim ms As New IO.MemoryStream(value.Length)
Dim decStream As New Security.Cryptography.CryptoStream(ms, des.CreateDecryptor(), Security.Cryptography.CryptoStreamMode.Write)
decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
decStream.FlushFinalBlock()
Dim plainBytes(CInt(ms.Length - 1)) As Byte
ms.Position = 0
ms.Read(plainBytes, 0, CInt(ms.Length))
decStream.Close()
Return Text.Encoding.UTF8.GetString(plainBytes)
End Function
TEST This from:
Sub Main()
Dim key As String = "a1B@c3D$"
Dim original As String = "This is a test, blah, blah, blah."
Console.WriteLine("Original" & vbCrLf & "-----------------")
Console.WriteLine(original & vbCrLf)
Dim encrypted As String = TripleDESEncode(original, key)
Console.WriteLine("Encrypted" & vbCrLf & "-----------------")
Console.WriteLine(encrypted & vbCrLf)
Dim decrypted As String = TripleDESDecode(encrypted, key)
Console.WriteLine("Decrypted" & vbCrLf & "-----------------")
Console.WriteLine(decrypted & vbCrLf)
Console.ReadLine()
End Sub
Private Function TripleDESEncode(ByVal value As String, ByVal key As String) As String
Dim des As New Security.Cryptography.TripleDESCryptoServiceProvider
des.IV = New Byte(7) {}
Dim pdb As New Security.Cryptography.PasswordDeriveBytes(key, New Byte(-1) {})
des.Key = pdb.CryptDeriveKey("RC2", "MD5", 128, New Byte(7) {})
Dim ms As New IO.MemoryStream((value.Length * 2) - 1)
Dim encStream As New Security.Cryptography.CryptoStream(ms, des.CreateEncryptor(), Security.Cryptography.CryptoStreamMode.Write)
Dim plainBytes As Byte() = Text.Encoding.UTF8.GetBytes(value)
encStream.Write(plainBytes, 0, plainBytes.Length)
encStream.FlushFinalBlock()
Dim encryptedBytes(CInt(ms.Length - 1)) As Byte
ms.Position = 0
ms.Read(encryptedBytes, 0, CInt(ms.Length))
encStream.Close()
Return Convert.ToBase64String(encryptedBytes)
End Function
Public Function TripleDESDecode(ByVal value As String, ByVal key As String) As String
Dim des As New Security.Cryptography.TripleDESCryptoServiceProvider
des.IV = New Byte(7) {}
Dim pdb As New Security.Cryptography.PasswordDeriveBytes(key, New Byte(-1) {})
des.Key = pdb.CryptDeriveKey("RC2", "MD5", 128, New Byte(7) {})
Dim encryptedBytes As Byte() = Convert.FromBase64String(value)
Dim ms As New IO.MemoryStream(value.Length)
Dim decStream As New Security.Cryptography.CryptoStream(ms, des.CreateDecryptor(), Security.Cryptography.CryptoStreamMode.Write)
decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
decStream.FlushFinalBlock()
Dim plainBytes(CInt(ms.Length - 1)) As Byte
ms.Position = 0
ms.Read(plainBytes, 0, CInt(ms.Length))
decStream.Close()
Return Text.Encoding.UTF8.GetString(plainBytes)
End Function
TEST This from:
Sub Main()
Dim key As String = "a1B@c3D$"
Dim original As String = "This is a test, blah, blah, blah."
Console.WriteLine("Original" & vbCrLf & "-----------------")
Console.WriteLine(original & vbCrLf)
Dim encrypted As String = TripleDESEncode(original, key)
Console.WriteLine("Encrypted" & vbCrLf & "-----------------")
Console.WriteLine(encrypted & vbCrLf)
Dim decrypted As String = TripleDESDecode(encrypted, key)
Console.WriteLine("Decrypted" & vbCrLf & "-----------------")
Console.WriteLine(decrypted & vbCrLf)
Console.ReadLine()
End Sub
Subscribe to:
Posts (Atom)