changepass.frm

修改 Network 网的密码

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmChangePass 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Change Network Password"
   ClientHeight    =   2280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   Icon            =   "ChangePass.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2280
   ScaleWidth      =   4680
   StartUpPosition =   1  'CenterOwner
   Begin MSWinsockLib.Winsock wsSendPass 
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.CommandButton cmdHelp 
      Caption         =   "?"
      Height          =   375
      Left            =   4200
      TabIndex        =   12
      Top             =   1800
      Width           =   375
   End
   Begin VB.TextBox txtUser 
      Height          =   285
      Left            =   2160
      TabIndex        =   0
      Top             =   240
      Width           =   2175
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2160
      TabIndex        =   5
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   840
      TabIndex        =   4
      Top             =   1800
      Width           =   1215
   End
   Begin VB.Frame fraPassword 
      BorderStyle     =   0  'None
      Height          =   1095
      Left            =   120
      TabIndex        =   10
      Top             =   600
      Width           =   4455
      Begin VB.TextBox txtConfirm 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Left            =   2040
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   720
         Width           =   2175
      End
      Begin VB.TextBox txtNewPass 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Left            =   2040
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   360
         Width           =   2175
      End
      Begin VB.TextBox txtOldPass 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Left            =   2040
         PasswordChar    =   "*"
         TabIndex        =   1
         Top             =   0
         Width           =   2175
      End
      Begin VB.Label lblConfirm 
         Alignment       =   1  'Right Justify
         Caption         =   "Confirm New Password"
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   720
         Width           =   1695
      End
      Begin VB.Label lblNewPass 
         Alignment       =   1  'Right Justify
         Caption         =   "New Password"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   360
         Width           =   1695
      End
      Begin VB.Label lblOldPass 
         Alignment       =   1  'Right Justify
         Caption         =   "Old Password"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   0
         Width           =   1695
      End
   End
   Begin VB.Label lblPassExp 
      Alignment       =   2  'Center
      Caption         =   "N/A"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   120
      TabIndex        =   13
      ToolTipText     =   "Days until Password Expires"
      Top             =   1800
      Visible         =   0   'False
      Width           =   495
   End
   Begin VB.Label lblMessage 
      Alignment       =   2  'Center
      Caption         =   "Messages go Here"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   735
      Left            =   240
      TabIndex        =   11
      Top             =   840
      Visible         =   0   'False
      Width           =   4095
   End
   Begin VB.Label lblUser 
      Alignment       =   1  'Right Justify
      Caption         =   "User ID"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   240
      Width           =   1935
   End
End
Attribute VB_Name = "frmChangePass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Connection As Boolean
Dim ChangeNT As Long
'ComputerName should be a DC where ChPassSrv is running
Const ComputerName = "EXCHANGE3"

Private Sub cmdCancel_Click()
 End
End Sub

Private Sub cmdHelp_Click()
 ' This will launch a web page to act as a help file.
 ShellExecute hwnd, "open", "http://www.vbcode.com", vbNullString, vbNullString, conSwNormal
End Sub

Private Sub cmdOK_Click()
 Dim ChangeNovell, cx As Long
 Dim Recipient, Message, Priority As String
 Dim Data, NEWLINE As String
 Dim SentMailErr, SMTPErr As Long
 Dim StartTime As Single
 
 NEWLINE = Chr(10) + Chr(13)
 
 If txtNewPass.Text <> txtConfirm.Text Then
  MsgBox "Passwords do not Match, Please try again", , "Error"
  txtNewPass.SetFocus
  Exit Sub
 End If
 
 If txtNewPass.Text = "" Then
  MsgBox "Password can not be blank, Please try again", , "Error"
  txtNewPass.SetFocus
  Exit Sub
 End If
 
 fraPassword.Visible = False
 lblMessage.Caption = "Changing Windows NT Domain Password"
 lblMessage.Visible = True
 cmdOK.Enabled = False
 cmdCancel.Enabled = False
 Me.Refresh
 
 Me.Refresh

 If Connection Then
  Data = UCase(txtUser.Text) + "," + LCase(txtOldPass.Text) + "," + LCase(txtNewPass.Text)
  wsSendPass.SendData Data
  StartTime = Timer
  Do
   DoEvents
   If StartTime + 45 < Timer Then ChangeNT = -3
  Loop Until ChangeNT
 Else
  MsgBox "No Connection"
  ChangeNT = -2
 End If
 If ChangeNT = -1 Then ChangeNT = 0
 
 Select Case ChangeNT
  Case 0
   lblMessage.Caption = "Password Change Successfully Completed"
  Case -2
   lblMessage.Caption = "No Connection to Server"
  Case -3
   lblMessage.Caption = "TimeOut waiting for Responce"
  Case Else
   lblMessage.Caption = "Untrapped Error"
 End Select
 
 cmdOK.Visible = False
 cmdCancel.Caption = "Exit"
 cmdCancel.Enabled = True
 
End Sub

Private Sub Form_Load()
 Dim PassExp As Integer
 
 If Environ("USER") <> "" Then
  txtUser.Text = Environ("USER")
  frmChangePass.Show
  txtOldPass.SetFocus
 End If
 
 wsSendPass.RemotePort = 55695
 wsSendPass.RemoteHost = ComputerName
 wsSendPass.Connect

End Sub

Private Sub txtConfirm_GotFocus()
 txtConfirm.SelStart = 0
 txtConfirm.SelLength = Len(txtConfirm.Text)
End Sub

Private Sub txtNewPass_GotFocus()
 txtNewPass.SelStart = 0
 txtNewPass.SelLength = Len(txtNewPass.Text)
End Sub

Private Sub txtOldPass_GotFocus()
 txtOldPass.SelStart = 0
 txtOldPass.SelLength = Len(txtOldPass.Text)
End Sub

Private Sub txtUser_GotFocus()
 txtUser.SelStart = 0
 txtUser.SelLength = Len(txtUser.Text)
End Sub

Private Sub wsSendPass_DataArrival(ByVal bytesTotal As Long)
 Dim Incoming As String
 
 wsSendPass.GetData Incoming
 If Incoming = "READY" Then Connection = True
 If InStr(1, Incoming, "ChangeNT|") Then
  ChangeNT = Val(Right(Incoming, Len(Incoming) - 9))
 End If
End Sub