Thursday, July 11, 2013

VB6 PictureBox - Print Left Center Right Align - PictureBox

Di bawah ini merupakan contoh print left - center - right pada PictureBox, seperti pada gambar di bawah ini:

Gambar - VB6 Print Left Center Right Align PictureBox

Option Explicit

'-------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------
'Print right align pada objek PictureBox
Private Sub PrintRightAlign(ByVal Teks As String, pic As PictureBox)
With pic
.CurrentX = pic.ScaleWidth - pic.TextWidth(Teks)
pic.Print Teks
End With
End Sub

'Print center pada objek PictureBox
Private Sub PrintCenter(ByVal Teks As String, pic As PictureBox)
With pic
.CurrentX = (pic.ScaleWidth - pic.TextWidth(Teks)) / 2
pic.Print Teks
End With
End Sub

'Print left pada objek PictureBox
Private Sub PrintLeft(ByVal Teks As String, pic As PictureBox)
With pic
pic.Print Teks
End With
End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = True
End Sub

'Contoh print left align
Private Sub cmdLeft_Click()
Static i As Long
i = i + 1
Call PrintLeft(i, Picture1)
End Sub

'Contoh print center
Private Sub cmdCenter_Click()
Static i As Long
i = i + 1
Call PrintCenter(i, Picture1)
End Sub

'Contoh print right
Private Sub cmdRight_Click()
Static i As Long
i = i + 1
Call PrintRightAlign(i, Picture1)
End Sub

Download: vb6_print_center_right_left.zip

Wednesday, July 10, 2013

VB6 API - Menghilangkan Border TextBox, ListBox, etc.

Mengenai cara menghilangkan border object TextBox, ListBox, dan lain sebagainya.

Option Explicit 
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
 
Private Const WS_EX_CLIENTEDGE = &H200 
Private Const GWL_EXSTYLE = (-20) 
 
Private Sub RemoveBorder(ctl As Control) 
    Dim lStyle As Long 
    ctl.Appearance = 1 
    lStyle = GetWindowLong(ctl.hwnd, GWL_EXSTYLE) 
    lStyle = lStyle And Not WS_EX_CLIENTEDGE 
    SetWindowLong ctl.hwnd, GWL_EXSTYLE, lStyle 
    ctl.Appearance = 0 
End Sub

Contoh penggunaan:

Private Sub Command1_Click() 
    Call RemoveBorder(Text1) 
End Sub

Tuesday, July 9, 2013

VB6 ListBox - Mengetahui Item Height Object ListBox

Untuk tujuan tertentu, terkadang kita memerlukan sebuah fungsi untuk mengukur Item Heigh sebuah object ListBox dan di bawah ini merupakan salah satu contohnya dengan menggunakan fungsi API.

Option Explicit   
   
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long   
Private Const LB_GETITEMRECT As Long = &H198   
   
Private Type RECT   
    Left As Long   
    Top As Long   
    Right As Long   
    Bottom As Long   
End Type   
   
Private Function ListBoxItemHeight(lst As ListBox) As Integer   
    Dim rc As RECT, i As Long, dy As Long   
    If lst.ListCount = 0 Then Exit Function   
    SendMessage lst.hwnd, LB_GETITEMRECT, ByVal 0&, rc   
    dy = rc.Bottom - rc.Top   
    ListBoxItemHeight = (dy * Screen.TwipsPerPixelY)   
End Function

Contoh penggunaan:

Private Sub Command1_Click() 
    List1.AddItem "A" 
    MsgBox ListBoxItemHeight(List1) 
End Sub

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:

Data type date sama seperti data type number lainnya (integer, long, double) yang ditampilkan dengan format tertentu.
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.
Limit bilangan negatif untuk data type date adalah: 1 January 100 (-657434) dan untuk bilangan positif: 31 December 9999 (2958465) .
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.
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
Jika tidak ada tulisan 'ditampilkan dengan format tertentu' pada poin kesatu, apabila orang bertanya: "Jam berapa sekarang?" jawabannya, sekarang jam: 0,904872685185185.
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

Thursday, July 4, 2013

VB6 Internet - Membuat FTP Uploader

Seringkali kita membutuhkan aplikasi untuk mengupload file melalui ftp, nah, untuk keperluan ini kita bisa memperolehnya banyak, mulai dari gratis hingga berbayar dari yang kurang lengkap hingga yang memiliki fitur lengkap. Aplikasi tersebut memang dikhususkan untuk keperluan yang serius. Tetapi setelah mencoba beberapa darinya, rasanya tidak sebanding dengan fiturnya yang hebat dan loadingya yang berat jika hanya digunakan untuk mengupload file-file lampiran (file-file source code VB) yang ukurannya hnaya 3kb, 5kb atau belasan kb. Lalu bagaimana solusinya?

Di bawah ini merupakan source code FTP yang dibuat menggunakan VB6 beserta file Installernya (setup.exe) yang bisa digunakan untuk membantu pekerjaan blogging.

Gambar - VB6 FTP uploader

Cara menggunakan:

Terlebih dahulu kita harus memiliki hosting, baik berbayar maupun gratisan. Untuk yang gratisan bisa daftar di sini. Detail mengenai pendaftaran bisa dilihat disini
Download source code ftp disini atau file setup.exe disini
Selanjutnya dalam aplikasi tersebut, kita harus mengisi:

Host = alamat ftp
Username = username Anda
Password = password
Remote Dir. = remote directory public
Situs = domain yang sudah Anda buat

Jika seluruhnya dirasa sudah benar, pilihlah salah satu file .zip yang ukurannya sekitar belasan kb.
Pada Explorer context menu, klik Upload File with Khoiriyyah-FTP seperti yang terlihat pada gambar di bawah ini:

Gambar - FTP Context Menu

Tunggu beberapa saat hingga selesai proses upload.
Setelah selesai, kita memperoleh link untuk dicopy-pastekan ke dalam artikel seperti terlihat pada gambar di bawah ini:

Gambar - Proses upload selesai

Download: Source Code VB6 FTP uploader.
Download: Setup VB6 FTP uploader
.

Wednesday, July 3, 2013

DeRef Dalam VB6

Dengan memanfaatkan salah satu fungsi (GetMem4) yang berada dalam runtime VB6 (msvbvm60.dll).

Option Explicit 
 
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) 
Private Declare Sub GetDWord Lib "MSVBVM60.dll" Alias "GetMem4" (ByRef inSrc As Any, ByRef inDst As Long) 
 
Public Function DeRef(ByVal ptr As Long) As Long 
    If (ptr) Then 
        Call GetDWord(ByVal ptr, DeRef) 
    End If 
End Function 
 
Private Sub Command1_Click() 
     
    Dim lngTest As Long 
    Dim lngAddress As Long 
 
    lngTest = 100 
    lngAddress = VarPtr(lngTest) 'lngAddress sekarang berisi pointer lngTest 
    Text1.Text = DeRef(lngAddress) 'Perhatikan sekarang Text1.Text = 100 (yang berasal dari pointer lngTest)
 
End Sub

Monday, July 1, 2013

VB6 Add-Ins - Mengambil String Terpilih (Code Module)

Mengenai cara mengambil string terpilih (selected) dari code module. Adapun kodenya adalah seperti di bawah ini:

Public Function GetSelections() As String 
     
    Dim cd As CodePane 
    Dim cm As CodeModule 
 
    Set cd = VBInstance.ActiveCodePane 
    Set cm = VBInstance.ActiveCodePane.CodeModule 
 
    Dim StartLine As Long 
    Dim StartColoum As Long 
    Dim EndLine As Long 
    Dim EndColoum As Long 
     
    Dim sKeyword As String 
     
    cd.GetSelection StartLine, StartColoum, EndLine, EndColoum 
    sKeyword = cm.Lines(StartLine, EndLine) 
    GetSelections = Mid$(sKeyword, StartColoum, EndColoum - StartColoum) 
     
End Function

VB6 Add-Ins Tools - Win32 Keyword Search

Dikarenakan saya tidak memiliki MSDN jadinya harus report membuat tools yang seperti ini. Tools ini gunanya untuk melakukan pencarian pada:

Win32.hlp (sebelumnya Anda harus memiliki file Win32.hlp ukurannya 24MB)
API-Guide.exe
Google (dengan keyword ... + VB6)

Hasilnya, pada menu klik kanan VB6 terdapat 3 tambahan menu seperti terlihat pada gambar:

Win32 Keyword Search

Adapun potongan kodenya adalah seperti di bawah:

'----------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com 
'----------------------------------------------------------------------------- 
 
Option Explicit 
 
Const HELP_COMMAND = &H102& 
Const HELP_CONTENTS = &H3& 
Const HELP_CONTEXT = &H1 
Const HELP_CONTEXTPOPUP = &H8& 
Const HELP_FORCEFILE = &H9& 
Const HELP_HELPONHELP = &H4 
Const HELP_INDEX = &H3 
Const HELP_KEY = &H101 
Const HELP_MULTIKEY = &H201& 
Const HELP_PARTIALKEY = &H105& 
Const HELP_QUIT = &H2 
Const HELP_SETCONTENTS = &H5& 
Const HELP_SETINDEX = &H5 
Const HELP_SETWINPOS = &H203& 
 
Private Declare Function WinHelp Lib "user32.dll" Alias "WinHelpA" (ByVal hWndMain As Long, ByVal lpHelpFile As String, ByVal uCommand As Long, dwData As Any) As Long 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal LpszDir As String, ByVal FsShowCmd As Long) As Long 
 
Public VBInstance As VBIDE.VBE 
 
Private oWin32Search As Office.CommandBarControl 
Private oGoogleSearch As Office.CommandBarControl 
Private oAPIGuideSearch As Office.CommandBarControl 
 
Private WithEvents Win32Search As CommandBarEvents 
Private WithEvents GoogleSearch As CommandBarEvents 
Private WithEvents APIGuideSearch As CommandBarEvents 
 
Private Sub SearchKeyword(Keyword As String) 
    Dim ret As Long 
    ret = WinHelp(frmDummy.hwnd, App.Path & "\win32.hlp", HELP_KEY, ByVal Keyword) 
End Sub 
 
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant) 
 
    On Error GoTo ErrHandler: 
 
    Set VBInstance = Application 
     
    If ConnectMode = ext_cm_Startup Then 
        Set oWin32Search = AddItemToMenu("&Win32 Keyword Search", "Code Window") 
        Set Win32Search = VBInstance.Events.CommandBarEvents(oWin32Search) 
         
        Set oGoogleSearch = AddItemToMenu("&Google Search", "Code Window") 
        Set GoogleSearch = VBInstance.Events.CommandBarEvents(oGoogleSearch) 
        
        Set oAPIGuideSearch = AddItemToMenu("&API-Guide Search", "Code Window") 
        Set APIGuideSearch = VBInstance.Events.CommandBarEvents(oAPIGuideSearch) 
    End If 
     
    Exit Sub 
 
ErrHandler: 
 
    MsgBox Err.Description 
 
End Sub 
 
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) 
    On Error Resume Next 
    Call oWin32Search.Delete 
    Set oWin32Search = Nothing 
    Call oGoogleSearch.Delete 
    Set oWin32Search = Nothing 
    Call oWin32Search.Delete 
    Set oAPIGuideSearch = Nothing 
    Set Win32Search = Nothing 
    Set GoogleSearch = Nothing 
    Set APIGuideSearch = Nothing 
    Set VBInstance = Nothing 
End Sub 
 
Private Function AddItemToMenu(sCaption As String, sMenuName As String, Optional Bitmap As Object) As Office.CommandBarControl 
 
    Dim cbMenuCommandBar As Office.CommandBarControl 
    Dim cbMenu As CommandBar 
    Dim oTemp As Object 
    Dim sClipText As String 
 
    On Error GoTo ErrHandler: 
 
    Set cbMenu = VBInstance.CommandBars(sMenuName) 
    If cbMenu Is Nothing Then Exit Function 
 
    Set cbMenuCommandBar = cbMenu.Controls.Add(msoControlButton, , , VBInstance.CommandBars(sMenuName).Controls.Item("&Definition").Index) 
    cbMenuCommandBar.Caption = sCaption 
 
'    If Not Bitmap Is Nothing Then 
'        With Clipboard 
'            sClipText = .GetText 
'            Set oTemp = .GetData 
'            .SetData Bitmap, vbCFBitmap 
'            cbMenuCommandBar.PasteFace 
'            .Clear 
'            If Not oTemp Is Nothing Then 
'                .SetData oTemp 
'            End If 
'            .SetText sClipText 
'        End With 
'        If Err Then GoTo ErrHandler 
'    End If 
 
    Set AddItemToMenu = cbMenuCommandBar 
 
    Exit Function 
 
ErrHandler: 
 
    MsgBox Err.Description 
 
End Function 
 
Private Sub Win32Search_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 
    Dim sSelections As String 
    sSelections = GetSelections 
    If Trim$(sSelections) = "" Then Exit Sub 
    Call SearchKeyword(sSelections) 
End Sub 
 
Private Sub GoogleSearch_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 
    Dim r As Long 
    Dim sSelections As String 
    sSelections = Trim$(GetSelections) 
    If sSelections = "" Then Exit Sub 
    r = ShellExecute(0, "open", "http://www.google.com/search?q=" & sSelections & "+VB6", 0, 0, 1) 
End Sub 
 
Private Sub APIGuideSearch_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 
    Dim sSelections As String 
    sSelections = Trim$(GetSelections) 
    If sSelections = "" Then Exit Sub 
    Dim wsh As New IWshRuntimeLibrary.WshShell 
    wsh.RegWrite "HKCU\Software\KPD-Team\API-Guide\LastAPI", sSelections 
    Shell "C:\Program Files\API-Guide\API-Guide.exe", vbNormalFocus 
End Sub 
 
Public Function GetSelections() As String 
     
    Dim cd As CodePane 
    Dim cm As CodeModule 
 
    Set cd = VBInstance.ActiveCodePane 
    Set cm = VBInstance.ActiveCodePane.CodeModule 
 
    Dim StartLine As Long 
    Dim StartColoum As Long 
    Dim EndLine As Long 
    Dim EndColoum As Long 
     
    Dim sKeyword As String 
     
    cd.GetSelection StartLine, StartColoum, EndLine, EndColoum 
    sKeyword = cm.Lines(StartLine, EndLine) 
    GetSelections = Mid$(sKeyword, StartColoum, EndColoum - StartColoum) 
     
End Function

Selengkapnya bisa didownload pada link di bawah ini:
Download: Win32KeywordSearch

VB6 Code: Memperoleh Serial Hardisk dan Sebagainya

Mengenai cara memperoleh serial hardisk dan sebagainya. Adapun kodenya seperti terlihat di bawah ini:

Option Explicit 
  
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long 
 
Public Function GetSerialNumber(ByVal sDrive As String) As Long 
    Call GetVolumeInformation(sDrive, vbNullString, 0, GetSerialNumber, ByVal 0&, ByVal 0&, vbNullString, 0) 
End Function 
 
Private Sub Command1_Click() 
    MsgBox Hex$(GetSerialNumber("C:\")) 
End Sub

Assembler - Embed Manifest Pada Aplikasi MASM

Mengenai cara menambahkan manifest pada resource MASM (Macro Assembler).

Tambahkan baris di bawah ini pada file resource (*.rc):

#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 
#define RT_MANIFEST 24 
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST DISCARDABLE "xpmanifest.xml"

Contoh lengkapnya seperti di bawah ini (tentu saja berbeda dengan file *.rc yang Anda miliki):

#define  ID_SPIN1 101
#define  ID_SPIN2 102

#define  ID_SLIDER1 201
#define  ID_SLIDER2 202

#define  ID_SCROLLBAR1 301
#define  ID_SCROLLBAR2 302

#define  ID_PROGRESS1 401
#define  ID_PROGRESS2 402

#define  ID_EDIT1 501
#define  ID_EDIT2 502

#define  ID_STATIC -1
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define RT_MANIFEST 24
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST DISCARDABLE "xpmanifest.xml"
;################################################################################

CONTROLS DIALOGEX 0, 0, 310, 199
STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Fun example using - Scroll Bar, Slider, Up Down, Progress controls"
FONT 8, "MS Sans Serif"
BEGIN
    CONTROL         "Slider1",ID_SLIDER1,"msctls_trackbar32",TBS_AUTOTICKS | 
                    TBS_BOTH | WS_TABSTOP,20,158,120,29,WS_EX_DLGMODALFRAME | 
                    WS_EX_STATICEDGE
    CONTROL         "Slider2",ID_SLIDER2,"msctls_trackbar32",TBS_VERT | 
                    TBS_TOP | WS_BORDER | WS_TABSTOP,23,53,27,89,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    SCROLLBAR       ID_SCROLLBAR1,25,14,108,24
    SCROLLBAR       ID_SCROLLBAR2,154,18,17,128,SBS_VERT
    EDITTEXT        ID_EDIT1,93,77,32,38,ES_CENTER | ES_NUMBER | NOT 
                    WS_BORDER,WS_EX_CLIENTEDGE
    CONTROL         "Spin1",ID_SPIN1,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS,83,77,11,38
    EDITTEXT        ID_EDIT2,197,67,31,17,ES_CENTER | ES_AUTOHSCROLL | 
                    ES_NUMBER | NOT WS_BORDER,WS_EX_DLGMODALFRAME | 
                    WS_EX_CLIENTEDGE
    CONTROL         "Spin2",ID_SPIN2,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS | UDS_HORZ,197,84,31,19,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    CONTROL         "Progress1",ID_PROGRESS1,"msctls_progress32",0x0,168,165,
                    114,17,WS_EX_DLGMODALFRAME
    CONTROL         "Progress2",ID_PROGRESS2,"msctls_progress32",
                    PBS_VERTICAL | PBS_SMOOTH,259,53,27,98,WS_EX_CLIENTEDGE | 
                    WS_EX_STATICEDGE
    CTEXT           "Click and drag any Slider or Scroll Bar control or click on the Up-Down control buttons.",
                    ID_STATIC,191,7,98,28,SS_SUNKEN | WS_BORDER
END

IDR_XPMANIFEST1 MANIFEST "xpmanifest.xml"

;####################################################################################

Contoh selengkapnya bisa Anda download pada link di bawah ini:

Download: khoiriyyah.vacau.com/masm_manifest.zip

Assembler: Mengenal Operasi Logika XOR

Option Explicit 
 
'-------------------------------------------------------------------- 
'http://khoiriyyah.blogspot.com 
'-------------------------------------------------------------------- 
 
Private Function XOR_(A, B) As Boolean 
    XOR_ = Not (Not (A And Not (A And B)) And Not (B And Not (A And B))) 
End Function 
 
Private Sub Command1_Click() 
    MsgBox XOR_(True, True)   'True  + True  = False 1 + 1 = 0 
    MsgBox XOR_(True, False)  'True  + False = True  1 + 0 = 1 
    MsgBox XOR_(False, True)  'False + True  = True  0 + 1 = 1 
    MsgBox XOR_(False, False) 'False + False = False 0 + 0 = 0 
End Sub

Dari sini maka:

XOR EAX, EAX ;maka hasilnya nilai EAX pasti 0
XOR AX, AX   ;maka hasilnya nilai AX pasti 0

Assembler - Menambahkan Icon 32bit pada Aplikasi MASM

Ini merupakan contoh lanjutan dari sini, mengenai cara menambahkan icon 32bit pada aplikasi MASM (Macro/Microsoft? Assembler). Adapun bagian yang ditambahkan pada file *.rc:

#define IDI_APPICON 100
IDI_APPICON ICON DISCARDABLE "icon.ico"

Sehingga lengkapnya menjadi:

#include "\masm32\include\resource.h"

;################################################################################

#define  ID_SPIN1 101
#define  ID_SPIN2 102

#define  ID_SLIDER1 201
#define  ID_SLIDER2 202

#define  ID_SCROLLBAR1 301
#define  ID_SCROLLBAR2 302

#define  ID_PROGRESS1 401
#define  ID_PROGRESS2 402

#define  ID_EDIT1 501
#define  ID_EDIT2 502

#define  ID_STATIC -1
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define RT_MANIFEST 24

#define IDI_APPICON 100
IDI_APPICON ICON DISCARDABLE "icon.ico"

CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST DISCARDABLE "xpmanifest.xml"
;################################################################################

CONTROLS DIALOGEX 0, 0, 310, 199
STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Fun example using - Scroll Bar, Slider, Up Down, Progress controls"
FONT 8, "MS Sans Serif"
BEGIN
    CONTROL         "Slider1",ID_SLIDER1,"msctls_trackbar32",TBS_AUTOTICKS | 
                    TBS_BOTH | WS_TABSTOP,20,158,120,29,WS_EX_DLGMODALFRAME | 
                    WS_EX_STATICEDGE
    CONTROL         "Slider2",ID_SLIDER2,"msctls_trackbar32",TBS_VERT | 
                    TBS_TOP | WS_BORDER | WS_TABSTOP,23,53,27,89,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    SCROLLBAR       ID_SCROLLBAR1,25,14,108,24
    SCROLLBAR       ID_SCROLLBAR2,154,18,17,128,SBS_VERT
    EDITTEXT        ID_EDIT1,93,77,32,38,ES_CENTER | ES_NUMBER | NOT 
                    WS_BORDER,WS_EX_CLIENTEDGE
    CONTROL         "Spin1",ID_SPIN1,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS,83,77,11,38
    EDITTEXT        ID_EDIT2,197,67,31,17,ES_CENTER | ES_AUTOHSCROLL | 
                    ES_NUMBER | NOT WS_BORDER,WS_EX_DLGMODALFRAME | 
                    WS_EX_CLIENTEDGE
    CONTROL         "Spin2",ID_SPIN2,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS | UDS_HORZ,197,84,31,19,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    CONTROL         "Progress1",ID_PROGRESS1,"msctls_progress32",0x0,168,165,
                    114,17,WS_EX_DLGMODALFRAME
    CONTROL         "Progress2",ID_PROGRESS2,"msctls_progress32",
                    PBS_VERTICAL | PBS_SMOOTH,259,53,27,98,WS_EX_CLIENTEDGE | 
                    WS_EX_STATICEDGE
    CTEXT           "Click and drag any Slider or Scroll Bar control or click on the Up-Down control buttons.",
                    ID_STATIC,191,7,98,28,SS_SUNKEN | WS_BORDER
END

IDR_XPMANIFEST1 MANIFEST "xpmanifest.xml"

;####################################################################################

Selanjutnya pada file *.ASM, bagian yang ditambahkan:

.CONST

    IDI_APPICON     EQU 100

Pada message pembuatan dialog WM_INITDIALOG tambahkan kode di bawah ini:

        .if uMsg == WM_INITDIALOG
        
                    ; set app icon
                    INVOKE LoadImage, hInstance, IDI_APPICON, IMAGE_ICON, 32, 32, LR_DEFAULTSIZE
                    mov hIcon, eax
                    INVOKE SendMessage, hWin, WM_SETICON, ICON_BIG, hIcon
                    INVOKE LoadImage, hInstance, IDI_APPICON, IMAGE_ICON, 16, 16, LR_DEFAULTSIZE
                    mov hIcon, eax
                    INVOKE SendMessage, hWin, WM_SETICON, ICON_SMALL, hIcon
                    ;End set icon

Sehingga sekarang hasil akhirnya seperti gambar di bawah ini:

Gambar: MASM Icon 32 bit

Download: MASM Icon32bit

Wednesday, April 17, 2013

VB6 Code - Membuat Cue Banner atau Placeholder Text

Apa yang dimaksud dengan cue banner atau placeholder text atau sebagian menyebutnya dengan watermark text itu? untuk memahaminya perhatikan gambar di bawah ini:

VB6 Cue Banner Placeholder Text Watermark Text

Terlihat pada gambar di atas beberapa objek (ComboBox dan beberapa TextBox) yang memiliki tulisan kurang jelas dengan warna keabu-abuan. Nah, tulisan yang kurang jelas itulah yang dinamakan dengan cue banner/placeholder text/watermark text. Tulisan itu hanya akan muncul apabila objek-objek tersebut memiliki property Text = "" serta dalam keadaan lost focus.

Berikut beberapa bagian kode darinya:

Option Explicit
 
Private Declare Function GetComboBoxInfo Lib "user32" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type COMBOBOXINFO
    cbSize As Long
    rcItem As RECT
    rcButton As RECT
    stateButton  As Long
    hwndCombo  As Long
    hwndEdit  As Long
    hwndList As Long
End Type
 
Private Const ECM_FIRST As Long = &H1500
Private Const EM_SETCUEBANNER As Long = (ECM_FIRST + 1)
 
Public Sub SetCueBanner(obj As Object, str As String)
    Dim s As String
    Dim c As COMBOBOXINFO
    If TypeOf obj Is ComboBox Then
        c.cbSize = Len(c)
        Call GetComboBoxInfo(obj.hwnd, c)
        s = StrConv(str, vbUnicode)
        Call SendMessage(c.hwndEdit, EM_SETCUEBANNER, 0&, ByVal s)
    Else 'TextBox
        s = StrConv(str, vbUnicode)
        Call SendMessage(obj.hwnd, EM_SETCUEBANNER, 0&, ByVal s)
    End If
End Sub

Catatan sangat penting:

Cue banner tidak bisa berjalan pada WinXP yang terinstall left to rigth language seperti arabic dsb. Hal tersebut merupakan bug dari Microsoft sendiri, dan telah diperbaiki pada OS selanjutnya.
Cue banner hanya akan berjalan setelah dicompile serta diberi manifest (XP Style)

Lebih lengkap mengenai pembuatan cue banner/placeholder text/watermark text bisa Anda download pada tautan di bawah ini:

Download: VB6_CueBanner

Sunday, March 31, 2013

Menghilangkan Ritual Mode Compatibility - VB6 Tips

Sebuah aplikasi yang dibuat dengan VB6 seringkali tidak kompatibel dengan OS yang berada di atas XP, akhirnya user harus melakukan kegiatan ritual rutinan pada saat pertama kali menjalankan aplikasi exe tersebut. Adapun rutinan yang dimaksud adalah sebagai berikut:

Klik kanan di icon exe program tersebut.
Pilih Properties
Kemudian klik pada tab Compatibility
Anda dapat memilih atau bisa juga tidak di tombol Change settings for all users
Berikan tanpa centang di Run this program in compatibility mode for
Di dalam menu drop-down pilih sistem operasi yang sesuai
Klik tombol Apply dan OK

Nah, agar user tidak direpotkan dengan kegiatan di atas, lebih baik Anda sisipkan saja beberapa script untuk memasukan beberapa nilai pada registry, di bawah adalah contohnya (InnoSetup Installer):

Scrip Inno sebelumnya....
[Registry]
Root: HKCU; Subkey: "Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers"; ValueType: String; ValueName:"{app}\AplikasiAnda.exe"; ValueData: "WINXP"; Flags: Uninsdeletekey
Root: HKLM; Subkey: "Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers"; ValueType: String; ValueName:"{app}\AplikasiAnda.exe"; ValueData: "WINXP"; Flags: Uninsdeletekey
Scrip Inno sesudahnya....

Demikian, semoga bermanfaat.

VB6 Tools: VB6 Code Tidy

Sebelumnya saya pernah memposting beberapa VB6 Tools, salah satu yang dianggap bermanfaat diantaranya adalah Manifest Creator yang dibuat LaVolpe.
Kali ini masih mengenai VB6 tools yang berguna untuk men-tidy code-code VB6. Contoh kode:

Private Sub GetProfilIDAndBloggerID(TextXML As String)

Dim child As IXMLDOMNode
Dim x As New DOMDocument
x.loadXML TextXML
Dim strID As String
Dim i As Integer
' Add the child nodes

ReDim strIDAndProfiles(0)

For Each child In x.documentElement.childNodes
If child.NodeName = "entry" Then
For i = 0 To child.childNodes.Length - 1
If child.childNodes(i).NodeName = "id" Then
strID = child.childNodes(i).Text
If Trim$(strID) <> "" Then
strIDAndProfiles(UBound(strIDAndProfiles)) = strID
End If
ReDim Preserve strIDAndProfiles(UBound(strIDAndProfiles) + 1)
End If
Next
End If
Next

If blnFromFile = False Then
strPathXML = App.Path & "\" & strTitle & ".XML"
End If

Dim b As Integer

frmBlog.List1.Clear

If UBound(strIDAndProfiles) > 0 Then
For i = 0 To UBound(strIDAndProfiles)
If Trim$(strIDAndProfiles(i)) <> "" Then
frmBlog.List1.AddItem strIDAndProfiles(i)
End If
Next
End If

With frmBlog
If .List1.ListCount > 1 Then
.Show vbModal, frmMain
strID = .List1.List(.List1.ListIndex)
Else
strID = .List1.List(0)
End If
End With

i = InStr(1, strID, "user-")
b = InStr(1, strID, "blog-")

strBlogID = Mid$(strID, b + 5, 19)
strProfileID = Mid$(strID, i + 5, Len(strID) - (b + 3))
Set x = Nothing

End Sub

Melihat kode di atas, tidak Anda kesulitan membacanya? Nah, dengan tools ini Anda akan mudah meng-indentnya secara tepat, sehingga menjadi:

Private Sub GetProfilIDAndBloggerID(TextXML As String)

    Dim child As IXMLDOMNode
    Dim x As New DOMDocument
    x.loadXML TextXML
    Dim strID As String
    Dim i As Integer
    ' Add the child nodes

    ReDim strIDAndProfiles(0)

    For Each child In x.documentElement.childNodes
        If child.NodeName = "entry" Then
            For i = 0 To child.childNodes.Length - 1
                If child.childNodes(i).NodeName = "id" Then
                    strID = child.childNodes(i).Text
                    If Trim$(strID) <> "" Then
                        strIDAndProfiles(UBound(strIDAndProfiles)) = strID
                    End If
                    ReDim Preserve strIDAndProfiles(UBound(strIDAndProfiles) + 1)
                End If
            Next
        End If
    Next

    If blnFromFile = False Then
        strPathXML = App.Path & "\" & strTitle & ".XML"
    End If

    Dim b As Integer

    frmBlog.List1.Clear

    If UBound(strIDAndProfiles) > 0 Then
        For i = 0 To UBound(strIDAndProfiles)
            If Trim$(strIDAndProfiles(i)) <> "" Then
                frmBlog.List1.AddItem strIDAndProfiles(i)
            End If
        Next
    End If

    With frmBlog
        If .List1.ListCount > 1 Then
            .Show vbModal, frmMain
            strID = .List1.List(.List1.ListIndex)
        Else
            strID = .List1.List(0)
        End If
    End With

    i = InStr(1, strID, "user-")
    b = InStr(1, strID, "blog-")

    strBlogID = Mid$(strID, b + 5, 19)
    strProfileID = Mid$(strID, i + 5, Len(strID) - (b + 3))
    Set x = Nothing

End Sub

Cara menggunakan:

Ekstrak terlebih dahulu
Klik Install.bat
Buka project VB6 apa saja (terserah)
Klik Menu Add-Ins, pada menu ini Anda akan menemukan sebuah menu baru yaitu menuu Rapikan Kode
Klik Rapikan Kode
Beri centang pada CheckBox Rapikan Seluruhnya untuk merapikan seluruh kode yang ada pada Project

Download: VB6 Code Tidy Source Code

Friday, January 25, 2013

Edit Class 1.0 - Mempermudah Membuat Posting di Blogspot

Mengenai Edit Class versi 1.0 sebuah sofware editor sederhana yang saya buat untuk mempermudah membuat postingan di blogspot.

Apakah Edit Class 1.0 itu?

Edit class 1.0 merupakan sebuah software editor sederhana untuk mempermudah membuat posting di blogspot. Edit class bukan HTML editor, dia hanya lebih spesifik dari itu. Karena tujuannya yang sederhana, Edit Class tidak memperlakukan HTML sebagai objek yang memiliki properties, atribut, dsb, tetapi ia lebih memperlakukan HTML sebagai string, jadi dalam kenyataannya ia hanya memanipulasi string. File yang dihasilkan berektensi .blr [pada kenyataannya ia hanya file teks biasa yang bisa Anda buka melalui NotePad].

Gambar: Edit Class 1.0 - Sofware Editor Sederhana

Sebelum Menggunakan Edit Class 1.0

Sebelum menggunakan ada hal yang harus diperhatikan, bahwa Edit Class terdiri dari beberapa bagian, di antaranya yang paling terpenting adalah: SideBar yang tediri dari dua bagian: Daftar HTML dan Daftar Macro, MainEdit yang terdiri dari: BodyPost, Preview, CustomCSS, EditHTML, EditMacros.

Daftar HTML

Daftar HTML berguna untuk membuat daftar tags HTML yang dibutuhkan. Untuk menambah daftar HTML yang dibutuhkan, Anda dapat membuka file yang terdapat pada Program Files\Code\HTMLTag.txt dan mengeditnya menggunakan Notepad. Adapun format kodenya adalah sebagai berikut:

{Name!+StartTags|EndTags}

Contoh:

{Underline!+<U>|</U>}

Daftar Macro

Daftar Macro macro dibuat berdasarkan daftar HTML di atas, untuk menambah daftar Macro yang dibutuhkan, Anda dapat membuka file yang terdapat pada Program Files\Code\Macros.txt. Macro digunakan untuk meng-eksekusi (menjalankan) rangkaian perintah daftar HTML di atas secara berurutan dari kiri ke kanan. Adapun format kodenya adalah sebagai berikut:

{MacroName:HTMLName,HTMLName, etc.}

Contoh:

{italic+underline:italic,Underline}

Preview

Preview digunakan untuk melihat hasil tulisan Anda yang dibuat pada Tab Body Post.

Custom CSS

Custom CSS merupakan style CSS yang yang akan mempengaruhi preview. Custom CSS digunakan sebagai simulasi CSS yang terdapat pada blog agar style tulisan offline yang Anda buat dengan Edit Class menyerupai style tulisan online.

Daftar Built-In Functions

Pada versi 1.0 ini, Edit Class memiliki beberapa fungsi built-in yang dapat ditambahkan pada file yang terdapat di Program Files\Code\HTMLTag.txt. Adapun format kode untuk memanggil fungsi-fungsi built-in adalah sebagai berikut:

{Name!+Built-In}

Contoh:

{Encode!+EncodeHTML}

Adapun fungsi-fungsi built-in tersebut, yaitu:

DecodeHTML
EncodeHTML
RemoveHTML
MakeTable
FormatVB6Code
OrdinerList
UnOrdinerList
InsertLink
InsertImage

Cara menggunakan Edit Class 1.0

Buatlah tulisan pada Body Post
Pilih teks yang akan dimodifikasi
DoubleKlik HTML atau Macro yang dibutuhkan
Setelah, selesai kopi tulisan ke dalam posting blogspot milik Anda.

Download: EditClass1.0

Thursday, January 24, 2013

TEST - Membuat Table di Blogspot

Catatan
Because while loops do not have explicit built-in counter variables, they are more vulnerable to infinite looping than the other types of loops. Moreover, because it is not necessarily easy to discover where or when the loop condition is updated, it is easy to write a while loop in which the condition never gets updated. For this reason, you should be careful when you design while loops.

HTML List Tags

Tag	Description
<ol>	Defines an ordered list
<ul>	Defines an unordered list
<li>	Defines a list item
<dl>	Defines a definition list
<dt>	Defines an item in a definition list
<dd>	Defines a description of an item in a definition list

Wednesday, December 26, 2012

Mempercepat Loading Blogger TOC (Daftar Isi) - Blogging

Mengenai cara mempercepat loading daftar isi (table of content) pada blogspot yang telah dilengkapi dengan script daftar isi (table of content), terlebih bagi blogspot yang memiliki konten yang sudah cukup banyak (di atas 500 posting).

Full Feed dan Summary Feed adalah kata kuncinya seperti yang telah saya posting sebelumnya, mengapa bisa demikian? mengapa full feed dan summary feed mempengaruhi kecepatan loading daftar isi? begini saja coba Anda bandingkan dua feed link default (bawaan asli blogger tanpa parameter) di bawah ini:

feed/default

feed/summary

Manakah yang menurut Anda lebih cepat?

Nah, dikarenakan yang dibutuhkan oleh script TOC javascript hanyalah Title dan URL-nya saja maka tentulah kita lebih memilih summary feed, bahkan kalau ada yang tanpa konten sekalipun (hanya Title dan URl-nya saja) tentu ini akan jauh lebih cepat lagi.

Di bawah ini merupakan cara mengganti default menjadi summary:

<script src="http://blog-milik-anda.blogspot.com/feeds/posts/default?start-index=1&max-results=500&amp;alt=json-in-script&amp;callback=loadtoc"></script>

Gantilah default di atas (yang diberi warna merah) menjadi summary seperti di bawah ini:

<script src="http://blog-milik-anda.blogspot.com/feeds/posts/summary?start-index=1&max-results=500&amp;alt=json-in-script&amp;callback=loadtoc"></script>

Bagaimana dengan daftar isi blog ini, coba Anda klik disini. Tulisan ini umumnya berlaku juga bagi widget-widget yang melibatkan feed seperti recent post (home made version).

Blogging - Mengenal 2 Jenis Feed Blogger

Untuk konten (posting), blogger memiliki dua jenis feed, yang pertama full feeds sedangkan yang kedua adalah summary feeds. Full feed akan mengandung satu konten penuh postingan, sedangkan summary feed hanya ringkasannya saja.

Pemilik blog (blogger) dapat menentukan sendiri, jenis feed mana yang akan diterapkan pada blognya. Jika pemilik blog menerapkan summary feed pada blog-nya maka pada saat seseorang yang tanpa otentifikasi dan otorisasi mengaksesnya akan selalu menampilkannya ringkasannya saja. Sedangkan apabila seseorang yang memiliki otentifikasi atau otorisasi (mis. dengan login terlebih dahulu) melakukan akses terhadap feed tersebut maka ia akan selalu memperoleh full feed, walaupun pada settingan, ia menyetelnya menjadi summary feed.

Demikian sekilas mengenai feed blogger berdasarkan pada perolehan data pada saat di akses, full feed dan summary feed.

Gambar: Setting feed pada blogger >> side menu Settings >> Other

Sunday, December 23, 2012

JavaScript Events: OnMouseOver OnMouseOut - Blogging

Mengenai event pada javascript atau lainnya - Apa yang dimaksud event dalam pemrograman? hmm...apa ya, begini saja agar mudah terhook dengan memory, kita terjemahkan saja secara harfiah bahwa event itu adalah terjadinya sebuah peristiwa.

Untuk mempermudah pemahaman, maka kita ambil dua contoh event yang terdapat pada javascript yaitu event OnMouseOver dan event OnMouseOut. Berdasarkan terjemahan tadi di atas, maka event OnMouseEver bisa kita terjemahkan saja terjadinya peristiwa [pointer mouse di atas objek] sedangkan event OnMouseOut bisa kita terjemahkan terjadinya peristiwa [pointer mouse di luar objek], dan sebagainya.

Apakah Kegunaan Event itu?

Event berguna sebagai trigger/pemicu/eksekusi/menjalankan kode lainnya yang berada di bawahnya.

Contoh Fungsi Yang Dipanggil Melalui Events

Di bawah merupakan contoh fungsi javascript yang dipanggil melalui events onmousehover dan events onmouseout:

< script type = 'text/javascript' >
function mousehover(x) {
	x.style.overflow = "auto" ;
}

function mouseout(x) {
	x.style.overflow = "hidden" ;
}
<  / script >

<DIV style="HEIGHT: 330px; OVERFLOW: hidden" onmouseover=mousehover(this) onmouseout=mouseout(this) expr:class='"widget-content " + data:display + "-label-widget-content"'></DIV>

Friday, December 21, 2012

Contoh Sederhana Bekerja Dengan TabStrip - VB6

Bekerja dengan objek TabStrip dalam pengkodean VB6, maka tidak akan terlepas dari yang dinamakan Container. Diantara container yang banyak digunakan untuk keperluan ini adalah PictureBox. TabStrip berbeda dengan SSTab, TabStrip memerlukan tambahan kode untuk menampilkan objek-objek yang berada di bawah tab-nya.

Berikut merupakan contoh sederhana bagaimana bekerja dengan TabStrip. TabStrip yang digunakan dalam contoh adalah TabStrip yang berada pada komponen COMCTL32.OCX. Dengan mempergunakan COMCTL32.OCX maka tampilannya dapat mengikuti style window yang ada. Karena di dalam pengkodeannya akan banyak melakukan resize terhadap beberapa objek, cobalah untuk mempertimbangkan posting saya sebelumnya di sini.

Gambar: Tampilan tabstrip yang berada di bawah tabstrip lagi.

Download: Source Code VB6 - Contoh sederhana menggunakan TabStrip.

Method .Move Jauh Lebih Cepat - VB6 Tips

Menjelaskan bahwa method .Move yang terdapat pada objek jauh lebih cepat dibandingkan setting pada properties - Apabila Anda bekerja dengan tampilan yang terdapat pada VB6 dan pada tampilan tersebut banyak melakukan resize terhadap objek misalnya: Form melakukan resize terhadap Container1 (PictureBox), Container1 melakukan resize terhadap Container2 (PictureBox), Container2 melakukan resize terhadap Container3, dan seterusnya hingga akhirnya Container terakhir melakukan resize terhadap objek-objek. Barulah Anda menyadari sebuah ketidakstabilan karena menggunakan kode seperti yang dicontohkan di bawah ini:

Private Sub Picture1_Resize()
    With Text1
        .Left = 0
        .Top = 0
        .Width = Picture1.ScaleWidth
        .Height = Picture1.ScaleHeight
    End With
End Sub

Sebaiknya kode di atas Anda ganti saja dengan menggunakan methode move seperti yang dicontohkan di bawah ini:

Private Sub Picture1_Resize()
    With Text1
        .Move 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
    End With
End Sub

Atau sebaiknya buatlah sebuah method reusable seperti di bawah ini:

Public Sub SetSameSize(Parent, Child)
   With Child
        .Move 0, 0, Parent.ScaleWidth, Parent.ScaleHeight
    End With
End Sub

Contoh penggunaan dari method di atas:

Private Sub Picture1_Resize()
    SetSameSize Picture1, Text1
End Sub

Ngomong-ngomong mengapa method move lebih cepat? tentu saja karena ia hanya memerlukan satu kali proses dan langsung memanggil fungsi API, sementara setting properties membutuhkan bebarapa kali proses disebabkan OOP dan Class-nya.

Thursday, December 20, 2012

Context Menu Untuk File Ber-ektensi VBL - VB6 OCX

Masih ingatkah Anda? Ya, tentu saja. Masih ingatkah Anda dengan posting saya terdahulu tentang file yang ber-ektensi .VBL. Jika lupa coba Anda buka link di samping untuk mengingatnya klik disini. Apakah pada saat mencoba komponen Shadow.OCX menampilkan gambar di bawah ini:

Gambar: Lisensi tidak ditemukan untuk komponen shadow.ocx

Hal tersebut terjadi karena Anda tidak memiliki lisensi untuk menggunakan shadow.ocx pada saat design time dan hanya diperbolehkan melihat demonya saja. Sekarang kita bermain pura-pura, pura-puranya Anda telah membeli lisensi dari saya, kemudian saya memberikan lisensinya berupa file ber-ektensi .vbl atau tepatnya lisensi.vbl.
Download: Lisensi.VBL

Apa Yang Harus Dilakukan Dengan Lisensi.VBL

Memasukan lisensi key yang terdapat pada file lisensi.vbl ke dalam registry agar Anda dapat menggunakan file shadow.ocx tersebut pada saat design time, tetapi bagaimana caranya? Kita ambil dua cara termudah:

Mengganti ektensi .vbl dengan ektensi .reg kemudian double klik
Membuat context menu untuk file .vbl dengan cara mengetik file registry di bawah ini pada notepad:

REGEDIT4[HKEY_CLASSES_ROOT\.vbl]
@="VisualBasic.VBLFile"
[HKEY_CLASSES_ROOT\VisualBasic.VBLFile]
@="Visual Basic Control License File"
[HKEY_CLASSES_ROOT\VisualBasic.VBLFile\shell\open]
@="&Insert License"

Kemudian simpan dengan nama lisensi.reg lakukan double klik, selanjutnya akan ada konfirmasi sukses.
Klik kanan file lisensi.vbl maka pada context menu akan terdapat menu Insert Lisensi seperti gambar di bawah ini:
Gambar: Context Menu Baru (Insert License)
Selanjutnya apa lagi jika bukan klik!

Nah, setelah Anda paham maka kita hentikan kepura-puraannya.

Nama file: Shadow.OCX
GUID: A434183A-F9E0-4DFA-AB7B-7538C391A576
License Key: kkgdjdikddedddfdieikpdfkqesjgdjdkdpj

VB6 Code: Menggunakan ( := ) dalam Coding VB6

Apabila Anda sering bekerja dengan pemrograman macro yang terdapat dalam Microsoft Office , entah itu macro yang ada dalam Microsoft Office 97, Microsoft Office 2000, Microsoft Office 2003, Microsoft Office 2007, dan Microsoft Office seterusnya, tentu Anda sudah tidak asing lagi dengan := (titik dua sama dengan).

Dikarenakan VB6 identik dengan VBA office dalam artian keduanya menggunakan bahasa yang sama, kebutuhan runtime file yang sama, dan sebagainya (yang berbeda hanya objek-objek saja), maka apa yang ada dalam VBA tentu bisa dijalankan dalam VB6. Salah satunya adalah tanda (:=) walau jarang sekali melihatnya dalam pengkodean VB6.

Tanda (:=) merupakan pemberitahuan kepada compiler bahwa sebuah argumen optional telah diisi dengan nilai tertentu. Agar lebih jelasnya berikut merupakan contoh sebuah function yang memiliki 26 argument optional (argumen yang memiliki 2 opsi, boleh diisi atau tidak):

Option Explicit

'Sebuah function dengan 26 argument, nama argument dari a s/d z
Private Function Test(Optional a, Optional b, Optional c, Optional d, Optional e _
, Optional f, Optional g, Optional h, Optional i, Optional j, Optional k, Optional l _
, Optional m, Optional n, Optional o, Optional p, Optional q, Optional r, Optional s _
, Optional t, Optional u, Optional v, Optional w, Optional x, Optional y, Optional z)
    MsgBox o
    MsgBox z
    'Kode dan seterusnya
End Function

Maka untuk memanggil fungsi di atas bisa seperti ini:

Private Sub Command1_Click()
    Call Test(, , , , , , , , , , , , , , 6, , , , , , , , , , , 1)
End Sub

Atau seperti ini:

Private Sub Command2_Click()
    Call Test(o:=6, z:=1) 'Call disini berguna untuk memudahkan pembacaan kode
End Sub

Atau seperti ini (dengan membalikan, argumen z di depan dan argumen o di belakang):

Private Sub Command3_Click()
     Call Test(z:=1, o:=6)
End Sub

Atau seperti ini (tanpa call):

Private Sub Command4_Click()
     Test z:=1, o:=6 'tanpa Call juga bisa berjalan kok
End Sub

Mana yang menurut Anda praktis?

Tuesday, December 18, 2012

Blogging - Merapikan Kode XML Dengan Mudah - XML Tidy

Struktur XML (Extensible Markup Language) memiliki tag pembuka juga tag penutup, memiliki parent (induk), dari parent ini kemudian memiliki child (anak), dari child ini memiliki child lagi, dan seterusnya. Sehingga secara tidak langsung parent yang tadi bisa menjadi grandfather, tak terkecuali uncle serta aunt, berikut daughter and son.

Berdasarkan dari cara penulisannya maka format XML ini memungkinkan untuk dibaca oleh kedua belah pihak, baik manusia maupun mesin (compiler/interpreter). Salah satu dari sekian banyak yang menggunakan XML diantaranya adalah template blogger.

Nah, apabila Anda menemukan kode XML misalnya widget yang kurang terformat rapi, dan menyebabkan ia hanya mudah dibaca oleh satu pihak saja yaitu mesin, maka ada cara yang paling mudah untuk merapikannya yaitu dengan menggunakan software editor Notepadd++. Adapun caranya adalah sebagai berikut:

Copykan potongan code XML tersebut ke Notepad++
Pada Notepad++ klik menu TextFX >> TextFX HTML Tidy >> Tidy: Reindent XML, seperti pada gambar di bawah ini:

Gambar: Merapikan kode XML - XML Tidy dengan Notepad++

Dengan dirapikannya kode XML tersebut, maka struktrurnya menjadi logis, mudah untuk dibaca kedua belah pihak (manusia dan mesin), sehingga menjadi mudah untuk diedit.

Contoh XML yang belum dirapikan:

<b:includable id=breadcrumb var="posts">
<b:if cond="data:blog.homepageUrl == data:blog.url">
<b:else></b:else><b:if cond='data:blog.pageType == "item"'>
<DIV class=breadcrumbs>Browse » <A rel=tag expr:href="data:blog.homepageUrl">Beranda</A>
<b:loop var="post" values="data:posts"><b:if cond="data:post.labels">
<b:loop var="label" values="data:post.labels"><b:if cond='data:label.isLast == "true"'> »
<A rel=tag expr:href="data:label.url"><?xml:namespace prefix = data /><data:label.name></data:label.name></A>
</b:if></b:loop>» <SPAN><data:post.title></data:post.title></SPAN>
</b:if></b:loop></DIV><b:else></b:else><b:if cond='data:blog.pageType == "archive"'>
<DIV class=breadcrumbs>Browse » <A expr:href="data:blog.homepageUrl">Beranda</A> » Arsip untuk <data:blog.pageName></data:blog.pageName></DIV><b:else></b:else>
<b:if cond='data:blog.pageType == "index"'>
<DIV class=breadcrumbs>
<b:if cond='data:blog.pageName == ""'>
Browse » <A expr:href="data:blog.homepageUrl">Beranda</A> » Seluruh Artikel
<b:else></b:else>
Browse » <A expr:href="data:blog.homepageUrl">Beranda</A> » Artikel Pada Kategori <data:blog.pageName></data:blog.pageName>
</b:if></DIV></b:if></b:if></b:if></b:if></b:includable>

Contoh XML yang sudah dirapikan:

<b:includable id=breadcrumb var="posts">
  <b:if cond="data:blog.homepageUrl == data:blog.url">
    <b:else></b:else>
    <b:if cond='data:blog.pageType == "item"'>
      <DIV class=breadcrumbs>Browse » 
      <A rel=tag expr:href="data:blog.homepageUrl">Beranda</A>
      <b:loop var="post" values="data:posts">
        <b:if cond="data:post.labels">
        <b:loop var="label" values="data:post.labels">
          <b:if cond='data:label.isLast == "true"'>» 
          <A rel=tag expr:href="data:label.url">
            <data:label.name></data:label.name>
          </A></b:if>
        </b:loop>» 
        <SPAN>
          <data:post.title></data:post.title>
        </SPAN></b:if>
      </b:loop></DIV>
      <b:else></b:else>
      <b:if cond='data:blog.pageType == "archive"'>
        <DIV class=breadcrumbs>Browse » 
        <A expr:href="data:blog.homepageUrl">Beranda</A>»
        Arsip untuk 
        <data:blog.pageName></data:blog.pageName></DIV>
        <b:else></b:else>
        <b:if cond='data:blog.pageType == "index"'>
          <DIV class=breadcrumbs>
            <b:if cond='data:blog.pageName == ""'>Browse » 
            <A expr:href="data:blog.homepageUrl">Beranda</A>»
            Seluruh Artikel 
            <b:else></b:else>Browse » 
            <A expr:href="data:blog.homepageUrl">Beranda</A>»
            Artikel Pada Kategori 
            <data:blog.pageName></data:blog.pageName></b:if>
          </DIV>
        </b:if>
      </b:if>
    </b:if>
  </b:if>
</b:includable>

Wednesday, December 12, 2012

Mengirim SMS Menggunakan Modem Wavecom - VB6 Code

Mengenai cara mengirim SMS menggunakan aplikasi yang dibuat dengan VB6 menggunakan modem GSM Wavecom - Adapun cara mengirim SMS menggunakan aplikasi VB6 secara sederhana kodenya adalah sebagai berikut:

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    With MSComm1
        .CommPort = 7 'Port disesuaikan terhadap modem Wavecom yang terdeteksi
        .Settings = "115200,n,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
    MSComm1.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
    Sleep 1000
    MSComm1.Output = TxtMessage.Text & Chr(26)
End Sub

Caranya:

Buatlah 2 TextBox masing-masing diberi nama TxtNumber dan TxtMessage
Tambahkan OCX Microsoft Comm Control 6.0 (MSComm)
Tambahkan satu CommandButton dengan nama default.

Mengirim SMS Disertai Verifikasi Terkirim - VB Source Code

Mengenai mengirim SMS menggunakan modem wavecom melalui aplikasi yang dibuat menggunakan VB6 - Ini merupakan kelanjutan dari project sebelumnya, pada kesempatan kali, kita akan menambahkan fitur verifikasi, apakah SMS telah terkirim atau gagal terkirim. Nah, bagaimanakah kode untuk mengirim SMS menggunakan modem wavecom melalui aplikasi VB6 yang disertai pesan verifikasi? berikut adalah kodenya:

Option Explicit

Dim strBuffer As String

Private Sub Command1_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    With MSComm1
        .CommPort = 7
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
    MSComm1.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
    Delay 1
    MSComm1.Output = TxtMessage.Text & Chr(26)
    If WaitForSuccess Then
        MsgBox "SMS telah terkirim", vbInformation + vbOKOnly
    Else
        MsgBox "SMS gagal terkirim", vbCritical, "SMS Gagal"
    End If
    
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
    Debug.Print strBuffer
End Sub

Private Function WaitForSuccess() As Boolean
    Dim i As Integer
    Dim strInput As String
    Dim strPart As String
    Dim c As String, b As String
    For i = 1 To 5
        Do
            Delay 1
            c = strBuffer
            strBuffer = ""
            If c = "" Then Exit Do
            b = strInput & c
        Loop
        strPart = b
        strInput = strInput & strPart
        If InStr(1, strInput, vbCrLf & "OK" & vbCrLf) > 0 Then Exit For
        If strPart = "" Then
            Delay 1
        End If
    Next
    WaitForSuccess = InStr(1, strInput, vbCrLf & "OK" & vbCrLf) > 0
End Function

Private Sub Delay(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Demikian mengenai cara mengirim SMS menggunakan modem wavecom melalui aplikasi VB6 yang ditambahkan fitur verifikasi, semoga bermanfaat.

Fungsi Wait Sleep Tanpa Windows API - VB6 Code

Mengenai fungsi wait atau sleep tanpa menggunakan fungsi API - Melanjutkan posting sebelumnya klik disini, sekarang kita akan membuat fungsi sleep atau wait tanpa bantuan API hanya menggunakan kode VB6 murni. Perbedaan fungsi sleep kali ini dengan fungsi sleep sebelumnya adalah:

Fungsi sleep menggunakan Sleep Kernel32.dll:

Mem-freeze GUI (membekukan tampilan)
Hitungan dalam millisecond

Fungsi sleep kali ini (lebih tepatnya delay time):

Tidak mem-freeze GUI
Hitungan dalam second

Adapun fungsi sleep atau wait tanpa fungsi API adalah sebagai berikut:

Private Sub Sleep(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Jika Anda mau bereksperimen maka buatlah kodenya seperti di bawah ini kemudian bandingkan antara fungsi sleep Kernel32.dll dengan fungsi sleep tanpa API.

Option Explicit

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    Label1.Caption = "Mulai menjalankan fungsi sleep atau wait"
    Label1.Refresh
    Sleep 5 'sleep/wait/hentikan eksekusi kode ke baris berikutnya selama 5 detik
    Label1.Caption = "Terhenti selama 5 detik"
End Sub

Private Sub Command2_Click()
    Dim frm As New Form1
    frm.Show
End Sub

Private Sub Timer1_Timer()
    Static i As Integer
    Caption = i
    i = i + 1
End Sub

Private Sub Sleep(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Demikianlah seputar fungsi sleep atau wait, menggunakan API dan tanpa menggunakan API.

Option Explicit

Private Function Sleep(mSecs As Long) As Double
    Dim Duration!
    Duration! = Timer + mSecs
    Do Until Timer > Duration!
        DoEvents
    Loop
End Function

Private Sub Command1_Click()
    Sleep 0.9
    MsgBox "Test"
End Sub

VB6 Code - Fungsi Sleep Atau Wait Yang Diperbaiki

Mengenai fungsi sleep atau wait dalam VB6 yang telah diperbaiki - Fungsi sleep disini berbeda dengan fungsi sleep sebelumnya yang menggunakaan salah satu API kernel32 klik disini atau tanpa API klik disini. Keunggulan dari fungsi sleep kali ini adalah:

Tidak memfreeze GUI (jadi jika ada objek visual, maka ia akan terefresh dengan baik)
Hitungan dalam millisecond.

Adapun fungsi sleep yang telah diperbaiki dengan menggunakan VB6 adalah sebagai berikut:

Option Explicit

Private mCancel As Boolean

Type MSG
   hwnd As Long
   message As Long
   wParam As Long
   lParam As Long
   time As Long
   ptX As Long
   ptY As Long
End Type

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Sub TimerProc()
    mCancel = True
End Sub

Public Sub Wait(frm As Form, mSecs As Long)
    Dim MyMsg As MSG
    Dim TimerID As Long
    
    TimerID = SetTimer(frm.hwnd, ObjPtr(frm), mSecs, AddressOf TimerProc)
    mCancel = False

    Do While Not mCancel
        GetMessage MyMsg, 0, 0, 0
        TranslateMessage MyMsg
        DispatchMessage MyMsg
    Loop

    KillTimer frm.hwnd, TimerID
End Sub

Demikian fungsi sleep dalam VB6 dengan menggunakan timer API. Semoga bermanfaat.

VB6 SMS Gateway: Mendeteksi Port Modem Secara Otomatis

Mengenai cara mendeteksi port modem secara otomatis menggunakan VB6 - Pada project sebelumnya klik disini dan disini. Kita telah berhasil mengirimkan SMS menggunakan modem GSM secara sederhana. Akan tetapi karena sederhana kedua project tersebut tidak diperlengkapi dengan deteksi port modem secara otomatis, sehingga untuk mengetahui port modem Anda lakukan langkah di bawah ini:

Klik tombol start (sebelah kiri bawah)
Selanjutnya klik Settings >> Control Panel >> System
Klik tab Hardware Klik tombol Device Manager
Klik Node Ports (COM & LPT)
Carilah di sana akan ada port modem Wavecom Anda.

Sungguh merepotkan sekali, setiap kali port modemnya berubah kita harus selalu mengulangi dan mengulangi langkah-langkah di atas. Mulai saat ini, tinggalkan cara di atas, dan beralihlah pada deteksi port modem secara otomatis. Adapun kode untuk mendeteksi port modem secara otomatis menggunakan VB6 adalah sebagai berikut:

Option Explicit

Dim strBuffer As String
Dim intPortNumber As String

Private Sub Command2_Click()
    On Error Resume Next
    Dim i As Integer
    For i = 1 To 20
    If MSComm1.PortOpen Then MSComm1.PortOpen = False
        intPortNumber = i
        MSComm1.CommPort = i
        MSComm1.PortOpen = True
        MSComm1.Output = "AT" & vbCrLf
        Wait Me, 50
    Next
End Sub

Private Sub Form_Load()
    With MSComm1
        .Settings = "115200,n,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
    End With
End Sub

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

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
    End Select
    Do
        strBuffer = strBuffer & MSComm1.Input
    Loop While MSComm1.InBufferCount
    If InStr(1, strBuffer, "OK") > 0 Then
        Caption = "COM" & intPortNumber
        Text1.Text = intPortNumber
    End If
End Sub

Demikian cara mendeteksi port modem secara otomatis menggunakan VB6, jika modemnya lebih dari 1, misalnya 2, 3, 8, 15 sampai tak terhingga, Anda hanya perlu sedikit memodifikasi kodenya. Semoga bermanfaat.

VB6 SMS Gateway: Menambahkan Fitur Auto Reply

Mengenai cara membalas SMS secara otomatis melalui aplikasi VB6 - Sebelumnya kita telah membahas mengenai cara menerima SMS baru klik disini, nah sekarang kita akan menambahkan fitur auto reply melalui AT Commands dengan aplikasi VB6 yang kita buat sendiri. Adapun contoh kode VB6 membalas SMS otomatis adalah seperti di bawah ini:

Option Explicit

Dim strBuffer As String
Dim blnFirstLoad As Boolean

Private Sub Command1_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    With MSComm1
        .PortOpen = True
        .Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
        .Output = TxtMessage.Text & Chr(26)
    End With
End Sub

Private Sub Form_Load()
    With MSComm1
        .CommPort = 7 'port disesuaikan atau beri kode auto detect port modem
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .NullDiscard = True
        .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
    Do
        strBuffer = strBuffer & MSComm1.Input
    Loop While MSComm1.InBufferCount
    If InStr(1, strBuffer, "+CMGR") Then
        If InStr(1, strBuffer, "OK") Then
            Text1.Text = strBuffer
        End If
    End If
    If InStr(1, strBuffer, "+CMTI") > 0 Then
        If Right(strBuffer, 1) = vbLf Then
            Dim s() As String
            s = Split(strBuffer, ",")
            Debug.Print s(UBound(s))
             ReadSMSByIndex Trim$(s(UBound(s)))
             Delay 1
             Command1_Click 'Auto reply
            strBuffer = ""
        End If
    End If
    End Select
End Sub

Private Sub ReadSMSByIndex(Index As Integer)
    strBuffer = ""
    MSComm1.Output = "AT+CMGR=" & Index & vbCrLf 'baca SMS yang berada di index ke-1
End Sub

Private Sub Delay(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Demikian contoh kode VB6 untuk membalas SMS baru secara otomatis, Anda dapat memodifikasi kodenya untuk disesuaikan dengan kebutuhan.

VB6 SMS Gateway: Contoh Mengekspor PhoneBook ke Excel

Private Sub ExportToExcel(PhoneBook As String)
    Dim ExcelObj As New Excel.Application
    Dim ExcelBook As Excel.Workbook
    Dim ExcelSheet As Excel.Worksheet
    Dim i As Integer
    
    Set ExcelBook = ExcelObj.Workbooks.Add
    Set ExcelSheet = ExcelBook.Worksheets(1)
    
    Dim s() As String
    Dim r As String
    
    s = Split(PhoneBook, vbCrLf & "+CPBR:")
    
    With ExcelSheet
        .Columns("A:A").ColumnWidth = 7
        .Columns("B:B").ColumnWidth = 16
        .Columns("C:C").ColumnWidth = 16
        .Columns("D:D").ColumnWidth = 16
        For i = 1 To UBound(s)
            If s(i - 1) <> "" Then
                r = Split(s(i - 1), ",")(0)
                If InStr(1, r, "+CPBR:") > 0 Then
                    r = Split(Split(s(i - 1), ",")(0), ":")(1)
                Else
                    r = Split(Split(s(i - 1), ",")(0), ":")(0)
                End If
                .Cells(i, 1) = r
                .Cells(i, 2) = Split(s(i - 1), ",")(1)
                .Cells(i, 3) = Split(s(i - 1), ",")(2)
                .Cells(i, 4) = Split(s(i - 1), ",")(3)
            End If
        Next
    End With

    ExcelObj.Visible = True
End Sub

VB6 SMS Gateway: AT Command Tester Sederhana

Option Explicit 

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 = 7
        .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, "OK") > 0 Then
        txtResult.Text = strBuffer
        txtResult.SelStart = Len(txtResult.Text)
    ElseIf InStr(1, strBuffer, "ERROR") Then
        txtResult.Text = strBuffer
        strBuffer = ""
    End If
End Sub

Download: Source Code

Subscribe to: Comments ( Atom )

Thursday, July 11, 2013

Wednesday, July 10, 2013

Tuesday, July 9, 2013

Friday, July 5, 2013

Thursday, July 4, 2013

Wednesday, July 3, 2013

Monday, July 1, 2013

Wednesday, April 17, 2013

Sunday, March 31, 2013

Friday, January 25, 2013

Apakah Edit Class 1.0 itu?

Sebelum Menggunakan Edit Class 1.0

Daftar Built-In Functions

Cara menggunakan Edit Class 1.0

Thursday, January 24, 2013

HTML List Tags

Wednesday, December 26, 2012

Manakah yang menurut Anda lebih cepat?

Sunday, December 23, 2012

Apakah Kegunaan Event itu?

Contoh Fungsi Yang Dipanggil Melalui Events

Friday, December 21, 2012

Thursday, December 20, 2012

Apa Yang Harus Dilakukan Dengan Lisensi.VBL

Tuesday, December 18, 2012

Wednesday, December 12, 2012

Perhatian

Page Rank

Online

Statistik Pengunjung

embrio9 - Auto Reply

Blog Archive

Visual Basic 6.0

Arabic

Blogging

Miscellaneous