Showing posts with label Internet. Show all posts
Showing posts with label Internet. Show all posts

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.
VB6 FTP uploader
Gambar - VB6 FTP uploader

Cara menggunakan:
  1. Terlebih dahulu kita harus memiliki hosting, baik berbayar maupun gratisan. Untuk yang gratisan bisa daftar di sini. Detail mengenai pendaftaran bisa dilihat disini
  2. Download source code ftp disini atau file setup.exe disini
  3. 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
  4. Jika seluruhnya dirasa sudah benar, pilihlah salah satu file .zip yang ukurannya sekitar belasan kb.
  5. Pada Explorer context menu, klik Upload File with Khoiriyyah-FTP seperti yang terlihat pada gambar di bawah ini:
  6. FTP context menu
    Gambar - FTP Context Menu

  7. Tunggu beberapa saat hingga selesai proses upload.
  8. Setelah selesai, kita memperoleh link untuk dicopy-pastekan ke dalam artikel seperti terlihat pada gambar di bawah ini:
VB6 FTP uploader finish
Gambar - Proses upload selesai

Download: Source Code VB6 FTP uploader.
Download: Setup VB6 FTP uploader
.
READ MORE - VB6 Internet - Membuat FTP Uploader

Thursday, December 6, 2012

VB6 Code - Menambah Internet Explorer Pada Saat Runtime

Contoh kode VB6 sederhana untuk dikembangkan mengenai cara menambah objek internet explorer pada saat runtime.
Option Explicit

Private IE As VBControlExtender

Private Sub Form_Load()
On Error GoTo IEMissing
Set IE = Form1.Controls.Add("Shell.Explorer", "wcIE")
IE.Visible = True
If Not IE Is Nothing Then
IE.object.silent = True
IE.object.Navigate "http://khoiriyyah.blogspot.com"
End If
IEMissing:

End Sub

Private Sub Form_Resize()
If Not IE Is Nothing Then
IE.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End If
End Sub
READ MORE - VB6 Code - Menambah Internet Explorer Pada Saat Runtime

Wednesday, July 4, 2012

VB6 Facebook: Mengakses Facebook Graph API

Mengenai teka-teki mengakses Facebook graph API - Agar tidak membosankan kali ini saya ajak Anda untuk bermain teka-teki saja, apakah semuanya setuju? oh, ternyata semuanya setuju. Baiklah teka-teki kali ini mengenai cara mengendalikan Facebook yang kita miliki dari aplikasi VB6 yang kita buat menggunakan Graph API. Di sini hanya diwakili dengan aplikasi facebook uploader sederhana. Untuk membuat aplikasi tersebut tidak sederhana/rumit, baik, user friendy maka kita membutuhkan satu lagi pemahaman mengenai JSON parser.

Tidak seperti Twitter yang menggunakan OAuth 1.0 yang sangat memusingkan kepala pada saat pembuatan digital signature yang valid (seperti yang telah saya posting sebelumnya, maka pada Facebook prosesnya jauh lebih sederhana kita hanya memerlukan access_token jangka panjang itu saja, atau access_token yang digenerate on the fly melalui OAuth 2.0, jadi kita sudah tidak memerlukan lagi password dan email untuk proses otentifikasi dan otorisasi yang tentu saja sangat tidak aman (berpotensi terjadinya pembajakan akun secara besar-besaran) dan ini sudah tidak dianjurkan lagi baik oleh Google, Facebook, Twitter, .dll (termasuk .ocx juga?).

Mengenai cara memperoleh access_token dari Facebook, silakan Anda cari di Google.

VB6 Facebook Graph API - Photo Uploader
Gambar: Upload photo ke Facebook melalui VB6
Demikian teka-teki kali ini mengenai cara mengakses Facebook graph API melalui aplikasi VB6. Baca juga teka-teka sebelumnya:
READ MORE - VB6 Facebook: Mengakses Facebook Graph API

Tuesday, June 26, 2012

Error: File not found: "C:\Windows\system32\ieframe.dll\1"

Mengenai cara mengatasi File not found: "C:\Windows\system32\ieframe.dll\1" secara otomatis dan mudah, anggap saja sebuah trik.

Bekerja dengan objek WebBrowser atau Microsoft Internet Control, terkadang kita sering berhadapan dengan error: File not found: "C:\Windows\system32\ieframe.dll\1" akibat perubahan nilai yang terdapat pada registry. Walaupun error tersebut bukanlah suatu hal yang serius dan sangat mudah diatasi, tetapi bagaimana jika kejadiannya berulang-ulang? sungguh sesuatu hal yang sangat mengesalkan.

Berdasarkan hal yang telah saya sebutkan di atas, akhirnya saya membuat sebuah tools untuk mengatasi hal ini, tools tersebut dapat bekerja dengan otomatis. Tools tersebut dibuat berdasarkan fakta, bahwa Add-Ins lebih dahulu dijalankan oleh VB6 sebelum melakukan Load terhadap seluruh objek. Jadi kata kuncinya adalah merubah registry menggunakan Add-Ins, adapun kodenya saya bagi dua: yang pertama terdapat pada Connect.dsr dan yang kedua terdapat pada module yang saya namakan dengan modRegistry.bas. Adapun penampakan kodenya adalah sebagai berikut:

Connect.dsr

Option Explicit

Public FormDisplayed As Boolean
Public VBInstance As VBIDE.VBE
Dim mcbMenuCommandBar As Office.CommandBarControl
Public WithEvents MenuHandler As CommandBarEvents

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
On Error GoTo error_handler
Set VBInstance = Application

Debug.Print VBInstance.FullName
RegWrite "HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32\", "C:\WINDOWS\system32\ieframe.dll"
If ConnectMode = ext_cm_External Then
RegWrite "HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32\", "C:\WINDOWS\system32\ieframe.dll"
Else
Set mcbMenuCommandBar = AddToAddInCommandBar("Handle Internet Error")
Set Me.MenuHandler = VBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
End If

If ConnectMode = ext_cm_AfterStartup Then
If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then
RegWrite "HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32\", "C:\WINDOWS\system32\ieframe.dll"
End If
End If

Exit Sub

error_handler:

MsgBox Err.Description

End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
On Error Resume Next
mcbMenuCommandBar.Delete
If FormDisplayed Then
SaveSetting App.Title, "Settings", "DisplayOnConnect", "1"
FormDisplayed = False
Else
SaveSetting App.Title, "Settings", "DisplayOnConnect", "0"
End If
End Sub

Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then
End If
End Sub

Function AddToAddInCommandBar(sCaption As String) As Office.CommandBarControl
Dim cbMenuCommandBar As Office.CommandBarControl
Dim cbMenu As Object

On Error GoTo AddToAddInCommandBarErr

Set cbMenu = VBInstance.CommandBars("Add-Ins")
If cbMenu Is Nothing Then
Exit Function
End If

Set cbMenuCommandBar = cbMenu.Controls.Add(1)
cbMenuCommandBar.Caption = sCaption

Set AddToAddInCommandBar = cbMenuCommandBar

Exit Function

AddToAddInCommandBarErr:

End Function
modRegistry.bas:
Option Explicit

Dim oWSHShell As WshShell

"untuk menulisi registry
Public Function RegWrite(sKey As String, sFilepath As String) As Boolean
On Error GoTo Err
Set oWSHShell = New WshShell
oWSHShell.RegWrite sKey, sFilepath
Set oWSHShell = Nothing
RegWrite = True
Exit Function
Err:
RegWrite = False
End Function

"untuk menghapus key dari registry
Public Function RegDelete(sKey As String) As Boolean
On Error GoTo Err
Set oWSHShell = New WshShell
oWSHShell.RegDelete sKey
Set oWSHShell = Nothing
RegDelete = True
Exit Function
Err:
RegDelete = False
End Function

"untuk membaca key dari registry
Public Function RegRead(strKey)
On Error Resume Next
Set oWSHShell = New WshShell
RegRead = oWSHShell.RegRead(strKey)
Set oWSHShell = Nothing
End Function

Langkah-langkah pembuatan:

  1. Buat project Add-Ins.
  2. Ganti seluruh kode yang terdapat pada Connect.dsr dengan kode di atas.
  3. Tambahkan satu Module dan beri nama dengan module modRegistry
  4. Simpan Project dan lakukan Compile
  5. Lakukan register dll apabila project yang Anda buat belum terigistrasi pada registry

Sekarang Anda tidak akan pernah diganggu lagi dengan error: File not found: "C:\Windows\system32\ieframe.dll\1" selamanya. Terakhir, mari kita ucapkan bersama, selamat tinggal error: File not found: "C:\Windows\system32\ieframe.dll\1"

READ MORE - Error: File not found: "C:\Windows\system32\ieframe.dll\1"

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 = "code" '
End If
Next
txtPost.Text = d.body.innerHTML
End Function
READ MORE - Contoh Menambahkan Attribut Pada Tag HTML - VB Code

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 menggunakan Script Control
'=================================================================
Public Function UrlEncodeUtf8(ByRef strSource As String) As String
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "Jscript"
UrlEncodeUtf8 = sc.CodeObject.encodeURIComponent(strSource)
Set sc = Nothing
End Function

'=================================================================
'UrlDecodeUtf8 menggunakan Script Control
'=================================================================
Public Function URLDecodeUTF8(strSource As String) As String
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "Jscript"
URLDecodeUTF8 = sc.CodeObject.decodeURIComponent(strSource)
Set sc = Nothing
End Function
READ MORE - URL Encode - Decode UTF8 Menggunakan Script Control

Mengakses Element WebBrowser Dari Visual Basic 6.0

Option Explicit

Private Sub cmdBack_Click()
On Error Resume Next
WebBrowser1.GoBack
End Sub

Private Sub cmdForward_Click()
On Error Resume Next
WebBrowser1.GoForward
End Sub

Private Sub cmdGo_Click()
WebBrowser1.Navigate txtAddress
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://www.microsoft.com"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

On Error Resume Next
If (pDisp Is WebBrowser1.object) Then

txtAddress = WebBrowser1.LocationURL
Me.Caption = WebBrowser1.LocationName
txtText = ""
tvTreeView.Nodes.Clear
RecurseFrames WebBrowser1.Document, Nothing
End If
End Sub

Private Sub RecurseFrames(ByVal iDoc As HTMLDocument, ByVal iNode As node)
Dim I As Integer
Dim Range As IHTMLTxtRange
Dim Title As String
Dim TextInfo As String
Dim tvNode As node

On Error Resume Next

Title = iDoc.Title
If Title = "" Then
Title = iDoc.parentWindow.Name
If Title = "" Then Title = iDoc.location
End If

If iNode Is Nothing Then
Set tvNode = tvTreeView.Nodes.Add(, , , Title)
Else
Set tvNode = tvTreeView.Nodes.Add(iNode.Index, tvwChild, , Title)
End If

TextInfo = "Frame: " & Title & vbCrLf & "{" + vbCrLf

If iDoc.body.tagName = "BODY" Then
FillTree iDoc, "OBJECT", tvNode, "ActiveX Controls"
FillTree iDoc, "A", tvNode, "Anchors"
FillTree iDoc, "IMG", tvNode, "Images"
FillTree iDoc, "", tvNode, "All"

Set Range = iDoc.body.createTextRange
TextInfo = TextInfo & Range.Text & vbCrLf
Set Range = Nothing
ElseIf iDoc.frames.length > 0 Then
For I = 0 To iDoc.frames.length - 1
TextInfo = TextInfo & "FRAME: " & iDoc.frames(I).Document.nameProp & vbCrLf
Dim doc As New HTMLDocument
Dim eCollection As IHTMLElementCollection
Dim uElement As HTMLUnknownElement
Set eCollection = iDoc.frames(I).Document.All
For Each uElement In eCollection
If uElement.tagName = "HTML" Then
doc.All(0).insertAdjacentHTML "BeforeBegin", uElement.innerHTML
doc.Title = "Frame: " & iDoc.frames(I).Document.nameProp
FillTree doc, "FRAME", tvNode, "FRAME"
RecurseFrames doc, tvNode
Set doc = Nothing
End If
Next uElement
Next I
End If

txtText.Text = txtText.Text & TextInfo & "}" & vbCrLf

End Sub

Private Sub FillTree(iDoc As HTMLDocument, iMatchTag As String, iNode As node, iCategory As String)
Dim Element As Object
Dim Info As String
Dim tvNode As node
Dim tvCatNode As node

On Error Resume Next

Set tvCatNode = Nothing
For Each Element In iDoc.All
If iMatchTag = "" Or Element.tagName = iMatchTag Then

Info = Element.tagName & " "

If Element.tagName = "IMG" Then
Info = Info & Element.href
ElseIf Element.tagName = "A" Then
Info = Info & Element.innerText & " (" & Element.href & ")"
ElseIf Element.tagName = "INPUT" Then
Info = Info & Element.Type
ElseIf Element.tagName = "META" Then
Info = Info & Element.nodeName
ElseIf Element.tagName = "FRAMESET" Then
Info = Info & Element.Name
ElseIf Element.tagName = "FRAME" Then
Info = Info & ": " & Element.src
Else
Info = Info & Element.Id
End If

If tvCatNode Is Nothing Then
Set tvCatNode = tvTreeView.Nodes.Add(iNode.Index, tvwChild, , iCategory)
End If
Set tvNode = tvTreeView.Nodes.Add(tvCatNode.Index, tvwChild, , Info)
End If
If Element.tagName = "FRAME" Then
Dim I As Long
For I = 0 To iDoc.frames.length - 1
If iDoc.frames(I).Document.nameProp = Element.Document.nameProp Then
Dim doc As New HTMLDocument
Dim eCollection As IHTMLElementCollection
Dim uElement As HTMLUnknownElement
Set eCollection = iDoc.frames(I).Document.All
For Each uElement In eCollection
If uElement.tagName = "HTML" Then
doc.All(0).insertAdjacentHTML "BeforeBegin", uElement.innerHTML
doc.Title = "Frame: " & iDoc.frames(I).Document.nameProp
RecurseFrames doc, tvNode
Set doc = Nothing
End If
Next uElement
End If
Next I
End If
Next
End Sub
READ MORE - Mengakses Element WebBrowser Dari Visual Basic 6.0

Mengirim dan Menerima Email Menggunakan MAPI

Option Explicit

Dim X As Long

Private 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 = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
End If

End Sub

Private Sub Command2_Click()

If X + 1 > MAPIMessages1.MsgCount Then
X = MAPIMessages1.MsgCount
Else
X = X + 1
MAPIMessages1.MsgIndex = X
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
End If

End Sub

Private Sub Command3_Click()
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Fetch
If MAPIMessages1.MsgCount > 0 Then
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
Command4.Enabled = True
Else
MsgBox "No messages to fetch"
MAPISession1.SignOff
Command4.Enabled = False
End If

End Sub

Private Sub Command4_Click()

MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = Text1.Text
MAPIMessages1.MsgSubject = Text2.Text
MAPIMessages1.MsgNoteText = Text4.Text
MAPIMessages1.ResolveName
MAPIMessages1.Send

End Sub

Private Sub Command5_Click()

MAPISession1.SignOff
Unload Me

End Sub
READ MORE - Mengirim dan Menerima Email Menggunakan MAPI

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 Sub

Private Sub Command2_Click()
Inet2.AccessType = icNamedProxy
Inet2.Proxy = "http://proxy:80"
MsgBox Inet1.OpenURL("http://www.microsoft.com")
End Sub

Private Sub Command3_Click()
Inet3.AccessType = icNamedProxy
Inet3.Proxy = "ftp=ftp://ftp-gw http=http://itgproxy:80"
MsgBox Inet2.OpenURL("http://www.microsoft.com")
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim vtData As Variant
Select Case State
Case icResponseCompleted
Open "c:\temp\output.txt" For Binary Access Write As #1

vtData = Inet1.GetChunk(1024, icString)

Do While LenB(vtData) > 0
Put #1, , vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
Put #1, , vtData
Close #1
End Select
End Sub
READ MORE - Contoh Menggunakan Proxy Pada Internet Transfer Control

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 = " " & _
" " & _
" " & _
" " & _
" " & _
" " & _
"
" & _
"
" & _
" "

backSlashPos = InStrRev(txtFileName.Text, "\")
If backSlashPos > 0 Then
fileNameNoPath = Mid(txtFileName.Text, backSlashPos + 1)
Else
fileNameNoPath = txtFileName.Text
End If

objSOAPXMLDoc.loadXML soapReq

objSOAPXMLDoc.setProperty "SelectionNamespaces", _
"xmlns:pxml='http://samples.perfectxml.com/BinaryData'"

objSOAPXMLDoc.selectSingleNode("//pxml:fileName").nodeTypedValue = _
fileNameNoPath

objSOAPXMLDoc.selectSingleNode("//pxml:imageData").dataType = _
"bin.base64"

Open txtFileName.Text For Binary Access Read As #1
ReDim btArr(LOF(1))
Get #1, , btArr()
Close #1

objSOAPXMLDoc.selectSingleNode("//pxml:imageData").nodeTypedValue = btArr
MsgBox objSOAPXMLDoc.xml

objXMLHTTP.open "POST", "http://localhost/EmpImages/EmpImages.asmx", False

objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=utf-8"

objXMLHTTP.setRequestHeader "SOAPAction", _
"http://samples.perfectxml.com/BinaryData/SaveImage"

objXMLHTTP.setRequestHeader "Content-Length", Len(objSOAPXMLDoc.xml)

objXMLHTTP.send objSOAPXMLDoc.xml

MsgBox objXMLHTTP.Status & ": " & objXMLHTTP.statusText
MsgBox objXMLHTTP.responseText

Set objXMLHTTP = Nothing
Set objSOAPXMLDoc = Nothing

End Sub
READ MORE - Menggunakan XMLHTTP dan MSXML

VB6 WebBrowser - Menampilkan Pop Up

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Dim frm As Form1
Set frm = New Form1
Set ppDisp = frm.WebBrowser1.Object
frm.Show
End Sub
READ MORE - VB6 WebBrowser - Menampilkan Pop Up

Saturday, June 16, 2012

Mengektrak Seluruh Link Atau Elemen Menggunakan MSHTML - VB6

Mengenai cara mengekstrak seluruh link atau elemen yang ditentukan dalam sebuah halamn HTML menggunakan VB6 dengan bantuan ActiveX MSHTML - Adapun contoh kode untuk mengektrak seluruh link menggunakan VB6 dengan bantuan MSHTML adalah sebagai berikut:
Private Sub Command1_Click()

Dim d As New MSHTML.HTMLDocument
Dim l As HTMLImg
Dim x As HTMLHtmlElement

List1.Clear
d.body.innerHTML = Text1.Text

Set x = d.getElementById("IMG")

For Each l In d.images
If l.src <> "" Then
List1.AddItem l.src
End If
Next
Text1.Text = d.body.innerHTML

End Sub
Demikian contoh untuk mengekstrak link atau elemen yang ditentukan menggunkan VB6 dengan bantuan ActiveX MSHTML, semoga bermanfaat.
READ MORE - Mengektrak Seluruh Link Atau Elemen Menggunakan MSHTML - VB6

Thursday, June 14, 2012

TwitterCOM.dll - Mengirim Tweet Ke Twitter Dari VB6

Mengenai cara mengirim tweet ke twitter.com menggunakan aplikasi yang dibuat dengan VB6 menggunakan bantuan COM ActiveX yang miskin fitur yang diberi nama TwitterCOM.dll. Sekarang saya mau share mengenai TwitterCOM.dll sebuah COM ActiveX yang miskin fiture, walaupun miskin fitur, akan tetapi dengan menggunakan TwitterCOM.dll maka mengirim tweet ke twitter menjadi sangat mudah, siapapun dapat melakukannya termasuk saya, Anda, ibu-ibu, kakek-kakek, nenek-nenek, anak di bawah umur, balita, bayi, baik pria maupun wanita. Dengan syarat terkoneksi dengan internet dan memiliki akun twitter. That's All.
Adapun kode untuk mengirim tweet ke twitter adalah sebagai berikut:
Option Explicit

'http://khoiriyyah.blogspot.com

Private Sub cmdSendTweet_Click()
Dim t As New Twitter
With t
.AccessToken = txtToken.Text
.AccessTokenSecret = txtAccessTokenSecret.Text
.ConsumerKey = txtConsumerKey.Text
.ConsumerSecret = txtConsumerSecret.Text
.Tweet = txtTweet.Text
.SendTweet
End With
Set t = Nothing
End Sub

Wah, ternyata mengirim tweet ke twitter.com menggunakan VB6, kodenya sederhana beungeut.
Catatan sangat penting:
Sebelum menggunakan TwitterCOM.dll Anda harus memperoleh 4 key, yaitu:
    1. Consumer Key
    2. Access Token
    3. Consumer Secret
    4. Access Token Secret
Sekarang kita sudah tidak membutuhkan UserName dan Password untuk melakukan proses ototirasi dan otentifikasi, karena sejak Desember 2009 Twitter sudah tidak menggunakan lagi Basic Auth dan berpindah ke OAuth 1.0a.
Anda dapat memperoleh 4 kunci di atas dari https://dev.twitter.com/apps kemudian aktifkan mode access read-writenya.
Download: TwitterCOM.dll
READ MORE - TwitterCOM.dll - Mengirim Tweet Ke Twitter Dari VB6

Tuesday, June 12, 2012

Google Page Rank Monitor 1.0 - Blogger Tools

Ini merupakan aplikasi untuk melihat Google Page Rank. Sebagian besar source codenya saya ambil dari situs milik Leandro Ascierto, saya hanya sedikit menambahkan kode agar kompatibel dengan firefox.

Fitur-Fitur Google Page Rank Monitor 1.0:
  1. Portable
  2. Automatic Checker (tanpa membutuhkan verifikasi yang merepotkan)
  3. Kecil dan ringan
  4. Bekerja dengan baik pada koneksi internet yang lambat
  5. dan lain-lain
Kekurangannya:
  1. Untuk sementara hanya bekerja pada Firefox.
Cara menggunakan:
  1. Buka Firefox
  2. Klik install.bat untuk meregistrasikan komponen PageRank.dll
  3. Jalankan Google Page Rank Monitor 1.0
  4. Selesai.
Download: Google Page Rank Monitor 1.0

Catatan: Pada dasarnya, kita dapat melihat dengan mudah Google Page Rank melalui Google ToolBar. Aplikasi ini hanya sekedar contoh, apabila kita ingin membuat browser sendiri yang dilengkapi dengan Google Page Rank, atau fasilitas-fasilitas yang terdapat pada Google Toolbar dengan cara melakukan Request ke http://toolbar.google.com/.... (query).
READ MORE - Google Page Rank Monitor 1.0 - Blogger Tools

Monday, June 11, 2012

Twitter OAuth 1.0a: Digital Signature - Base String - VB6

Dalam Twitter OAuth 1.0, setiap kita melakukan request ke twitter.com maka tiap-tiap request harus disertai dengan digital signature sebagai bukti otentifikasi dan otorisasi. Adapun digital signature tersebut adalah hasil dari hash (one way encrypt):HMAC-SHA1 (BaseString + Key).Adapun Key adalah gabungan dari: (ConsumerSecret + AccessTokenSecret)

Nah disini saya menjelaskan bagaimana merakit/membuat BaseString untuk men-generate digital signature melalui VB6 seperti yang telah dijelaskan di atas:

Private Function GetTwitterBaseString() As String

Dim strURL As String
Dim strBaseString As String
strURL = "http://api.twitter.com/1/statuses/update.json"

strBaseString = txtMethod & _
"&" & UrlEncodeUtf8(txtURL.Text)
strQuery = HSA1.URLEncode("oauth_consumer_key=" & txtConsumerKey.Text) & _
UrlEncodeUtf8("&oauth_nonce=" & txtNonce.Text) & _
UrlEncodeUtf8("&oauth_signature_method=" & txtSignatureMethod.Text) & _
UrlEncodeUtf8("&oauth_timestamp=" & txtTimeStamp.Text) & _
UrlEncodeUtf8("&oauth_token=" & txtToken.Text) & _
UrlEncodeUtf8("&oauth_version=" & txtVersion.Text)
strParameter = HSA1.URLEncode("&status=" & UrlEncodeUtf8(strURL))
GetTwitterBaseString = strBaseString & "&" & strQuery & strParameter

End Function
Demikian BaseString Twitter OAuth 1.0 melalui VB6. Semoga bermanfaat. Apabila kita gagal mengirim tweet ke twitter menggunakan OAuth 1.0, mungkin bisa kita ganti dengan OhOut atau lebih tepatnya Oh Out Of Memory (OOM), mengenai artikel OOM bisa Anda baca di sini.
READ MORE - Twitter OAuth 1.0a: Digital Signature - Base String - VB6

Friday, June 8, 2012

Membuat HyperLink Label Menggunakan Visual Basic 6

Mengenai cara membuat link label atau hyperlink label menggunakan VB6 - Link label atau hyperlink label merupakan label yang apabila diklik akan membuka browser dengan alamat website atau blog yang kita miliki. Bagaimana kode mengenai hiperlink label ini, berikut merupakan kode untuk membuat link label atau hyperlink label menggunakan Visual Basic 6:
'simpan kode ini pada module, atau satukan dengan form, jika ingin disatukan dengan form 
'gantilah Public menjadi Private
Option Explicit

Public Declare Function
ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const
SW_SHOW = 5
contoh penggunaan fungsi API di atas:
'simpan kode ini pada form 
'gantilah label caption dengan alamat blog atau website
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ShellExecute hwnd, "open", "http://khoiriyyah.blogspot.com", vbNullString, vbNullString, SW_SHOW
End Sub
Demikianlah mengenai cara pembuatan hyperlink label atau link label menggunakan Visual Basic 6. Selamat mencoba.
READ MORE - Membuat HyperLink Label Menggunakan Visual Basic 6

VB6 Code - Mengambil URL Dari Address Bar IE

Mengenai cara mengambil URL dari adress bar yang terdapat pada IE menggunakan fungsi API, dengan melakukan spy terhadap HWND induk dan turunannya. Selain dengan API di bawah ini, kita pun bisa mengambil URL yang terdapat pada adress bar IE atau Firefox dengan menggunakan DDE.
Option Explicit 
Private Declare Function
FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) 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 Const
WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private Sub
FindIt(ByVal sClassName As String)
On Error GoTo CallErrorA
lhWnd = FindWindowEx(lhWnd, 0, sClassName, vbNullString)
End Sub
Private Function
GetAddressText() As String
On Error GoTo
CallErrorA
Dim usText() As Byte
Dim
iPos As Integer
lhWnd = 0
Call FindIt("IEFrame")
Call FindIt("WorkerA")
Call FindIt("ReBarWindow32")
Call FindIt("ComboBoxEx32")
Call FindIt("ComboBox")
Call FindIt("Edit")
ReDim usText(0 To SendMessage(lhWnd, WM_GETTEXTLENGTH, 0, ByVal 0&) + 1)
If
UBound(usText) = 1 Then
GetAddressText = ""
Else
usText(0) = UBound(usText) And 255
usText(1) = UBound(usText) 256
Call SendMessage(lhWnd, WM_GETTEXT, UBound(usText), usText(0))
GetAddressText = StrConv(usText, vbUnicode)
iPos = InStr(GetAddressText, vbNullChar)
If iPos > 0 Then GetAddressText = Left(GetAddressText, iPos - 1)
End If
End Function
READ MORE - VB6 Code - Mengambil URL Dari Address Bar IE

Tuesday, May 29, 2012

VB6.0 - Set Mozilla Firefox & IE Default Home Site Via Code

Setelah berhasil mendefaultkan Google Chrome home page/site, maka sekarang kita akan mendefaultkan 2 browser lainnya, yaitu Internet Explorer dan Mozilla Firefox. Bagaimanakah caranya? Untuk Internet Explorer maka yang perlu kita lakukan adalah sedikit meng-utak-atik registry. Disini kita akan menggunakan cara akses registry yang mudah dengan menggunakan komponen jadi milik Microsoft yaitu "Microsoft Script Host Object Model" atau nama ocx-nya WSHOM.OCX seperti yang telah dibahas pada artikel yang lain. Adapun implementasi kodenya:
Option Explicit   

'Prosedure fungsi ini simpan di module
Public Sub SetIEHomePage(URL As String)
Dim wsh As New WshShell
wsh.RegWrite "HKCU" & "\Software\Microsoft\Internet Explorer\Main\Start Page", URL
Set wsh = Nothing
End Sub

'Cara menggukannya fungsi di atas
Private Sub Command1_Click()
Call SetIEHomePage("http://khoiriyyah.blogspot.com")
End Sub

Sedangkan untuk Mozilla Firefox hampir sama dengan Google Chrome yaitu dengan cara merubah beberapa jajar kode yang terdapat pada file tertentu. Adapun implementasi kodenya:
Option Explicit 

Public Sub
SetFirefoxHomepage(URL As String)

Dim
strPath As String, strProfile As String
Dim
strContent As String, strReplace As String
Dim
regex As RegExp

strPath = Environ("APPDATA")
strPath = strPath & "\Mozilla\Firefox\Profiles\"
strProfile = Dir(strPath & "*.default", vbDirectory)

If
Len(strProfile) Then
strPath = strPath & strProfile & "\prefs.js"
strReplace = "user_pref(""browser.startup.homepage"", """ & URL & """);"

strContent = fGetFileContents(strPath)
Set regex = New RegExp

If
InStr(1, strContent, Chr(34) & "browser.startup.homepage" & Chr(34)) = 0 Then
strContent = strContent & vbCrLf & "user_pref(""browser.startup.homepage"", """ & URL & """);"
sPutStringToFile strContent, strPath
Exit Sub
ElseIf
InStr(1, strContent, strReplace) Then
Exit Sub
End If

regex.Pattern = "user_pref\(""browser.startup.homepage"",\s""(.*)""\);"

strContent = regex.Replace(strContent, strReplace)
sPutStringToFile strContent, strPath

End If

End Sub

Public Function
fGetFileContents(strPath As String) As String
Dim
hFile As Integer
Dim
strFileContent As String


If
Len(Dir(strPath)) = 0 Then Exit Function

On Error GoTo
ErrGetFile
hFile = FreeFile

Open
strPath For Binary As #hFile
strFileContent = Space(LOF(hFile))
Get #hFile, , strFileContent
Close #hFile

fGetFileContents = strFileContent
Exit Function

ErrGetFile:

Close
MsgBox Err.Description, vbCritical, "GetFileContents"

End Function

Public Sub sPutStringToFile(strContent As String, strPath As String)
Dim hFile As Integer

'If file exists delete it.
On Error Resume Next
Kill
strPath
On Error GoTo ErrPutString

'Write file
hFile = FreeFile
Open
strPath For Binary As #hFile
Put #hFile, , strContent
Close #hFile

Exit Sub

ErrPutString:

Close #hFile
MsgBox Err.Description, vbCritical, "PutStringToFile"

End Sub

Apa kegunaan/manfaat mendefaultkan home page/site 3 browser besar di atas? Insya Allah dalam pertemuan lain kita akan membahasnya.
READ MORE - VB6.0 - Set Mozilla Firefox & IE Default Home Site Via Code

Menyimpan File Ke Dalam Format MHTML

Menyimpan file dalam format MHTML tentunya memiliki banyak keuntungan, salah satu dari banyak keuntungan tersebut ialah terintegrasinya seluruh gambar dan file dengan baik, sehingga kita bisa mendownload halaman situs/blog yang kita kunjungi utuh dengan seluruh gambarnya.

Apabila Anda gabungkan dengan prosedur untuk mengekstrak link dari sebuah blog, maka ia akan memiliki kemampuan yang lebih baik lagi, dengan kata lain Anda dapat mem-back-up satu blog milik Anda sendiri ataupun milik orang lain utuh dengan seluruh gambarnya.
Option Explicit  

Public Function
SaveWebPageToMHTFile(url As String, filepath As String)

On Error GoTo
ErrHandler

Dim
msg As New CDO.Message
Dim
stm As New ADODB.Stream

msg.MimeFormatted = True
msg.CreateMHTMLBody url, CDO.CdoMHTMLFlags.cdoSuppressNone, "", ""
'//Pilih charset yang sesuai
stm.Charset = "utf-8"
Set
stm = msg.GetStream()
stm.SaveToFile filepath, ADODB.SaveOptionsEnum.adSaveCreateOverWrite
Set
msg = Nothing
stm.Close

Exit Function

ErrHandler:

MsgBox Err.Description

End Function

Contoh pemanggilan prosedur fungsi di atas:
Private Sub Command1_Click()  
'//Coba menyimpan file dalam bentuk MHTML </i>
SaveWebPageToMHTFile "http://www.planet-source-code.com/vb/default.asp?lngWId=1", "c:\psc.MHTML"
End Sub

Catatan: Sebelum Anda menggunakan fungsi di atas, tambahkan referensi Microsoft ActiveX Data Objects 2.8 Liblari dan Microsoft CDO for Windows 2000 Liblary

READ MORE - Menyimpan File Ke Dalam Format MHTML

Blokir Situs Menggunakan Visual Basic 6.0

Option Explicit 

Public Declare Function
GetForegroundWindow Lib "user32" ) As Long
Public Declare Function
SendMessage Lib "user32" Alias "SendMessageA" ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function
GetWindowText Lib "user32" Alias "GetWindowTextA" ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Const
WM_CLOSE = &H10

Public Function
kick(target As String)
Dim H As Long
Dim T As String *
255
H = GetForegroundWindow
GetWindowText H, T, 255
If InStr(UCase(T), UCase(target)) > 0 Then
SendMessage H, WM_CLOSE, 0, 0
End If
End Function
READ MORE - Blokir Situs Menggunakan Visual Basic 6.0