Menghitung Umur (tahun, bulan dan hari) dengan VB6

Contoh program untuk menghitung umur dengan Visual Basic 6.
1. Fungsi calculateAge adalah fungsi untuk menghitung umur yang akan mengembalikan nilai string yang berisi informasi x Tahun, x Bulan dan x Hari

2. Sub test adalah contoh untuk memanggil fungsi calculateAge

Function calculateAge(dateOfBird As Date, fromData As Date) As String
    Dim dateNow As Date
    Dim tgl As Date
    Dim tgl1 As Date

    Dim years As Long
    Dim months As Long
    Dim days As Long

    Dim yearWord As String
    Dim monthWord As String
    Dim dayWord As String

    dateNow = fromData
    tgl = dateOfBird

    ' menghitung tahun
    years = DateDiff("yyyy", tgl, dateNow)
    If month(tgl) > month(dateNow) Then
        years = years - 1
    ElseIf month(tgl) = month(dateNow) And day(tgl) > day(dateNow) Then
        years = years - 1
    ElseIf month(tgl) = month(dateNow) And day(tgl) = day(dateNow) Then
        GoTo finally ' jika bulan dan tanggal sama maka perhitungan selesai
    End If

    ' menghitung bulan
    tgl = DateAdd("yyyy", years, tgl)
    months = DateDiff("m", tgl, dateNow)
    If day(tgl) > day(dateNow) Then
        months = months - 1
    ElseIf month(tgl) = month(dateNow) And day(tgl) >= day(dateNow) Then
        months = months - 1
    End If

    tgl = DateAdd("m", months, tgl)

    ' menghitung hari
    days = DateDiff("d", tgl, dateNow)

finally:
    yearWord = IIf(years = 0, "", years & " Tahun ")
    monthWord = IIf(months = 0, "", months & " Bulan ")
    dayWord = IIf(days = 0, "", days & " Hari ")

    calculateAge = yearWord & monthWord & dayWord
    calculateAge = Trim(calculateAge)
End Function

Private Sub test()
    Dim strMsg As String
    strMsg = "Umur : " & calculateAge(#1/30/2000#, #6/26/2008#)
    'result = "Umur : 8 Tahun 4 Bulan 27 Hari"
    MsgBox strMsg, vbInformation
End Sub

Filed under: VB 6

VB6 : Membuka berbagai jenis file

Berikut cara untuk berbagai jenis file seperti file .txt, .doc, dll….
Anda bisa saja cuma menggunakan keyword shell, tapi biasanya ini cuma sukses untuk memanggil bat file (*.bat).

Anda dapat menggunakan file shell32.dll, sintaknya sebagai berikut :

' membuat enum data untuk mode windows state
Enum State
    SHOWNORMAL = 1
    SHOWMINIMIZED = 2
    SHOWMAXIMIZED = 3
    SHOWMINNOACTIVE = 7
    SHOWDEFAULT = 10
End Enum

' mendeklarasikan fungsi yang memanggil library dari shell32.dll
Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" (ByVal hWnd As Long, _
        ByVal lpOperation As String, ByVal lpFile As String, _
        ByVal lpParameters As String, ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long

' fungsi untuk membuka file
Public Function OpenLocation(URL As String, _
    WindowsState As State) As Long

    Dim lHWnd As Long
    Dim lAns As Long

    lAns = ShellExecute(lHWnd, "open", URL, vbNullString, _
    vbNullString, WindowsState)
    OpenLocation = lAns
End Function

Sub Main()
    OpenLocation "c:\test.txt", SHOWNORMAL
End Sub

Filed under: VB 6

VB6 : Error 28: “Out of Stack Space” saat package VB Project + Crystal Report 8.5 dengan PDW

Jika anda sedang membuat package menggunakan tool Packaging and Development Wizard (PDW) dan anda mengalami masalah Error 28: “Out of Stack Space”, untuk pemecahannya silahkan anda kunjungi link berikut : http://support.microsoft.com/kb/305558#top.

Link ini saya dapat dari milis visualbasic6programming@yahoogroups.com

Filed under: VB 6

VB6 : Contoh Fungsi yang mengembalikan nilai array

Di suatu milis dulu pernah ada yang tanya apakah bisa suatu fungsi mengembalikan nilai array, saat itu saya ikut jawab tidak bisa, karena saya mengacu pada cara penulisan fungsi yang sama dengan cara penulisan array.
Akan tetapi ternyata bisa jika suatu fungsi mengembalikan nilai bertipe array, contohnya sebagai berikut :

'fungsi getArray akan mengembalikan data array bertipe Long Integer
Function getArray() As Long()
    Dim myLocalArray() As Long
    Dim i As Integer
    ReDim myLocalArray(100) As Long
    For i = 0 To 100
        myLocalArray(i) = i * 10
    Next i
    getArray = myLocalArray
End Function

Sub main()
    Dim myArray() As Long
    myArray = getArray
End Sub

Filed under: VB 6

SQL : Replace Single Quote dengan Double Single Quote

Apakah anda bermasalah jika memasukan kata yang mengandung caracter single quote (‘) dengan perintah SQL?

Contoh SQL :
INSERT INTO Publisher(Code, Name) VALUES (‘P001′,’O'Riley’);

Apa yang akan terjadi jika kita coba mengeksekusi SQL diatas, tentunya akan terjadi error karena ada caracter singel quote (‘) pada data yang kita masukan, tepatnya pada kata O’Riley.

Untuk mengatasi permasalahan diatas anda dapat menambahkan satu caracter single quote disebelah caracter single quote yang telah ada, sehingga menjadi double single quote.
SQL menjadi :
INSERT INTO Publisher(Code, Name) VALUES (‘P001′,’O”Riley’);

SQL diatas tidak akan merubah maksud dari penyimpanan, data yang tersimpan tetap O’Riley dan bukan O”Riley

Cara ini sepertinya bisa untuk semua database engine, karena ini merupakan cara standard.( CMIIW)
DB engine yang telah saya test antara lain MySQL, PostgreSQL, MS. Access, HSQL, SQLite 3

Filed under: SQL