ارسال pm با winsock

Printable View

سه شنبه 25 بهمن 1390, 20:30 عصر
movaffag

ارسال pm با winsock

سلام من با winsock لاگین شدم الان چطوری به یه ایدی مشخص pm بدم
سه شنبه 25 بهمن 1390, 20:44 عصر
سید حمید حق پرست

نقل قول: ارسال pm با winsock
چرا از YMSGMod.OCX استفاده نمیکنی؟
راحتره
با YMSGMod.OCX :
```
Call YMSG1.PckSendMsg(send2.Text, SendPM.Text)
```
سه شنبه 25 بهمن 1390, 22:59 عصر
movaffag

نقل قول: ارسال pm با winsock

سوس مربوط به این کامپوننت یا مقاله اموزشی داره؟
سه شنبه 25 بهمن 1390, 23:08 عصر
سید حمید حق پرست

1 ضمیمه

نقل قول: ارسال pm با winsock

اره دوست عزیز اینم سورس :
سه شنبه 25 بهمن 1390, 23:12 عصر
movaffag

نقل قول: ارسال pm با winsock

فقط یه مشکلی که هست من نمی خوام با کامپوننت بنویسم winsock هم چون مال خود ویندوز هست ازش استفاده میکنم

نقل قول: ارسال pm با winsock

این کدهارو اقای _behnam_ عزیز تو یه تاپیک گذاشتن :

اینم کدهاش :
یاهو چندین پروتکل داره که فکر کنم ساده تر از همش 102 باشه که از سرعت بالایی هم برخورداره

شما به 2 تا وینسوک نیاز دارید البته با یک وینسوک هم میشه اما چون اولشه با 2تا راحت هستی
با وینسوک 1 به یاهو کانکت میشی
Winsock1.Connect "login.yahoo.com", "80"
وقتی که کانکت شدی باید هدر و بقرستی که ایدی و پسورد هم شاملش میشه
کد زیر رو وقتی که کانکت شدی با وینسوک ارسال کد
Dim LoginYahoo As String

 LoginYahoo = "GET http://login.yahoo.com/config/login?login=" & ID & "&passwd=" & password & " HTTP/1.1" & vbCrLf

 LoginYahoo = LoginYahoo & "Accept-Language: en-us" & vbCrLf

 LoginYahoo = LoginYahoo & "User-Agent: Mozilla/5.0 (compatible; MSIE 8.0; Windows NT 5.1; Expulsion-Creations)" & vbCrLf

 LoginYahoo = LoginYahoo & "Accept: */*" & vbCrLf

 LoginYahoo = LoginYahoo & "Host: login.yahoo.com" & vbCrLf

 LoginYahoo = LoginYahoo & "Connection: Keep-Alive" & vbCrLf & vbCrLf

 Winsock1.SendData LoginYahoo
3 وقتی هدر رو ارسال کردی کوکی ها رو دریافت کنی
On Error Resume Next

 Dim Data As String

 Winsock1.GetData Data

 If InStr(Data, "Yahoo! - 400 Bad Request") Then

 Winsock1.Close

 Debug.Print "Yahoo! - 400 Bad Request"

 Exit Sub

 Else:

 If InStr(Data, "302 Found") Then

 StrYcook = Split(Data, "Y=")(1)

 StrYcook = Split(StrYcook, "np=1")(0)

 StrYcook = "Y=" & StrYcook & "np=1;"

 StrTcook = Split(Data, "T=")(1)

 StrTcook = Split(StrTcook, ";")(0)

 StrTcook = "T=" & StrTcook

 Debug.Print "connect to port 80"

 Winsock1.Close

 Winsock2.Close

 Winsock2.Connect "mcs.msg.yahoo.com", 5050

 Else:

 msgbox "Error!!"

 Exit Sub

 End If

 End If
خوب اگه آیدی درست باشه کوکی دریافت میشه و با وینسوک 2 به سرور یاهو وصل میشید برای ارسال پکت ها

واسه ارسال پکت نیاز به یه هدر درست و حسابی داریم! هدرهای زیادی وجود دارن که بعضی از اونا کامل نیستن و تو دریافت پکت مشکل دارن اینی که قرار میدم تقریبا کامله من خودم حتی فایل هم از طریق یاهو باش دریافت کردم
'header

Public Function Header(YMSGPacketData As String, YMSGStatus As String, YMSGKey As String, YMSGCommand As Long) As String

Dim YMSGVendor As Long

Dim YMSGVersion As Integer

YMSGVendor = 0

YMSGVersion = 17

Header = "YMSG" & Chr(Int(YMSGVersion / 256)) & Chr(Int(YMSGVersion Mod 256)) & Chr(Int(YMSGVendor / 256)) & Chr(Int(YMSGVendor Mod 256)) & Chr(Int(Len(YMSGPacketData) / 256)) & Chr(Int(Len(YMSGPacketData) Mod 256)) & Chr(Int(YMSGCommand / 256)) & Chr(Int(YMSGCommand Mod 256)) & Mid(YMSGStatus, 1, 4) & Mid(YMSGKey, 1, 4) & YMSGPacketData

End Function
و حالا یه پکت برای ارسال کوکی و لاگین شدن
' Send Login

Public Function Login(YahooID As String, YCookie As String, TCookie As String)

 On Error Resume Next

 Dim InVType As String

 InVType = Chr(0)

 Login = Header("0À€" & YahooID & "À€2À€" & YahooID & "À€1À€" & YahooID & "À€244À€" & "0" & "À€6À€" & YCookie & " " & TCookie & "À€98À€usÀ€", String(3, Chr(0)) & InVType, String(3, Chr(0)) & InVType, 550)

End Function
خوب الان ما همه چیرو آماده داریم واسه لاگین شده میتونیم تا Winsock2 کانکت شد باش پکت لاگین رو ارسال کنیم
Winsock2.SendData Login(ID, StrYcook, StrTcook)
الان اگه اطلاعات درست باشن آیدی لاگین میشه

تو قسمت Winsock2_DataArrival پکت ها دریافت میشن
هر پکت یه شماره مخصوص داره میتونید از شماره پکت ها مشخص کنید پکت دریافتی چه پکتی هست
Dim Data as string

Dim Types as integer

Winsock2.GetData Data

 Types = Asc(Mid(Data, 12, 1))
اینم کد برای بدست آوردن شماره پکت

میتونید Select case Types بزارید
برای مثال
case 6 = دریافت پی ام
case 75 = دریافت تایپینگ
case 85 = لاگین شدن
case 29 = دریافت پی ام های کنفرانس
...

پایان

موفق باشی

یا علی (ع)

چهارشنبه 26 بهمن 1390, 01:12 صبح
سید حمید حق پرست

نقل قول: ارسال pm با winsock
اینم برای فرستادن پی ام :
```
    sendData SendPm(tUser.Text, txtPersonID.Text, txtMessage.Text)

    txtMessage.Text = ""
```
چهارشنبه 26 بهمن 1390, 11:54 صبح
سید حمید حق پرست

1 ضمیمه

نقل قول: ارسال pm با winsock

سلام

اینم سورس ارسال و دریافت پی ام
موفق باشید

یا علی (ع)
پنج شنبه 27 بهمن 1390, 15:21 عصر
movaffag

نقل قول: ارسال pm با winsock

نقل قول:

نوشته شده توسط سید حمید حق پرست

سلام

اینم سورس ارسال و دریافت پی ام
موفق باشید

یا علی (ع)

این سورس جواب نمیده
پنج شنبه 27 بهمن 1390, 20:02 عصر
_behnam_

نقل قول: ارسال pm با winsock

فکرکنم پروتکل 102 یه مدت هست که لاگین نمیشه!
جمعه 28 بهمن 1390, 16:36 عصر
movaffag

نقل قول: ارسال pm با winsock

من الان خودم با winsock لاگین می کنم ولی کد ارسال Pm رو ندارم
جمعه 28 بهمن 1390, 17:09 عصر
_behnam_

نقل قول: ارسال pm با winsock

سورس رو قرار دهید تا در صورت امکان رسیدگی بشه

نقل قول: ارسال pm با winsock

این کد کامل لاگین کردن هستش که به صورت کامل ایدی رو لاگین می کنه الان برای این چطوری یه pm سندر بنویسم خواهشا از کد های دیگه کپی نکنین چون کار نمیکنه

Public StrYcook As String

Public StrTcook As String

Public BotID As String

Dim Out1 As String

Dim Out2 As String







Private Sub Command1_Click()

BotID = id.Text

Winsock1.Close

Winsock1.Connect "login.yahoo.com", "80"

End Sub





Private Sub Winsock1_Connect()

On Error Resume Next

    Dim LoginYahoo As String

    LoginYahoo = "GET http://login.yahoo.com/config/login?login=" & id.Text & "&passwd=" & pass.Text & " HTTP/1.1" & vbCrLf

    LoginYahoo = LoginYahoo & "Accept-Language: en-us" & vbCrLf

    LoginYahoo = LoginYahoo & "User-Agent: Mozilla/5.0 (compatible; MSIE 8.0; Windows NT 5.1; Expulsion-Creations)" & vbCrLf

    LoginYahoo = LoginYahoo & "Accept: */*" & vbCrLf

    LoginYahoo = LoginYahoo & "Host: login.yahoo.com" & vbCrLf

    LoginYahoo = LoginYahoo & "Connection: Keep-Alive" & vbCrLf & vbCrLf

    Winsock1.SendData LoginYahoo

End Sub



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

    Dim Data As String

    Winsock1.GetData Data

    If InStr(Data, "Yahoo! - 400 Bad Request") Then

        Winsock1.Close

        Debug.Print "Yahoo! - 400 Bad Request"

    Exit Sub

    Else:

    If InStr(Data, "302 Found") Then

        StrYcook = Split(Data, "Y=")(1)

        StrYcook = Split(StrYcook, "np=1")(0)

        StrYcook = "Y=" & StrYcook & "np=1;"

        StrTcook = Split(Data, "T=")(1)

        StrTcook = Split(StrTcook, ";")(0)

        StrTcook = "T=" & StrTcook

        Debug.Print "connect to port 80"

        Winsock1.Close

        Winsock2.Close

        Winsock2.Connect "mcs.msg.yahoo.com", 5050

    Else:

    Exit Sub

    End If

    End If

End Sub



Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

Debug.Print "number=" & Number & "des=" & Description

End Sub



Private Sub Winsock2_Connect()

On Error Resume Next

    Winsock2.SendData Login(BotID, StrYcook, StrTcook)

    Me.Caption = "Please Wait Chat Bot.."

End Sub



Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

    Dim Data As String

    Dim cas As String

    Winsock2.GetData Data

    cas = Asc(Mid(Data, 12, 1))

    '

    Select Case Asc(Mid(Data, 12, 1))

    '

    Case 168

    If InStr(Data, "samaneh_lalala_o3") Then

    Dim sss As String

    sss = Data

    End If

    Case 75

    Dim InstanseIdType As String

    InstanseIdType = Split(Data, "4À€")(1)

    InstanseIdType = Split(InstanseIdType, "À€5À€")(0)

    Me.Caption = InstanseIdType & " typed message for you"

    '

    Case 6

    Dim InstanseMsgPm As String

    Dim InstanseIdPm As String

    InstanseIdPm = Split(Data, "4À€")(1)

    InstanseIdPm = Split(InstanseIdPm, "À€5À€")(0)

    InstanseMsgPm = Split(Data, "14À€")(1)

    InstanseMsgPm = Split(InstanseMsgPm, "À€63")(0)

    Me.Caption = InstanseIdPm

    Text1.Text = InstanseMsgPm

    '

    Case 85

    Me.Caption = "Logged in"

    Debug.Print "Logged in"

    blnconnected = True

    '

    Case 2

    If InStr(Data, "ÿÿÿÿ") Then

        Me.Caption = "Logged Out By Server"

        blnconnected = False

        Winsock2.Close

    End If

    '

    Case 117

    Data1 = Split(Data, "À€109À€")

     On Error Resume Next

      For i = 1 To 60

      List1.AddItem Split(Data1(i), "À€")(0)

    Next i

        Case Is = 150

            'if allowed sends join chatroom

            Winsock2.SendData chatjoin(id.Text, Chatroom.Text)

        Case Is = 152

            If InStr(Data, "To help prevent") > 0 Then

                Out1 = Split(Data, "chatting")(1)

                Out1 = Mid(Out1, 3, Len(Out1))

                Out1 = Split(Out1, "À€108À€2À€109À€")(0)

                Out2 = Split(Out1, "img=")(1)

                Out2 = Split(Out2, ".jpg")(0)

                Out2 = Out2 & ".jpg"

                WebBrowser1.Navigate Out2



            ElseIf InStr(Data, "114À€-35À€") > 0 Then

            Me.Caption = "Room is full"

            Winsock3.Close

Winsock3.Connect "captcha.chat.yahoo.com", 80



            ElseIf InStr(Data, "À€128À€") > 0 Then



                If InStr(Data, "À€109À€") > 0 Then

                    Data1 = Split(Data, "À€109À€")

                    On Error Resume Next

                    For i = 1 To 60

                        List1.AddItem Split(Data1(i), "À€")(0)

                    Next i

                End If

            End If

        Debug.Print Data

            Text1.Text = Text1.Text & Chr(13) & Data

    End Select

End Sub



Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

    Debug.Print Description, vbCritical

    Winsock2.Close

End Sub



Public Function Login(YahooID As String, YCookie As String, TCookie As String)

    Login = Header("0À€" & YahooID & "À€2À€" & YahooID & "À€1À€" & YahooID & "À€244À€1À€6À€" & YCookie & " " & TCookie & "À€98À€usÀ€", String(4, Chr(0)), String(4, Chr(0)), 550)

End Function





Public Function chatjoin(YahooID As String, Chatroom As String)

If Chatroom = vbNullString Then

    chatjoin = Header("109À€" & YahooID & "À€1À€" & YahooID & "À€6À€abcdeÀ€98À€usÀ€135À€9.0.0.  2152À€", String(4, Chr(0)), String(4, Chr(0)), 150)

Else

    chatjoin = Header("1À€" & YahooID & "À€104À€" & Chatroom & "À€129À€" & "À€62À€2À€", String(4, Chr(0)), String(4, Chr(0)), 152)

End If

End Function





Private Sub captchaword_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Winsock3.Close

Winsock3.Connect "captcha.chat.yahoo.com", 80

End If

End Sub



Public Function captchasend(CaptImg As String, CaptWord As String, CaptCookie As String) As String

Dim pck As String, StrCap As String

On Error Resume Next

pck = "question=" & CaptImg & "&.intl=us&answer=" & CaptWord

StrCap = "POST http://captcha.chat.yahoo.com/captcha1 HTTP/1.1" & vbCrLf

StrCap = StrCap + "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*" & vbCrLf

StrCap = StrCap + "Referer: http://captcha.chat.yahoo.com" & vbCrLf

StrCap = StrCap + "Accept-Language: en-us" & vbCrLf

StrCap = StrCap + "Content-Type: application/x-www-form-urlencoded" & vbCrLf

StrCap = StrCap + "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)" & vbCrLf

StrCap = StrCap + "Host: captcha.chat.yahoo.com" & vbCrLf

StrCap = StrCap + "Content-Length: " & Len(pck) & vbCrLf

StrCap = StrCap + "Connection: Keep-Alive" & vbCrLf

StrCap = StrCap + "Cache-Control: no-cache" & vbCrLf

StrCap = StrCap + "Cookie: " & Replace(CaptCookie, "&lang=en", "") & vbCrLf & vbCrLf & pck

captchasend = StrCap

End Function



Private Function YTunnel(Whofrom As String, Whoto As String) As String

Dim pck As String

pck = "1À€" & Whofrom & "À€302À€240À€300À€240À€7À€" & Whoto & "À€224À€" & String(1000, Chr$(181)) & "À€264À€" & String(1000, Chr$(164)) & "À€301À€240À€303À€240À€"

h = Chr$(69) + Chr$(55)

YTunnel = Header(pck, String(4, 0), String(4, 0), 124)

End Function





Public Function Header(ByVal StrPacketType As String, ByVal StrStat As String, ByVal StrSession As String, ByVal StrComm As Long) As String

    Dim Version As String

    '

    Version = 102

    '

    Header = "YMSG" & Chr(Int(Version / 256)) & Chr(Int(Version Mod 256)) & Chr(Int(409 / 256)) & Chr(Int(409 Mod 256)) & Chr(Int(Len(StrPacketType) / 256)) & Chr(Int(Len(StrPacketType) Mod 256)) & Chr(Int(StrComm / 256)) & Chr(Int(StrComm Mod 256)) & Mid(StrStat, 1, 4) & Mid(StrSession, 1, 4) & StrPacketType

End Function









Private Sub btnbot_Click()

'Winsock2.SendData fagboy(Id.Text, txtWhoto.Text)

Dim msg As String

msg = txtWhoto.Text

Winsock2.SendData YRoomText(id.Text, Chatroom.Text, msg)

End Sub





Private Function Assemble(ByVal iService As Integer, ByVal iPacket As String) As String

Dim Data As String

Data = "YMSG" & Chr(Int(102 / 256))

Data = Data & Chr(Int(102 Mod 256))

Data = Data & Chr(Int(409 / 256)) & Chr(Int(409 Mod 256))

Data = Data & Chr(Int(Len(iPacket) / 256))

Data = Data & Chr(Int(Len(iPacket) Mod 256))

Data = Data & Chr(Int(iService / 256))

Data = Data & Chr(Int(iService Mod 256))

Data = Data & String(8, Chr(0))

Data = Data & iPacket

              '

    Assemble = Data

              ' Debug.Print Assemble

             

End Function

یک شنبه 30 بهمن 1390, 15:52 عصر
_behnam_

نقل قول: ارسال pm با winsock

سورس رو به صورت کامل قرار بدید نه کد!!!
واسه من که لاگین نمیشه
یک شنبه 30 بهمن 1390, 16:14 عصر
movaffag

نقل قول: ارسال pm با winsock

چرا درست کار میکنه من کد گذاشتم معاومه که همه چیز
یک شنبه 30 بهمن 1390, 18:18 عصر
_behnam_

نقل قول: ارسال pm با winsock

نقل قول:

نوشته شده توسط movaffag

چرا درست کار میکنه من کد گذاشتم معاومه که همه چیز

اینجوری امتحان کردم لاگین نشد،
توش موندم چطور میگید میشه؟
اگه سورسی که دارید لاگین میشه بزارید تا بررسی شه در صورت درست بودن پکت رو اسنیف میکنم و میزارم تو سورس
سه شنبه 02 اسفند 1390, 11:07 صبح
mafia5000

نقل قول: ارسال pm با winsock
نقل قول:
نوشته شده توسط سید حمید حق پرست

چرا از YMSGMod.OCX استفاده نمیکنی؟
راحتره
با YMSGMod.OCX :

Call YMSG1.PckSendMsg(send2.Text, SendPM.Text)
این کامپوننت برای من درست کار نمیکنه وقته برناممو ران میکنم دیگه نمی تونم استاپش کنم فقط میتونم پاوزش کنم
سه شنبه 02 اسفند 1390, 14:34 عصر
m2011kh

نقل قول: ارسال pm با winsock

لاگین میشه ولی نمیدونم چرا تو ساعت ها شلوغ روز مثل بعد از ظهر ها بسته هست و لاگین نمیشه.
صبح زود یا شب دیر وقت متحان کن جواب میده.
سه شنبه 02 اسفند 1390, 14:49 عصر
m2011kh

نقل قول: ارسال pm با winsock

چیزی برای دریافت وجود نداره؟
سه شنبه 02 اسفند 1390, 16:03 عصر
m2011kh

نقل قول: ارسال pm با winsock

همه اینا که میگن برا ارساله چیزی برا دریافت نیست؟
سه شنبه 02 اسفند 1390, 17:38 عصر
_behnam_

نقل قول: ارسال pm با winsock

یعنی چی چیزی واسه دریافت نیست؟
جمعه 05 اسفند 1390, 00:32 صبح
mafia5000

نقل قول: ارسال pm با winsock

اگر هدر رو عوض کنین مشکل همه پروتکل ها حل میشه