Tuesday, October 1, 2013

VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512

VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512
Option Explicit

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
(ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _
ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _
ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" _
(ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" _
(ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" _
(ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _
ByVal dwFlags As Long) As Long

Private Const PROV_RSA_FULL As Long = 1
Private Const PROV_RSA_AES As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000

Private Const HP_HASHVAL As Long = 2
Private Const HP_HASHSIZE As Long = 4

Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768

Private Const ALG_SID_MD2 As Long = 1
Private Const ALG_SID_MD4 As Long = 2
Private Const ALG_SID_MD5 As Long = 3
Private Const ALG_SID_SHA As Long = 4
Private Const ALG_SID_SHA_256 As Long = 12
Private Const ALG_SID_SHA_384 As Long = 13
Private Const ALG_SID_SHA_512 As Long = 14

Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)

' Create Hash
Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String
Dim hProv As Long, hHash As Long
Dim abytHash(0 To 63) As Byte
Dim lngLength As Long
Dim lngResult As Long
Dim strHash As String
Dim i As Long
strHash = ""
If CryptAcquireContext(hProv, vbNullString, vbNullString, _
IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _
CRYPT_VERIFYCONTEXT) <> 0& Then
If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then
lngLength = UBound(abytData()) - LBound(abytData()) + 1
If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) _
Else lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&)
If lngResult <> 0& Then
lngLength = UBound(abytHash()) - LBound(abytHash()) + 1
If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) <> 0& Then
For i = 0 To lngLength - 1
strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2)
Next
End If
End If
CryptDestroyHash hHash
End If
CryptReleaseContext hProv, 0&
End If
CreateHash = LCase$(strHash)
End Function

' Create Hash From String(Shift_JIS)
Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String
CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID)
End Function

' Create Hash From File
Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Long) As String
Dim abytData() As Byte
Dim intFile As Integer
Dim lngError As Long
On Error Resume Next
If Len(Dir(strFileName)) > 0 Then
intFile = FreeFile
Open strFileName For Binary Access Read Shared As #intFile
abytData() = InputB(LOF(intFile), #intFile)
Close #intFile
End If
lngError = Err.Number
On Error GoTo 0
If lngError = 0 Then CreateHashFile = CreateHash(abytData(), lngAlgID) _
Else CreateHashFile = ""
End Function

' MD5
Public Function CreateMD5Hash(abytData() As Byte) As String
CreateMD5Hash = CreateHash(abytData(), CALG_MD5)
End Function
Public Function CreateMD5HashString(ByVal strData As String) As String
CreateMD5HashString = CreateHashString(strData, CALG_MD5)
End Function
Public Function CreateMD5HashFile(ByVal strFileName As String) As String
CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5)
End Function

' SHA-1
Public Function CreateSHA1Hash(abytData() As Byte) As String
CreateSHA1Hash = CreateHash(abytData(), CALG_SHA)
End Function
Public Function CreateSHA1HashString(ByVal strData As String) As String
CreateSHA1HashString = CreateHashString(strData, CALG_SHA)
End Function
Public Function CreateSHA1HashFile(ByVal strFileName As String) As String
CreateSHA1HashFile = CreateHashFile(strFileName, CALG_SHA)
End Function

' SHA-256
Public Function CreateSHA256Hash(abytData() As Byte) As String
CreateSHA256Hash = CreateHash(abytData(), CALG_SHA_256)
End Function
Public Function CreateSHA256HashString(ByVal strData As String) As String
CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256)
End Function
Public Function CreateSHA256HashFile(ByVal strFileName As String) As String
CreateSHA256HashFile = CreateHashFile(strFileName, CALG_SHA_256)
End Function

' SHA-384
Public Function CreateSHA384Hash(abytData() As Byte) As String
CreateSHA384Hash = CreateHash(abytData(), CALG_SHA_384)
End Function
Public Function CreateSHA384HashString(ByVal strData As String) As String
CreateSHA384HashString = CreateHashString(strData, CALG_SHA_384)
End Function
Public Function CreateSHA384HashFile(ByVal strFileName As String) As String
CreateSHA384HashFile = CreateHashFile(strFileName, CALG_SHA_384)
End Function

' SHA-512
Public Function CreateSHA512Hash(abytData() As Byte) As String
CreateSHA512Hash = CreateHash(abytData(), CALG_SHA_512)
End Function
Public Function CreateSHA512HashString(ByVal strData As String) As String
CreateSHA512HashString = CreateHashString(strData, CALG_SHA_512)
End Function
Public Function CreateSHA512HashFile(ByVal strFileName As String) As String
CreateSHA512HashFile = CreateHashFile(strFileName, CALG_SHA_512)
End Function

Keywords: vb6, md5, hash, function, sha256, hashing, in, vb, sha512, generator, sha1, sha, vba, algorithm, sha512.dll

READ MORE - VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512

Thursday, August 15, 2013

Contoh VB6 Kode Cek Stok SEV Indosat (STK)

Di bawah ini merupakan contoh kode yang digunakan untuk mengecek stok SEV Indosat.

Peralatan yang dibutuhkan:

  1. Modem GSM
  2. Kartu chip Indosat

Adapun kodenya adalah sebagai berikut:

Option Explicit 

'-----------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-----------------------------------------------------------------------------

Dim strBuffer As String

Private Sub cmdSend_Click()
txtResult.Text = ""
txtProcess.Text = ""
strBuffer = ""
If UCase$(Left$(txtATCommand.Text, 2)) <> "AT" Then
MSComm1.Output = txtATCommand.Text & Chr(26)
Else
MSComm1.Output = txtATCommand.Text & vbCrLf
End If
End Sub

Private Sub Form_Load()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.CommPort = 3 'Port disesuaikan
.Settings = "115200,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub

Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
strBuffer = strBuffer & MSComm1.Input
End Select
txtProcess.Text = strBuffer
txtProcess.SelStart = Len(txtProcess.Text)
Do
strBuffer = strBuffer & MSComm1.Input
Loop While MSComm1.InBufferCount

If InStr(1, strBuffer, "+STIN: 99" & vbCrLf) Then
MSComm1.Output = "AT+STGI=99" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 9" & vbCrLf) Then
MSComm1.Output = "AT+STGI=9" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 6" & vbCrLf) Then
MSComm1.Output = "AT+STGI=6" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 3" & vbCrLf) Then
MSComm1.Output = "AT+STGI=3" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 1" & vbCrLf) Then
MSComm1.Output = "AT+STGI=1" & vbCrLf
strBuffer = ""
End If

If InStr(1, strBuffer, "+STGI") Then
If InStr(1, strBuffer, "SEV Menu") Then
MSComm1.Output = "AT+STGR=0,1,3" & vbCrLf
strBuffer = ""
End If

If InStr(1, strBuffer, "Inventory") Then
MSComm1.Output = "AT+STGR=6,1,1" & vbCr
strBuffer = ""
End If
If InStr(1, strBuffer, "Optional") Then
MSComm1.Output = "AT+STGR=6,1,1" & vbCr
strBuffer = ""
End If
If InStr(1, strBuffer, "Enter MPIN") Then
MSComm1.Output = "AT+STGR=3,1" & vbCr
MSComm1.Output = "313131" & Chr(26) 'PIN disesuaikan, hati-hati 3x salah PIN kartu akan diblokir
strBuffer = ""
End If
End If

End Sub

Catatan penting:

  1. Sebelumnya kita harus mengaktifkan terlebih dahulu menu STK-nya seperti yang telah dijelaskan dalam posting disini.
  2. Setelah seluruhnya selesai, yang harus kita lakukan adalah mengetikan AT+STGI=0 dan klik tombol Send seperti yang terlihat pada gambar di bawah:

Cek STOK SEV Indosat
Gambar - Cek STOK SEV Indosat

Download: Contoh kode VB6 cek stok SEV Indosat

Keywords: contoh, cek, gambar, vb6, code, visual, basic, 6.0, contok, chek, kode, html, contohcek, stk, output, instr, indosat, contoh-contoh, coding, source, mscomm1.output

READ MORE - Contoh VB6 Kode Cek Stok SEV Indosat (STK)

Monday, July 29, 2013

VB6 Database: Listview Code Generator Source Code

Tools VB6 Add-Ins yang satu ini digunakan untuk mengenerate source code listview untuk berinteraksi dengan database. Cara menggunakan:

  • Registrasikan terlebih dahulu komponen VB6 Listview Generator.dll yang terdapat dalam folder bin.
  • Buka project VB6
  • Klik menu Add-Ins >> VB6 Listview Generator, maka akan muncul form seperti di bawah ini:

VB6 Listview Generator
Gambar - VB6 Listview Generator

  • Pilih database apa saja (terserah), seperti gambar di bawah ini :

VB6 Listview Generator - Memilih database
Gambar: VB6 Listview Generator - Memilih database

  • Pilih tabel apa saja (terserah), seperti gambar di bawah ini:

VB6 Listview Generator - Memilih Tabel
VB6 Listview Generator - Memilih Tabel

Pilih ID (sebaiknya AUTO INCREMENT), seperti gambar di bawah ini:

VB6 Listview Generator - Memilih ID
VB6 Listview Generator - Memilih ID

  • Klik tombol Generate Code.
  • Ulangi seluruh langkah di atas sejumlah form listview yang Anda butuhkan.
  • Terakhir, edit manual jika ada kode yang kurang sesuai.
  • Selesai.

Download: VB6 Listview Generator Source Code. 

READ MORE - VB6 Database: Listview Code Generator Source Code

Friday, July 26, 2013

VB6 DataGrid: Mengatur Tinggi Listitem Dropdown

Membahas hal yang kurang penting mengenai cara mengatur tinggi Listitem pada dropdown datagrid. Seperti biasa menggunakan fungsi API SendMessage yang bisa dilihat penjelasannya disini, kemudian beberapa konstanta ListBox yang bisa Anda lihat penjelasannya disini, serta konstanta ComboBox yang bisa Anda lihat penjelasannya disini.

Option Explicit 

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const
LB_SETITEMHEIGHT = &H1A0
Private Const CB_SETITEMHEIGHT = &H15

Private Sub SetListItemHeight(ctrl As Control, ByVal newHeight As Long)
Dim uMsg As Long
If TypeOf ctrl Is ListBox Then
uMsg = LB_SETITEMHEIGHT
ElseIf TypeOf ctrl Is ComboBox Then
uMsg = CB_SETITEMHEIGHT
Else
Exit Sub
End If
SendMessage ctrl.hwnd, uMsg, 0, ByVal CLng(newHeight And &HFFFF&)
ctrl.Refresh
End Sub

Contoh penggunaan:

Private Sub Command1_Click() 
SetListItemHeight List1, 25
End Sub

Private Sub Form_Load()
Dim i As Integer
For i = 1 To 10
List1.AddItem i
Next
End Sub

Sehingga hasilnya:

dropdown_normal_height
Gambar: Dropdown DataGrid dengan Tinggi Normal

Kemudian: 

dropdown_autoheight_listitem
Gambar: Dropdown DataGrid dengan Listitem yang Diperbesar (otomatis mengikuti row height datagrid).

READ MORE - VB6 DataGrid: Mengatur Tinggi Listitem Dropdown