Showing posts with label Date And Time. Show all posts
Showing posts with label Date And Time. Show all posts

Friday, July 5, 2013

VB6 Date Time: Cara Mudah Menghitung Selisih Waktu

Menjelaskan cara mudah/termudah untuk menghitung selisih waktu - Mengapa disebut sebagai cara termudah? Karena ia hanya membutuhkan satu baris kode saja.

Untuk memahami manipulasi Date and Time seperti fungsi built-in dalam VB6 (DateAdd, DatePart, dan sebagainya) atau fungsi-fungsi date custom (bukan built-in), ada baiknya Anda mengetahui fakta mengenai data type date di bawah ini:

  1. Data type date sama seperti data type number lainnya (integer, long, double) yang ditampilkan dengan format tertentu.
  2. Bilangan 0 pada data type number (integer, long, double) padanannya dalam data type date adalah 30 December 1899, Jadi yang kurang dari tanggal 30 December 1899 menjadi bilangan negatif dan yang lebih dari 30 December 1899 akan menjadi bilangan positif.
  3. Limit bilangan negatif untuk data type date adalah: 1 January 100 (-657434) dan untuk bilangan positif: 31 December 9999 (2958465) .
  4. Date type date adalah angka 0,0000115740740740741 yang terus menerus ditambahkan atau terus menerus dikurangkan. 0,0000115740740740741 adalah 1 detik. Jadi (0,0000115740740740741 * 3600 * 24) hasilnya adalah 1. Angka 1 itu maksudnya adalah satu hari.
  5. Seluruh tanggal berada di depan koma dan seluruh jam berada di belakang koma [tanggal, jam] dan sekarang (pada saat saya menulis artikel ini) adalah tanggal/jam: 41460,9088310185
  6. Jika tidak ada tulisan 'ditampilkan dengan format tertentu' pada poin kesatu, apabila orang bertanya: "Jam berapa sekarang?" jawabannya, sekarang jam: 0,904872685185185.
  7. Dan sebagainya, dan sebagainya, dan lain sebagainya.

Dari statement di atas maka, berapa selisih waktu antara: "10:11:01" s/d "11:23:01", jawabannya adalah:

CDate ("11:23:01") - CDate ("10:11:01") hasilnya adalah: 0,049537037037037. Duh, yang benar saja Mang, jadi pusing membacanya. Ingat pada point yang kesatu 'ditampilkan dengan format tertentu' sehingga: CDate (0,049537037037037) hasilnya adalah selisih waktu yang sebenarnya. Atau:

MsgBox  CDate (CDate ("11:23:01") - CDate ("10:11:01")) 'hasilnya adalah selisih waktu yang sebenarnya atau 1:12:00.

Kesimpulannya: Untuk menghitung selisih waktu, kita bisa menggunakan fungsi: CDate (CDate (Time) - CDate (Time)), sehingga tidak harus mengkonversi jam ke detik, menit ke detik dengan bantuan fungsi Abs atau Mod kemudian dari detik dikonversi lagi ke jam, menit, dan detik. Walaupun hasinya sama, tetapi CDate (CDate (Time) - CDate (Time)) jauh lebih simple, bukankah demikian? Nah, bagaimana jika selisih waktunya ditambah hari? Contohnya: berapa selisih waktu antara 18/02/2013 s/d 25/03/2013 hmm... ingat pada point ke satu: 'seperti bilangan lainnya hanya saja ditampilkan dengan format tertentu.'

Keywords: cara, menghitung, jam, selisih, waktu, vb6, date, perbedaan, mencari, angka, time, menit, detik, bilangan

READ MORE - VB6 Date Time: Cara Mudah Menghitung Selisih Waktu

Sunday, June 17, 2012

Memperoleh Informasi Time Zone Dari Local Time

Option Explicit

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(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Function GetTimeZone() As String
Dim tzInfo As TIME_ZONE_INFORMATION
Dim s As String
GetTimeZoneInformation tzInfo
s = IIf(tzInfo.Bias < 0, "+", "-")
GetTimeZone = s & Format((Abs(tzInfo.Bias) \ 60) & ":" & (Abs(tzInfo.Bias) Mod 60), "hh:mm")
End Function

Private Sub Command1_Click()
MsgBox GetTimeZone
End Sub
READ MORE - Memperoleh Informasi Time Zone Dari Local Time

Konversi Detik Ke Hari, Jam, Menit, dan Detik

Public Function SecondsToDateTimeSerial(ByVal Sec As Long) As String
Dim lngSecParam As Long
Dim lngSeconds As Long
Dim lngHours As Long
Dim lngMinutes As Long
Dim tempSecParam As Long

lngSecParam = Sec
lngSeconds = lngSecParam \ 86400
lngSecParam = lngSecParam - (lngSeconds * 86400)
lngHours = lngSecParam \ 3600
lngSecParam = lngSecParam - (lngHours * 3600)
lngMinutes = lngSecParam \ 60
lngSecParam = lngSecParam - (lngMinutes * 60)
tempSecParam = lngSecParam

SecondsToDateTimeSerial = _
IIf(Sec >= 86400, lngSeconds & " day(s), ", vbNullString) & _
IIf(Sec >= 0, Format(lngHours, "0#") & ":", vbNullString) & _
Format(lngMinutes, "0#") & ":" & Format(tempSecParam, "0#")
End Function
READ MORE - Konversi Detik Ke Hari, Jam, Menit, dan Detik

Mengetahui Tanggal Berada Pada Posisi Minggu Ke Berapa?

Private Function GetDayInWeek(d As Date) As Integer
Dim dt As Date, i As Integer
For dt = CDate(Format$(d, "mm/yyyy")) To DateAdd("m", 1, d)
If Weekday(dt) = 2 Then
i = i + 1
If dt > d Then Exit For
End If
Next
GetDayInWeek = i
End Function
READ MORE - Mengetahui Tanggal Berada Pada Posisi Minggu Ke Berapa?

Konversi Masehi Ke Hijriyah Dan Sebaliknya

Private Sub Command2_Click()
Dim c As Date
c = CDate("21/12/1945")
Calendar = vbCalHijri
MsgBox c
MsgBox Format(#8/17/1945#, "dddd")
End Sub

Private Sub Command3_Click()
Dim c As Date
Calendar = vbCalHijri
c = CDate("1/1/1455")
Calendar = vbCalGreg
MsgBox c
MsgBox Format(#8/17/1945#, "dddd")
End Sub
READ MORE - Konversi Masehi Ke Hijriyah Dan Sebaliknya

Memperoleh Jumlah Hari Dari Bulan Yang Ditentukan

Private Function DayCount(d As Date) As Integer
DayCount = Day(DateSerial(Year(d), Month(d) + 1, 0))
End Function

Private Sub Command3_Click()
MsgBox DayCount(#2/2/2008#)
End Sub
READ MORE - Memperoleh Jumlah Hari Dari Bulan Yang Ditentukan

Merubah Time Zone Secara Pemrograman

Option Explicit

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) 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 REGTIMEZONEINFORMATION
Bias As Long
StandardBias As Long
DaylightBias As Long
StandardDate As SYSTEMTIME
DaylightDate As SYSTEMTIME
End Type

Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(0 To 63) As Byte
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(0 To 63) As Byte
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Private Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
Private Const TIME_ZONE_ID_UNKNOWN = 0
Private Const TIME_ZONE_ID_STANDARD = 1
Private Const TIME_ZONE_ID_DAYLIGHT = 2

Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Const REG_SZ As Long = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD As Long = 4

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const ERROR_SUCCESS = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_ARENA_TRASHED = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259

Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal lpdwReserved As Long, lpdwType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Const SKEY_NT = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
Const SKEY_9X = "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpWideCharStr As Any, ByVal cchWideChar As Long) As Long

Private Const CP_ACP = 0
Private Const MB_PRECOMPOSED = &H1
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numbytes As Long)
Dim SubKey As String

Private Sub Form_Load()
Dim lRetVal As Long, lResult As Long, lCurIdx As Long
Dim lDataLen As Long, lValueLen As Long, hKeyResult As Long
Dim strvalue As String
Dim osV As OSVERSIONINFO

osV.dwOSVersionInfoSize = Len(osV)
Call GetVersionEx(osV)
If osV.dwPlatformId = VER_PLATFORM_WIN32_NT Then
SubKey = SKEY_NT
Else
SubKey = SKEY_9X
End If

lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, KEY_ALL_ACCESS, hKeyResult)

If lRetVal = ERROR_SUCCESS Then

lCurIdx = 0
lDataLen = 32
lValueLen = 32

Do
strvalue = String(lValueLen, 0)
lResult = RegEnumKey(hKeyResult, lCurIdx, strvalue, lDataLen)

If lResult = ERROR_SUCCESS Then
List1.AddItem Left(strvalue, lValueLen)
End If

lCurIdx = lCurIdx + 1

Loop While lResult = ERROR_SUCCESS

RegCloseKey hKeyResult
Else
List1.AddItem "Could not open registry key"
End If
End Sub

Private Sub List1_DblClick()
Dim TZ As TIME_ZONE_INFORMATION, oldTZ As TIME_ZONE_INFORMATION
Dim rTZI As REGTIMEZONEINFORMATION
Dim bytDLTName(32) As Byte, bytSTDName(32) As Byte
Dim cbStr As Long, dwType As Long
Dim lRetVal As Long, hKeyResult As Long, lngData As Long

lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey & "\" & List1.Text, 0, KEY_ALL_ACCESS, hKeyResult)

If lRetVal = ERROR_SUCCESS Then
lRetVal = RegQueryValueEx(hKeyResult, "TZI", 0&, ByVal 0&, rTZI, Len(rTZI))

If lRetVal = ERROR_SUCCESS Then
TZ.Bias = rTZI.Bias
TZ.StandardBias = rTZI.StandardBias
TZ.DaylightBias = rTZI.DaylightBias
TZ.StandardDate = rTZI.StandardDate
TZ.DaylightDate = rTZI.DaylightDate

cbStr = 32
dwType = REG_SZ

lRetVal = RegQueryValueEx(hKeyResult, "Std", 0&, dwType, bytSTDName(0), cbStr)

If lRetVal = ERROR_SUCCESS Then
Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, bytSTDName(0), cbStr, TZ.StandardName(0), 32)
Else
RegCloseKey hKeyResult
Exit Sub
End If

cbStr = 32
dwType = REG_SZ

lRetVal = RegQueryValueEx(hKeyResult, "Dlt", 0&, dwType, bytDLTName(0), cbStr)

If lRetVal = ERROR_SUCCESS Then
Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, bytDLTName(0), cbStr, TZ.DaylightName(0), 32)
Else
RegCloseKey hKeyResult
Exit Sub
End If

lRetVal = GetTimeZoneInformation(oldTZ)

If lRetVal = TIME_ZONE_ID_INVALID Then
MsgBox "Error getting original TimeZone Info"
RegCloseKey hKeyResult
Exit Sub
Else
If TZ.DaylightDate.wMonth <> 0 And TZ.DaylightBias <> 0 Then
lRetVal = SetTimeZoneInformation(TZ)
Else
Call CopyMemory(TZ.DaylightName(0), TZ.StandardName(0), 64)
TZ.DaylightBias = 0
lRetVal = SetTimeZoneInformation(TZ)
End If
MsgBox "Time Zone Changed, Click OK to restore"
lRetVal = SetTimeZoneInformation(oldTZ)
End If
End If

RegCloseKey hKeyResult
End If
End Sub
READ MORE - Merubah Time Zone Secara Pemrograman

Thursday, June 14, 2012

Dua Cara Memperoleh Nama Hari Dari Tanggal Tertentu

Cara Pertama
Private Function GetDayName(d As Date) As String
GetDayName = WeekdayName(Weekday(d, vbMonday))
End Function
Cara Kedua
Private Function GetDayName(d As Date) As String
GetDayName = Format$(d, "dddd")
End Function
Contoh penggunaan
Private Sub Command1_Click()
MsgBox GetDayName(#6/14/2012#)
End Sub
READ MORE - Dua Cara Memperoleh Nama Hari Dari Tanggal Tertentu

Dua Cara Memperoleh Tanggal Terakhir Dari Bulan Tertentu

Cara Pertama:
Private Function GetLastDayOfMonth(d As Date) As Integer
GetLastDayOfMonth = DateDiff("d", Format$(d, "mm/yyyy"), Format$(DateAdd("m", 1, d), "mm/yyyy"))
End Function
Cara Kedua:
Private Function GetLastDayOfMonth(d As Date) As String
GetLastDayOfMonth = DateAdd("m", 1, DateSerial(Year(d), Month(d), 1)) - 1
End Function
Contoh Penggunaan:
Private Sub Command2_Click()
Dim d As Date
d = #7/13/2012#
MsgBox GetLastDayOfMonth(d)
End Sub
READ MORE - Dua Cara Memperoleh Tanggal Terakhir Dari Bulan Tertentu

Cara Yang Sangat Efisien Untuk Mengkonversi Detik

Mengenai cara yang sangat efisien untuk mengkonversi detik ke jam:menit:detik menggunakan VB6 - Kita hanya perlu 1 baris untuk mengkonversi detik ke jam:menit:detik, adapun kodenya adalah sebagai berikut:
Option Explicit

Private Sub Command1_Click()
MsgBox Format$(DateAdd("s", SecondToConvert, 0), "hh:mm:ss")
End Sub
READ MORE - Cara Yang Sangat Efisien Untuk Mengkonversi Detik

Apa Yang Terjadi Jika dd/mm/yyyy dirubah menjadi mm/yyyy

Mengenai merubah format "dd/mm/yyyy" yang dirubah menjadi "mm/yyyy" dalam VB6 - Judul di atas sangat jelas, Apakah yang akan terjadi dengan sebuah tanggal yang memiliki format "dd/mm/yyyy" kemudian kita rubah formatnya menjadi "mm/yyyy" dalam pemrograman Visual Basic 6.0? pemahaman ini sangat penting terutama jika kita banyak berhubungan dengan pemrograman VB6 yang melibatkan banyak format tanggal, misalnya merancang aplikasi database.

Apabila kita menginput sebuah tanggal misalnya #12/06/2012# dalam format "dd/mm/yyyy" kemudian kita rubah dengan "mm/yyyy" sehingga menjadi #06/2012# apakah yang terjadi dengan tanggal 12? tanggal 12 akan kembali ke tanggal awal atau tanggal 01. Untuk membuktikannya coba Anda buat kode yang sangat sederhana seperti di bawah ini:

Option Explicit

Private Sub Command1_Click()
Dim d As Date
d = #23/12/2012#
Dim s As String
s = Format$(d, "mm/yyyy")
MsgBox CDate(Format$(s, "dd/mm/yyyy"))
End Sub
Apakah artinya? banyak, mari kita buat logika pemrograman sederhana dengan menggunakan pengetahuan di atas. Contoh kasus sederhana: Diketahui tanggal #30/01/2012#, ditanyakan nama hari dari awal tanggal a.k.a #01/01/2012#? maka:
Option Explicit

Private Sub Command1_Click()
Dim d As Date
d = #23/12/2012#
Dim s As String
s = Format$(d, "mm/yyyy")
MsgBox Format$(s, "dddd")
End Sub
Bukankah kode di atas akan menghasilkan Sabtu untuk tanggal #01/12/2012# dan Minggu untuk tanggal #23/12/2012#?
READ MORE - Apa Yang Terjadi Jika dd/mm/yyyy dirubah menjadi mm/yyyy

Memperoleh Jumlah Hari Dalam Tahun Tertentu

Private Function GetDaysInYear(d As Date) As Integer()
Dim dt As Date, i As Integer, x(7) As Integer, c As Integer, g As Date
g = CDate(Format$(d, "mm/yyyy"))
c = IIf(Year(d) Mod 4 = 0, 366, 365)
For dt = g To DateAdd("d", c - 1, g)
x(Weekday(dt)) = x(Weekday(dt)) + 1
Next
GetDaysInYear = x
End Function
Private Sub Command2_Click()
Dim d() As Integer
d = GetDaysInYear(#2/22/2011#)
MsgBox d(1) + d(2) + d(3) + d(4) + d(5) + d(6) + d(7)
End Sub
READ MORE - Memperoleh Jumlah Hari Dalam Tahun Tertentu

Memperoleh Jumlah Hari Dalam Selisih Tanggal Tertentu

Private Function GetDaysInRange(d As Date, f As Date) As Integer()
Dim dt As Date, x(7) As Integer
For dt = d To f
x(Weekday(dt)) = x(Weekday(dt)) + 1
Next
GetDaysInRange = x
End Function
Private Sub Command1_Click()
Dim d() As Integer
d = GetDaysInRange(#2/1/2012#, #2/28/2012#)
MsgBox d(1) + d(2)
End Sub
READ MORE - Memperoleh Jumlah Hari Dalam Selisih Tanggal Tertentu

Menampilkan Tanggal Lengkap Disertai Hari

Private Function DateFull(d As Date) As String
DateFull = Format$(d, "dddd, dd/mm/yyyy")
End Function

Private Sub Command1_Click()
MsgBox DateFull(#12/12/2012#)
End Sub
READ MORE - Menampilkan Tanggal Lengkap Disertai Hari

Apakah Tahun Tertentu Merupakan Tahun Kabisat?

Private Function IsLeapYear(d As Date) As String
IsLeapYear = (Year(d) Mod 4 = 0)
End Function

Private Sub Command1_Click()
MsgBox IsLeapYear(#12/12/2012#)
End Sub
READ MORE - Apakah Tahun Tertentu Merupakan Tahun Kabisat?

Memperoleh Jumlah Hari Dalam Bulan Tertentu

Private Function GetDaysInMonth(d As Date) As Integer()
Dim dt As Date, i As Integer, x(7) As Integer, c As Integer, g As Date
g = CDate(Format$(d, "mm/yyyy"))
c = Day(DateSerial(Year(d), Month(d) + 1, 0))
For dt = g To DateAdd("d", c - 1, g)
x(Weekday(dt)) = x(Weekday(dt)) + 1
Next
GetDayInWeek = x
End Function
Private Sub Command2_Click()
Dim d() As Integer
d = GetDaysInMonth(#2/22/2012#)
MsgBox d(1) + d(2)
End Sub
READ MORE - Memperoleh Jumlah Hari Dalam Bulan Tertentu

Sunday, May 27, 2012

Generator Timestamp ISO 8601 Compliant - VB6 Code

Di bawah ini merupakan fungsi Visual Basic 6.0 untuk melakukan generate timestamp (oauth_timestamp dalam Google atau Twitter) yang dibutuhkan pada saat kita melakukan request terhadap situs affiliate Amazon bersamaan dengan signature yang valid. Fungsi di bawah saya peroleh dari vbhelper. Adapun kode untuk Amazon timestamp tersebut adalah sebagai berikut:

Option Explicit 

Private Declare Sub
GetSystemTime Lib "kernel32.dll" (lpSystemTime As SYSTEMTIME)

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

' Return an ISO 8601 compliant timestamp.
Private Function GetIsoTimestamp() As String
Dim st As
SYSTEMTIME

' Get the local date and time.
GetSystemTime st
' Format the result.
GetIsoTimestamp = _
Format$(st.wYear, "0000") & "-" & _
Format$(st.wMonth, "00") & "-" & _
Format$(st.wDay, "00") & "T" & _
Format$(st.wHour, "00") & ":" & _
Format$(st.wMinute, "00") & ":" & _
Format$(st.wSecond, "00") & "Z"
End Function

Tools Amazon yang dapat membantu Anda dalam hal ini (membuat signature valid untuk request): http://associates-amazon.s3.amazonaws.com/signed-requests/helper/index.html
Keterangan mengenai pembuatan signature: http://docs.amazonwebservices.com/AlexaTopSites/latest/index.html?CalculatingSignatures.html
READ MORE - Generator Timestamp ISO 8601 Compliant - VB6 Code