db connections and vb program

Question

cdata....

--------------

Imports System.IO

Imports System.Globalization

Imports System.Data.OleDb

Imports System.IO.Compression

Imports System.Data.SqlClient

Imports MySql.Data.MySqlClient

Imports System.Data.OracleClient

Public Class CDataAccess

Implements IDisposable

Dim cmd As OleDbCommand

Dim adpt As OleDbDataAdapter

Dim result_ds As New DataSet

Dim conn As OleDbConnection

Dim sql_cmd As SqlCommand

Dim sql_adpt As SqlDataAdapter

Dim sql_result_ds As New DataSet

Dim sql_conn As SqlConnection

Dim mysql_cmd As MySqlCommand

Dim mysql_adpt As MySqlDataAdapter

Dim mysql_result_ds As New DataSet

Dim mysql_conn As MySqlConnection

Public errorlogfile_name = "Secure_log" & Format(Now, "dd-MMM-yyyy")

Dim error_FileStream As Stream

Dim error_Stream As StreamWriter

Dim sqlqry As String

Dim result As Integer

Dim errorlockobj As New Object

Dim update_insert_delete_lockobj As New Object

Public MyConString As String

Public m_meterno As String

Public dateformat As String = System.Globalization.DateTimeFormatInfo.CurrentInfo.ShortDatePattern()

Private disposedValue As Boolean = False ' To detect redundant calls

' IDisposable

Protected Overridable Sub Dispose(ByVal disposing As Boolean)

If Not Me.disposedValue Then

If disposing Then

' TODO: free unmanaged resources when explicitly called

End If

' TODO: free shared unmanaged resources

End If

Me.disposedValue = True

End Sub

#Region " IDisposable Support "

' This code added by Visual Basic to correctly implement the disposable pattern.

Public Sub Dispose() Implements IDisposable.Dispose

' Do not change this code. Put cleanup code in Dispose(ByVal disposing As Boolean) above.

Dispose(True)

GC.SuppressFinalize(Me)

End Sub

#End Region

Public Overloads Function getdata(ByVal qry As String, ByVal strconnection As String) As DataSet

Try

conn = New OleDbConnection

conn.ConnectionString = strconnection

conn.Open()

result_ds.Tables.Clear()

result_ds.Clear()

adpt = New OleDbDataAdapter(qry, conn)

'adpt.Fill(result_ds, "Res")

adpt.Fill(result_ds)

Close_connection(conn)

'MsgBox(ds.Tables(0).Rows.Count)

Catch oraex As OleDbException

Me.write_error(oraex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), oraex.StackTrace)

Catch ex As Exception

write_error(ex.Message & qry & vbCrLf, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

If Not result_ds Is Nothing Then

If result_ds.Tables.Count > 0 Then

If result_ds.Tables(0).Rows.Count > 0 Then

Return result_ds.Copy

Else

Return result_ds

End If

Else

Return Nothing

End If

Else

Return Nothing

End If

End Function

Public Overloads Function sql_getdata(ByVal qry As String, ByVal strconnection As String) As DataSet

Try

sql_conn = New SqlClient.SqlConnection

sql_conn.ConnectionString = strconnection

sql_conn.Open()

sql_result_ds.Tables.Clear()

sql_result_ds.Clear()

sql_adpt = New SqlDataAdapter(qry, sql_conn)

'adpt.Fill(result_ds, "Res")

sql_adpt.Fill(sql_result_ds)

sql_Close_connection(sql_conn)

'MsgBox(ds.Tables(0).Rows.Count)

Catch sqlex As SqlException

Me.write_error(sqlex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), sqlex.StackTrace)

Catch ex As Exception

write_error(ex.Message & qry & vbCrLf, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

If Not result_ds Is Nothing Then

If result_ds.Tables.Count > 0 Then

If result_ds.Tables(0).Rows.Count > 0 Then

Return result_ds.Copy

Else

Return result_ds

End If

Else

Return Nothing

End If

Else

Return Nothing

End If

End Function

Public Overloads Function Mysql_getdata(ByVal qry As String, ByVal strconnection As String) As DataSet

Try

mysql_conn = New MySqlConnection

Mysql_conn.ConnectionString = strconnection

Mysql_conn.Open()

Mysql_result_ds.Tables.Clear()

Mysql_result_ds.Clear()

mysql_adpt = New MySqlDataAdapter(qry, mysql_conn)

'adpt.Fill(result_ds, "Res")

Mysql_adpt.Fill(Mysql_result_ds)

Mysql_Close_connection(Mysql_conn)

'MsgBox(ds.Tables(0).Rows.Count)

Catch sqlex As MySqlException

Me.write_error(sqlex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), sqlex.StackTrace)

Catch ex As Exception

write_error(ex.Message & qry & vbCrLf, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

If Not mysql_result_ds Is Nothing Then

If mysql_result_ds.Tables.Count > 0 Then

If mysql_result_ds.Tables(0).Rows.Count > 0 Then

Return mysql_result_ds.Copy

Else

Return mysql_result_ds

End If

Else

Return Nothing

End If

Else

Return Nothing

End If

End Function

Public Function Execute_ShellCommand(ByVal strShellCmd As String, ByVal strsearchstring As String) As Boolean

Dim objPSI As System.Diagnostics.ProcessStartInfo = New System.Diagnostics.ProcessStartInfo("cmd.exe")

Dim results As String = ""

Try

objPSI.UseShellExecute = False

objPSI.RedirectStandardOutput = True

objPSI.RedirectStandardInput = True

objPSI.RedirectStandardError = True

objPSI.WindowStyle = ProcessWindowStyle.Hidden

Dim proc As System.Diagnostics.Process = System.Diagnostics.Process.Start(objPSI)

'Attach the output for reading

Dim sOut As System.IO.StreamReader = proc.StandardOutput

'Attach the in for writing

Dim sIn As System.IO.StreamWriter = proc.StandardInput

'Write command to standard input

sIn.WriteLine(strShellCmd)

' sIn.WriteLine("unzip " & Chr(34) & "c:\AJAXEnabledSample.zip" & Chr(34) & " -l")

'Exit Command

sIn.WriteLine("EXIT")

proc.WaitForExit()

'Close the process

proc.Close()

While sOut.EndOfStream = False

results = results & (sOut.ReadLine() & vbCrLf)

' Application.DoEvents()

End While

'Read the sOut to a string.

' results = sOut.ReadToEnd().Trim()

If results.Contains(strsearchstring) = True Then

'Close the io Streams;

sOut.Close()

sOut.Dispose()

sIn.Close()

sIn.Dispose()

proc.Dispose()

Return True

Else

'Close the io Streams;

sOut.Close()

sOut.Dispose()

sIn.Close()

sIn.Dispose()

proc.Dispose()

write_error(results, Now.ToShortDateString(), strShellCmd)

Return False

End If

Catch ex As Exception

objPSI = Nothing

write_error(ex.Message, Now.ToShortDateString(), ex.StackTrace)

Finally

objPSI = Nothing

End Try

End Function

Public Overloads Function delete_update_insert(ByVal qry As String, ByVal strconnection As String) As Integer

SyncLock update_insert_delete_lockobj

Try

result = 0

conn = New OleDbConnection

conn.ConnectionString = strconnection

conn.Open()

cmd = New OleDbCommand(qry, conn)

result = cmd.ExecuteNonQuery()

cmd.Dispose()

Close_connection(conn)

Threading.Thread.Sleep(10)

'Catch oraex As OleDbException

' Me.write_error(oraex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), oraex.StackTrace)

Catch ex As Exception

Me.write_error(ex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), ex.StackTrace)

End Try

Return result

End SyncLock

End Function

Public Overloads Function sql_delete_update_insert(ByVal qry As String, ByVal strconnection As String) As Integer

SyncLock update_insert_delete_lockobj

Try

'Dim sql_conn As SqlClient.SqlConnection

'Dim sql_cmd As SqlClient.SqlCommand

result = 0

sql_conn = New SqlClient.SqlConnection

sql_conn.ConnectionString = strconnection

sql_conn.Open()

sql_cmd = New SqlClient.SqlCommand(qry, sql_conn)

result = sql_cmd.ExecuteNonQuery()

sql_cmd.Dispose()

sql_Close_connection(sql_conn)

Threading.Thread.Sleep(10)

'Catch oraex As OleDbException

' Me.write_error(oraex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), oraex.StackTrace)

Catch ex As Exception

Me.write_error(ex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), ex.StackTrace)

End Try

Return result

End SyncLock

End Function

Public Overloads Function mysql_delete_update_insert(ByVal qry As String, ByVal strconnection As String) As Integer

SyncLock update_insert_delete_lockobj

Try

'Dim mysql_conn As mysqlClient.mysqlConnection

'Dim mysql_cmd As mysqlClient.mysqlCommand

result = 0

mysql_conn = New MySqlConnection

mysql_conn.ConnectionString = strconnection

mysql_conn.Open()

mysql_cmd = New MySqlCommand(qry, mysql_conn)

result = mysql_cmd.ExecuteNonQuery()

mysql_cmd.Dispose()

mysql_Close_connection(mysql_conn)

Threading.Thread.Sleep(10)

'Catch oraex As OleDbException

' Me.write_error(oraex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), oraex.StackTrace)

Catch ex As Exception

Me.write_error(ex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), ex.StackTrace)

End Try

Return result

End SyncLock

End Function

Public Overloads Function sql_getcount(ByVal qry As String, ByVal strconnection As String) As Object

Try

sql_conn = New SqlConnection

sql_conn.ConnectionString = strconnection

sql_conn.Open()

sql_cmd = New SqlCommand(qry, sql_conn)

result = sql_cmd.ExecuteScalar()

sql_cmd.Dispose()

sql_Close_connection(sql_conn)

Catch sqlex As SqlException

Me.write_error(sqlex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), sqlex.StackTrace)

Catch ex As Exception

Me.write_error(ex.Message & qry & vbCrLf, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

Return result

End Function

Public Overloads Function mysql_getcount(ByVal qry As String, ByVal strconnection As String) As Object

Try

mysql_conn = New MySqlConnection

mysql_conn.ConnectionString = strconnection

mysql_conn.Open()

mysql_cmd = New MySqlCommand(qry, mysql_conn)

result = mysql_cmd.ExecuteScalar()

mysql_cmd.Dispose()

mysql_Close_connection(mysql_conn)

Catch mysqlex As MySqlException

Me.write_error(mysqlex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), mysqlex.StackTrace)

Catch ex As Exception

Me.write_error(ex.Message & qry & vbCrLf, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

Return result

End Function

Public Overloads Function getcount(ByVal qry As String, ByVal strconnection As String) As Object

Try

conn = New OleDbConnection

conn.ConnectionString = strconnection

conn.Open()

cmd = New OleDbCommand(qry, conn)

result = cmd.ExecuteScalar()

cmd.Dispose()

Close_connection(conn)

Catch oraex As OleDbException

Me.write_error(oraex.Message & vbCrLf & qry & vbCrLf, Now.ToShortDateString(), oraex.StackTrace)

Catch ex As Exception

Me.write_error(ex.Message & qry & vbCrLf, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

Return result

End Function

Public Overloads Function mysql_Close_connection(ByVal mycon As MySqlConnection) As Boolean

Try

mycon.Close()

mycon.Dispose()

Catch sqlex As MySqlException

Me.write_error(sqlex.Message, Now.ToShortDateString(), sqlex.StackTrace)

Return False

Catch ex As Exception

Me.write_error(ex.Message, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

Return False

End Try

Return True

End Function

Public Overloads Function sql_Close_connection(ByVal mycon As SqlConnection) As Boolean

Try

mycon.Close()

mycon.Dispose()

Catch sqlex As SqlException

Me.write_error(sqlex.Message, Now.ToShortDateString(), sqlex.StackTrace)

Return False

Catch ex As Exception

Me.write_error(ex.Message, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

Return False

End Try

Return True

End Function

Public Overloads Function Close_connection(ByVal mycon As OleDbConnection) As Boolean

Try

mycon.Close()

mycon.Dispose()

Catch oraex As OleDbException

Me.write_error(oraex.Message, Now.ToShortDateString(), oraex.StackTrace)

Return False

Catch ex As Exception

Me.write_error(ex.Message, Now.ToShortDateString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

Return False

End Try

Return True

End Function

Public Function write_error(ByVal errormessage As String, ByVal errortime As String, ByVal errorcodeline As String)

SyncLock errorlockobj

errorlogfile_name = "Error_Log" & Format(Now, "dd-MMM-yyyy")

Try

If Not errormessage.Contains("duplicate") Then

If Dir(Application.StartupPath & "\Error_Log", FileAttribute.Directory) = String.Empty Then

CreateFolder(Application.StartupPath & "\Error_Log")

End If

If System.IO.Directory.Exists(Application.StartupPath & "\Error_Log\" & errorlogfile_name & ".txt") Then

error_FileStream = IO.File.Open(Application.StartupPath & "\Error_Log\" & errorlogfile_name & ".txt", FileMode.OpenOrCreate, FileAccess.Write)

Else

error_FileStream = IO.File.Open(Application.StartupPath & "\Error_Log\" & errorlogfile_name & ".txt", FileMode.Append, FileAccess.Write)

End If

error_Stream = New StreamWriter(error_FileStream)

error_Stream.WriteLine("Error:" & errormessage & " Error Time:" & errortime & ":" & Now.ToShortTimeString() & " Error In Code" & errorcodeline)

error_Stream.WriteLine("------------------------------------------------------------------------------------------------------------")

error_Stream.Flush()

error_Stream.Close()

End If

Catch ex As Exception

'dataclass.write_error(ex.Message, Now.ToShortTimeString() & ":" & Now.ToShortTimeString(), ex.StackTrace)

End Try

End SyncLock

End Function

End Class

--------------------

main page

-------------------

 

Public Class test

Dim m_db As New CDataAccess

Private Sub loaddata()

Dim m_ds As New DataSet, i As Integer

lstClothStore.Items.Clear()

m_ds = dataclass.Mysql_getdata("select ind_billno,ind_wear,ind_age,ind_models,ind_size,ind_type,ind_quality,ind_cost from ind_cloth_store;", strconnection)

If Not m_ds Is Nothing Then

If m_ds.Tables(0).Rows.Count > 0 Then

For i = 0 To m_ds.Tables(0).Rows.Count - 1

lstClothStore.Items.Add(m_ds.Tables(0).Rows(i)("ind_billno").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_wear").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_age").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_models").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_size").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_type").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_quality").ToString.Trim)

lstClothStore.Items(i).SubItems.Add(m_ds.Tables(0).Rows(i)("ind_cost").ToString.Trim)

Next

End If

m_ds.Dispose()

m_ds = Nothing

End If

End Sub

Private Sub btnModify_Click(sender As Object, e As EventArgs) Handles btnModify.Click

If txtBillno.Text = "" Then

MsgBox("Selct a Valid From Billno type", MsgBoxStyle.Critical)

txtBillno.Focus()

Exit Sub

End If

If CmbWears.Text = "" Then

MsgBox("Selct a Valid From Wears type", MsgBoxStyle.Critical)

CmbWears.Focus()

Exit Sub

End If

If CmbAge.Text = "" Then

MsgBox("Selct a Valid From Age type", MsgBoxStyle.Critical)

CmbAge.Focus()

Exit Sub

End If

If CmbModel.Text = "" Then

MsgBox("Selct a Valid From Models type", MsgBoxStyle.Critical)

CmbModel.Focus()

Exit Sub

End If

If CmbSize.Text = "" Then

MsgBox("Selct a Valid From Size type", MsgBoxStyle.Critical)

CmbSize.Focus()

Exit Sub

End If

If CmbType.Text = "" Then

MsgBox("Selct a Valid From Type", MsgBoxStyle.Critical)

CmbType.Focus()

Exit Sub

End If

If CmbQuality.Text = "" Then

MsgBox("Selct a Valid From Quality Type", MsgBoxStyle.Critical)

CmbQuality.Focus()

Exit Sub

End If

If CmbCost.Text = "" Then

MsgBox("Selct a Valid From Cost Type", MsgBoxStyle.Critical)

CmbCost.Focus()

Exit Sub

End If

If CheckRecordAvailability(txtBillno.Text) = False Then

m_db.mysql_delete_update_insert("insert into ind_cloth_store(ind_billno,ind_wear,ind_age,ind_models,ind_size,ind_type,ind_quality,ind_cost)Value ('" & txtBillno.Text & "','" & CmbWears.Text & "','" & CmbAge.Text & "','" & CmbModel.Text & "','" & CmbSize.Text & "','" & CmbType.Text & "','" & CmbQuality.Text & "','" & CmbCost.Text & "')", strconnection)

MsgBox("Record Saved Successfully", MsgBoxStyle.Information)

Else

If txtBillno.Enabled = False Then

m_db.mysql_delete_update_insert("Update ind_cloth_store set ind_wear='" & CmbWears.Text & "', ind_age='" & CmbAge.Text & "', ind_models='" & CmbModel.Text & "', ind_size='" & CmbSize.Text & "',ind_type='" & CmbType.Text & "',ind_quality='" & CmbQuality.Text & "',ind_cost='" & CmbCost.Text & "' where ind_billno='" & txtBillno.Text & "';", strconnection)

MsgBox("Record Saved Successfully", MsgBoxStyle.Information)

Else

MsgBox("Record Already Exists", MsgBoxStyle.Information)

End If

End If

lstClothStore.Items.Clear()

loaddata()

End Sub

Private Function CheckRecordAvailability(ByVal strSource As String)

Dim m_ds As New DataSet, strqry As String = ""

strqry = "select * from ind_cloth_store where ind_billno='" & txtBillno.Text & "'"

m_ds = m_db.Mysql_getdata(strqry, strconnection)

If Not m_ds Is Nothing Then

If m_ds.Tables(0).Rows.Count = 0 Then

m_ds.Dispose()

Return False

Else

m_ds.Dispose()

Return True

End If

End If

End Function

Private Sub BtnExit_Click(sender As Object, e As EventArgs) Handles BtnExit.Click

Me.Close()

End Sub

Private Sub btnDeleteStage_Click(sender As Object, e As EventArgs) Handles btnDeleteStage.Click

If txtBillno.Text <> "" And txtBillno.Text <> "" Then

If MsgBox("Are You Sure You want to delete the Selected Record ", MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Items") = MsgBoxResult.Yes Then

m_db.mysql_delete_update_insert("delete from ind_cloth_store where ind_billno='" & txtBillno.Text & "';", strconnection)

''m_db.mysql_delete_update_insert("delete from ind_cloth_store;", strconnection)

MsgBox("Record(s) Deleted Successfully", MsgBoxStyle.Information)

lstClothStore.Items.Clear()

loaddata()

End If

Else

MsgBox("Select a record for Delete", MsgBoxStyle.Critical)

End If

End Sub

Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load

Dim m_ds As New DataSet, strqry As String = ""

Dim i As Integer

strqry = "select ind_wear,ind_age,ind_models,ind_size,ind_type,ind_quality,ind_cost from ind_cloth_store;"

m_ds = m_db.Mysql_getdata(strqry, strconnection)

If Not m_ds Is Nothing Then

If m_ds.Tables(0).Rows.Count > 0 Then

For i = 0 To m_ds.Tables(0).Rows.Count - 1

CmbWears.Items.Add(m_ds.Tables(0).Rows(i)(0))

CmbAge.Items.Add(m_ds.Tables(0).Rows(i)(1))

CmbModel.Items.Add(m_ds.Tables(0).Rows(i)(2))

CmbSize.Items.Add(m_ds.Tables(0).Rows(i)(3))

CmbType.Items.Add(m_ds.Tables(0).Rows(i)(4))

CmbQuality.Items.Add(m_ds.Tables(0).Rows(i)(5))

CmbCost.Items.Add(m_ds.Tables(0).Rows(i)(6))

Next i

End If

m_ds.Dispose()

End If

loaddata()

End Sub

Private Sub btnAddStage_Click(sender As Object, e As EventArgs) Handles btnAddStage.Click

Dim m_ds As New DataSet

txtBillno.Enabled = False

m_ds = m_db.Mysql_getdata("select max(CONVERT(ind_billno,UNSIGNED INTEGER)) from ind_cloth_store;", strconnection)

If Not m_ds Is Nothing Then

If m_ds.Tables(0).Rows.Count > 0 Then

txtBillno.Text = m_ds.Tables(0).Rows(0)(0) + 1

Else

txtBillno.Text = 1

End If

End If

End Sub

Private Sub lstClothStore_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lstClothStore.SelectedIndexChanged

If lstClothStore.SelectedItems.Count > 0 Then

txtBillno.Text = lstClothStore.SelectedItems(0).SubItems(0).Text

CmbWears.Text = lstClothStore.SelectedItems(0).SubItems(1).Text

CmbAge.Text = lstClothStore.SelectedItems(0).SubItems(2).Text

CmbModel.Text = lstClothStore.SelectedItems(0).SubItems(3).Text

CmbSize.Text = lstClothStore.SelectedItems(0).SubItems(4).Text

CmbType.Text = lstClothStore.SelectedItems(0).SubItems(5).Text

CmbQuality.Text = lstClothStore.SelectedItems(0).SubItems(6).Text

CmbCost.Text = lstClothStore.SelectedItems(0).SubItems(7).Text

txtBillno.Enabled = False

End If

End Sub

End Class

---------------------------------------------------------------------- 

 gobal

 -----------------------------------------------------------------------

Imports System

Imports System.IO

Imports System.Configuration

Imports System.Data

Module Globals

Public log_error As String

Public listlockObject As New Object

Public strconnection As String = ConfigurationManager.AppSettings.Item("SQLConstring") '"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Application.StartupPath & "\master.mdb;" 'Jet OLEDB:Database Password=633546280611"

Public m_main As New frmMain

Public m_glbportname As String

Public m_glbBaudrate As Integer = "115200"

Public m_Devicelist As New Hashtable

Public Hash_ipSocket As New Hashtable

Public m_BilledRecordLength As Integer = 305

' Public m_MaxOtherRecordSize As Integer = 305

Public m_OtherBilledRecordLength As Integer = 71

Public dataclass As New CDataAccess

Public Function CountCharacter(ByVal value As String, ByVal ch As Char) As Integer

Dim cnt As Integer = 0

For Each c As Char In value

If c = ch Then cnt += 1

Next

Return cnt

End Function

Public Function checkDate(ByVal m_date As String) As String

Try

If Convert.ToDouble(m_date.Substring(0, 2)) >= 1 And Convert.ToDouble(m_date.Substring(0, 2)) <= 12 Then

If Convert.ToDouble(m_date.Substring(3, 2)) >= 1 And Convert.ToDouble(m_date.Substring(3, 2)) <= 31 Then

If Convert.ToDouble(m_date.Substring(8, 2)) >= 0 And Convert.ToDouble(m_date.Substring(8, 2)) <= 99 Then

Return m_date

End If

Else

Return ""

End If

Else

Return ""

End If

Catch ex As Exception

Return " "

End Try

End Function

Public Function AddRightSpaces(ByVal m_SOURCE As String, ByVal LENGTH As Integer) As String

Dim i As Integer = 0

If m_SOURCE.Length > LENGTH Then

Return m_SOURCE.Substring(0, LENGTH)

End If

For i = 0 To LENGTH - 1

If m_SOURCE.Length < LENGTH Then

m_SOURCE = m_SOURCE & " "

Else

Exit For

End If

Next i

Return m_SOURCE

End Function

''Public Function WriteCollectionChecksum(ByVal xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet, ByVal rownumber As Integer, ByVal deviceid As String) As Boolean

'' Try

'' Dim i As Integer = 0, checksum1 As Double, strchecksum1 As String, checksum2 As Double, strchecksum2 As String

'' Dim checksum3 As Double, strchecksum3 As String, checksum4 As Double, strchecksum4 As String = "", checksum5 As Double, strchecksum5 As String = ""

'' For i = 2 To rownumber

'' checksum1 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 3).Value)))

'' checksum2 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 4).Value)))

'' checksum3 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 6).Value)))

'' checksum4 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 7).Value)))

'' Next

'' 'If checksum1 < 0 Then

'' ' checksum1 = -checksum1

'' 'End If

'' 'If checksum2 < 0 Then

'' ' checksum2 = -checksum2

'' 'End If

'' 'If checksum3 < 0 Then

'' ' checksum3 = -checksum3

'' 'End If

'' 'If checksum4 < 0 Then

'' ' checksum4 = -checksum4

'' 'End If

'' 'strchecksum1 = ((System.Math.Floor(checksum1) * 4123) + 675).ToString & GetDecimalpointValue(checksum1)

'' 'strchecksum1 = calculatelength(strchecksum1) & strchecksum1

'' 'strchecksum1 = strchecksum1 & Addallnumbers(strchecksum1)

'' 'strchecksum2 = ((System.Math.Floor(checksum2) * 4123) + 675).ToString & GetDecimalpointValue(checksum2)

'' 'strchecksum2 = calculatelength(strchecksum2) & strchecksum2

'' 'strchecksum2 = strchecksum2 & Addallnumbers(strchecksum2)

'' 'strchecksum3 = ((System.Math.Floor(checksum3) * 4123) + 675).ToString & GetDecimalpointValue(checksum3)

'' 'strchecksum3 = calculatelength(strchecksum3) & strchecksum3

'' 'strchecksum3 = strchecksum3 & Addallnumbers(strchecksum3)

'' 'strchecksum4 = ((System.Math.Floor(checksum4) * 4123) + 675).ToString & GetDecimalpointValue(checksum4)

'' 'strchecksum4 = calculatelength(strchecksum4) & strchecksum4

'' 'strchecksum4 = strchecksum4 & Addallnumbers(strchecksum4)

'' 'strchecksum5 = ((System.Math.Floor(xlWorkSheet.UsedRange.Rows.Count - 1) * 4123) + 675).ToString & GetDecimalpointValue(xlWorkSheet.UsedRange.Rows.Count - 1)

'' 'strchecksum5 = calculatelength(strchecksum5) & strchecksum5

'' 'strchecksum5 = strchecksum5 & Addallnumbers(strchecksum5)

'' 'checksum1 = 0

'' 'checksum2 = 0

'' 'checksum3 = 0

'' 'checksum4 = 0

'' 'For i = 2 To rownumber

'' ' checksum1 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 3).Value)))

'' ' checksum2 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 4).Value)))

'' ' checksum3 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 6).Value)))

'' ' checksum4 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 7).Value)))

'' 'Next

'' 'If checksum1 < 0 Then

'' ' strchecksum1 = -strchecksum1

'' 'End If

'' 'If checksum2 < 0 Then

'' ' strchecksum2 = -strchecksum2

'' 'End If

'' 'If checksum3 < 0 Then

'' ' strchecksum3 = -strchecksum3

'' 'End If

'' 'If checksum4 < 0 Then

'' ' strchecksum4 = -strchecksum4

'' 'End If

'' '' Dim m_encrypt As New Cryptography.EncryptDecrypt

'' 'xlWorkSheet.Cells(rownumber + 1, 1) = m_encrypt.encrypt(xlWorkSheet.UsedRange.Rows.Count - 1)

'' 'xlWorkSheet.Cells(rownumber + 1, 1).NumberFormat = "0"

'' 'xlWorkSheet.Cells(rownumber + 1, 3) = m_encrypt.encrypt(checksum1)

'' 'xlWorkSheet.Cells(rownumber + 1, 3).NumberFormat = "0"

'' 'xlWorkSheet.Cells(rownumber + 1, 4) = m_encrypt.encrypt(checksum2)

'' 'xlWorkSheet.Cells(rownumber + 1, 4).NumberFormat = "0"

'' 'xlWorkSheet.Cells(rownumber + 1, 5) = deviceid

'' 'xlWorkSheet.Cells(rownumber + 1, 5).NumberFormat = "0"

'' 'xlWorkSheet.Cells(rownumber + 1, 6) = m_encrypt.encrypt(checksum3)

'' 'xlWorkSheet.Cells(rownumber + 1, 6).NumberFormat = "0"

'' 'xlWorkSheet.Cells(rownumber + 1, 7) = m_encrypt.encrypt(checksum4)

'' 'xlWorkSheet.Cells(rownumber + 1, 7).NumberFormat = "0"

'' 'm_encrypt = Nothing

'' Catch ex As Exception

'' Return False

'' End Try

'' Return True

'' 'checksum = calculatelength() & ((System.Math.Floor(checksum) * 4193) + 675).ToString

''End Function

''Public Function calculateCustomerChecksum(ByVal xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet, ByVal rownumber As Integer) As Boolean

'' Try

'' Dim i As Integer = 0, checksum1 As Double, strchecksum1 As String, checksum2 As Double, strchecksum2 As String

'' Dim signchecksum1 As Double = 0, signchecksum2 As Double = 0

'' For i = 2 To rownumber - 1

'' checksum1 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 9).Value)))

'' checksum2 += System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(i, 10).Value)))

'' Application.DoEvents()

'' Next

'' signchecksum1 = checksum1

'' signchecksum2 = checksum2

'' 'If checksum1 < 0 Then

'' ' checksum1 = -checksum1

'' 'End If

'' 'If checksum2 < 0 Then

'' ' checksum2 = -checksum2

'' 'End If

'' 'strchecksum1 = ((System.Math.Floor(checksum1) * 4123) + 675).ToString & GetDecimalpointValue(checksum1)

'' 'strchecksum1 = calculatelength(strchecksum1) & strchecksum1

'' 'strchecksum1 = strchecksum1 & Addallnumbers(strchecksum1) & "A"

'' 'strchecksum2 = ((System.Math.Floor(checksum2) * 4123) + 675).ToString & GetDecimalpointValue(checksum2)

'' 'strchecksum2 = calculatelength(strchecksum2) & strchecksum2

'' 'strchecksum2 = strchecksum2 & Addallnumbers(strchecksum2) & "A"

'' 'If signchecksum1 < 0 Then

'' ' strchecksum1 = -strchecksum1

'' 'End If

'' 'If signchecksum2 < 0 Then

'' ' strchecksum2 = -strchecksum2

'' 'End If

'' '' Dim m_encrypt As New Cryptography.EncryptDecrypt

'' 'strchecksum1 = m_encrypt.encrypt(checksum1) & "A"

'' 'strchecksum2 = m_encrypt.encrypt(checksum2) & "A"

'' 'If Trim(strchecksum1) = Trim((xlWorkSheet.Cells(xlWorkSheet.UsedRange.Rows.Count, 9).Value)) Then

'' ' If Trim(strchecksum2) = Trim((xlWorkSheet.Cells(xlWorkSheet.UsedRange.Rows.Count, 10).Value)) Then

'' ' ' strchecksum2 = ((System.Math.Floor(System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(xlWorkSheet.UsedRange.Rows.Count - 1, 1).Value)))) * 4123) + 675).ToString & GetDecimalpointValue(System.Convert.ToDouble(Trim(CheckForZero(xlWorkSheet.Cells(xlWorkSheet.UsedRange.Rows.Count - 1, 1).Value))))

'' ' 'strchecksum2 = calculatelength(strchecksum2) & strchecksum2

'' ' 'strchecksum2 = strchecksum2 & Addallnumbers(strchecksum2) & "A"

'' ' strchecksum2 = m_encrypt.encrypt(xlWorkSheet.Cells(xlWorkSheet.UsedRange.Rows.Count - 1, 1).Value) & "A"

'' ' If Trim(strchecksum2) = Trim((xlWorkSheet.Cells(xlWorkSheet.UsedRange.Rows.Count, 3).Value)) Then

'' ' Return True

'' ' Else

'' ' Return False

'' ' End If

'' ' Else

'' ' Return False

'' ' End If

'' 'Else

'' ' Return False

'' 'End If

'' Catch ex As Exception

'' Return False

'' End Try

'' Return False

'' 'checksum = calculatelength() & ((System.Math.Floor(checksum) * 4193) + 675).ToString

''End Function

Public Function AlignMonth(ByVal m_month As String) As String

If m_month.Contains("M") Then

Return m_month

Else

If m_month.Substring(0, 1) = "0" Then

m_month = m_month.Substring(1, 1)

End If

Return "M" & m_month

End If

End Function

Public Function CheckForNull(ByVal m_Value As Object) As String

If Not m_Value Is Nothing Then

If m_Value Is DBNull.Value Then

Return " "

Else

Return m_Value

End If

Else

Return " "

End If

End Function

Public Function CheckForZero(ByVal m_Value As String) As String

Try

If Not m_Value Is Nothing Then

If IsNumeric(m_Value) Then

Return m_Value

Else

Return 0

End If

Else

Return 0

End If

Catch ex As Exception

Return 0

End Try

End Function

Public Sub releaseObject(ByVal obj As Object)

Try

System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)

obj = Nothing

Catch ex As Exception

obj = Nothing

Finally

GC.Collect()

End Try

End Sub

Public Function GetDecimalpointValue(ByVal m_value As Double) As String

Dim result As String = m_value.ToString

If result.Contains(".") = False Then

Return "00"

Else

result = result.Split(".")(1)

End If

End Function

Public Function calculatelength(ByVal strChecksum As String)

If strChecksum.Length > 9 Then

Return strChecksum.Length

Else

Return "9" & strChecksum.Length

End If

End Function

Public Function Addallnumbers(ByVal dblValue As String) As String

Dim i As Integer = 0, StrSum As Integer = 0

For i = 2 To dblValue.Length - 1

StrSum += dblValue.Substring(i, 1)

Next

Return StrSum

End Function

Public Function AddLeftZeros(ByVal m_SOURCE As String, ByVal LENGTH As Integer, ByVal noofdigits As Integer) As String

Dim i As Integer = 0

m_SOURCE = m_SOURCE * (10 ^ noofdigits)

For i = 0 To LENGTH - 1

If m_SOURCE.Length < LENGTH Then

m_SOURCE = "0" & m_SOURCE

Else

Exit For

End If

Next i

Return m_SOURCE

End Function

Public Function CreateFolder(ByVal strPath As String) As Boolean

Dim objDir As New DirectoryInfo(strPath)

Try

If Not objDir.Exists Then

objDir.Create()

Return True

Else

Return False

End If

Catch

Return False

End Try

End Function

Public Function deleteFolder(ByVal strPath As String) As Boolean

Dim objDir As New DirectoryInfo(strPath)

Try

If objDir.Exists Then

Dim m_fileinfo As FileInfo

For Each m_fileinfo In objDir.GetFiles("*.*", SearchOption.AllDirectories)

m_fileinfo.Delete()

Next

Return True

Else

Return False

End If

Catch

End Try

End Function

Public Function copyfile(ByVal srcfile As String, ByVal destfolder As String) As Boolean

Try

'Dim dirinfo As New DirectoryInfo(srcfolder)

'If dirinfo.Exists Then

'Dim fileinfo As FileInfo

' For Each fileinfo In dirinfo.GetFiles("*.*", SearchOption.AllDirectories)

System.IO.File.Copy(Application.StartupPath & "\temp\" & srcfile, destfolder & srcfile)

' Next

' End If

Catch Aceessex As UnauthorizedAccessException

log_error = Aceessex.Message

Return False

Catch ioex As IOException

log_error = ioex.Message

Return False

Catch ex As Exception

log_error = ex.Message

Return False

End Try

Return True

End Function

Public Function AlignmonthforPDA(ByVal m_month As String) As String

If m_month.Contains("M") Then

m_month = Trim(m_month.Replace("M", ""))

End If

If m_month.Length = 1 Then

m_month = "0" & m_month

End If

Return m_month

End Function

End Module