rahmatdcc.blogspot.com

Private Sub ActiveReport_ReportStart()
Dim strSql As String
Dim sql As String

    lblNamaBank.Caption = xLoginLembaga & " - " & xLoginCabang
    lblAlamatBank.Caption = xLoginCabangAlamat & " Telp. " & xLoginCabangTelp
  
    lblJudul.Caption = "NOMINATIF LAPORAN ANALISA KREDIT"
    lblPeriode.Caption = "Periode " & Format(frmReportAnalisa.dtAnalisa1.Value, "dd mmmm yyyy") & _
                         " s.d " & Format(frmReportAnalisa.dtAnalisa2.Value, "dd mmmm yyyy")
    lblDicetak.Caption = "Dicetak oleh " & xLoginNama & ", Tanggal " & Format(Now, "dd-mm-yyyy") & _
                         ", Jam " & Format(Now, "hh:mm:ss")
  
    With frmReportAnalisa
        If .txtKdKantor.Text <> "" Then _
            sql = sql & " AND pengajuan_kantor = '" & .txtKdKantor.Text & "'"
        If .txtKdSkim.Text <> "" Then _
            sql = sql & " AND analisa_jenis_skim = '" & .txtKdSkim.Text & "'"
        If .txtKdJenis.Text <> "" Then _
            sql = sql & " AND analisa_jenis_kredit = '" & .txtKdJenis.Text & "'"
        If .txtKdBunga.Text <> "" Then _
            sql = sql & " AND analisa_sistem_bunga = '" & .txtKdBunga.Text & "'"
        If .txtKdAngsuran.Text <> "" Then _
            sql = sql & " AND analisa_sistem_angsuran = '" & .txtKdAngsuran.Text & "'"
        If .txtKdCS.Text <> "" Then _
            sql = sql & " AND pengajuan_reg_alias = '" & SplitText(.cboCS.Text, ":", 2) & "'"
        If .txtKdKolektor.Text <> "" Then _
            sql = sql & " AND pelengkap_kode_kolektor = '" & .txtKdKolektor.Text & "'"
        If .txtKdAnalisa.Text <> "" Then _
            sql = sql & " AND kredit_metode = '" & .txtKdAnalisa.Text & "'"
        If .txtPlafon1.Text <> "0" And .txtPlafon2.Text <> "0" Then _
            sql = sql & " AND analisa_plafon BETWEEN " & CCur(.txtPlafon1.Text) & " AND " & CCur(.txtPlafon2.Text) & " "
    End With
  
    strSql = "SELECT pengajuan_regnumber, pengajuan_register, pengajuan_kantor, pengajuan_tanggal_registrasi, kredit_metode, " & _
            "kredit_skor_akhir, analisa_bunga, analisa_jkw, kredit_tgl_analisa, kredit_rekomendasi, " & _
            "analisa_jenis_kredit, analisa_plafon, pengajuan_reg_alias, analisa_sistem_bunga, pengajuan_tanggal_kunjungan, " & _
            "analisa_sistem_angsuran, analisa_jenis_skim, pelengkap_kode_avalis, pelengkap_kode_kolektor, kredit_regnumber, " & _
            "pelengkap_kode_wilayah, pelengkap_kode_wilayah2, pelengkap_notaris_kode, pelengkap_kode_avalis, " & _
            "GetNamaKolektor(pelengkap_kode_kolektor, left(pengajuan_regnumber, 2)) as NamaKolektor, " & _
            "GetSistemBunga(analisa_sistem_bunga) as SistemBunga, " & _
            "GetAnalisaMetode(kredit_metode) as MetodeAnalisa, " & _
            "GetSistemAngsuran(analisa_sistem_angsuran) as SistemAngsuran, " & _
            "GetNasabahNama(pengajuan_register) as NamaNasabah, " & _
            "GetAlamat(pengajuan_register) as AlamatNasabah " & _
            "FROM data_kredit_skor " & _
            "LEFT JOIN data_kredit_analisa ON analisa_regnumber = kredit_regnumber " & _
            "LEFT JOIN data_kredit_pengajuan ON pengajuan_regnumber = kredit_regnumber " & _
            "LEFT JOIN data_kredit_pelengkap ON pelengkap_rekening = kredit_regnumber " & _
            "WHERE 1 = 1 AND kredit_status = '1' AND (kredit_tgl_analisa " & _
            "BETWEEN '" & Format(frmReportAnalisa.dtAnalisa1.Value, "yyyy-mm-dd") & "' " & _
            "AND '" & Format(frmReportAnalisa.dtAnalisa2.Value, "yyyy-mm-dd") & "') " & sql
    RunSQL strSql
  
End Sub
Private Sub ActiveReport_FetchData(EOF As Boolean)
  
    On Error Resume Next
    If rsNew.EOF = True Then Exit Sub
        EOF = False
        Screen.MousePointer = 11
      
            lblNo.Caption = Val(lblNo.Caption) + 1
            lblNoPengajuan.Caption = rsNew.Fields("pengajuan_regnumber")
            lblNama.Caption = " " & rsNew.Fields("NamaNasabah")
            lblAlamat.Caption = " " & rsNew.Fields("AlamatNasabah")
            lblTglPengajuan.Caption = Format(rsNew.Fields("pengajuan_tanggal_registrasi"), "dd-mm-yyyy")
            lblTglAnalisa.Caption = Format(rsNew.Fields("kredit_tgl_analisa"), "dd-mm-yyyy")
            lblAnalisa.Caption = " " & rsNew.Fields("MetodeAnalisa")
            lblSkim.Caption = rsNew.Fields("analisa_jenis_skim")
            lblJenis.Caption = rsNew.Fields("analisa_jenis_kredit")
            lblSistemBunga.Caption = rsNew.Fields("SistemBunga")
            lblSistemAngsuran.Caption = rsNew.Fields("SistemAngsuran")
            lblPlafon.Caption = Format(rsNew.Fields("analisa_plafon"), "#,##0") & " "
                lblTotal.Caption = Val(Replace(lblTotal.Caption, ".", "")) + Val(Replace(lblPlafon.Caption, ".", ""))
                lblTotal.Caption = Format(lblTotal.Caption, "#,##0") & " "
            lblBunga.Caption = rsNew.Fields("analisa_bunga") & " %"
            lblJkw.Caption = rsNew.Fields("analisa_jkw")
            lblKolektor.Caption = rsNew.Fields("NamaKolektor")
            lblSkor.Caption = Replace(rsNew.Fields("kredit_skor_akhir"), ".", ",") & " % "
            lblKet.Caption = rsNew.Fields("kredit_rekomendasi")
                If lblKet.Caption = "TIDAK LAYAK" Then lblKet.Caption = "TIDAK"
              
        rsNew.MoveNext
        Screen.MousePointer = 0
      
      
End Sub

 'Front Critical
   If MsgBox("Apakah yakin akan menghapus : " & xxx & "", _
        vbCritical + vbYesNo, Me.Caption) = vbYes Then 

'Call proccedure
    dB.Execute "CALL `db`.`procedure_name('" & xIdKredit & "')

       ' EXPORT TO EXCEL

            If ListView1.ListItems.Count = 0 Then
                MsgBox "Tidak ada data!", vbExclamation, App.Title
                exit sub
            End If
       
        XLSFILENAME = ""
        With Me.cd1
            .Filter = "Excel Workbook (.xls)"
            .ShowSave
        XLSFILENAME = .filename
        End With
      
        If XLSFILENAME = "" Then
        Exit Sub
        End If
      
        Call ExportListview(ListView1, XLSFILENAME)
            MsgBox "Export sukses!", vbInformation, App.Title
        XLSFILENAME = ""

Label1.Caption = "Hello AN," & vbCrLf & "This is Bob."

Sub CapitalTb()
Dim oText(100) As String
Dim i As Integer

    For Each obj In Me.Controls
        If Left(obj.Name, 3) = "txt" Then
            obj.Text = UCase(obj.Text)
            obj.Text = Replace(obj.Text, "'", "`")
        End If
    Next
          
End Sub

Function HanyaAngka(ByRef KeyAscii As Integer)
    If ((KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57) Then
        MsgBox "Isilah dengan angka!", vbExclamation, App.Title
        KeyAscii = 0
    End If
End Function

Function HijriDate()
Dim xTgl As String
Dim xHijri As String
Dim days As DayConstants

    xTgl = Format(xLoginDate, "yyyy-mm-dd")
    days = Date - CDate(xTgl)
    days = days + 1
    DateTime.Calendar = vbCalHijri
    xHijri = Format(Date - days, "dd-mm-yyyy")
    xSistemHijriDate = xHijri
        If Mid(xHijri, 4, 2) = "01" Then xHijri = Replace(xHijri, "-01-", " Muharram ")
        If Mid(xHijri, 4, 2) = "02" Then xHijri = Replace(xHijri, "-02-", " Safar ")
        If Mid(xHijri, 4, 2) = "03" Then xHijri = Replace(xHijri, "-03-", " Rabiul Awal ")
        If Mid(xHijri, 4, 2) = "04" Then xHijri = Replace(xHijri, "-04-", " Rabiul Akhir ")
        If Mid(xHijri, 4, 2) = "05" Then xHijri = Replace(xHijri, "-05-", " Jumadal Ula ")
        If Mid(xHijri, 4, 2) = "06" Then xHijri = Replace(xHijri, "-06-", " Jumadal Tsani ")
        If Mid(xHijri, 4, 2) = "07" Then xHijri = Replace(xHijri, "-07-", " Rajab ")
        If Mid(xHijri, 4, 2) = "08" Then xHijri = Replace(xHijri, "-08-", " Sya'ban ")
        If Mid(xHijri, 4, 2) = "09" Then xHijri = Replace(xHijri, "-09-", " Ramadhan ")
        If Mid(xHijri, 4, 2) = "10" Then xHijri = Replace(xHijri, "-10-", " Syawwal ")
        If Mid(xHijri, 4, 2) = "11" Then xHijri = Replace(xHijri, "-11-", " Dzulkaidah ")
        If Mid(xHijri, 4, 2) = "12" Then xHijri = Replace(xHijri, "-12-", " Dzulhijjah ")
    xLoginHijri = xHijri
    DateTime.Calendar = vbCalGreg
   
End Function

Function CpuId() As String
Dim computer As String
Dim wmi As Variant
Dim processors As Variant
Dim cpu As Variant
Dim cpu_ids As String

    computer = "."
    Set wmi = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & _
        computer & "\root\cimv2")
    Set processors = wmi.ExecQuery("Select * from " & _
        "Win32_Processor")

    For Each cpu In processors
        cpu_ids = cpu_ids & ", " & cpu.ProcessorID
    Next cpu
    If Len(cpu_ids) > 0 Then cpu_ids = Mid$(cpu_ids, 3)

    CpuId = cpu_ids
End Function

Sub TreeALL()
Dim nodX As Node
Dim nodX2 As Node
Dim s As String
Dim i As Long
Dim xParent As Long
Dim xParent2 As Long
  
    nMenu = 0
    For Each obj In frmMain.Controls
        If Left(obj.Name, 2) = "mn" Then
            If Mid(obj.Name, 3, 1) = "0" Then menuName(nMenu) = Mid(obj.Name, 4, 10)
                If Mid(obj.Name, 3, 1) = "1" Then menuName(nMenu) = Mid(obj.Name, 3, 10)
                    menuCaption(nMenu) = Replace(obj.Caption, "&", "")
                    menuCaption(nMenu) = obj.Name & ". " & SplitText(menuCaption(nMenu), ".", 2)
                    menuCaption(nMenu) = Replace(menuCaption(nMenu), "mn", "")
                    nMenu = nMenu + 1
        End If
    Next
          
        For i = 0 To nMenu - 1
                If Len(menuName(i)) = 1 Then
                    xParent = Left(menuName(i), 1)
                    Set nodX = treeview1.Nodes.Add(, , "mn" & xParent, menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                  
                ElseIf Len(menuName(i)) = 2 Then
                    xParent = Left(menuName(i), 2)
                    Set nodX = treeview1.Nodes.Add(, , "mn" & xParent, menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                  
                ElseIf Len(menuName(i)) > 2 And Len(menuName(i)) < 5 Then
                    Set nodX = treeview1.Nodes.Add("mn" & xParent, tvwChild, , menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                       
                ElseIf Len(menuName(i)) = 5 Then
                    Set nodX2 = treeview1.Nodes.Add(nodX, tvwChild, , menuCaption(i))
                    nodX2.Checked = False
                    nodX2.Expanded = True
                End If
            Next
            treeview1.BorderStyle = vbFixedSingle
            Call TreeBold
          
End Sub
Sub TreeGroup()
Dim i As Integer
Dim j As Integer
Dim xMenuGroup As String
Dim xMenuMaster As String

    For i = 1 To Me.ListView1.ListItems.Count
        xMenuGroup = Me.ListView1.ListItems.Item(i).ListSubItems(2).Text
        For j = 1 To Me.treeview1.Nodes.Count
            xMenuMaster = SplitText(Me.treeview1.Nodes.Item(j).Text, ".", 1)
            If xMenuGroup = xMenuMaster Then Me.treeview1.Nodes.Item(j).Checked = True
        Next
    Next
  
End Sub
Sub TreeBold()
Dim i As Integer

    For i = 1 To Me.treeview1.Nodes.Count
        If Len(SplitText(Me.treeview1.Nodes(i).Text, ".", 1)) = 2 Then Me.treeview1.Nodes(i).Bold = True
    Next
  
End Sub

Untuk proses backup kita cukup menggunakan tool bawaan MySQL yaitu mysqldump dan untuk restorenya menggunakan mysql.

Adapun perintah dasar untuk melakukan backup dan restore adalah sebagai berikut :

parameter –routines ditambahkan jika database mempunyai fungsi/trigger

Sekarang tinggal kita siapkan kode berikut :

kemudian tinggal panggil di masing-masing proses (backup dan restore)

kode diatas dengan asumsi direktori bin MySQL ada di folder “C:\Program Files\MySQL\MySQL Server 5.1\bin”.

Selamat mencoba sumber

NSIS adalah salah satu tool gratis dan open source untuk membuat paket instalasi. Oke sebelum kita melangkah lebih jauh, berikut adalah hal-hal yang perlu kita persiapkan :

1. NSIS
2. MySQL versi noninstall disesuaikan dengan versi MySQL yang terinstall di komputer Anda
3. Connector ODBC yang sudah terinstall biasanya ada di C:\Program Files\MySQL\Connector ODBC 5.1
4. Database yang sudah di backup/dump
5. Untuk editor, bagi Anda yang buta warna cukup pake notepad , saya sendiri menggunakan notepad++ atau kalo pengen lebih nyaman bisa menggunakan eclipse kemudian download plug-in NSIS

Memang kalo dilihat dari segi skrip, Inno Setup lebih simple dibandingkan NSIS tetapi setelah saya bandingkan hasil paket instalasi NSIS lebih kecil dibandingkan Inno Setup.

Skrip Inno Setup dan NSIS sama-sama dikelompokkan dalam section-section bedanya kalo Inno Setup untuk nama sectionnya sudah fix (misal Setup, Tasks, Files de el el) sedangkan NSIS untuk nama sectionnya bebas dan tentunya dalam penamaan section di NSIS disesuaikan dengan isinya (misal Install MySQL 5).

Salah satu bagian penting dari skrip NSIS yang kita bahas disini adalah skrip yang digunakan untuk membuat service MySQL, mendaftarkan driver MySQL Connector ODBC dan melakukan proses undump skrip databse (.sql).

Saya ambil contoh untuk membuat service MySQL tentunya dilihat dari versi windows yang terinstall kalo keluarga Win9x jelas tidak bisa karena belum mendukung pembuatan service, oleh karena itu sebelum menjalankan perintah membuat service akan dilakukan pengecekan versi windows terlebih dulu.

Nah disini akan terlihat jelas perbedaan skrip Inno Setup dan NSIS dimana untuk melakukan ini inno setup cukup menambahkan flag MinVersion, misal :

Sedangkan untuk NSIS kita perlu mendownload Version plug-in terlebih dulu dan mengekstraknya kemudiakan mengcopykan file version.dll ke folder instalasi NSIS\Plugins, walaupun sebenarnya kita bisa membuat fungsi sendiri di NSIS untuk mengecek versi windows yang terinstall.

Contoh skrip NSIS untuk mengecek versi windows dan menginstall service MySQL :

Gimana lumayan beda kan?

Khusus untuk file-file Runtime VB memerlukan penanganan khusus dan untuk memudahkan Anda mencoba sample skrip ini download terlebih dahulu file Runtime VB disini dan jangan lupa diekstrak.

Persiapan terakhir untuk struktur folder saya buat seperti berikut :

Dan saya tidak akan menjelaskan fungsi-fungsi/perintah yang digunakan dalam skrip NSIS karena sudah saya sisipkan komentar di sample skrip instalasi NSIS.

Jika masih kesulitan Anda bisa langsung membaca manual NSIS yang penjelasannya sudah sangat lengkap.

Berikut contoh skrip instalasi lengkap menggunakan NSIS :

Di dalam skrip instalasi ada file exec.cmd, isinya adalah :

Isi file exec.cmd sebenarnya untuk proses undump dan ternyata Inno Setup dan NSIS gagal menjalankan perintah tersebut, padahal perintah-perintah yang lainnya sukses.

Contoh hasil instalasi :

Gambar 1

Gambar 2

Gambar 3

Gambar 4

Selamat mencoba

sumber