• Home
 · 
• Internet/HTML
 · 
• Change Yahoo password programmatically

Change Yahoo password programmatically

Change Yahoo password programmatically

Rate Change Yahoo password programmatically

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

' Author : Dr Morphin
' Complete Exe Project
' Easy way for Change Yah! PW changing
'======================================
'Email : [email protected]
'======================================
Option Explicit

Private Sub Command1_Click()
Dim strData As String

If LenB(Trim$(txtUser)) > 0 _
And LenB(Trim$(txtCurPass)) > 0 _
And LenB(Trim$(txtNewPass)) > 0 _
And Inet1.StillExecuting = False Then

lblStatus.Caption = " Status - Preparing to change password..." 'Status
Inet1.OpenURL "https://login.yahoo.com/config/login?logout", icString 'Logout
                                                        
lblStatus.Caption = " Status - Logging in..."

strData = Inet1.OpenURL("https://login.yahoo.com/config/login?login=" & txtUser & "&passwd=" & txtCurPass & "&.done=http://edit.yahoo.com/config/change_pw", icString)
'^Log In, Redirect

If InStr(strData, "Sign In") Then ' Login Failed
    lblStatus.Caption = " Status - Invalid ID or Password" 'Status
ElseIf InStr(strData, "999") Then '999 Usually = (IP) Banned " Temporarily "
    lblStatus.Caption = " Status - Banned, Cannot Login.." 'Status
Else
    lblStatus.Caption = " Status - Changing Password..." 'Status
    
    strData = Inet1.OpenURL("https://edit.yahoo.com/config/change_pw?.opw=" & txtCurPass & "&.pw1=" & txtNewPass & "&.pw2=" & txtNewPass & "&.commit=Save")
    '^ Change Password
    
    If InStr(strData, "Changed") Then 'If found then password is changed
        lblStatus.Caption = " Status - Password Changed!!!" 'Status
        List1.AddItem "ID: " & txtUser
        List1.AddItem "PW: " & txtNewPass
        List1.AddItem "---------------------------"
    Else
        lblStatus.Caption = " Status - Unsuccessful" 'Status
    End If
End If

End If
End Sub

Private Sub Command2_Click()
    If LenB(Trim$(txtUser)) > 0 Then txtUser = vbNullString
    If LenB(Trim$(txtCurPass)) > 0 Then txtCurPass = vbNullString
    If LenB(Trim$(txtNewPass)) > 0 Then txtNewPass = vbNullString
End Sub

Private Sub Command3_Click()
Dim x As Integer
On Error GoTo Error

With CommonDialog1
    .DialogTitle = "Save As"
    .FileName = vbNullString
    .Filter = "Text Document (*.txt)|*.txt"
    .ShowSave
    
    Open .FileName For Output As #1
      For x = 0 To List1.ListCount - 1
        Print #1, List1.List(x)
      Next x
    Close #1
End With

Error: Exit Sub
End Sub

Private Sub Command4_Click()
    If List1.ListCount > 0 Then List1.Clear ' List will be Clear
End Sub



Private Sub txtUser_KeyPress(KeyAscii As Integer) 'When Person Presses Enter on Last TxtBox
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        Call Command1_Click
    End If
End Sub
Private Sub txtCurpass_KeyPress(KeyAscii As Integer) 'When Person Presses Enter on Last TxtBox
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        Call Command1_Click
    End If
End Sub
Private Sub txtNewPass_KeyPress(KeyAscii As Integer) 'When Person Presses Enter on Last TxtBox
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        Call Command1_Click
    End If
End Sub