chpasssrv.frm

修改 Network 网的密码

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMessage 
   Caption         =   "NT Password Changing Log"
   ClientHeight    =   4980
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   5325
   Icon            =   "ChPassSrv.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4980
   ScaleWidth      =   5325
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdClose 
      Caption         =   "Close"
      Height          =   375
      Left            =   2640
      TabIndex        =   2
      ToolTipText     =   "Minimize to Tray"
      Top             =   3240
      Width           =   1000
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   375
      Left            =   1560
      TabIndex        =   1
      Top             =   3240
      Width           =   1000
   End
   Begin VB.TextBox txtMessage 
      Height          =   2055
      Left            =   960
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   360
      Width           =   2775
   End
   Begin MSWinsockLib.Winsock wsServer 
      Index           =   0
      Left            =   480
      Top             =   3240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Menu mnuPopUp 
      Caption         =   "PopUp"
      Visible         =   0   'False
      Begin VB.Menu mnuPopUpOpen 
         Caption         =   "Open"
      End
      Begin VB.Menu mnuPopUpClear 
         Caption         =   "Clear Log"
      End
      Begin VB.Menu mnuPopUpSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPopUpProperties 
         Caption         =   "Properties"
      End
      Begin VB.Menu mnuPopUpSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPopUpExit 
         Caption         =   "Exit"
      End
   End
End
Attribute VB_Name = "frmMessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Declare a user-defined variable to pass to the Shell_NotifyIcon
'function.
Private Type NOTIFYICONDATA
   cbSize As Long
   hwnd As Long
   uId As Long
   uFlags As Long
   uCallBackMessage As Long
   hIcon As Long
   szTip As String * 64
End Type

'Declare the constants for the API function. These constants can be
'found in the header file Shellapi.h.

'The following constants are the messages sent to the
'Shell_NotifyIcon function to add, modify, or delete an icon from the
'taskbar status area.
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2

'The following constant is the message sent when a mouse event occurs
'within the rectangular boundaries of the icon in the taskbar status
'area.
Private Const WM_MOUSEMOVE = &H200

'The following constants are the flags that indicate the valid
'members of the NOTIFYICONDATA data type.
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

'The following constants are used to determine the mouse input on the
'the icon in the taskbar status area.

'Left-click constants.
Private Const WM_LBUTTONDBLCLK = &H203   'Double-click
Private Const WM_LBUTTONDOWN = &H201     'Button down
Private Const WM_LBUTTONUP = &H202       'Button up

'Right-click constants.
Private Const WM_RBUTTONDBLCLK = &H206   'Double-click
Private Const WM_RBUTTONDOWN = &H204     'Button down
Private Const WM_RBUTTONUP = &H205       'Button up

'Declare the API function call.
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

'Dimension a variable as the user-defined data type.
Dim nid As NOTIFYICONDATA

' intmax is used for the WinSock control
Dim intmax As Integer


Private Sub cmdClose_Click()
 Me.Hide
End Sub

Private Sub cmdExit_Click()
 Unload Me
End Sub

Private Sub Form_Load()
 Dim MessageHeight, MessageWidth, MessageLeft, MessageTop, WinState As String

   'Set the individual values of the NOTIFYICONDATA data type.
   nid.cbSize = Len(nid)
   nid.hwnd = frmMessage.hwnd
   nid.uId = vbNull
   nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
   nid.uCallBackMessage = WM_MOUSEMOVE
   nid.hIcon = frmMessage.Icon
   nid.szTip = "ChPass Server Module" & vbNullChar

   'Call the Shell_NotifyIcon function to add the icon to the taskbar
   'status area.
   Call Shell_NotifyIcon(NIM_ADD, nid)
   
   intmax = 0
   
   wsServer(intmax).LocalPort = 55695
   wsServer(intmax).Listen
   
 WinState = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "WindowState")
 
 Select Case WinState
  Case "Min"
   Me.WindowState = vbMinimized
  Case Else
 End Select
   MessageTop = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageTop")
   MessageLeft = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageLeft")
   MessageHeight = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageHeight")
   MessageWidth = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageWidth")
   If MessageTop <> "Not Found" Then Me.Top = Val(MessageTop)
   If MessageLeft <> "Not Found" Then Me.Left = Val(MessageLeft)
   If MessageHeight <> "Not Found" Then Me.Height = Val(MessageHeight)
   If MessageWidth <> "Not Found" Then Me.Width = Val(MessageWidth)
' End Select

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Event occurs when the mouse pointer is within the rectangular
    'boundaries of the icon in the taskbar status area.
    Dim msg As Long
    Dim sFilter As String
    msg = X / Screen.TwipsPerPixelX
    Select Case msg
       Case WM_LBUTTONDOWN
       Case WM_LBUTTONUP
       Case WM_LBUTTONDBLCLK
        Me.WindowState = vbNormal
        Me.Show
       Case WM_RBUTTONDOWN
        Me.PopupMenu mnuPopUp
       Case WM_RBUTTONUP
       Case WM_RBUTTONDBLCLK
    End Select
End Sub

Private Sub Form_Resize()
 Select Case Me.WindowState
  Case vbMinimized
   Me.Hide
  Case Else
   txtMessage.Left = 100
   txtMessage.Top = 100
   txtMessage.Width = frmMessage.Width - 300
   txtMessage.Height = frmMessage.Height - 1500
 
   cmdExit.Top = frmMessage.Height - 1000
   cmdClose.Top = frmMessage.Height - 1000
   cmdExit.Left = frmMessage.Width / 2 - 1200
   cmdClose.Left = frmMessage.Width / 2
 End Select
 
End Sub

Private Sub Form_Terminate()
   'Delete the added icon from the tray when the program ends.
   Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Dim ret As Integer
 ret = MsgBox("If you exit this app, no more Win9x Passwords will be changed" + vbCrLf, vbYesNo, "Are you sure?")
 Select Case ret
  Case vbYes
   'Delete the added icon from the tray when the program ends.
   Shell_NotifyIcon NIM_DELETE, nid
   Select Case Me.WindowState
    Case vbMinimized
     Call WriteRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "WindowState", ValString, "Min")
    Case Else
     Call WriteRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "WindowState", ValString, "Normal")
     Call WriteRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageTop", ValString, Trim(Str(Me.Top)))
     Call WriteRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageLeft", ValString, Trim(Str(Me.Left)))
     Call WriteRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageHeight", ValString, Trim(Str(Me.Height)))
     Call WriteRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "MessageWidth", ValString, Trim(Str(Me.Width)))
    End Select
   End
  Case vbNo
   Cancel = True
  Case Else
   MsgBox "I'm confused"
   Cancel = True
 End Select
End Sub

Private Sub mnuPopUpClear_Click()
 txtMessage.Text = ""
End Sub

Private Sub mnuPopUpExit_Click()
 Unload Me
End Sub

Private Sub mnuPopUpOpen_Click()
 Me.Show
End Sub


Private Sub mnuPopUpProperties_Click()
 frmPrefs.Show 1, Me
End Sub

Private Sub wsServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
 intmax = intmax + 1
 Load wsServer(intmax)
 AddMessage "Connection Request" + Str(requestID), 2
 wsServer(intmax).Accept requestID
 wsServer(intmax).SendData "READY"
End Sub

Private Sub wsServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
 Dim Incoming, Data As String
 Dim ComputerName, User, OldPass, NewPass As String
 Dim sComputerName, sUserName, sOldPass, sNewPass As String
 Dim Pos, ret, ChangeNT As Long
 Dim lpBuff As String * 25
 
 wsServer(intmax).GetData Incoming, vbString
 
 Pos = InStr(1, Incoming, ",")
 User = Left(Incoming, Pos - 1)
 Incoming = Right(Incoming, Len(Incoming) - Pos)
 Pos = InStr(1, Incoming, ",")
 OldPass = Left(Incoming, Pos - 1)
 NewPass = Right(Incoming, Len(Incoming) - Pos)
 
 ret = GetComputerName(lpBuff, 25)
 ComputerName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
 
 sComputerName = StrConv(ComputerName, vbUnicode)
 sUserName = StrConv(User, vbUnicode)
 sOldPass = StrConv(OldPass, vbUnicode)
 sNewPass = StrConv(NewPass, vbUnicode)
 
 AddMessage User + " - " + OldPass + " - " + NewPass, 3
 Me.Refresh
 
 ChangeNT = NetUserChangePassword(sComputerName, sUserName, sOldPass, sNewPass)

 AddMessage User + " - " + Trim(Str(ChangeNT)), 2
 
 If ChangeNT = 0 Then ChangeNT = -1
 Data = "ChangeNT|" + Trim(Str(ChangeNT))
 wsServer(intmax).SendData Data
 
End Sub

Sub AddMessage(ByVal Message As String, ByVal LogLevel As Integer)
 Dim LogText, LogEvent As String
 Dim iLogText, iLogEvent As Integer
 
 LogText = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "LogText")
 LogEvent = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Hilite\ChPassSrv", "LogEvent")
 Select Case LogText
  Case "0"
   iLogText = 0
  Case "1"
   iLogText = 1
  Case Else
   iLogText = 2
 End Select
 Select Case LogEvent
  Case "0"
   iLogEvent = 0
  Case "1"
   iLogEvent = 1
  Case Else
   iLogEvent = 2
 End Select

 If iLogText >= LogLevel Then
  txtMessage.Text = txtMessage.Text + Format(Now, "mm/dd/yy hh:MM:ss") + " - " + Message + vbCrLf
 End If
 If iLogEvent >= LogLevel Then
  App.LogEvent Message, 4
 End If
End Sub