Mengenai cara men-trap (menjebak) objek error yang berada di bawah bari On Error Resume Next - Bagaimana kita dapat melakukan sebuah pengecualian dalam baris yang berada di bawah On Error Resume Next, di bawah adalah contoh kode VB6 beserta penjelasannya:...
Wednesday, June 20, 2012
Cara Yang Cerdik Untuk Mentrap On Error Resume Next - VB6
READ MORE - Cara Yang Cerdik Untuk Mentrap On Error Resume Next - VB6
Labels:
Article
Sunday, June 17, 2012
Contoh Menambahkan Attribut Pada Tag HTML - VB Code
Private Function AddPreWithClassName() Dim d As New MSHTML.HTMLDocument Dim l As HTMLMetaElement Dim x As HTMLHtmlElement d.body.innerHTML = txtPost.Text For Each l In d.All If l.tagName = "PRE" Then l.className...
Labels:
Internet
URL Encode - Decode UTF8 Menggunakan Script Control
Mungkin bisa disebut sebagai cara termudah untuk melakukan Encoding dan Decoding URL UTF8 dalam VB6, dengan memanfaatkan OCX Microsoft Script Control. Adapun kode untuk Encode dan Decode URL UTF8 menggunakan Visual Basic 6.0 adalah sebagai berikut: '================================================================='UrlEncodeUtf8...
VB6 Code - Mencari seluruh Printer Port
Lebih tepatnya mencari port printer tertentu dari seluruh printer port yang ada menggunakan kode VB6. Adapun kode VB6 untuk mencari port tertentu dari seluruh printer port yang ada adalah sebagai berikut:Public Function FindPrinterPort(Port As String)...
Labels:
Printer
VB6 Code - Menampilkan Dialog Page Setup
Option ExplicitPrivate Sub Command1_Click() With CommonDialog1 .Flags = CommonDialog1.Flags Or PrinterConstants.cdlPDPrintSetup .CancelError = True On Error Resume Next Call .ShowPrinter If Err.Number <> ErrorConstants.cdlCancel...
Labels:
Printer
VB6 Code - Memperoleh Control Yang Sedang Aktif - Focus
Option ExplicitPrivate Sub Timer1_Timer() Dim cControl As Control Set cControl = Me.ActiveControl If Not cControl Is Nothing Then Caption = cControl.Name End IfEnd ...
Labels:
Misc-VB6
Contoh Menggunakan CommonDialog Open Save As
'Contoh untuk CommonDialog OpenPrivate Sub Command1_Click() On Error GoTo ErrHandler Dim strPath As String With CommonDialog1 .CancelError = True .Flags = cdlOFNHideReadOnly .Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch...
Labels:
Dialog
Membaca File Binary Dengan Visual Basic 6.0
Option ExplicitPrivate Sub Command1_Click() Open "C:\Documents and Settings\Admin\My Documents\Blogger VB6\Blogger\4basic-vb.xml" For Binary As #1 Dim strBuff As String strBuff = Space(LOF(1)) Get #1, , strBuff Close #1 ...
Labels:
File-And-Folder
XML Pretty Print - Merapikan Format File XML
Private Sub PrettyPrint(Parent As IXMLDOMNode, Optional Level As Integer) Dim Node As IXMLDOMNode Dim Indent As IXMLDOMText If Not Parent.ParentNode Is Nothing And Parent.ChildNodes.Length > 0 Then For Each Node In Parent.ChildNodes...
Labels:
XML-VB6
XML Tidy - Untuk Merapikan File XML
Public Function PrettyPrintXML(XML As String) As String Dim Reader As New SAXXMLReader60 Dim Writer As New MXXMLWriter60 Writer.Indent = True Writer.standalone = False Writer.omitXMLDeclaration = False Writer.encoding = "utf-8" Set...
Labels:
XML-VB6
Memperoleh Informasi Time Zone Dari Local Time
Option ExplicitPrivate 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 IntegerEnd TypePrivate Type TIME_ZONE_INFORMATION...
Labels:
Date And Time
Encode Decode Base64 Menggunakan MSXML
Public Function Base64Enc(ByRef vxbData() As Byte) As String With CreateObject("MSXML.DOMDocument").CreateElement(" Base64 ") .DataType = "bin.base64" .NodeTypedValue = vxbData Base64Enc = .Text End WithEnd FunctionPublic Function...
Labels:
Cryptography
,
String-Manipulation
,
XML-VB6
Mengkopi Gambar Ke Clipboard Melalui VB6
Private Sub CopyFromPictureBox(pic As PictureBox) With Clipboard .Clear .SetData pic.Picture End WithEnd SubPrivate Sub CopyFromFile(Path As String) With Clipboard .Clear .SetData LoadPicture(Path) End WithEnd...
Labels:
PictureBox
Progress Bar dari PictureBox Seperti Pada VB Classic
Option ExplicitDim tenth As LongPrivate Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop...
Labels:
PictureBox
Cara Mudah Baca File Dan Menyimpannya Dalam Array
Option ExplicitPrivate Sub Command1_Click() Dim strArray() As String Open "c:\autoexec.bat" For Input As #1 strArray = Split(Input(LOF(1), 1), vbCrLf) Close #1End ...
Labels:
File-And-Folder
Tutorial File - Membaca, Menghapus Baris Tertentu, dsb
'Kode ini dibuat oleh plenderj salah satu member VBForums'http://www.vbforums.com/showthread.php?s=&threadid=132171' Clear the contents of a filePrivate Sub clearFile(ByVal strPath As String) If Not Len(Dir(strPath)) = 0 Then Open strPath...
Labels:
File-And-Folder
Membaca File Dan Memasukannya Ke Dalam Array
Option ExplicitPrivate Sub Command1_Click() Dim L As Long Dim MyArray() As String ' Load file into string array FileToArray "C:\TEST.txt", MyArray ' Reverse array contents ReverseStrArray MyArray ' show result in...
Labels:
Array
,
File-And-Folder
Mengakses Element WebBrowser Dari Visual Basic 6.0
Option ExplicitPrivate Sub cmdBack_Click() On Error Resume Next WebBrowser1.GoBackEnd SubPrivate Sub cmdForward_Click() On Error Resume Next WebBrowser1.GoForwardEnd SubPrivate Sub cmdGo_Click() WebBrowser1.Navigate txtAddressEnd SubPrivate...
Labels:
Internet
Membaca File Binary atau Text Dengan Cepat
'Kode ini dibuat oleh plenderj salah satu member VBForums'http://www.vbforums.com/showthread.php?s=&threadid=132171' Return a specific line number from a file (note: first line = line number 0)Private Function getLine(ByVal strFile As String, ByVal...
Labels:
File-And-Folder
Custom File Untuk Keperluan Import Database
''Gunakan editor terbaik dari Microsoft yakni Notepad''Tulis seperti di bawah ini'1, Description 1 ,1,100.00,3/1/1998'2, Description 2 ,2,200.00,3/2/1998'Simpan dengan nama c:\test.txt.Private Sub Command1_Click() Dim F As Long, sLine As String, A(0...
Labels:
Database
,
File-And-Folder
Membaca dan Menampilkan Karakter Unicode
Option ExplicitPrivate Sub Command1_Click() Dim a(0 To 5) As Byte a(0) = &HFF a(1) = &HFE a(2) = &H39 a(3) = &H4E a(4) = &H44 a(5) = &H0 Open "unicode.txt" For Binary As #1 Put #1, , a Close #1End...
Labels:
Misc-VB6
TAB Karakter Pada RichTextBox Control
Private Sub RichTextBox1_GotFocus() ReDim arrTabStop(0 To Controls.Count - 1) As Boolean For I = 0 To Controls.Count - 1 arrTabStop(I) = Controls(I).TabStop Controls(I).TabStop = False NextEnd SubPrivate Sub RichTextBox1_LostFocus()...
Labels:
RichTextBox
Implementasi Pencarian Pada RichTextBox Control
Option ExplicitPrivate Sub Command1_Click() HighlightWords RichTextBox1, "text", vbRedEnd SubPrivate Function HighlightWords(rtb As RichTextBox, sFindString As String, lColor As Long) As Integer Dim lFoundPos As Long Dim lFindLength As Long...
Labels:
RichTextBox
Scroll Treeview Ketika Sedang Drag And Drop Sebuah Node
Option ExplicitPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongDim mfX As SingleDim mfY As SingleDim moNode As nodeDim m_iScrollDir As IntegerDim...
Labels:
TreeView
Membuat Random Auto Number - DAO
Public Sub CreateRandomAutonumber() Dim db As DAO.Database Dim td As DAO.TableDef Dim f As DAO.field Set db = CurrentDb Set td = db.CreateTableDef("Table1") Set f = td.CreateField("MyAutoNumber") f.Type = dbLong f.Attributes...
Labels:
Database
Memperoleh Icon Asosiasi File Menggunakan SHFileInfo
Option ExplicitPrivate Const SHGFI_DISPLAYNAME = &H200Private Const SHGFI_EXETYPE = &H2000Private Const SHGFI_SYSICONINDEX = &H4000Private Const SHGFI_LARGEICON = &H0Private Const SHGFI_SMALLICON = &H1Private Const ILD_TRANSPARENT...
Labels:
API-VB6
,
File-And-Folder
Apakah ScrollBar Visible Pada Sebuah Control?
Option ExplicitPrivate Const GWL_STYLE = (-16)Private Const WS_HSCROLL = &H100000Private Const WS_VSCROLL = &H200000Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate...
Bagaimana Cara Mem-Print RichTextBox Yang Memiliki Image
Option ExplicitPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Const WM_PAINT = &HFPrivate Const WM_PRINT = &H317Private...
Labels:
RichTextBox
Pencarian Secara Recursive Pada RichTextBox
Private Sub Form_Load() RichTextBox1.LoadFile "license.txt"End SubPrivate Sub Command1_Click() Dim strval As String Dim nStrings As Long RichTextBox1.LoadFile "license.txt" strval = " " & InputBox("Enter the string to find.", "Findit",...
Labels:
RichTextBox
Bermain Dengan Horizontal Vertical Scroll TextBox
Option ExplicitConst EM_LINESCROLL = &HB6Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As LongPrivate Sub Form_Load() Dim intLineIndex...
Labels:
TextBox
Contoh CommonDialog - Print Dengan Range Tertentu
Option ExplicitPrivate Sub Command1_Click() Dim myDatabase As Database Dim rsMyTable As Recordset Dim i As Integer Dim j As Integer Dim startpage As Integer CommonDialog1.Max = 3 CommonDialog1.FromPage = 1 CommonDialog1.ToPage...
Contoh MRU - Most Recently Used
Option ExplicitPrivate Const MaxMRU = 4Private Const NotFound = -1Private Const NoMRUs = -1Private MRUCount As LongPrivate Sub Form_Load() MRUCount = NoMRUs GetMRUFileListEnd SubPrivate Sub Form_Unload(Cancel As Integer) SaveMRUFileListEnd SubPrivate...
Labels:
Misc-VB6
Contoh Mengisi ListView Dengan Database
Option ExplicitFunction FillList(strDomain As String, objListView As Object) As Boolean Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim intTotCount As Integer Dim intCount1 As Integer Dim intCount2 As Integer Dim colNew As ColumnHeader...
Labels:
ListView
Contoh Mengisi ListView Secara Recursive
Function FirstFileMatch() Dim strFileName As String On Error Resume Next strFileName = Dir(InputBox("Enter a valid path and file name.")) If strFileName = "" Then FirstFileMatch = FirstFileMatch() Else FirstFileMatch = strFileName...
Rename Node TreeView Seperti Pada Explorer
Option ExplicitDim sNodeText As StringPrivate Sub Form_Load() TreeView1.Nodes.Add , , , "test" TreeView1.Nodes.Add , , , "test 1" TreeView1.Nodes.Add , , , "test 2"End SubPrivate Sub Timer1_Timer() TreeView1.StartLabelEdit Timer1.Enabled...
Labels:
TreeView
Mengubat BackGround TreeView Control
Option ExplicitPrivate Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongPrivate Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal...
Labels:
TreeView
Cara Membuat Generic Handler Error
Option ExplicitPrivate Sub Form_Load() On Error GoTo FormLoadErr Err.Raise 76 Err.Raise 70 Exit SubFormLoadErr: Select Case Err.Number Case 76 MsgBox "Form_Load Error Handler. Form Does Not Exist" Case Else ...
Labels:
Error-Handling
,
Misc-VB6
Membuat Aplikasi Console Dengan Visual Basic 6.0
Option ExplicitDeclare Function AllocConsole Lib "kernel32" () As LongDeclare Function FreeConsole Lib "kernel32" () As LongDeclare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongDeclare Function GetStdHandle Lib "kernel32" (ByVal...
Labels:
Misc-VB6
Contoh Membuat Picture Yang Dapat DiScroll
Option ExplicitPrivate Sub Form_Load() Picture1.Move 0, 0, ScaleWidth - VScroll1.Width, ScaleHeight - HScroll1.Height With Picture2 .AutoSize = True .Picture = LoadPicture("splash.bmp") .Move 0, 0 End With With HScroll1...
Labels:
PictureBox
Contoh Penggunaan Fungsi API SetCapture and WindowFromPoint
Option ExplicitPrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Type POINT X As Long Y As LongEnd TypePrivate Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare...
Labels:
API-VB6
Contoh Print Preeview Pada Visual Basic 6.0
Option ExplicitPrivate Sub Form_Load() CommonDialog1.CancelError = True Command1.Caption = "Load Picture" Command2.Caption = "Print Preview" Command3.Caption = "Print"End SubPrivate Sub Command1_Click() Dim sFileFilter As String On...
Memperoleh Array Dari Prosedur Fungsi
Option ExplicitPrivate aiLeftSide() As IntegerPrivate asLeftSide() As StringPrivate aiRightSide(1 To 10) As IntegerPrivate asRightSide(1 To 10) As StringPrivate obj As ObjectPublic Function ArrayFromClass() As String() Dim astr(1 To 10) As String...
Labels:
Array
Mengirim dan Menerima Email Menggunakan MAPI
Option ExplicitDim X As LongPrivate Sub Command1_Click() If X - 1 < 0 Then Else X = X - 1 MAPIMessages1.MsgIndex = X Text1.Text = MAPIMessages1.RecipDisplayName Text2.Text = MAPIMessages1.MsgSubject Text3.Text...
Form dan Control Yang Terbebas Resolusi Layar
'Kode Pada FormOption ExplicitDim MyForm As FRMSIZEDim DesignX As IntegerDim DesignY As IntegerPrivate Sub Form_Load() Dim ScaleFactorX As Single, ScaleFactorY As Single ' Scaling factors ' Size of Form in Pixels at design resolution DesignX...
Labels:
Form
Contoh Menjalankan Procedure Di dalam Script Control
Option ExplicitPrivate Sub Command1_Click() ScriptControl1.Modules.Add Text1.Text Form_ActivateEnd SubPrivate Sub Command2_Click() ScriptControl1.Modules(List1).AddCode Text1.Text List1_ClickEnd SubPrivate Sub Command3_Click() Dim RetVal...
Labels:
Misc-VB6
Cara Menggunakan Error Object Yang Ada Pada Script Control
Option ExplicitPrivate Sub Command1_Click() On Error Resume Next With ScriptControl1 .Language = "VBScript" .AllowUI = True .AddCode Text1.Text .Run "Test" End With If Err Then MsgBox Err & " " &...
Labels:
Script-Control
Contoh Memparsing XML Attributes
Private Sub Command1_Click() Dim fso As Object Dim sDir As String Dim doc As Object Dim oFile As Object Set fso = CreateObject("Scripting.FileSystemObject") sDir = "C:\work" Set doc = CreateObject("Msxml2.DOMDocument") doc.async...
Labels:
XML-VB6
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 \...
Labels:
Date And Time
MSXML Encode Decode Base64
Private Function EncodeBase64(ByRef arrData() As Byte) As String Dim objXML As MSXML2.DOMDocument Dim objNode As MSXML2.IXMLDOMElement ' help from MSXML Set objXML = New MSXML2.DOMDocument ' byte array to base64 Set objNode = objXML.createElement("b64")...
Labels:
Cryptography
PrintWindow - Capture Form Beserta Seluruh Objeknya
Option ExplicitPrivate Declare Function PrintWindow Lib "user32" (ByVal hwnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As LongPrivate Sub Command2_Click() Picture1.AutoRedraw = True Set Picture1.Picture = Nothing PrintWindow Me.hwnd,...
Contoh Menggunakan Proxy Pada Internet Transfer Control
Private Sub Command1_Click() Inet1.AccessType = icNamedProxy Inet1.Proxy = "ftp=ftp://ftp-gw" Inet1.URL = "ftp://ftp.microsoft.com" Inet1.Execute , "DIR"End SubPrivate Sub Command2_Click() Inet2.AccessType = icNamedProxy Inet2.Proxy...
Labels:
Internet
Contoh Mengurutkan ListView Berdasarkan Tanggal
'Kode pada ModuleOption ExplicitPublic Type POINT x As Long y As LongEnd TypePublic Type LV_FINDINFO flags As Long psz As String lParam As Long pt As POINT vkDirection As LongEnd TypePublic Type LV_ITEM mask As Long iItem As...
Labels:
ListView
Contoh Menggunakan tarts-with() Dalam Fungsi XPath
Private Sub Command1_Click() Dim doc As MSXML2.DOMDocument Dim nlist As MSXML2.IXMLDOMNodeList Dim node As MSXML2.IXMLDOMNode Set doc = New MSXML2.DOMDocument doc.setProperty "SelectionLanguage", "XPath" doc.Load "c:\books.xml" Set...
Labels:
XML-VB6
Contoh Kode XML Query XPath
Option ExplicitDim gCn As New ADODB.ConnectionConst DBGUID_DEFAULT As String = "{C8B521FB-5CF3-11CE-ADE5-00AA0044773D}"Const DBGUID_SQL As String = "{C8B522D7-5CF3-11CE-ADE5-00AA0044773D}"Const DBGUID_MSSQLXML As String = "{5D531CB2-E6Ed-11D2-B252-00C04F681B71}"Const...
Labels:
XML-VB6
Penyimpanan URL Seperti Pada Blogger - Blogspot
Private Function BloggerTitle(Title As String) As String Dim strCaption() As String strCaption = Split(Title, " ") Dim i As Integer Dim o As String For i = 0 To UBound(strCaption) If Len(Trim$(o) & " " & strCaption(i)) <...
Labels:
Blogger
,
String-Manipulation
Menampillkan File Pada Directory Yang Ditentukan
'Judul : Memunculkan file atau sub direktori pada direktori yang ditentukan'Coder : Tongam Tampubolon (Tomero)'Penjelasan : Buat 1 Listbox, 1 CommandButton, Masukkan kode tsb dalam Form1Private Sub Command1_Click() Call ProsesLokasi(List1,...
Labels:
File-And-Folder
Cara Menggunakan CommonDialog Printer
Private Sub Command1_Click() Dim BeginPage, EndPage, NumCopies, iOn Error GoTo ErrHandler With CommonDialog1 .CancelError = True .ShowPrinter BeginPage = .FromPage EndPage = .ToPage NumCopies = .Copies End...
CommonDialog Help, Cara Menggunakannya
Private Sub Command1_Click() With CommonDialog1 .HelpFile = "mis.chm" .HelpCommand = cdlHelpContents .ShowHelp End WithEnd ...
Labels:
Dialog
CommonDialog Font, Cara Menggunakannya
Private Sub Command1_Click() With CommonDialog1 .CancelError = True On Error GoTo ErrHandler .Flags = cdlCFEffects Or cdlCFBoth .ShowFont Text1.Font.Name = .FontName Text1.Font.Size = .FontSize Text1.Font.Bold...
CommonDialog Color, Cara Menggunakannya
Private Sub Command1_Click() With CommonDialog1 .CancelError = True On Error GoTo ErrHandler .Flags = cdlCCRGBInit .ShowColor Form1.BackColor = .Color End With Exit SubErrHandler:End ...
Labels:
Dialog
VB6 Code - XML Yang Mengandung Binary Data
Option ExplicitDim oDoc As DOMDocumentDim DOCINPATH As StringDim XMLOUTPATH As StringDim DOCOUTPATH As StringPrivate Sub cmdCreateXML_Click() Dim oEle As IXMLDOMElement Dim oRoot As IXMLDOMElement Dim oNode As IXMLDOMNode DOCINPATH = App.Path...
Labels:
XML-VB6
Menggunakan XMLHTTP dan MSXML
Private Sub Command1_Click() Dim soapReq As String Dim objSOAPXMLDoc As New MSXML2.DOMDocument30 Dim objXMLHTTP As New MSXML2.XMLHTTP30 Dim btArr() As Byte Dim backSlashPos As Integer Dim fileNameNoPath As String soapReq = " " &...
Subscribe to:
Posts
(
Atom
)