RSS

Active Report Mysql dengan VB6



Private Sub ActiveReport_ReportStart()
Dim strSql As String
Dim TglAwal As String
Dim TglAkhir As String

    lblLembagaNama.Caption = UCase(xNamaKantor)
    lblLembagaAlamat.Caption = xAlamatKantor

    With frmAbsensiLaporan
        TglAwal = Format(.dtAwal.Value, "yyyy-mm-dd")
        TglAkhir = Format(.dtAkhir.Value, "yyyy-mm-dd")
        
        lblPeriode.Caption = "Periode: " & Format(TglAwal, "dd-mm-yyyy") & " s.d " & Format(TglAkhir, "dd-mm-yyyy")
        lblDicetak.Caption = "Dicetak oleh " & frmMain.StatusBar1.Panels(1).Text & _
                             ", Tanggal " & Format(Now, "dd-mm-yyyy") & _
                             ", Jam " & Format(Now, "hh:mm:ss")
        
        strSql = "SELECT absensi_karyawan, karyawan_nama, absensi_tanggal, absensi_date_time, " & _
                 "GetAbsensiJenis(absensi_jenis) as Jenis, absensi_keterangan " & _
                 "FROM data_absensi " & _
                 "LEFT JOIN data_karyawan_master ON karyawan_kode = absensi_karyawan " & _
                 "WHERE absensi_status = 1 " & _
                 "AND (absensi_tanggal BETWEEN '" & TglAwal & "' AND '" & TglAkhir & "') " & _
                 "ORDER BY absensi_date_time ASC"
        RunSQL strSql
        
    End With
    
End Sub
Private Sub ActiveReport_FetchData(EOF As Boolean)
    
    On Error Resume Next
    If rsNew.EOF = True Then Exit Sub
        EOF = False
        Screen.MousePointer = 13
        
            lblNo.Caption = Val(lblNo.Caption) + 1
            lblTanggal.Caption = Format(rsNew.Fields("absensi_tanggal"), "dd-mm-yyyy")
            lblNama.Caption = rsNew.Fields("karyawan_nama")
            lblKode.Caption = rsNew.Fields("absensi_karyawan")
            lblKeterangan.Caption = rsNew.Fields("absensi_keterangan")
            lblJenis.Caption = rsNew.Fields("jenis")
            lblWaktu.Caption = Format(rsNew.Fields("absensi_date_time"), "hh:mm:ss")
            lblTotal.Caption = lblNo.Caption
            
        rsNew.MoveNext
        Screen.MousePointer = 0
        
End Sub


  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

SendKeys error dengan VB6 di windows 8

Ada masalah kecil ketika menggunakan perintah SendKeys pada VB6 dengan OS windows 8, setelah googling, akhirnya mendapatkan script berikut dan alhamdulillah sukses. tapi sory lupa save link sumbernya. berikut scriptnya:

Public Sub Sendkeys(text$, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys text, wait
   Set WshShell = Nothing
End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Menampilkan Data dengan Listview di VB6 + Mysql

1. Buatlah form yang berisi Listview
2. Copy script berikut
3. panggil di form-load
    - call TabelClient
    - call DataClient


Sub TabelClient()
    With ListView1
        .view = lvwReport
        .GridLines = True
        .FullRowSelect = True
        .HotTracking = True
        .ColumnHeaders.Clear
                
        With .ColumnHeaders
             .Add , , 0, 1
             .Add , , "No", 700, lvwColumnCenter
             .Add , , "Kode", 900, lvwColumnCenter
             .Add , , "Nama Client", 4500
             .Add , , "Alamat", 7500
             .Add , , "Kota", 2500
             .Add , , "Telpon", 1500
             .Add , , "Fax", 1500
        End With
      End With
End Sub
Sub DataClient()
Dim rs As New MYSQL_RS
Dim rs2 As New MYSQL_RS
        
    On Error Resume Next
    rs.OpenRs "SELECT * " & _
        "FROM data_client_master ", db
    
    ListView1.ListItems.Clear
        If rs.EOF = False Then
            ListView1.ListItems.Clear
            rs.MoveFirst
            
            Do While Not rs.EOF
            Set List = ListView1.ListItems.Add
                List.SubItems(1) = Me.ListView1.ListItems.Count
                List.SubItems(2) = rs.Fields("client_kode")
                List.SubItems(3) = rs.Fields("client_nama")
                List.SubItems(4) = rs.Fields("client_alamat")
                List.SubItems(5) = rs.Fields("client_kota")
                List.SubItems(6) = rs.Fields("client_telpon")
                List.SubItems(7) = rs.Fields("client_fax")
            rs.MoveNext
            Loop
        End If
        rs.CloseRecordset
        lblJumlah.Caption = "Jumlah : " & ListView1.ListItems.Count
End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Disable MaxButton in VB6

Sub DisableMaxButton()
    Dim hMenu As Long
    Dim OldStyle As Long
    'Remove Max button
    OldStyle = GetWindowLong(Me.HWND, GWL_STYLE)
    SetWindowLong Me.HWND, GWL_STYLE, OldStyle And (Not WS_MAXIMIZEBOX)
    'Remove from system menu
    hMenu = GetSystemMenu(Me.HWND, 0&)
    If hMenu Then
        Call DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
        Call DrawMenuBar(Me.HWND)
    End If
End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Looping Menu Item di VB6 dari Mysql sesuai dengan level groupnya

Function MenuAkses()
Dim obj As Object
Dim xList As ListView
Dim rs As New MYSQL_RS
Dim xMenuMaster(9999) As String
Dim xMenuSet(9999) As String
Dim xMenuMain(9999) As String
Dim i As Integer
Dim j As Integer

    rs.OpenRs "SELECT menu_set, menu_kode FROM kode_menu " & _
        "WHERE menu_group = '" & xLevel & "' ORDER BY menu_id ASC", db
    If rs.EOF = False Then
        rs.MoveFirst
        For i = 1 To rs.RecordCount
            xMenuMaster(i) = rs.Fields("menu_kode")
            xMenuSet(i) = rs.Fields("menu_set")
            For Each obj In frmMain.Controls
                If Left(obj.Name, 2) = "mn" Then
                    On Error Resume Next
                    If obj.Name = xMenuMaster(i) And xMenuSet(i) = "1" Then obj.Visible = True
                    If obj.Name = xMenuMaster(i) And xMenuSet(i) = "0" Then obj.Visible = False
                End If
            Next
            rs.MoveNext
        Next
    
    End If
    rs.CloseRecordset
  
End Function

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Koneksi Mysql di VB dengan VBMysqlDirect

mysql logo wallpaper

1. copy file libmySQL.dll di folder project
2. registrasikan vbmysqldirect di windows/system32 atau windows/syswow64
3. tambahkan reference di vb dengan "vbmysql direct"
4. buat module baru, copy file berikut ke dalamnya
5. load module dengan perintah "call KoneksiDb"

Public dBPrimer As New MYSQL_CONNECTION
Public rs As New MYSQL_RS
Public rsNew As New MYSQL_RS

Public Function KoneksiDb() As Boolean
Dim db_nama1 As String
Dim db_server1 As String
Dim db_login1 As String
Dim db_password1 As String
Dim db_port1 As String
    
    db_server1 = xxx          'IP Mysql
    db_nama1 =  xxx          'Nama Database
    db_login1 =   xxx          'Login Mysql
    db_password1 =  xxx     'Password Mysql
    db_port1 = "3306"         'Port Mysql
    
    Set dBPrimer = New MYSQL_CONNECTION
    dBPrimer.OpenConnection db_server1, db_login1, db_password1, db_nama1, db_port1
    dBPrimer.CursorLocation = adUseClient
    
    If dBPrimer.State = MY_CONN_CLOSED Then
        MsgBox "Ada kesalahan dengan server, periksa apakah server sudah berjalan!", vbExclamation, "Fatal error"
    End If
    
End Function

Public Sub RunSQL(strSql As String)
    
    Set rsNew = New MYSQL_RS
    rsNew.OpenRs strSql, dbprimer, adOpenDynamic, adLockBatchOptimistic
    
End Sub

Function CloseDB() As Boolean
    If CloseDB = True Then
        rsNew.CloseRecordset
    End If
End Function

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Looping data di Myql



CREATE PROCEDURE `DoRasioHarianRange`(IN TglAwal DATE, IN TglAkhir DATE)
    NOT DETERMINISTIC
    SQL SECURITY DEFINER
    COMMENT ''
BEGIN
   DECLARE xTanggal DATE;
   -- this flag will be set to true when cursor reaches end of table

   DECLARE exit_loop BOOLEAN;
   -- Declare the cursor

   DECLARE rasio_cursor CURSOR FOR
     SELECT jurnal_tanggal FROM temp_tanggal
            WHERE jurnal_tanggal BETWEEN TglAwal AND TglAkhir;

   -- set exit_loop flag to true if there are no more rows
   DECLARE CONTINUE HANDLER FOR NOT FOUND SET exit_loop = TRUE;

   -- open the cursor
   OPEN rasio_cursor;

   -- start looping
   rasio_loop: LOOP

     -- read the name from next row into the variables
     FETCH  rasio_cursor INTO xTanggal;
     CALL DoRasioHarian(xTanggal);

     -- check if the exit_loop flag has been set by mysql,
     -- close the cursor and exit the loop if it has.
     IF exit_loop THEN
         CLOSE rasio_cursor;
         LEAVE rasio_loop;
     END IF;

   END LOOP rasio_loop;
 END;

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

SplitString dengan Mysql

Copy Script dibawah ini ke dalam function di MYSQL:

CREATE FUNCTION `SplitString`(x LONGTEXT, delim VARCHAR(12), pos INTEGER)
    RETURNS longtext CHARSET latin1
    NOT DETERMINISTIC
    SQL SECURITY DEFINER
    COMMENT ''
RETURN REPLACE(SUBSTRING(SUBSTRING_INDEX(x, delim, pos),
       LENGTH(SUBSTRING_INDEX(x, delim, pos -1)) + 1),
       delim, '');

Keterangan: 
x : text yang akan di split, jika kurang panjang pakai longtext
delim : karakter pemisah untuk split
pos : urutan text yang mau di split

semoga bermanfaat.

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Membuat Autonumbering di Mysql

CREATE PROCEDURE `RepairPosting`(IN RekAwal VARCHAR(20))
    NOT DETERMINISTIC
    SQL SECURITY DEFINER
    COMMENT ''
BEGIN

     DECLARE RekMax INT(20);
     DECLARE KodeBaru VARCHAR(8);
     DECLARE urut INT;
     DECLARE RekJadi VARCHAR(20);
     
     select max(right(kre_rekening, 5)) INTO RekMax
     from data_kredit_master
     where LEFT(kre_rekening, 6) = LEFT(RekAwal, 6);

     SET urut = IF(RekMax IS NULL, 1, RekMax + 1);
     SET KodeBaru = LPAD(urut, 5, 0);
     SET RekJadi = CONCAT(LEFT(RekAwal, 6), KodeBaru);
     
     UPDATE `data_kredit_master`
     SET kre_rekening = RekJadi WHERE kre_rekening = RekAwal;
        
END;

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS