Bagaimana Mengkonversi 10 Digit Angka ke Nilai Tanggal?

Saya memiliki ratusan record yang akan disalin dari suatu tabel dan database (database pertama) ke tabel yang lain pada database yang berbeda (database kedua). Sayangnya, salah satu dari kolom di tabel dalam database pertama memiliki sebuah field yang isinya merupakan data Tanggal dalam format angka 10 digit. Contoh: 1206980969. Data ini seharusnya kalau diterjemahkan menjadi format Tanggal dan Jam, akan menghasilkan 31 Maret 2008 pukul 16:29:29 menurut waktu GMT. Bagaimana caranya saya harus mengkonversi nilai data tanggal 10 digit tadi menjadi Tanggal yang sebenarnya karena di database kedua, field tersebut bertipe Date/Time? Lalu, bagaimana pula saya dapat mengetahui waktu tersebut menurut waktu lokal saya?
Oke, ini solusi yang saya lakukan dengan menggunakan Visual Basic 6.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47

Option Explicit   Private Declare Function GetTimeZoneInformation Lib "KERNEL32.dll" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long   Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type   Private Type TIME_ZONE_INFORMATION Bias As Long StandardName As String * 64 StandardDate As SYSTEMTIME StandardBias As Long DaylightName As String * 64 DaylightDate As SYSTEMTIME DaylightBias As Long End Type   Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2 Private Const Unix1970 As Long = 25569 'CDbl(DateSerial(1970, 1, 1)) Public Function Unix2Date(vUnixDate As Long, ByVal bReturnUTC As Boolean) As Date Unix2Date = DateAdd("s", vUnixDate, Unix1970) - IIf(bReturnUTC, 0, GetCurrentTZOffset) End Function   Public Function GetCurrentTZOffset() As Double Dim tz As TIME_ZONE_INFORMATION Dim lRet As Long 'Cara tercepat utk memeriksa apakah kita termasuk 'Daylight Savings adalah dengan memeriksa lRet lRet = GetTimeZoneInformation(tz) 'Offset dalam menit GetCurrentTZOffset = tz.Bias + IIf(lRet = TIME_ZONE_ID_DAYLIGHT, tz.DaylightBias, tz.StandardBias) GetCurrentTZOffset = GetCurrentTZOffset / 1440 End Function   Private Sub Command1_Click() MsgBox "GMT = " & Unix2Date(1206980969, True) '31 Maret 2008 16:29:29 (GMT) MsgBox "Local = " & Unix2Date(1206980969, False) '31 Maret 2008 23:29:29 (GMT + 7)End Sub

Dari kode program di atas, kesimpulan yang dapat diambil adalah: Kita dapat menggunakan fungsi buatan bernama Unix2Date yang memiliki dua parameter di dalamnya. Parameter pertama adalah nilai 10 digit tadi, sedangkan parameter kedua merupakan flag apakah kita akan mengkonversi ke waktu GMT atau waktu menurut lokal kita.
Jika kita ingin mengkonversi data 10 digit tadi ke tanggal menurut GMT, maka parameter kedua bernilai True, sedangkan jika kita ingin mengkonversinya ke waktu lokal (dalam hal ini waktu lokal saya adalah GMT + 7), maka parameter kedua harus bernilai False.

Read more »

Bagaimana Menghitung Selisih Dua Tanggal Menggunakan VB6

Kode berikut akan menunjukkan kepada Anda bagaimana caranya menghitung selisih dua buah tanggal yang diketahui dengan menggunakan pemrograman Visual Basic 6. Hasil perhitungan akan memberikan hasil yang mengandung perbedaan di antara dua tanggal tadi dalam format: Hari, Jam:Menit:Detik. Kedua tanggal harus dalam format lengkap. Contoh: Tanggal pertama: 1 Maret 2002 17:18:00, dan tanggal kedua: 1 September 2002 09:42:30. Setelah dihitung, maka hasil akhirnya adalah: 183 hari, 16:24:30. Artinya: Selisih di antara dua tanggal tersebut adalah: 183 hari, 16 jam, 24 menit, dan 30 detik.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89

'Deskripsi: Menghitung selisih dua buah tanggal yang diketahui ' lalu menampilkan hasilnya dalam bentuk selisih hari' dan selisih durasi jam lengkapnya. Contoh: Jika ' tanggal awal = 01/03/2002 17:18:00 dan ' tanggal akhir = 01/09/2002 09:42:30, maka akan' menghasilkan --> 183 hari, 16:24:30 ' Artinya: (183 hari, 16 jam, 24 menit, dan 30 detik).' Tips ini menggunakan fungsi DateDiff'Pembuat : Masino Sinaga 'Diupload : Minggu, 1 September 2002'Persiapan: 1. Buat 1 Project Standard exe baru dengan 1 Form.' 2. Tambahkan 2 TextBox, 1 Label, dan 1 Timer ke atas Form.' 3. Copy-kan coding berikut ke dalam editor form yang bertalian.'-------------------------------------------------------------------------- Option Explicit   Function SelisihHariJam(ByVal Awal As Date, _ ByVal Akhir As Date) As String   Dim Detik As Long, Hari As Long, Jam As Long Dim JamLengkap As String If Awal > Akhir Then MsgBox "Tanggal dan waktu awal harus lebih kecil " & vbCrLf & _ "dari pada tanggal dan waktu akhir", _ vbCritical, "Peringatan" Exit Function End If   'Tampung dalam durasi satuan terkecil, yaitu: DETIK Detik = DateDiff("s", Awal, Akhir)   'Hitung jumlah jam dgn cara membagi 3600 '(backslash ("\") supaya menghasilkan 'nilai Integer tanpa pembulatan ke atas) Jam = Detik \ 3600   'Jika jumlah jam lebih besar dari 23 'artinya: lebih dari 1 hari If Jam > 23 Then   'Hitung jumlah hari dgn cara membagi 24 '(backslash ("\") supaya menghasilkan 'nilai integer tanpa pembulatan ke atas) Hari = Jam \ 24   'Hitung Durasi Jam dalam hh:mm:ss JamLengkap = Format((Akhir - Awal), "hh:mm:ss")   Else 'Jika jumlah jam <= 23 Hari = 0 'maka jumlah hari = nol 'Hitung Durasi Jam dalam hh:mm:ss JamLengkap = Format((Akhir - Awal), "hh:mm:ss") End If   If Hari = 0 Then 'Jika jumlah hari = 0 'Tampung hasil akhirnya SelisihHariJam = JamLengkap   Else 'Jika jumlah hari > 0, tampilkan jumlah harinya 'Tampung hasil akhirnya SelisihHariJam = Hari & " hari, " & JamLengkap End If Exit Function   End Function   Private Sub Form_Load() Timer1.Interval = 500 Timer1.Enabled = True Text1.Text = "01/03/2002 17:18:00" 'Text2.Text = "01/09/2002 09:42:30" Text2.Text = Now End Sub   Private Sub Timer1_Timer() On Error GoTo PesanError Text2.Text = Now Label1.Caption = SelisihHariJam(CDate(Text1.Text), _ CDate(Text2.Text)) Exit Sub PesanError: MsgBox "Tanggal atau format-nya salah!", _ vbCritical, "Error Tanggal" End Sub

Dari potongan code di atas, parameter pertama milik fungsi SelisihHariJam ditempatkan di control Text1, sedangkan parameter kedua ditempatkan di control Text2, di mana nilainya dibangkitkan oleh control Timer1 dalam interval waktu 1 detik.
Hasil perhitungan ditampilkan di control Label1 berdasarkan perubahan tanggal yang dibangkitkan oleh control Timer1. Tentu, Anda bisa memodifikasi sendiri kode di atas, misalnya dengan menghilangkan control Timer dan menutup kode yang terkait dengan kontrol Timer1, lalu cukup menggunakan fungsi SelisihHariJam saja pada prosedur Form_Load.

Read more »

Belajar V.B

Serpihan Kode Database Access

Pertama yang perlu disapkan adalah :

• Nama Database : DBPembelajaran.mdb format Microsoft Office Access 2000

• Nama Tabel : SiswaLogin

• Nama Field dalam Tabel SiswaLogin : Nama Field Nama_Siswa TypeField Text dan field kedua   Nama Field NIS TypeField Text

• Klik Menu Project Pilih References.. : Microsoft ActiveX Data Object 2.0 Library atau versi yang lebih tinggi.

Dibawah ini serpihan kode yang mungkin bermanfaat, silahkan...
1. a. Koneksi Dengan Database Yang Tidak Berpassword

Option Explicit
Dim db As ADODB.Connection
Dim adoPrimaryRSLoginSiswa As ADODB.Recordset

Private Sub Form_Load()
On Error GoTo err
        Set db = New ADODB.Connection
        db.CursorLocation = adUseClient
        db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & App.Path & "\DBPembelajaran.mdb;"
err:
        If db.State = 1 Then
            MsgBox "Terkoneksi dengan database"
        ElseIf db.State = 0 Then
            MsgBox "Tidak Terkoneksi dengan database.", vbInformation, "Error"
        End If
End Sub
 

1. b. Koneksi Dengan Database Berpassword

Private Sub Form_Load()
On Error GoTo ERR
        Dim DBBerPassword
        Set DBBerPassword = New ADODB.Connection
        DBBerPassword.CursorLocation = adUseClient
        DBBerPassword.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBPembelajaran - Copy.mdb" & ";Persist Security Info=False;Mode=12;Jet OLEDB:Database Password=TulisPasswordnya"
ERR:
        If DBBerPassword.State = 1 Then
            MsgBox "Terkoneksi dengan database"
        ElseIf DBBerPassword.State = 0 Then
            MsgBox "Tidak Terkoneksi dengan database.", vbInformation, "Error"
        End If
End Sub

2. Buka Record

Private Sub Command1_Click()
On Error GoTo err
        Set adoPrimaryRSLoginSiswa = New ADODB.Recordset
        adoPrimaryRSLoginSiswa.Open "TblSiswaLogin", db, adOpenStatic, adLockOptimistic
err:
        If adoPrimaryRSLoginSiswa.State = 1 Then
            MsgBox "Terkoneksi dengan Tabel"
        ElseIf adoPrimaryRSLoginSiswa.State = 0 Then
            MsgBox "Tabel tidak ditemukan, cek kembali tabel yang ada dalam database.", vbInformation, "Error"
        End If
End Sub

3. Cek Isi Field

Private Sub Command2_Click()
    adoPrimaryRSLoginSiswa.MoveFirst
    MsgBox "NAMA FIELD : " & adoPrimaryRSLoginSiswa.Fields(0).Name & _
    vbCrLf & "ISI FIELD RECORD PERTAMA : " & adoPrimaryRSLoginSiswa.Fields(0).Value, vbInformation
End Sub

4. Menghubungkan Isi Field Ke Control

Private Sub Command3_Click()
    Set Me.Text1.DataSource = adoPrimaryRSLoginSiswa
    Set Me.Text2.DataSource = adoPrimaryRSLoginSiswa
    
    Me.Text1.DataField = "NAMA_SISWA"
    Me.Text2.DataField = "NIS"
    
End Sub

5. Mengecek Field Kosong (IsNull)

Private Sub Command4_Click()
    'DI PROPERTY Text3 MultiLine pilih True
    'DI PROPERTY Text3 ScrollBars pilih 3
    Text3.Text = "MENGECEK FIELD NIS KOSONG"
    adoPrimaryRSLoginSiswa.MoveFirst
    While Not adoPrimaryRSLoginSiswa.EOF
    If IsNull(adoPrimaryRSLoginSiswa.Fields("NIS")) = True Then
        Text3.Text = Text3.Text & vbCrLf & "NO : " & adoPrimaryRSLoginSiswa.AbsolutePosition & ". " & adoPrimaryRSLoginSiswa.Fields("NAMA_SISWA").Value & " KOSONG"
    ElseIf IsNull(adoPrimaryRSLoginSiswa.Fields("NIS")) = False Then
        Text3.Text = Text3.Text & vbCrLf & "NO : " & adoPrimaryRSLoginSiswa.AbsolutePosition & " TIDAK KOSONG "
    End If
        adoPrimaryRSLoginSiswa.MoveNext
    Wend
End Sub

6. Navigasi

Private Sub Command5_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = 1 Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MoveFirst 'Ke record Pertama
    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

Private Sub Command6_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = 1 Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MovePrevious "Ke record Sebelumnya    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

Private Sub Command7_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = adoPrimaryRSLoginSiswa.RecordCount Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MoveNext 'Ke record Selanjutnya    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

Private Sub Command8_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = adoPrimaryRSLoginSiswa.RecordCount Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MoveLast 'Ke record Terakhir    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

6. Mendapatkan Tabel Dalam database

Private Sub Command9_Click()
Dim NamaTabel As ADODB.Recordset
Set NamaTabel = db.OpenSchema(adSchemaTables)
    While Not NamaTabel.EOF
        If NamaTabel!TABLE_TYPE = "TABLE" Then Text4.Text = Text4.Text & vbCrLf & NamaTabel!TABLE_NAME
        NamaTabel.MoveNext
    Wend
End Sub

7. Mendapatkan Field Dalam Tabel

Private Sub Command10_Click()
Dim Column As ADODB.Field
If adoPrimaryRSLoginSiswa.State = adStateOpen Then
    For Each Column In adoPrimaryRSLoginSiswa.Fields
        Text5.Text = Text5.Text & vbCrLf & Column.Name
    Next
End If
End Sub

8. Membuat Tabel - Create Table

Private Sub Command11_Click()
    Dim Cmd As New ADODB.Command
    Cmd.ActiveConnection = db
    Cmd.CommandText = "create table TabelBaru (NAMA_SISWA varchar(20), KELAS varchar(5), TENTANG_SISWA LongChar, Foto LongBinary)"
    Cmd.Execute
End Sub

9. Menambahkan Field Di Tabel Yang Sudah Ada - Add Field In Exists Table

Private Sub Command12_Click()
'Tambahkan references Microsoft ADO Ext. 2.1 for DDL and Security atau versi lebih tinggi
    Dim Xconx As ADODB.Connection
    Dim Xcmd As ADODB.Command
    Dim Xrs As ADODB.Recordset
    Dim m_MDBdatabase As String
    Dim m_MDBtable As String

'Tambahkan columns di tabel yang sudah ada
    Dim ADOXcat As ADOX.Catalog
    Dim MStbl As ADOX.table
    Dim MScol As ADOX.Column
    
    m_MDBdatabase = App.Path & "\DBPembelajaran.mdb"
    m_MDBtable = "TblSiswaLogin"

'Membuat koneksi
    Set Xconx = New ADODB.Connection
    Set Xcmd = New ADODB.Command
    Set Xrs = New ADODB.Recordset
    Set Xconx = CreateObject("ADODB.Connection")
    Xconx.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Persist Security Info=False;" & _
    "Data Source=" & m_MDBdatabase
    Set Xrs = CreateObject("ADODB.Recordset")
    Xrs.CursorLocation = adUseServer

'Mengirimkan MDB dan table ke catalog
    Set ADOXcat = New ADOX.Catalog
    ADOXcat.ActiveConnection = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & m_MDBdatabase
    Set MStbl = ADOXcat.Tables(m_MDBtable)

'Menambahkan columns/Field ke tabel yang ada
    MStbl.Columns.Append "NILAI", adDouble
    MStbl.Columns.Append "KETERANGAN", adVarWChar, 255
    MStbl.Columns.Append "TANGGAL_LAHIR", adDate
    
'Bersihkan
    ADOXcat.ActiveConnection.Close
    Set ADOXcat = Nothing
    Set MStbl = Nothing
    Set MScol = Nothing
    Set Xconx = Nothing
    Set Xcmd = Nothing
    Set Xrs = Nothing
End Sub

10. Hapus Semua Record Dalam Tabel

Private Sub Command13_Click()
    db.Execute "DELETE FROM TBLsiswalogin"
End Sub

11. Hapus Tabel

Private Sub Command14_Click()
'Tambahkan references Microsoft DAO 3.6 Object Library atau versi lebih tinggi
    Dim ConMateri As Database, AdoDao%
    Set ConMateri = OpenDatabase(App.Path & "\DBPembelajaran.MDB", False, False, "MS Access;Pwd=dbpwd")
    Dim TbDef As TableDefs
    Set TbDef = ConMateri.TableDefs
    ConMateri.TableDefs.Delete "NamaTabelYangAkanDiHapus"
End Sub

Read more »