rahmatdcc.blogspot.com

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

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

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

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

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

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;

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.

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;