rahmatdcc.blogspot.com

Imports MySql.Data.MySqlClient
Imports System.IO

Module modFungsi
    Public result As String
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand

    Public Sub DeleteFile(namaFile As String)
        Try
            If File.Exists(namaFile) Then
                File.Delete(namaFile)
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Public Sub LogValidasi(Lv As ListView, kode As String, nama As String, err As String)
        Dim ls As New ListViewItem()
        ls.SubItems.Add(kode)
        ls.SubItems.Add(nama)
        ls.SubItems.Add(err)
        Lv.Items.Add(ls)
    End Sub
    Public Sub SimpanValidasi(id As String, kode As String, nama As String, err As String)

        Dim strSql As String
        strSql = "INSERT INTO temp_slik_error SET " & _
                 "temp_id = '" & id & "', temp_kode  = '" & kode & _
                 "', temp_nama = '" & nama & "', temp_error = '" & err & "'"
        Try
            With cmd2
                .Connection = conn
                .CommandTimeout = 0
                .CommandText = strSql

                'execute the data
            End With
            result = cmd2.ExecuteNonQuery

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Function TimeDifCalc(d1 As DateTime, d2 As DateTime)
        d1 = DateTime.Parse(d1)
        d2 = DateTime.Parse(d2)
        Dim difference As TimeSpan = d2 - d1
        'round down total hours to integer'
        Dim hours = Math.Floor(difference.TotalHours)
        Dim minutes = Math.Abs(difference.Minutes)
        Dim seconds = difference.Seconds
        Dim timeleft As String = Format(hours, "00") + " h " + Format(minutes, "00") + " m " + Format(seconds, "00") + " s "
        If Int(seconds) < 0 Then
            timeleft = "00 h 00 m 00 s (Time Out)"
        End If
        Return timeleft

    End Function
    Function LastDayOfMonth(aDate As DateTime) As Date
        Return New DateTime(aDate.Year, _
                            aDate.Month, _
                            DateTime.DaysInMonth(aDate.Year, aDate.Month))
    End Function

    Sub PesanHapus()
        MsgBox("Data telah dihapus", MsgBoxStyle.Information, Application.ProductName)
    End Sub
    Sub PesanSimpan()
        MsgBox("Data telah disimpan", MsgBoxStyle.Information, Application.ProductName)
    End Sub
    Function strReplace(str As String, vOld As String, vNew As String)
        str = str.Replace(vOld, vNew)
        Return str
    End Function
    Function strReplaceKolek(str As String)
        On Error Resume Next
        str = str.Replace("L", "1")
        str = str.Replace("KL", "3")
        str = str.Replace("D", "4")
        str = str.Replace("M", "5")
        Return str
    End Function
    Function strReplaceBadan(str As String)
        On Error Resume Next
        str = str.Replace("PT", "")
        str = str.Replace("KOPERASI", "")
        str = str.Replace("CV", "")
        str = str.Replace("UD", "")
        str = str.Replace(".", "")
        str = str.Replace("-", "")
        Return str
    End Function
    Function strReplaceSlik(str As String)
        On Error Resume Next
        If Len(str) > 0 Then
            str = str.Replace(".", "")
            str = str.Replace(",", "")
            str = str.Replace(":", "")
            str = str.Replace(";", "")
            str = str.Replace("-", "")
            str = str.Replace("/", "")
            str = str.Replace("\", "")
            str = str.Replace("?", "")
            str = str.Replace("+", "")
            str = str.Replace("_", "")
            str = str.Replace("  ", "")
            str = str.Replace("   ", "")
            str = str.Replace("'", "")
            str = str.Replace("*", "")
            str = str.Replace("**", "")
            str = str.Replace("***", "")
            str = str.Replace("****", "")
        End If
        Return str
    End Function
    Function tbPersen(oText As TextBox)
        oText.Text = fDesimal(oText.Text)
        oText.Select(oText.Text.Length, 0)
        Return oText.Text
    End Function
    Function tbRupiah(oText As TextBox)
        oText.Text = fRupiah(oText.Text)
        oText.Select(oText.Text.Length, 0)
        Return oText.Text
    End Function
    Function fDbDesimal(byText As String)
        Dim angka As String
        angka = Replace(byText, ",", ".")
        Return angka
    End Function
    Function fDesimal(byText As Decimal)
        Dim angka As String
        angka = Format(byText, "#,##0.#0")
        Return angka
    End Function
    Function fInteger(ByVal byText As Integer)
        Dim angka As Integer
        angka = Convert.ToInt32(angka)
        Return angka
    End Function
    Function fRupiah(byText As Double)
        Dim angka As String
        angka = Format(byText, "#,##0")
        Return angka
    End Function
    Function fDbRupiah(byText As String)
        Dim angka As String
        angka = Replace(byText, ".", "")
        Return angka
    End Function
    Function FormatTglDb(ByVal byText As Date)
        Dim tanggal As String
        tanggal = Format(byText, "yyyy-MM-dd")
        Return tanggal
    End Function
    Function FormatTgl(byText As Date)
        Dim tanggal As String
        tanggal = Format(byText, "dd-MM-yyyy")
        Return tanggal
    End Function
    Public Sub ClearTB(frm As Form)

        For Each Control In frm.Controls
            If TypeOf Control Is TextBox Then Control.Text = ""
            If TypeOf Control Is ComboBox Then Control.text = ""
            If TypeOf Control Is Date Then Control.value = Now
        Next Control

    End Sub
    Function sLeft(ByVal Str As String, ByVal Len1 As Integer)
        Str = Left(Str, Len1)
        Return Str
    End Function
    Function sMid(ByVal Val As String, ByVal Len As Integer)
        Return Val.Substring(Val.Length / 2 - Len / 2, Len)
    End Function

    Function sRight(ByVal Val As String, ByVal Len As Integer)
        Return Val.Substring(Val.Length - Len, Len)
    End Function
    'Fungsi split string
    'Tanggal : 13-08-2016
    Function SplitText(ByVal text As String, ByVal limiter As String, ByVal ke As Integer)
        On Error Resume Next
        Return Split(text, Trim(limiter))(ke)
    End Function
End Module

Export data dari listview ke format excel sangat sering dilakukan, apalagi data tersebut terkait dengan data operasional harian yang akan di modifikasi dengan aplikasi lain. Microsoft excel merupakan salah satu aplikasi yang paling sering digunakan untuk mengedit dokumen dalam bentuk data. berikut cara export data dari listview ke microsoft excel dengan VB.NET

CRUD (CREATE, READ, UPDATE, DELETE) merupakan bagian yang tidak mungkin terpisahkan dari pemrograman, apalagi jika program yang digunakan sangat tergantung kepada database. berikut adalah module CRUD VB.NET dangan database MYSQL

Imports MySql.Data.MySqlClient
Module modCrud

    ''declaring a string
    Public result As String
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand
    Public rdr As MySqlDataReader
    Public rdr2 As MySqlDataReader
    Public rdt As DataTable

    'INSERT
    Public Sub cInsert(ByVal strSql As String)

        Try
            With cmd2
                .Connection = conn
                .CommandTimeout = 0
                .CommandText = strSql

                'execute the data
                result = cmd2.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    'SELECT
    Public Sub cSelect(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                rdr = cmd.ExecuteReader
            End With
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    'UPDATE
    Public Sub cUpdate(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    'DELETE
    Public Sub cDelete(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try


    End Sub

Imports MySql.Data.MySqlClient
Module modCrud

    ''declaring a string
    Public result As String
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand
    Public rdr As MySqlDataReader
    Public rdr2 As MySqlDataReader
    Public rdt As DataTable
    Public Sub cCall(ByVal strSql As String)

        Try
            With cmd2
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                'execute the data
                result = cmd2.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Public Sub cInsert(ByVal strSql As String)

        Try
            With cmd2
                .Connection = conn
                .CommandTimeout = 0
                .CommandText = strSql

                'execute the data
                result = cmd2.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    'for holding the data to retrieve.
    Public Sub cSelect(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                rdr = cmd.ExecuteReader
            End With
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    'Fungsi Populate GridView
    'tanggal 18-08-16
    Public Sub PopDataGrid(ByVal strSql As String, gv As DataGridView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using dt As New DataTable()
                    sda.Fill(dt)
                    gv.DataSource = dt
                End Using
            End Using
        End Using
    End Sub
    'Fungsi Populate Listview
    'tanggal 18-08-16
    Public Sub PopDataLv(ByVal strSql As String, Lv As ListView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using dt As New DataTable()
                    sda.Fill(dt)
                    Dim itemctr As Integer
                    For itemctr = 0 To dt.Rows.Count - 1
                        Lv.Items.Add(dt.Rows(itemctr)(1))
                    Next
                End Using
            End Using
        End Using


    End Sub
    Sub FillListView(ByVal strSql As String, Lv As ListView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using ds As New DataSet()
                    sda.Fill(ds)

                    Dim c As DataColumn
                    For Each c In ds.Tables(0).Columns

                        'adding names of columns as Listview columns
                        Dim h As New ColumnHeader
                        h.Text = c.ColumnName
                        Lv.Columns.Add(h)
                    Next
                    Dim dt As DataTable = ds.Tables(0)
                    Dim str(ds.Tables(0).Columns.Count) As String
                    'adding Datarows as listview Grids
                    Dim rr As DataRow
                    For Each rr In dt.Rows
                        For col As Integer = 0 To ds.Tables(0).Columns.Count - 1

                            str(col) = rr(col).ToString()
                        Next
                        Dim ii As New ListViewItem(str)
                        Lv.Items.Add(ii)
                        'showing the number of records still added
                    Next

                End Using
            End Using
        End Using
    End Sub

    Public Sub cSelect2(ByVal strSql As String)
        Dim conn As New MySqlConnection
        Dim cmd As New MySqlCommand
        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                rdr2 = cmd.ExecuteReader
            End With
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    'updating the data from the database.
    Public Sub cUpdate(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    'deleting the data from the database
    Public Sub cDelete(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub

End Module

Imports System
Imports System.IO
Imports System.Data
Imports MySql.Data.MySqlClient
Module modKoneksi

    Public conn As New MySqlConnection
    Public conn2 As New MySqlConnection
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand
    Public Sub connDb()
        Dim db_nama1 As String
        Dim db_server As String
        Dim db_login1 As String
        Dim db_password1 As String


        Try
            'db_server = IP-Address
            db_nama1 = NamaDatabase
            db_login1 = LoginDatabase
            db_password1 = PasswordDatabase

            LoginServerIP = db_server
            LoginServerDb = db_nama1

            conn.ConnectionString = "server=" & db_server _
                                    & ";user id=" & db_login1 _
                                    & ";password=" & db_password1 _
                                    & ";database=" & db_nama1 _
                                    & ";Convert Zero Datetime=" & True


            'cmd.Connection = conn
            'cmd2.Connection = conn

            If conn.State = 0 Then
                conn.Open()
            Else
                MsgBox("SERVER TIDAK DITEMUKAN!", vbExclamation, "Fatal error")
            End If
        Catch Err As Exception
            MsgBox("Maaf, tidak ada koneksi", MsgBoxStyle.Information, Application.ProductName)
            End
        End Try
    End Sub
    
    Sub CloseConn()
        If conn.State = 1 Then
            conn.Close()
        End If
    End Sub

End Module

Dim MainMenu As New MenuStrip
Dim ParentMenu, ChildMenu, ChildMenu2 As ToolStripMenuItem
Dim MenuKode, MenuLabel As String

Sub MenuAkses()

        cSelect("SELECT * FROM kode_menu WHERE menu_group = '" & LoginLevel & "' " & _
                "ORDER BY menu_kode ASC ")
        Do While rdr.Read
            MenuKode = rdr.Item("menu_kode")
            MenuLabel = rdr.Item("menu_label").ToString
            If Len(MenuKode) = 4 Then
                Dim MenuItem As New ToolStripMenuItem(MenuLabel)
                ParentMenu = MenuItem
            End If
            If Len(MenuKode) = 6 Then
                If MenuLabel <> "-" Then
                    Dim MenuItem As New ToolStripMenuItem(MenuLabel)
                    ChildMenu = MenuItem
                    ParentMenu.DropDownItems.Add(ChildMenu)
                Else
                    ParentMenu.DropDownItems.Add(New ToolStripSeparator)
                End If
            End If
            If Len(MenuKode) = 8 Then
                If MenuLabel <> "-" Then
                    Dim MenuItem As New ToolStripMenuItem(MenuLabel)
                    ChildMenu2 = MenuItem
                    ChildMenu.DropDownItems.Add(ChildMenu2)
                Else
                    ChildMenu.DropDownItems.Add(New ToolStripSeparator)
                End If
            End If
            MainMenu.Items.Add(ParentMenu)
        Loop
        rdr.Close()
        Me.Controls.Add(MainMenu)

    End Sub