?? chpasssrv.frm
字號:
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -