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
2 Replies
Know the answer? Post it — somebody with the same question will find it here.
Sign in to answer this question
It is the same account you read, post and publish with — and you will come straight back to this page.
Manas MohapatraPosted Dec 7, 2015, 12:56 AM
Nishant MittalPosted Dec 7, 2015, 12:43 AM