سلام یه کمک برای لاگین کردن آی دی با winsock کنید.
winsock به سرور های لاگین کانکت میشه. ولی درخواست لاگین و آی دی پس رو چطور باید بفرستم بهش؟
لاگین کردن آی دی با winsock
سلام یه کمک برای لاگین کردن آی دی با winsock کنید.
winsock به سرور های لاگین کانکت میشه. ولی درخواست لاگین و آی دی پس رو چطور باید بفرستم بهش؟
یاهو چندین پروتکل داره که فکر کنم ساده تر از همش 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 & "98us", 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 = دریافت پی ام های کنفرانس
...
پایان
سوالی بود بپرسین اگه بلد بودم جواب میدم
هر روزتان نوروز / نوروزتان پیروز
آقا من واقعا نمیدونم چطور ازتون تشکر کنم. خیلی لطف کاردید. کاملا دقیق و واضح بود.
ممنونم ازت آقا بهنام
m.t.p بابت پاسخ شما هم ممنون
دوست عزیز نیازی نیست که واسه تشکر پست بدیدنوشته شده توسط HamedFaa
همون دکمه تشکر رو بزنید کافیه
از توضیحاتتون ممنونم اگه لطف کند یه Sample بزارید ممنون میشم
آخرین ویرایش به وسیله vbhamed : جمعه 01 آذر 1392 در 14:40 عصر
سلام. ببخشید میشه آموزش ارسال پی ام در ادامه ی همین آموزش هم بدید. ممنون
اگه سورس کامل رو می گذاشتید دیگه گیج نمی شدیم
سلام آقا بهنام
ببخشید اگه میشه یه مثال بزارید ممنون میشم
یا علی
درود دوست من .من فکر میکنم بهتره از این روش استفاده کنید سورس رو هم براتون میزارم
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$ & _
"24416" & strYCookie$ & " " & strTCookie$ & "98us", 550)
End Function
در این روش لوگین که به اصطلاح انتی بوت هست شما پاکتهای خواسی رو میتونید بفرستید
PM or FILE or Join room And GAME
Source For Download
http://www.2shared.com/file/A7kO-mAp/102.html
سلام بچه ها
من یه سوال برام پیش اومده. راستش من داشتم این برنامه رو با 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# بنویسمش!!
ممنون
درود.
دوست عزیز این کاملا مشخص شده
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 که آخر رشته رو مشخص می کنه و دیگه بقیش مهم نیس
سلام .
با این سورس که لاگین می کنیم . یک سری از امکانات غیر فعال مثل شکلک ها و buzz و ... . کسی نمی دونه چطوری میشه اینارو فعال کرد ؟
ymsg که لاگین میشه همه اینا فعال هستند.
با تشکر
سلام به همگی دوستان عزیز میخواستم ببینم کسی میدونه چطوری من میتونم پیام ارسال کنم یا دریافت کنم هر چقد اسنف زدم و نوشتم کار نکرد ؟
اگه میشه منو راهنمایی کنین ممنون میشم ؟
من اینو نوشتم ؟
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=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
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول