VB 6.0 dengan PostgreSQL

Pada saat ini aku ingin mencoba membuat tutorial tentang bagaimana visual basic 6.0 terkoneksi dengan database postgreSQL. Walaupun vb 6.0 sudah usang tapi masih tetap powerful untuk membuat aplikasi yang tidak membutuhkan resource komputer yang tinggi, tidak seperti varian terbarunya (.NET).

Pada dasarnya dalam membuat koneksi ke database postgreSQL sama saja, hanya yang membedakan adalah string koneksinya saja. kali ini aku menggunakan pgsqlodbc yang sudah terinstall di komputerku. Mungkin anda bertanya “Kenapa tidak menggunkan SQL Server or MySQL?“. SQL Server adalah punya microsoft yang tentunya tidak free dan pastinya harganyapun masih mahal. MySQL free tapi memiliki batasan record (klo gak salah hingga 4 GB)

PostgreSQL adalah free dan unlimited. Tools bawaan yang terinstal adalah pgAdmin III dan yang terpenting adalah Stable & Unlimited.

Langkah-langkahnya adalah sebagai berikut:

1. Install PostgreSQL for Windows
2. Untuk tambahan anda juga dapat menginstall tools yang berjalan pada web browser yaitu phpPgAdmin
3. Setelah PostgreSQL terinstall buatlah sebuah database vbpgsql. Kemudian buatlah sebuah tabel Customer

    -- Table: customer
    -- DROP TABLE customer
    CREATE TABLE customer
    (
      id character(10) NOT NULL,
      custname character varying(35) NOT NULL,
      address character varying(100) NOT NULL,
      zipcode character varying(10),
      city character varying(35),
      CONSTRAINT customer_pkey PRIMARY KEY (id)
    )            

    WITH (OIDS=FALSE);
    ALTER TABLE customer OWNER TO postgres;

4. Buat Data Source(ODBC) dan pilih System DSN Tab, klik tombol Add kemudian pilih driver PostgreSQL Unicode. Pada dialog setup selanjutnya anda diminta untuk menentukan nama koneksinya dan tentukanlah nama database yang telah dibuat. Kemudian lakukan test terlebih dahulu, jika muncul pesan “Connection Successful” selamat anda sudah membuat Data Source(ODBC) untuk PostgreSQL



5. Buka IDE VB 6.0, kemudian buat satu project yang terdiri dari 2 form dan satu modul.
6. pada modul ketikan atau copy syntax berikut ini:

Option Explicit   

Public Con As ADODB.Connection
Public rs As ADODB.Recordset

Sub main()
    Call connectToserver
    frmMain.Show
End Sub

Public Sub connectToserver()
    Set Con = New ADODB.Connection
    ' Connect to the database using ODBC
      With Con
          .ConnectionString = "dsn=vbtopgsql;"
          .Open
          .CursorLocation = adUseClient
      End With
End Sub

7. Pada 2 form selanjutnya beri nama frmMain dan frmCustomerAdd
8. Pada frmMain buat sebuah Listview dan 4 Tombol, jika listview belum ada tambahkan komponen Microsoft Windows Common Control kemudian copy syntax berikut ini

Option Explicit 

Private Sub cmdAdd_Click()
frmCustomerAdd.Show 1
End Sub

Private Sub cmdDelete_Click()
If lv1.ListItems.Count <> 0 Then
  If MsgBox("Are you sure to delete selected customer", vbCritical + vbYesNo, "Delete Customer") = vbYes Then
    Call deleteCustomer
  End If
End If
End Sub

Private Sub cmdEdit_Click()
frmCustomerAdd.Caption = "Edit Customer"
frmCustomerAdd.Show 1
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Set lv1.SmallIcons = iml
loadDataCustomer
End Sub

Public Sub loadDataCustomer()
Dim i As Integer
Set rs = New ADODB.Recordset
rs.Open "select * from customer order by custname asc", Con, 2, 3
If Not rs.BOF And Not rs.EOF Then
  lv1.ListItems.Clear
  Do Until rs.EOF
    i = i + 1
      lv1.ListItems.Add , , rs!custname, , 1
      lv1.ListItems(i).ListSubItems.Add , , rs!id
      lv1.ListItems(i).ListSubItems.Add , , vbNullString & rs!address
      lv1.ListItems(i).ListSubItems.Add , , vbNullString & rs!zipcode
      lv1.ListItems(i).ListSubItems.Add , , vbNullString & rs!city
    rs.MoveNext
  Loop
  cmdEdit.Enabled = True
  cmdDelete.Enabled = True
Else
  lv1.ListItems.Clear
  cmdEdit.Enabled = False
  cmdDelete.Enabled = False
End If
End Sub

Private Sub deleteCustomer()
Con.Execute "delete from customer where id='" & lv1.SelectedItem.ListSubItems(1).Text & "'"
Call loadDataCustomer
End Sub

9. Pada frmCustomerAdd buat 5 Label, 5 TextBox dan 2 Command Button kemudian atur posisinya sesuaikan menurut selera anda dan copy syntax berikut ini:

Option Explicit 

Private stsEdit As Integer
Private hasAddnew As Integer

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdSave_Click()
If cmdSave.Caption = "&Save" Then
  If txtCustomer(1).Text = "" Then
    MsgBox "Please fill Customer name!!", vbExclamation
    txtCustomer(1).SetFocus
  Else
    If MsgBox("Save this Customer?", vbQuestion + vbYesNo, "Save Customer") = vbYes Then
      Call saveCustomer
    End If
  End If
Else
  If MsgBox("Update this Customer?", vbQuestion + vbYesNo, "Update Customer") = vbYes Then
    Call updateCustomer
  End If
End If
End Sub

Private Sub Form_Activate()
If stsEdit = 0 Then
  stsEdit = 1
  If Me.Caption = "Edit Customer" Then
    Call EditMode
    cmdSave.Caption = "&Update"
  Else
    txtCustomer(0).Text = autoNumberCustomer
  End If
End If
End Sub

Private Sub EditMode()
Set rs = New ADODB.Recordset
rs.Open "select * from customer where id='" & frmMain.lv1.SelectedItem.ListSubItems(1).Text & "'", Con, 2, 3
If Not rs.BOF And Not rs.EOF Then
  txtCustomer(0).Text = rs!id
  txtCustomer(1).Text = rs!custname
  txtCustomer(2).Text = rs!address
  txtCustomer(3).Text = rs!zipcode
  txtCustomer(4).Text = rs!city
  txtCustomer(0).Locked = True
Else
  MsgBox "Data Customer not found!!", vbExclamation, "Edit Customer"
End If
rs.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
If hasAddnew = 1 Then
  frmMain.loadDataCustomer
End If
Set frmCustomerAdd = Nothing
End Sub

Private Sub txtCustomer_KeyPress(Index As Integer, KeyAscii As Integer)
nextTabIndex KeyAscii
End Sub

Private Sub saveCustomer()
Dim i As Integer
Con.Execute "insert into customer (id,custname,address,zipcode,city) " _
  & " values ('" & txtCustomer(0).Text & "','" & txtCustomer(1).Text & "', " _
  & "'" & txtCustomer(2).Text & "','" & txtCustomer(3).Text & "', '" & txtCustomer(4).Text & "')"
hasAddnew = 1
If MsgBox("New Customer was saved." & vbCrLf & "Do you want to Add new customer again?", vbQuestion + vbYesNo, "Save Customer") = vbYes Then
  For i = txtCustomer.LBound To txtCustomer.UBound
    txtCustomer(i).Text = ""
  Next i
  txtCustomer(0).Text = autoNumberCustomer
  txtCustomer(0).SetFocus
Else
  Unload Me
End If

End Sub

Private Sub updateCustomer()
Dim i As Integer
Con.Execute "update customer set custname='" & txtCustomer(1).Text & "', " _
  & " address='" & txtCustomer(2).Text & "',zipcode='" & txtCustomer(3).Text & "', " _
  & " city='" & txtCustomer(4).Text & "' where id='" & txtCustomer(0).Text & "'"

Unload Me
frmMain.loadDataCustomer

End Sub

Private Function autoNumberCustomer() As String
Dim noCustomer As String
Set rs = New ADODB.Recordset
rs.Open "select id from customer order by id desc limit 1", Con, 2, 3

If Not rs.BOF And Not rs.EOF Then
  noCustomer = Val(rs!id) + 1
Else
  noCustomer = "1"
End If

autoNumberCustomer = noCustomer
'// Close Reocrd
rs.Close
End Function

10. Untuk lebih jelasnya anda dapat donlot Tutorial ini. Good luck!

Salam, Ahmad Nasrul