引用 | 編輯
啊條o
2010-08-20 15:24 |
樓主
▼ |
||
x1
作品名稱 : YAHOO即時通補助 作品說明 : 有抓取大頭貼、狀態輪播、封鎖、多開,並使用VB6撰寫 請先把壓縮檔內的資料夾覆蓋至C槽 原始碼 表單: 複製程式 Const HKEY_CURRENT_USER = &H80000001 Const REG_DWORD = 4 Const s = "Software\Yahoo\pager\Test" Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Sub RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) Private Declare Sub RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) Private Declare Sub RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) Dim ch, rh As Boolean Dim ti As Integer Dim yahoo As New Messenger2 Private Sub Combo1_Change() If Val(Combo1.Text) < 5 Or 100 < Val(Combo1.Text) Then ch = Not ch If ch = True Then MsgBox "範圍錯誤", , "Error" Combo1.Text = "" End If End If End Sub Private Sub Command1_Click() If Check1.Value = 0 Then List1.AddItem 0 & Text1.Text Else List1.AddItem 1 & Text1.Text End If List1.ListIndex = List1.NewIndex End Sub Private Sub Command10_Click() Timer2.Interval = 200 Timer2.Enabled = True Timer3.Interval = 5000 Timer3.Enabled = True End Sub Private Sub Command11_Click() Label3.Caption = Text3 End Sub Private Sub Command12_Click() MsgBox "輸入帳號然後按鎖定在按封鎖 ! 就OK .", vbOKOnly, "說明" End Sub Private Sub Command2_Click() On Error GoTo f List1.RemoveItem List1.ListIndex f: End Sub Private Sub Command3_Click() Timer1.Interval = Val(Combo1.Text) * 1000 Timer1.Enabled = True End Sub Private Sub Command4_Click() Timer1.Enabled = False End Sub Private Sub Command5_Click() If List1.ListIndex = -1 Then List1.ListIndex = List1.ListCount - 1 Exit Sub End If If List1.ListIndex = 0 Then Exit Sub End If TmpStr = List1 TmpSqr = List1.ListIndex List1.RemoveItem List1.ListIndex List1.AddItem TmpStr, TmpSqr - 1 List1.ListIndex = TmpSqr - 1 End Sub Private Sub Command6_Click() If List1.ListIndex = -1 Then List1.ListIndex = 0 Exit Sub End If If List1.ListIndex = List1.ListCount - 1 Then Exit Sub End If TmpStr = List1 TmpSqr = List1.ListIndex List1.RemoveItem List1.ListIndex List1.AddItem TmpStr, TmpSqr + 1 List1.ListIndex = TmpSqr + 1 End Sub Private Sub Command7_Click() Dim h& RegOpenKey HKEY_CURRENT_USER, s, h RegSetValueEx h, "plural", 0, REG_DWORD, 1&, 4 RegCloseKey h End Sub Private Sub Command8_Click() Dim r&, h& r = RegOpenKey(HKEY_CURRENT_USER, s, h) If r = 0 Then RegDeleteValue h, "plural" RegCloseKey h End Sub Private Sub Command9_Click() URL = "http://img.msg.yahoo.com/avatar.php?yids=" & Text2 WebBrowser2.Navigate URL WebBrowser2.Visible = True URL2 = "[url=http://opi.yahoo.com/online?m=g&t=0&l=tw&u]http://opi.yahoo.com/online?m=g&t=0&l=tw&u[/url]=" & Text2 WebBrowser1.Navigate URL2 WebBrowser1.Visible = True End Sub Private Sub Form_Load() MsgBox "歡迎使用本程式 作者即時通:s9652387 ", 64, "(!)" Shell "explorer http://www.wretch.cc/blog/s9652387" WebBrowser3.Navigate "https://login.yahoo.com" WebBrowser2.Visible = False 'WebBrowser2.Navigate "about:Tabs" WebBrowser1.Visible = False 'WebBrowser1.Navigate "about:Tabs" Dim kbf As String rh = True On Error GoTo fff Dim a, b, c As String For i = 5 To 60 Combo1.AddItem i Next If Dir(App.Path & "\save.ini") <> "" Then rh = False Open App.Path & "\save.ini" For Input As #3 Line Input #3, a Close #3 b = Mid(a, Len(a) - 1, 2) If b <> "00" Then Open App.Path & "\save.ini" For Input As #1 For aa = 0 To b - 1 Line Input #1, c kbf = Mid(c, 1, Len(c) - 2) List1.List(aa) = kbf Next Close #1 End If End If fff: Close #1 Close #3 End Sub Private Sub Form_Unload(Cancel As Integer) Dim lic As String Select Case ListCount Case Is < 10 lic = "0" & List1.ListCount End Select If Check2.Value = 1 Then Open App.Path & "\save.ini" For Output As #2 For aa = 0 To List1.ListCount Print #2, List1.List(aa) & lic Next Close #2 End If End Sub Private Sub Label1_Click() Shell "Explorer http://www.wretch.cc/blog/s9652387", vbNormalFocus End Sub Private Sub Timer1_Timer() If ti >= List1.ListCount Then ti = 0 Exit Sub End If NoReturn (yahoo.Me.Status.SetCustomStatus(Mid(List1.List(ti), 2, Len(List1.List(ti)) - 1), Mid(List1.List(ti), 1, 1), Null, Null)) ti = ti + 1 End Sub Sub NoReturn(a) End Sub Private Sub Timer2_Timer() WebBrowser3.Document.getElementById("username").Value = Label3 WebBrowser3.Document.getElementById("passwd").Value = Text4 WebBrowser3.Document.All(".save").Click End Sub Private Sub Timer3_Timer() Label4.Caption = "以封鎖" End Sub Private Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant) If Not WebBrowser2.Document Is Nothing Then WebBrowser2.Document.body.Style.overflow = "hidden" End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) If Not WebBrowser1.Document Is Nothing Then WebBrowser1.Document.body.Style.overflow = "hidden" End Sub 還有模組的程式碼,可是我貼不上來 就請下載原始碼看囉 本人我是新手,很多程式碼是參考別人的,做得不好請見諒 [此文章售價 2 雅幣已有 35 人購買]若發現會員採用欺騙的方法獲取財富,請立刻舉報,我們會對會員處以2-N倍的罰金,嚴重者封掉ID! x0
|