Monday, July 1, 2013

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:
  1. Win32.hlp (sebelumnya Anda harus memiliki file Win32.hlp ukurannya 24MB)
  2. API-Guide.exe
  3. Google (dengan keyword ... + VB6)

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

Win32 Keyword Search
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
READ MORE - VB6 Add-Ins Tools - Win32 Keyword Search

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
READ MORE - VB6 Code: Memperoleh Serial Hardisk dan Sebagainya

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

READ MORE - Assembler - Embed Manifest Pada Aplikasi MASM

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
READ MORE - Assembler: Mengenal Operasi Logika XOR