Home > Visual Basic > Manganalisa source code mesin penjawab otomatis Y!M versi 8, 9 & 10

Manganalisa source code mesin penjawab otomatis Y!M versi 8, 9 & 10

February 22, 2010

Kalo pada artikel sebelumnya kita sudah mengetahui bagaimana cara menganalisa bagian-bagian penting program Y!M untuk mendapatkan informasi yang kita butuhkan guna membuat program mesin penjawab otomatis Y!M ini maka pada artikel kali ini kita akan membahas full semua source code penting untuk membuat aplikasi ini.

Sebenarnya saya sudah lama ingin mengupload source code ini tapi berhubung waktu itu baru support untuk Y!M 8 saya jadi males nguploadnya, tapi setelah melakukan sedikit penyesuaian untuk mendukung Y!M 9 dan 10 akhirnya saya bisa dengan tenang mengupload source code ini😀.

Seperti pada artikel sebelumnya untuk melanjutkan pembahasan ini kita harus mengetahui urutan windows parent->anak baik untuk membaca pesan yang masuk atau membalasnya.

Berikut adalah urutannya :

1. Y!M 8

  • YSearchMenuWndClass ->  IMClass -> YHTMLContainer -> Internet Explorer_Server (membaca pesan yang masuk)
  • YSearchMenuWndClass ->  IMClass -> YIMInputWindow (membalas pesan)

2. Y!M 9

  • ATL:007C07F0 -> YHTMLContainer -> Internet Explorer_Server (membaca pesan yang masuk)
  • ATL:007C07F0 -> YIMInputWindow (membalas pesan)

3. Y!M 10

  • CConvWndBase -> YHTMLContainer -> Internet Explorer_Server (membaca pesan yang masuk)
  • CConvWndBase -> YIMInputWindow (membalas pesan)

Telihat ada sedikit perbedaan nama class/window untuk Y!M 8, 9 dan 10 dan jika Anda lupa bagaimana cara untuk mendapatkan informasi tersebut silahkan mampir kesini dulu.

Karena aplikasi kita kali ini akan mendukung 3 versi Y!M otomatis kita harus mempunyai sebuah fungsi untuk mengecek versi Y!M yang terinstall di komputer, salah satu cara termudah untuk mendapatkan informasi tersebut adalah via registry windows dan setelah melakukan sedikit investigasi saya mendapatkan lokasi berikut di registry windows :

;Y!M 8 dan 9
Key : HKEY_LOCAL_MACHINE\SOFTWARE\Yahoo\pager
Name : ProductVersion

;Y!M 10
Key : HKEY_CURRENT_USER\Software\yahoo\pager
Name : Version

Fungsinya akan terlihat seperti berikut :

Private Function getYMVersion() As String
    Dim ymVersion       As String
    Dim arrYMVersion()  As String

    'cek key Y!M 8 dan 9
    ymVersion = getFromWindowsRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Yahoo\pager", "ProductVersion")

    'Y!M 10
    'jika pengecekan key Y!M versi 8 dan 9 masih kosong coba cek key Y!M 10
    If Not (Len(ymVersion) > 0) Then ymVersion = getFromWindowsRegistry(HKEY_CURRENT_USER, "Software\yahoo\pager", "Version")

    If Len(ymVersion) > 0 Then
        arrYMVersion = Split(ymVersion, ".") ' ex : 10.0.0.1102, kita ambil mayor versionnya aja = 10
    Else
        ReDim arrYMVersion(0)
    End If

    getYMVersion = arrYMVersion(0)
End Function

Cara yang kedua dengan memanfaatkan registry berikut :

HKEY_CLASSES_ROOT\ymsgr\shell\open\command

dan jika kita lihat nilai dari key tersebut lebih kurang seperti berikut :

"C:\Program Files\Yahoo!\Messenger\YahooMessenger.exe" %1

Loh mana informasi versi Y!Mnya ? Versi Y!Mnya bisa langsung kita dapatkan dari file YahooMessenger.exe jadi dengan cara kedua ini kita membutuhkan referensi Microsoft Scripting Runtime untuk membuat fungsi getYMVersion.

Private Function getYMVersion() As String
    Dim fso             As Scripting.FileSystemObject
    Dim YMExe           As String
    Dim arrYMVersion()  As String

    YMExe = getFromWindowsRegistry(HKEY_CLASSES_ROOT, "ymsgr\shell\open\command", "") 'output -> "C:\Program Files\Yahoo!\Messenger\YahooMessenger.exe" %1
    YMExe = Replace(YMExe, " %1", "") 'hapus karakter spasi+%1
    YMExe = Replace(YMExe, Chr(34), "") 'hapus karakter petik "

    If Len(YMExe) > 0 Then
        Set fso = New Scripting.FileSystemObject
        arrYMVersion = Split(fso.GetFileVersion(YMExe), ".") ' ex : 10.0.0.1102, kita ambil mayor versionnya aja = 10
        Set fso = Nothing

    Else
        ReDim arrYMVersion(0)
    End If

    getYMVersion = arrYMVersion(0)
End Function

Dari 2 fungsi getYMVersion tersebut terserah Anda mau menggunakan yang mana, yang jelas hasilnya sama. Selanjutnya kita tinggal panggil fungsi tersebut seperti berikut :

Public Sub Main()
    Dim ymVersion   As String

    ymVersion = getYMVersion
    If Not (Len(ymVersion) > 0) Then
        MsgBox "Y!M belum terinstall, aplikasi tidak bisa dilanjutkan", vbExclamation, "Peringatan"
        End
    End If

    'TODO : tampilkan form utama disini
End Sub

Oke sampai disini kita sudah punya fungsi pengecekan versi Y!M langkah berikutnya adalah mendapatkan ymID yang sedang chat dengan kita.

Informasi ymID ini nanti digunakan untuk memudahkan kita memparsing pesan yang masuk.

Satu-satunya cara yang saat ini saya ketahui untuk mendapatkan informasi ymID adalah dengan membaca informasi Title Bar Y!M, tetapi informasi Title Bar ini tidak fix tergantung kondisi berikut :

  1. Versi Y!M
  2. Lawan chat sudah terdaftar Messenger List/belum

berikut cuplikannya

Berdasarkan gambar diatas kita bisa dengan mudah membuat fungsi untuk mendapatkan ymID.

Private Function getYMID(ByVal hwndYMMainClass As Long) As String
    Dim titleBar        As String
    Dim ymID            As String
    Dim arrTitleBar()   As String
    Dim pos             As Long

    titleBar = String$(100, Chr$(0))
    GetWindowText hwndYMMainClass, titleBar, 100
    titleBar = Left$(titleBar, InStr(titleBar, Chr$(0)) - 1)

    If InStr(1, titleBar, " (") > 0 Then 'lawan chat terdaftar di Messenger List
        'ex YM8    : KoKom Armag3d0n (k4m4r82) - Instant Message
        '   YM9/10 : KoKom Armag3d0n (k4m4r82)

        arrTitleBar = Split(titleBar, " (")
        ymID = arrTitleBar(0)

    Else
        Select Case ymVersion
            Case "8" 'ex : KoKom Armag3d0n - Instant Message
                arrTitleBar = Split(titleBar, " - ")
                ymID = arrTitleBar(0)

            Case "9", "10" 'ex : KoKom Armag3d0n
                ymID = titleBar
        End Select
    End If

    getYMID = ymID
End Function

Contoh penggunaan fungsi getYMID

Private Sub cmdGetYMID_Click()
    Dim hwndYMMainClass     As Long
    Dim ymID                As String

    Select Case ymVersion
        Case "8": hwndYMMainClass = FindWindow("YSearchMenuWndClass", vbNullString)
        Case "9": hwndYMMainClass = FindWindow("ATL:007C07F0", vbNullString)
        Case "10": hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
    End Select

    ymID = getYMID(hwndYMMainClass)
    MsgBox "YM ID : " & ymID
End Sub

Fungsi berikutnya yang akan kita buat adalah fungsi untuk membaca pesan yang masuk, kondisinya juga sama seperti Title Bar informasinya tidak fix tergantung :

  1. Versi Y!M
  2. Lawan chat sudah terdaftar Messenger List/belum

Kalo penasaran lihat gambar berikut :

Contoh beberapa variasi pesan yang masuk setelah dibaca di program

Terlihat dengan jelas perbedaan antara Y!M 8 dan Y!M 9/10 pada saat pembacaan pesan yang masuk, dimana untuk Y!M 9 dan 10 menambahkan informasi tanggal dan jam pesan masuk.

Berikut adalah fungsi untuk menghandle semua variasi tersebut.

Private Function getYMMessage(ByVal hwndYMMainClass As Long) As String
    Dim hwndIMClass         As Long
    Dim hwndYHTMLContainer  As Long
    Dim hwndIEServer        As Long

    Dim ymID                As String
    Dim msg                 As String

    Dim arrMsg()            As String
    Dim arrValidMsg()       As String
    Dim validMsg            As String
    Dim i                   As Long

    Select Case ymVersion
        Case "8"
            'urutkan kelas yg harus dilalui untuk membaca pesan yang masuk
            'YSearchMenuWndClass ->  IMClass -> YHTMLContainer -> Internet Explorer_Server

            If hwndYMMainClass <> 0 Then
                ymID = getYMID(hwndYMMainClass)

                hwndIMClass = FindWindowEx(hwndYMMainClass, 0&, "IMClass", vbNullString)
                hwndYHTMLContainer = FindWindowEx(hwndIMClass, 0&, "YHTMLContainer", vbNullString)
                hwndIEServer = FindWindowEx(hwndYHTMLContainer, 0&, "Internet Explorer_Server", vbNullString)

                msg = getIEText(hwndIEServer)

                arrMsg = Split(msg, Chr(10))
                For i = LBound(arrMsg) To UBound(arrMsg)
                    If Len(arrMsg(i)) > 0 Then
                        If Left(arrMsg(i), Len(ymID) + 2) = ymID & ": " Then
                            arrValidMsg = Split(arrMsg(i), ": ")
                            validMsg = arrValidMsg(UBound(arrValidMsg))
                            Exit For
                        End If
                    End If
                Next i

                validMsg = Replace(validMsg, Chr(13), "")
                getYMMessage = validMsg
            End If

        Case "9", "10"
            'urutkan kelas yg harus dilalui untuk membaca pesan yang masuk
            'Y!M 9  : ATL:007C07F0 -> YHTMLContainer -> Internet Explorer_Server
            'Y!M 10 : CConvWndBase -> YHTMLContainer -> Internet Explorer_Server

            If hwndYMMainClass <> 0 Then
                ymID = getYMID(hwndYMMainClass)

                hwndYHTMLContainer = FindWindowEx(hwndYMMainClass, 0&, "YHTMLContainer", vbNullString)
                hwndIEServer = FindWindowEx(hwndYHTMLContainer, 0&, "Internet Explorer_Server", vbNullString)

                msg = getIEText(hwndIEServer)

                arrMsg = Split(msg, Chr(10))
                For i = LBound(arrMsg) To UBound(arrMsg)
                    If Len(arrMsg(i)) > 0 Then
                        If Left(arrMsg(i), Len(ymID) + 2) = ymID & " (" Then
                            arrValidMsg = Split(arrMsg(i), "): ")
                            validMsg = arrValidMsg(UBound(arrValidMsg))
                            Exit For
                        End If
                    End If
                Next i

                validMsg = Replace(validMsg, Chr(13), "")
                getYMMessage = validMsg
            End If

        Case Else
            'silahkan coba sendiri versi ym yg lain
    End Select
End Function

Contoh penggunaan fungsi getYMMessage

Private Sub cmdGetYMMessage_Click()
    Dim hwndYMMainClass     As Long
    Dim ymMessage           As String

    Select Case ymVersion
        Case "8": hwndYMMainClass = FindWindow("YSearchMenuWndClass", vbNullString)
        Case "9": hwndYMMainClass = FindWindow("ATL:007C07F0", vbNullString)
        Case "10": hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
    End Select

    ymMessage = getYMMessage(hwndYMMainClass)
    MsgBox "Pesan masuk : " & ymMessage
End Sub

Fungsi terakhir adalah fungsi untuk mengirim pesan ke lawat chat

Private Sub YMChatSend(ByVal hwndYMMainClass As Long, ByVal msgToSend As String)
    Dim hwndIMClass         As Long
    Dim hwndYIMInputWindow  As Long

    Select Case ymVersion
        Case "8"
            'urutkan kelas yg harus dilalui untuk membalas pesan yang masuk
            'YSearchMenuWndClass ->  IMClass -> YIMInputWindow

            If hwndYMMainClass <> 0 Then
                hwndIMClass = FindWindowEx(hwndYMMainClass, 0&, "IMClass", vbNullString)
                hwndYIMInputWindow = FindWindowEx(hwndIMClass, 0&, "YIMInputWindow", vbNullString)
            End If

        Case "9", "10"
            'urutkan kelas yg harus dilalui untuk membalas pesan yang masuk
            'Y!M 9  : ATL:007C07F0 -> YIMInputWindow
            'Y!M 10 : CConvWndBase -> YIMInputWindow
            If hwndYMMainClass <> 0 Then hwndYIMInputWindow = FindWindowEx(hwndYMMainClass, 0&, "YIMInputWindow", vbNullString)
    End Select

    If hwndYIMInputWindow <> 0 Then
        Call SendMessageByString(hwndYIMInputWindow, WM_SETTEXT, 0&, msgToSend)
        Call SendMessage(hwndYIMInputWindow, WM_KEYDOWN, VK_RETURN, 0&) 'otomatis menekan tombol Send
    End If
End Sub

Contoh penggunaan fungsi ymChatSend

Private Sub cmdSendMessage_Click()
    Dim hwndYMMainClass     As Long
    Dim msg                 As String

    Select Case ymVersion
        Case "8": hwndYMMainClass = FindWindow("YSearchMenuWndClass", vbNullString)
        Case "9": hwndYMMainClass = FindWindow("ATL:007C07F0", vbNullString)
        Case "10": hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
    End Select

    msg = "Hallo bro gue udah selesai nih nGebuatin mesin penjawab otomatis Y!Mnya" & vbCrLf & _
          "Tinggal maem-maemnya ya !!!"
    Call ymChatSend(hwndYMMainClass, msg)
End Sub

Akhirnya selesai juga🙂 dan potongan kode diatas sudah saya susun menjadi program sederhana dengan kasus “Tes Bahasa Inggris” yang bisa didownload disini.

Kalo males download kita lihat  aja trailernya🙂

Selamat mencoba🙂

  1. azka
    April 7, 2010 at 1:19 pm

    maaf ni mas ,mw tanya lagi,…yg satu ini (Manganalisa source code mesin penjawab otomatis Y!M versi 8, 9 & 10) sy jg bener2 bingung cara pakenya mas / maksudnya sprt apa ya????????

    coz stlh sy buka programnya ‘n DB nya ko banyak ttng soal2 gitu2….???

    gmn cara y……………….

  2. April 7, 2010 at 2:50 pm

    Klo mau coba samplenya harus pake 2 komputer yg terhubung dg internet dan masing2x komputer harus aktif YMnya dan tentunya dg YM ID yg berbeda, seperti contoh diatas saya online menggunakan YM ID : k4m4r82 sedangkan komputer 1 lagi login dengan YM ID agenym01

    Setelah itu sy tinggal mengetikkan keyword : about

    Otomatis akan mendapatkan jawaban YM! Answering Machine – bla bla seperti gambar diatas, dan jangan lupa sample programnya harus dijalankan terlebih dulu di komputer sebelah sebelum mengetikkan keyword tersebut.

    Selamat mencoba🙂

  3. azka
    April 8, 2010 at 4:40 pm

    mas sy sdh coba dng 2 PC ,… msh blm bs ,… tuk ID YM nya dibuka di YM yg ada di PC or kita masukan lagi ID di YM!Answering Machine ,…
    logika/alurnya msh blm ‘nyambung’ niii mas

  4. April 8, 2010 at 10:52 pm

    Gampangnya gini aja (ini mas/mba ya? :D)
    1. Mba punya teman chatingkan ?
    2. Sebelum chat buka dulu source code program YM! Answering Machine trus di jalankan (F5)
    3. Login ke Y!M sampai online
    4. Minta temannya memulai chat, misal dg mengetikkan “hallo”. Mbanya ngGa usah ngapa2xin dan dudux maniz aja😀 biarkan program YM! Answering Machine yg ngejawab, dan seharusnya temannya akan mendapat jawaban “Keyword hallo tidak terdaftar. Ketik BANTUAN untuk informasi lebih lanjut”.
    5. Jika sampai langkah 4 sudah oke, berarti sudah bisa mencoba keyword2x lainnya : bantuan, about, mulai, soal de el el.

    Jadi program YM! Answering Machine ini berfungsi sama seperti program SMS Gateway yang membaca pesan masuk dan membalasnya, hanya medianya saja yg berbeda.

    Selamat mencoba🙂

  5. azka
    April 9, 2010 at 7:39 am

    klo yg mas maksud posisi Y!M yahoo kondisi ON dan YM! Answering jg ON sdh sy lakukan tapi ko tetap aja pesan yg dikirim oleh teman sy itu ga masuk k YM! Answering ,…knp y mas?//?

  6. April 9, 2010 at 8:24 am

    Wah klo gitu sy nyerah mba😀, emg pake Y!M brp ? Soalnya udah sy coba di beberapa komputer/laptop sukses maniz😀

    Atau mungkin aja ini bug mba dan sy senang banget klo mba mengirimkan screenshot Y!Mnya seperti yang diSINI.

  7. azka
    April 14, 2010 at 3:02 am

    mas tolong dibantu doong mas ,… gmn caranya yaaaa,…

  8. April 14, 2010 at 4:18 am

    azka :

    mas tolong dibantu doong mas ,… gmn caranya yaaaa,…

    Mungkin bisa dicoba di komputer lain dulu, soalnya sy belum punya gambaran penyebab programnya gagal membaca pesan YM yang masuk.

  9. August 11, 2010 at 3:31 am

    om, ini harus sama2 pakek YM ya om?? . . . kok saya coba, 1 pakek YM, satu pakek pidgin kasusnya sama kaya mbak/mas azka itu . . . pesan chat-nya langsung masuk ke chat window-nya YM, trus gak ada auto reply yang masuk ke pidgin?? . . . bingung dah . . .

  10. November 14, 2010 at 8:36 am

    mantap , scriptnya jalan …,
    tapi ada beberapa pembaharuan untuk YM 10,

    nice share ….

    • November 14, 2010 at 9:18 am

      Wah si om bikin penasaran nih😀, pembaharuan untuk YM 10 apa ya? Biar sy bs update artikel ini.

      Tq

  11. Chandra
    January 9, 2011 at 7:22 am

    Saya sudah coba , dan waktu trace ada masalah di :
    Case “9”
    hwndYMMainClass = FindWindow(“ATL:007C07F0”, vbNullString)

    Case didapat 9 benar…
    tapi findwindows nya tidak ditemukan

    Ym yang saya pakai 9
    dan windows vista
    apa ada beda di findwindow ?

    • January 9, 2011 at 8:49 am

      Coba meluncur ke postingan saya yg disini om, untuk mengecek benar enggak class windows YMnya ATL:007C07F0.

      Mana tau ada sedikt perbedaan, walaupun sama2x versi 9

  12. Ahmad
    January 30, 2011 at 3:15 pm

    bisa ga mas kasih contoh untuk ngerubah fungsi case nya?
    misal case nya membaca xxx.text yg ada di form?
    ————————————————–
    Select Case UCase$(keyword)
    Case “(isi keyword text di form)”
    msg = Replace(ABOUT, “”, appVersion)

    Case “(isi keyword text di form)”
    msg = Replace(BANTUAN, “”, appVersion)
    ————————————————–
    contoh nya seperti ini
    [img]http://i53.tinypic.com/fncxll.jpg[/img]

    makasih sebelum nya🙂

    • January 31, 2011 at 1:39 am

      Ya tinggal gini aja lagi om

      Select Case UCase$(keyword)
          Case Text1.Text
              msg = Text3.Text
              
          Case Text2.Text
              msg = Text4.Text
      End Select
      
      • Ahmad
        January 31, 2011 at 2:53 am

        makasih om..dah bisa🙂

        • January 31, 2011 at 3:01 am

          Sama2x om

  13. HERMAWAN
    February 11, 2011 at 10:37 am

    mas klo jawabannya gini kenapa yah
    Keyword halooBookmark tidak terdaftar. Ketik BANTUAN untuk informasi lebih lanjut

    saya pake ym versi 10

  14. HERMAWAN
    February 12, 2011 at 7:14 am

    masih belom bisa mas,maklum pemula,mungkin ada yg salah lagi yah..:d

    • February 12, 2011 at 9:55 am

      Emg om udah coba sejauh mana? Coba copas ke sini kode yg udah om modifikasi biar ketauan salahnya dimana?

  15. Chandra
    April 17, 2011 at 7:33 am

    Bro, kalau saya mau send ym ke misalkan ID_NAMA1 didaftar list kita, bisa gak ? kalau selama ini saya lihat dan baca codingnya, itu cuma bisa direspond aja kalau di send message oleh pihak luar, tapi kalau misalkan saya mau kirim pesan pada jam 1 berupa “Sudah Jam 1 ini pak anton” ke ID_Anton_Di_Yahoo .. untuk itu coding :
    – Jam 1 gak ? kalau jam 1 kirim pesan ke :
    – ID_Anton_di_Yahoo … (nah proses kirim ini gimana caranya ?)

  16. karwan
    May 14, 2011 at 1:12 pm

    Mas kalau untuk YM 11 gimana.. mohon di bantu ya…!!

    • May 15, 2011 at 7:07 am

      Wedewww si om males coba nih, padahal YM 11 itu sama seperti YM 10, jadi kode berikut :

      Select Case ymVersion
          Case "8"
              hwndYMMainClass = FindWindow("YSearchMenuWndClass", vbNullString)
          
          Case "9"
              hwndYMMainClass = FindWindow("ATL:007C07F0", vbNullString)
                  
          Case "10"
              hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
                  
      End Select
      

      diubah menjadi :

      Select Case ymVersion
          Case "8"
              hwndYMMainClass = FindWindow("YSearchMenuWndClass", vbNullString)
          
          Case "9"
              hwndYMMainClass = FindWindow("ATL:007C07F0", vbNullString)
                  
          Case "10", "11" ' DAFTARKAN VERSI 11 NYA DISINI
              hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
                  
      End Select
      
      • Azharry
        May 24, 2011 at 2:38 pm

        Wuih cantik tuh program… thx berat atas pencerahanya. cuma ada satu masalah ini, kita sdh online YM nya cuma window chat belum dibuka, nah gimana codingnya membuka jendela chating dengan id YM lawan chating tertentu. mohon pencerahanya lagi gan mksh.

        • May 25, 2011 at 3:35 am

          Ini om hasil riset sementara kodenya belum sempat saya rapikan :

          Alur program :
          1. Mengaktifkan dialog Send an Instant Message
          2. Otomatis fokus ke tab Other Contact
          3. Otomatis mengisikan YM ID (Ex : k4m4r82)
          4. Otomatis menekan tombol Enter
          5. Otomatis mengetikan pesan (Ex : Tes ngirim pesan via Instant Message)

          Baru di sy test di YM ver 10.0.0.1270

          Option Explicit
          
          Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
          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 GetMenu Lib "user32" (ByVal hwnd As Long) As Long
          Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
          Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
          
          Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
          Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
          
          Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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_COMMAND As Long = &H111
          Private Const WM_SETTEXT As Long = &HC
          Private Const WM_KEYDOWN As Long = &H100
          Private Const VK_RETURN As Long = &HD
          Private Const TCM_SETCURFOCUS As Long = &H1330&
          
          Private Sub ymChatSend(ByVal hwndYMMainClass As Long, ByVal msgToSend As String)
              Dim hwndYIMInputWindow As Long
              
              'urutkan kelas yg harus dilalui untuk membalas pesan yang masuk
              'Y!M 10 : CConvWndBase -> YIMInputWindow
              
              Do While hwndYIMInputWindow = 0
                  hwndYIMInputWindow = FindWindowEx(hwndYMMainClass, 0&, "YIMInputWindow", vbNullString)
                  DoEvents
              Loop
              
              If hwndYIMInputWindow <> 0 Then
                  Call SendMessageByString(hwndYIMInputWindow, WM_SETTEXT, 0&, msgToSend)
                  Call SendMessage(hwndYIMInputWindow, WM_KEYDOWN, VK_RETURN, 0&) 'otomatis menekan tombol Send
              End If
          End Sub
          
          Private Sub cmdTestSendInstantMsg_Click()    
              Dim hwndYMMainClass     As Long
              Dim YHandle             As Long
              Dim hMain               As Long
              Dim hSub                As Long
              Dim SelectItemID        As Long
              
              Dim hwndMsgrBuddyTab    As Long
              Dim hWndInstantMsg      As Long
              
          
              Dim hwnd32770           As Long
              Dim hwndEdit            As Long
              
              Dim i                   As Integer
              
              Dim ymIDTarget          As String
              Dim ymMsg               As String
              
              YHandle = FindWindow("YahooBuddyMain", vbNullString)
              
              hMain = GetMenu(YHandle)
              hSub = GetSubMenu(hMain, 2)
              
              ' cek dialog Send Instant Message
              hWndInstantMsg = FindWindow("#32770", "Send an Instant Message")
              
              ymIDTarget = "k4m4r82"
              ymMsg = "Tes ngirim pesan via Instant Message"
              
              If hWndInstantMsg = 0 Then ' klo dialog Send Instant Message belum diaktfkan
              
                  SelectItemID = GetMenuItemID(hSub, 0&)
                  PostMessage YHandle, WM_COMMAND, SelectItemID, 0& ' akses menu send instant message
                  
                  Do While hWndInstantMsg = 0
                      hWndInstantMsg = FindWindow("#32770", "Send an Instant Message")
                      
                      DoEvents
                  Loop
                  
                  Do While hwndMsgrBuddyTab = 0
                      hwndMsgrBuddyTab = FindWindowEx(hWndInstantMsg, 0&, "MsgrBuddyTab", vbNullString)
                      
                      DoEvents
                  Loop
                  
                  ' fokus ke tab other contact
                  For i = 1 To 30
                      SendMessage hwndMsgrBuddyTab, TCM_SETCURFOCUS, 1&, 0&
                      DoEvents
                  Next i
                  
                  ' cek class #32770, karna objek text untuk mengetikkan YM ID merupakan child dari class ini
                  hwnd32770 = FindWindowEx(hWndInstantMsg, 0&, "#32770", vbNullString)
                  hwndEdit = FindWindowEx(hwnd32770, 0&, "Edit", vbNullString)
                  
                  ' tulis target YM ID
                  Call SendMessageByString(hwndEdit, WM_SETTEXT, 0&, ymIDTarget)
          
                  ' tekan tombol enter
                  PostMessage hwndEdit, WM_KEYDOWN, VK_RETURN, 0&
                  
                  Do While hwndYMMainClass = 0
                      hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
                      
                      DoEvents
                  Loop
                  
                  ' kirim pesan
                  Call ymChatSend(hwndYMMainClass, ymMsg)
                  
              Else
                  hwndMsgrBuddyTab = FindWindowEx(hWndInstantMsg, 0&, "MsgrBuddyTab", vbNullString)
                  
                  ' fokus ke tab other contact
                  SendMessage hwndMsgrBuddyTab, TCM_SETCURFOCUS, 1&, 0&
                  
                  ' cek class #32770, karna objek text untuk mengetikkan YM ID merupakan child dari class ini
                  hwnd32770 = FindWindowEx(hWndInstantMsg, 0&, "#32770", vbNullString)
                  hwndEdit = FindWindowEx(hwnd32770, 0&, "Edit", vbNullString)
                  
                  ' tulis target YM ID
                  Call SendMessageByString(hwndEdit, WM_SETTEXT, 0&, ymIDTarget)
                  
                  ' tekan tombol enter
                  PostMessage hwndEdit, WM_KEYDOWN, VK_RETURN, 0&
                  
                  Do While hwndYMMainClass = 0
                      hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
                      
                      DoEvents
                  Loop
                  
                  ' kirim pesan
                  Call ymChatSend(hwndYMMainClass, ymMsg)
                  
              End If
          End Sub
          

          Selamat mencoba🙂

          • Azharry
            May 26, 2011 at 4:36 am

            SEMPURNA!…………….

            Cuma tambahan sedikit…. karena pak dosen menggunakan yang Y!M 10 versi bahasa inggris jadi
            hWndInstantMsg = FindWindow(“#32770”, “Send an Instant Message”)

            kalo pake yang bahasa indonesianya tinggal di ganti
            hWndInstantMsg = FindWindow(“#32770”, “Kirim Pesan Instan”)
            sesuai dengan titel barnya.

            makasih….makasih…makasih….

            • May 26, 2011 at 5:33 am

              Oke om tq info tambahannya

  17. Azharry
    May 26, 2011 at 6:41 am

    pak dosen…. ada artikel ttg koneksi Y!M dengan winsock?

  18. miartha
    August 22, 2011 at 8:10 am

    Pak dosen minta petunjuk, cara membuka ID ym yang ada dikontak, u. kirim pesan

    • August 22, 2011 at 9:52 am

      Sudah sy jawab di komentar #27 diatas

  19. irfan
    August 22, 2011 at 8:33 am

    mas admin sy pake wind 7 (laptop) , trus sudah sy coba pakai ym ver,8,9,10,11 gak jalan sama sekali.
    tp di wind XP (PC kantor yg tak seberapa) bisa,,,,, mohon bantuan ilmunya mas admin untuk di wind 7 (laptop sy tercinta)
    after that tq mas admin.

    • August 22, 2011 at 9:53 am

      Emg yg enggak bisanya nerima taw balas om ?

  20. miartha
    August 23, 2011 at 3:41 am

    Pak Dosen
    Setelah Kotak dialog Send Instant Message diaktfkan
    target id YM sudah ditentukan
    setelah Chat muncul kenapa pesan tidak otomatis terkirim

    '................ Code............
    If hWndInstantMsg = 0 Then ' klo dialog Send Instant Message belum diaktfkan
    
            SelectItemID = GetMenuItemID(hSub, 0&amp;)
            PostMessage YHandle, WM_COMMAND, SelectItemID, 0&amp; ' akses menu send instant message
    
            Do While hWndInstantMsg = 0
                hWndInstantMsg = FindWindow("#32770", "Send an Instant Message")
    
                DoEvents
            Loop
    
            Do While hwndMsgrBuddyTab = 0
                hwndMsgrBuddyTab = FindWindowEx(hWndInstantMsg, 0&amp;, "MsgrBuddyTab", vbNullString)
    
                DoEvents
            Loop
    
            ' fokus ke tab other contact
            For i = 1 To 30
                SendMessage hwndMsgrBuddyTab, TCM_SETCURFOCUS, 1&amp;, 0&amp;
                DoEvents
            Next i
    
            ' cek class #32770, karna objek text untuk mengetikkan YM ID merupakan child dari class ini
            hwnd32770 = FindWindowEx(hWndInstantMsg, 0&amp;, "#32770", vbNullString)
            hwndEdit = FindWindowEx(hwnd32770, 0&amp;, "Edit", vbNullString)
    
            ' tulis target YM ID
            Call SendMessageByString(hwndEdit, WM_SETTEXT, 0&amp;, ymIDTarget)
    
            ' tekan tombol enter
            PostMessage hwndEdit, WM_KEYDOWN, VK_RETURN, 0&amp;
    
            Do While hwndYMMainClass = 0
                hwndYMMainClass = FindWindow("CConvWndBase", vbNullString)
    
                DoEvents
            Loop
    
            ' kirim pesan
            Call ymChatSend(hwndYMMainClass, ymMsg)
    end if
    

    Mohon Bantuannya

    • miartha
      August 23, 2011 at 3:51 am

      dan Juga ID Ym tidak otomatis di cari
      Padahal Menu Kontak sudah muncul

      Terima Kasih

      • August 24, 2011 at 2:16 am

        Klo ini memang belum support

    • August 24, 2011 at 2:19 am

      Memang dibaris keberapa yang enggak jalan ?
      Trus Y!Mnya pake versi brp?

  21. handoyo
    September 19, 2011 at 3:49 pm

    Makasih om buat tutorialnya..Mantapzz..

    • September 20, 2011 at 1:49 am

      Sama2x om, tq udah mampir🙂

  22. handoyo
    September 20, 2011 at 4:03 pm

    om,sy coba jalanin aplikasinya,sy pakai versi 11,sy udh tmbh2in di code nya utk versi 11,pas sy run,tmn kirim pesan tp bkn di keyword yg tersedia,ga berhasil.Apa yg salah ya kira2?thx

  23. handoyo
    September 20, 2011 at 4:16 pm

    om,sy udh download code nya n sy tes,sy pakai ym versi 11,ga berhasil euy.Apa hrs pakai keyword?Atau apa kira2 yg salah?thx

  24. handoyo
    September 20, 2011 at 4:27 pm

    sori om,sdh bisa,ada yg salah td.hehehe

    • September 21, 2011 at 1:54 am

      Oke om sippp🙂

    • May 16, 2013 at 7:51 am

      OM Bagi2 Source code untuk ym 11 dong….

  25. handoyo
    September 21, 2011 at 3:58 pm

    Oya om,kl misalkan offline message ga bs diproses ya?Harus ol baru bs proses autorespondnya?Tq

    • September 22, 2011 at 3:10 am

      Iya om soalnya class dari dialog pesan offline dan online itu beda, untuk ngetesnya gini aja coba tambahkan 2 fungsi berikut ke modul modYM :

      Public Function getYMIDOfflineMessage(ByVal offlineMsg As String) As String
          Dim ymID            As String
          Dim arrMsg()   As String
          
          If InStr(1, offlineMsg, "SpamReply") > 0 Then
              arrMsg = Split(offlineMsg, "SpamReply")
              ymID = arrMsg(0)
          End If
                  
          getYMIDOfflineMessage = ymID
      End Function
      
      Public Function getYMOfflineMessage(ByVal hwndYMMainClass As Long, ByRef ymID As String) As String
          Dim msg                 As String
          Dim arrMsg()            As String
          Dim validMsg            As String
          
          Dim hwnd2               As Long
          Dim hwnd3               As Long
          Dim hwnd4               As Long
          Dim hwnd5               As Long
          
          If hwndYMMainClass <> 0 Then
              'CMerlinWndBase -> ATL:0088EC78 -> Shell Embedding -> Shell DocObject View -> Internet Explorer_Server
              'hwnd1             hwnd2           hwnd3              hwnd4                   hwnd5
              
              hwnd2 = FindWindowEx(hwndYMMainClass, 0&, "ATL:0088EC78", vbNullString)
              hwnd3 = FindWindowEx(hwnd2, 0&, "Shell Embedding", vbNullString)
              hwnd4 = FindWindowEx(hwnd3, 0&, "Shell DocObject View", vbNullString)
              hwnd5 = FindWindowEx(hwnd4, 0&, "Internet Explorer_Server", vbNullString)
              
              msg = getIEText(hwnd5)
              ymID = getYMIDOfflineMessage(msg)
              
              arrMsg = Split(msg, ymID)
              arrMsg(1) = Replace(arrMsg(1), "SpamReply", "")
              validMsg = Right(arrMsg(1), Len(arrMsg(1)) - 13)
              
              getYMOfflineMessage = validMsg
          End If
      End Function
      

      kemudian set properties Enable timer yg ada di frmMain menjadi false, tambahkan 1 command button n copas kode berikut :

      Private Sub Command1_Click()
          Dim hwndYMMainClass As Long
          Dim msg             As String
          Dim ymID            As String
          
          hwndYMMainClass = FindWindow("CMerlinWndBase", vbNullString)
          msg = getYMOfflineMessage(hwndYMMainClass, ymID)
          
          MsgBox "YM ID : " & ymID & vbCrLf & "Pesan : " & msg
      End Sub
      

      Kode diatas sy test di YM 10, jangan lupa utk ngetes kode diatas harus ada sample window offline messagenya

  26. handoyo
    September 24, 2011 at 2:40 pm

    Saya udh tes om,ada error di kode arrMsg(1) = Replace(arrMsg(1), “SpamReply”, “”)

    Thanks..

    • September 26, 2011 at 4:14 am

      Oke om selamat berburu bug🙂

  27. October 1, 2011 at 3:58 pm

    Ok om,tq,btw ijin blajar rubah codenya jd activex dll ya om..Hehehe…

    • October 2, 2011 at 4:16 am

      Silahkan om

  28. putu artha
    October 9, 2011 at 5:00 pm

    om gmn caranya hapus recent messages YM, mohon bantuannya

    • October 10, 2011 at 8:32 am

      Maksudnya pesan yg ada di archive ya om ?

  29. putu artha
    October 10, 2011 at 8:53 am

    Betul………..

    • October 10, 2011 at 11:23 am

      Coba sini om.

  30. putu artha
    October 10, 2011 at 2:58 pm

    Apa bisa di dilakukan dgn VB6 Om..

    • October 11, 2011 at 6:07 am

      Bisa om, kan udah ketauan folder nyimpan arsipnya dimana trus untuk ngapusnya pake aja fungsi Kill.

  31. Tumadi
    November 3, 2011 at 1:15 pm

    Aplikasinya SANGAT MENARIK om, saya suka banget dengan aplikasi ini (sekedar untuk belajar) tapi saya belum bisa Connect ke data basenya nich. Mohon pencerahan di bagian modDatabase,
    fungsi konekToServer, dan setiap ketemu conn.Execute strSql , debug nya = Run-time error ‘3704’ Operation is not allowed when the object is closed.
    saya masih awam banget nih di VB, saya biasa koding di .asp clasic ya mirip sama vb karena memang bahasanya juga vbscript. Tapi di vb pas ada error bingung nelusurinya. Sudah otak-atik belum nemu nih. Trimakasih banyak Om..

    • November 4, 2011 at 5:50 am

      Coba prosedur konekToServer dinonaktifkan on error handlernya

      • Tumadi
        November 15, 2011 at 2:48 am

        Sudah Om.. eror programnya ketika conn.open jadi nggak bisa buka data basenya. path-nya sudah benar, kesalahannya dimana ya? masih otak-atik belum nemu nich. Sudah nyoba-nyoba script connection dari om Google juga blm bisa. Apa ada setting di komputernya ya?

        • November 15, 2011 at 12:53 pm

          Gini aja om, mendingan buat aplikasi kecil untuk ngetes koneksi kedatabasenya.

          • Tumadi
            November 16, 2011 at 4:35 am

            Terimakasih Om, setelah puyeng selama 2 minggu ini akhirnya terjawab sudah, kemarin saya pakai VB yang portable. Setelah saya install yang vb beneran,, ternyata semua berjalan dengan baik. Saya sudah test bikin aplikasi yang kecil hanya untuk Connect ke mdb saja pakai VB-Portable tetep gak jalan.
            Terimakasih, sekali lagi… Semoga Om selalu menebar ilmu yang bermanfaat untuk sesama sebagai sarana ibadah..

            • November 16, 2011 at 8:54 am

              Amin🙂

  32. akhiagus
    November 5, 2011 at 3:55 am

    Pak DOsen source code ini gak support utk menerima dan mengirim pesan ke nomor HP melalu no HP… mohon penbambahan kode untuk mengirim dan menerima dari no hp. Terimakasih

    • November 5, 2011 at 5:54 am

      Coba om baca komentar #27 saya diatas, semoga mendapat pencerahan😀

      • November 5, 2011 at 7:29 am

        Ok. Terimakasih. pak Dosen sekarang sudah paham, jadi untuk menerima atau mengirim sms pake ym, tinggal mengganti seluruh property handle window yang ada pada script program tersebut, dari CConvWndBase Menjadi YTabbedIMParent.
        terimakasih pak atas share script progragramnya.
        salam
        dari
        Agus Triono, S.Pd
        Aceh Timur

        • November 5, 2011 at 7:53 am

          Nah itu dia om, siippp🙂

  33. February 7, 2012 at 11:39 am

    om saya coba download kok file zipnya eror yah?
    g ada filenya..

    bisa dibantu?

    • February 7, 2012 at 12:04 pm

      Sy baru coba link download diatas masih bisa kok om, coba deh didownload lagi

  34. klonoa
    June 18, 2012 at 1:21 am

    om saya pake YM versi 11.5, sudah cek pake spy++ tapi kok YHTMLContainer gak ada y , sudah coba bgini CTabbedIMHost(Versi 11.5) -> Internet Explorer_Server ndak bisa , cuman bisa dapet id nya saja

  35. klonoa
    June 18, 2012 at 9:56 am

    sudah bisa ternyata begini
    Y!M 11.5 : CTabbedIMHost -> CConvWndBase -> YHTMLContainer -> Internet Explorer_Server

    • June 18, 2012 at 3:43 pm

      Siipp om, lumayan buat tambahan informasi🙂

  36. September 18, 2012 at 4:14 pm

    Mantap, om…
    ini yang ane pengen..
    Izin download dan mempelajari…
    :mrgreen:

  37. December 21, 2012 at 11:03 am

    masih blom ngerti,, dimana cara masukin username dan password nya, hehe.. lom pernah make VB

  38. January 3, 2013 at 12:35 pm

    assalamu alaikum

    saya mau coba bikin aplikasi informasi khs dengan ym penjawab otomatis.
    saya berharap anda bisa mempermudah ide saya. dengan minta saran dan kritik.
    untuk mempermudah saya mohon ym anda biar mudah koneksinya.
    trims
    Jazakallohu
    wasalam

  39. May 15, 2013 at 10:19 am

    mas
    punya saya sudah jalan tapi yang muncul di programnya hanya nama pengirim saja…
    Itu saya ganti dengan Kata2 di koment #66

    Karena saya ingin membuat semacam sms gateway dengan vb6

    Mohon pencerahannya

  40. October 11, 2013 at 3:06 pm

    pak kalau di windows 7 kan jika ada pesan yg masuk formnya kan berkedip2 itu ndak bisa langsung dibaca pesanya…
    kalau formnya ym diklik dulu baru bisa dibaaca sama program vb6, bagaimana mengatasi seperti itu pak

    • October 12, 2013 at 10:58 am

      Tambahkan pengecekan form Y!Mnya kemudian langsung diaktifkan, untuk contohnya bisa om cek disini.

  41. Ade
    February 5, 2014 at 5:13 pm

    yang saya gak ngerti, kenapa gak langsung saja menyisipkan modul YM di progran tersebut, jadi program nya bisa dipakai chat, juga bisa dibuat mesin penjawab otomatis
    tanpa harus menggunakan aplikasi YM bawaan Yahoo ?

  42. Ade
    February 5, 2014 at 6:10 pm
  43. February 8, 2014 at 11:12 am

    Mas.. saya pakai YM Ver 11.5.0.192 us
    gk ngaruh apa?? mohon solusi

    • March 4, 2014 at 10:10 am

      Nama class induk dan anaknya ganti lagi om :
      CTabbedIMHost -> CConvWndBase -> YHTMLContainer -> Internet Explorer_Server (membaca pesan yang masuk)
      CTabbedIMHost -> CConvWndBase -> YIMInputWindow (membalas pesan)

      Coba disesuaikan.

  1. April 16, 2014 at 9:12 am
Comments are closed.
%d bloggers like this: