# Native Code > برنامه نویسی در 6 VB > برنامه نویسی مرتبط با شبکه و وب در VB6 > سوال: لاگین کردن آی دی با winsock

## HamedFaa

سلام یه کمک برای لاگین کردن آی دی با winsock کنید.

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  = دریافت پی ام های کنفرانس
...

                                                           پایان

 سوالی بود بپرسین اگه بلد بودم جواب میدم




*هر روزتان نوروز / نوروزتان پیروز*

----------


## HamedFaa

آقا من واقعا نمیدونم چطور ازتون تشکر کنم. خیلی لطف کاردید. کاملا دقیق و واضح بود.
ممنونم ازت آقا بهنام

m.t.p بابت پاسخ شما هم ممنون

----------


## _behnam_

> آقا من واقعا نمیدونم چطور ازتون تشکر کنم. خیلی لطف کاردید. کاملا دقیق و واضح بود.
> ممنونم ازت آقا بهنام
> 
> m.t.p بابت پاسخ شما هم ممنون


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

----------


## dolati1703

> یاهو چندین پروتکل داره که فکر کنم ساده تر از همش 102 باشه که از سرعت بالایی هم برخورداره  
> 
>  شما به 2 تا وینسوک نیاز دارید البته با یک وینسوک هم میشه اما چون اولشه با 2تا راحت هستی
> با وینسوک 1 به یاهو کانکت میشی 
> ٌWinsock1.Connect "login.yahoo.com", "80"
> وقتی که کانکت شدی باید هدر و بقرستی که ایدی و پسورد هم شاملش میشه 
> 
> کد زیر رو وقتی که کانکت شدی با وینسوک ارسال کد
> 
> ...


از توضیحاتتون ممنونم اگه لطف کند یه Sample بزارید ممنون میشم

----------


## HamedFaa

سلام. ببخشید میشه آموزش ارسال پی ام در ادامه ی همین آموزش هم بدید. ممنون

----------


## Hossis

اگه سورس کامل رو می گذاشتید دیگه گیج نمی شدیم

----------


## program2vb

> یاهو چندین پروتکل داره که فکر کنم ساده تر از همش 102 باشه که از سرعت بالایی هم برخورداره  
> 
>  شما به 2 تا وینسوک نیاز دارید البته با یک وینسوک هم میشه اما چون اولشه با 2تا راحت هستی
> با وینسوک 1 به یاهو کانکت میشی 
> ٌWinsock1.Connect "login.yahoo.com", "80"
> وقتی که کانکت شدی باید هدر و بقرستی که ایدی و پسورد هم شاملش میشه 
> 
> کد زیر رو وقتی که کانکت شدی با وینسوک ارسال کد
> 
> ...


سلام آقا بهنام 

ببخشید اگه میشه یه مثال بزارید ممنون میشم 

یا علی

----------


## MagNus

درود دوست من .من فکر میکنم بهتره از این روش استفاده کنید سورس رو هم براتون میزارم

Dim StrYcook As String
Option Explicit
Private gotCookie As Boolean
Private isConnected As Boolean
Private inChat As Boolean
Private strID As String
Private strPassword As String
Private strYPart As String
Private strTPart As String

Private Sub Command1_Click()
gotCookie = False
inChat = False
isConnected = False
strID = Text1.Text
strPassword = Text2.Text
Winsock1.Connect "login.yahoo.com", "80"
End Sub

Private Sub Form_Load()

End Sub

Private Sub Winsock1_Connect()
On Error Resume Next
If gotCookie = False Then Call Winsock1.SendData(GrabCookies$(strID, strPassword, "login.yahoo.com"))
    If gotCookie = True Then Call Winsock1.SendData(Login$(strID, strYPart, strTPart))
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
   Dim strData As String
    
    Call Winsock1.GetData(strData$)
    Debug.Print strData$
    If gotCookie = False Then
        If Mid(strData$, 10, 3) = 302 Then
            strYPart$ = Split(strData$, "Y=")(1)
            strYPart$ = Split(strYPart$, ";")(0)
            strYPart$ = "Y=" & strYPart$ & ";"
            strTPart$ = Split(strData$, "T=")(1)
            strTPart$ = Split(strTPart$, ";")(0)
            strTPart$ = "T=" & strTPart$
            gotCookie = True
            lblStatus.Caption = "Bot " & Text1.Text & " Got Cookie"
            Call Winsock1.Close
            Call Winsock1.Connect("scs.msg.yahoo.com", 5050)
        Else
            Call Winsock1.Close
            
            Exit Sub
        End If
    End If
    
    If gotCookie = True Then
        Select Case Asc(Mid$(strData$, 12, 1))
            
            Case 85
                isConnected = True
                lblStatus.Caption = "Bot " & Text1.Text & " Logged In"
                 End Select
    End If
End Sub



Module1

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function Pause(ByVal Interval As Single) As Single
    Dim x As Single

    x! = Timer
    Do While (Timer - x!) < Val(Interval)
        DoEvents
        Sleep 1
    Loop
End Function

Public Function GrabCookies(strID As String, strPass As String, strServer As String) As String
    GrabCookies$ = "GET /config/login?" & "login=" & strID$ & "&passwd=" & strPass$ & _
        " HTTP/1.1" & vbCrLf & "Host: " & strServer$ & vbCrLf & "Accept: */*" & vbCrLf & vbCrLf
End Function



Module2

Private Function AssemblePacket(strPacket As String, packetType As Integer) As String
    AssemblePacket$ = Chr$(&H59) & Chr$(&H4D) & Chr$(&H53) & Chr$(&H47) & Chr$(0) & Chr$(102) & Chr$(&H0) & Chr$(&H1) & _
                    Chr$(Int(Len(strPacket$) / 256)) & Chr$(Int(Len(strPacket$) Mod 256)) & Chr$(Int(packetType / 256)) & _
                    Chr$(Int(packetType Mod 256)) & String$(8, Chr$(&H0)) & strPacket$
End Function

Public Function Login(strYahooID As String, strYCookie As String, strTCookie As String) As String
    Login$ = AssemblePacket$("0À€" & strYahooID$ & "À€2À€" & strYahooID$ & "À€1À€" & strYahooID$ & _
            "À€244À€1À€6À€" & strYCookie$ & " " & strTCookie$ & "À€98À€usÀ€", 550)
End Function




در این روش لوگین که به اصطلاح انتی بوت هست شما پاکتهای خواسی رو میتونید بفرستید

PM or FILE or  Join room And  GAME 

Source For Download
http://www.2shared.com/file/A7kO-mAp/102.html

----------


## akbar8298

سلام بچه ها

من یه سوال برام پیش اومده. راستش من داشتم این برنامه رو با C#‎‎ مینوشتم به نکته ای برخوردم که برام قابل درک نیست.


 Private Function AssemblePacket(strPacket As String, packetType As Integer) As String
     AssemblePacket$  = Chr$(&H59) & Chr$(&H4D) & Chr$(&H53) &  Chr$(&H47) & Chr$(0) & Chr$(102) & Chr$(&H0) &  Chr$(&H1) & _
                     Chr$(Int(Len(strPacket$) / 256)) & Chr$(Int(Len(strPacket$) Mod 256)) & Chr$(Int(packetType / 256)) & _
                     Chr$(Int(packetType Mod 256)) & String$(8, Chr$(&H0)) & strPacket$
 End Functio


این کدی که نوشنید یه جاییش نوشته chr(0)

خوب این مگه همون NULL نیست؟ و VB و C#‎‎ مگه این رو به عنوان انتهای رشته  نمیدونن؟  :متفکر:  خوب وقتی که این تابع رشته ای رو که حاوی کاراکتر NULL هست رو بر  میگردونه مگه نه که تا همون کاراکتر NULL برمی گردونه؟؟ من حتی خروجی این  تابع رو به عنوان caption فرم اختصاص دادم ولی فقط YMSG رو نشون میده! 

لطفا یه راهنمایی بکنید تا بتونم با C#‎‎ بنویسمش!!  :لبخند: 
ممنون

----------


## MagNus

درود.
 دوست عزیز این کاملا مشخص شده

Chr$(102)  ورژنی هست که یاهو اوگین میشه

Chr$(&H59) & Chr$(&H4D) & Chr$(&H53) &  Chr$(&H47) & Chr$(0) & Chr$(102)
Y M S G                   102 

و جالب اینجاست که اگر از Chr$(0) استفاده نکنی 102 به بقیه حروف میچسبه که error میشه

----------


## akbar8298

> درود.
>  دوست عزیز این کاملا مشخص شده
> 
> Chr$(102)  ورژنی هست که یاهو اوگین میشه
> 
> Chr$(&H59) & Chr$(&H4D) & Chr$(&H53) &  Chr$(&H47) & Chr$(0) & Chr$(102)
> Y M S G                   102 
> 
> و جالب اینجاست که اگر از Chr$(0) استفاده نکنی 102 به بقیه حروف میچسبه که error میشه


 مشکل من با ورژن نیست. آخه منطق برنامه نویسی رو دارم عرض می کنم. در کل chr(0) میشه NULL که آخر رشته رو مشخص می کنه و دیگه بقیش مهم نیس

----------


## ho3ein.3ven

سلام .
با این سورس که لاگین می کنیم . یک سری از امکانات غیر فعال مثل شکلک ها و buzz و ...  . کسی نمی دونه چطوری میشه اینارو فعال کرد ؟
ymsg که لاگین میشه همه اینا فعال هستند.
با تشکر

----------


## program2vb

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

اگه میشه منو راهنمایی کنین ممنون میشم ؟ 

من اینو نوشتم ؟ 


Public Function sendPM(ByVal PM As String, ByVal Fuser As String, Tuser As String) As String
    sendPM = Header("1À€" & Fuser & "À€5À€" & Tuser & "À€97À€1À€63À€;0À€64À€0À€206  €2À€14À€" & PM & "À€429À€000000001731368FÀ€450À€0À€"  , String(4, Chr(0)), String(4, Chr(0)),6)
End Function


موفق و پیروز باشید در پناه حق ... یا علی

----------


## _behnam_

[QUOTE=program2vb;1636700]سلام به همگی دوستان عزیز میخواستم ببینم کسی میدونه چطوری من میتونم پیام ارسال کنم یا دریافت کنم هر چقد اسنف زدم و نوشتم کار نکرد ؟ 

اگه میشه منو راهنمایی کنین ممنون میشم ؟ 

من اینو نوشتم ؟ 


Public Function sendPM(ByVal PM As String, ByVal Fuser As String, Tuser As String) As String
    sendPM = Header("1À€" & Fuser & "À€5À€" & Tuser & "À€97À€1À€63À€;0À€64À€0À€206  €2À€14À€" & PM & "À€429À€000000001731368FÀ€450À€0À€"  , String(4, Chr(0)), String(4, Chr(0)),6)
End Function


موفق و پیروز باشید در پناه حق ... یا علی[/QUOTE
]
سلام ، 
Public Function sendPM(ByVal PM As String, ByVal Fuser As String, Tuser As String) As String
    sendPM = Header("1À€" & Fuser & "À€5À€" & Tuser & "À€14À€" & PM & "À€"  , String(4, Chr(0)), String(4, Chr(0)),6)
End Function

----------

