frmdomainlogin.frm
--------------------------------------
VERSION 5.00
Begin VB.Form frmdomainlogin
BorderStyle = 0 'None
ClientHeight = 4665
ClientLeft = 0
ClientTop = 0
ClientWidth = 4425
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4665
ScaleWidth = 4425
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Caption = "Tip:"
Height = 1935
Left = 120
TabIndex = 11
Top = 2640
Width = 3135
Begin VB.Label Label2
Alignment = 2 'Center
Caption = $"frmdomainlogin.frx":0000
Height = 1575
Left = 120
TabIndex = 12
Top = 240
Width = 2895
End
End
Begin VB.OptionButton Option2
Caption = "Computer"
Height = 255
Left = 120
TabIndex = 9
Top = 480
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "Domain"
Height = 255
Left = 120
TabIndex = 8
Top = 120
Value = -1 'True
Width = 1215
End
Begin VB.Frame Frame2
Caption = "Administrator Credentials "
Height = 1455
Left = 120
TabIndex = 2
Top = 960
Width = 4215
Begin VB.CheckBox Check1
Caption = "Use Current Credentials"
Height = 255
Left = 240
TabIndex = 5
Top = 1080
Width = 2895
End
Begin VB.TextBox Text2
Height = 285
IMEMode = 3 'DISABLE
Left = 1560
PasswordChar = "*"
TabIndex = 4
Top = 720
Width = 2415
End
Begin VB.TextBox Text1
Height = 285
Left = 1560
TabIndex = 3
Text = "Administrator"
Top = 360
Width = 2415
End
Begin VB.Label lblAdminPassword
Caption = "Pass&word:"
Height = 255
Left = 240
TabIndex = 7
Top = 720
Width = 855
End
Begin VB.Label lblAdminName
Caption = "Use&r Name:"
Height = 255
Left = 225
TabIndex = 6
Top = 360
Width = 975
End
End
Begin VB.CommandButton Command1
Caption = "OK"
Height = 285
Left = 3360
TabIndex = 1
Top = 4320
Width = 975
End
Begin VB.ComboBox Combo1
Height = 315
Left = 1560
TabIndex = 0
Top = 480
Width = 2295
End
Begin VB.Label Label1
Caption = "Domain/Computer Name:"
Height = 255
Left = 1560
TabIndex = 10
Top = 240
Width = 2295
End
End
Attribute VB_Name = "frmdomainlogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Check1_Click()
If (Check1.Value = 1) Then
bCheck = False
Else
bCheck = True
End If
'Now set the controls based on the credential mode
Text1.Enabled = bCheck
lblAdminName.Enabled = bCheck
Text2.Enabled = bCheck
lblAdminPassword.Enabled = bCheck
End SubPrivate Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command1_Click
DoEvents
End If
End SubPrivate Sub Command1_Click()
frmdomainlogin.Hide
DoEvents
frmadmin.Show
frmadmin.Timer2.Enabled = True
End SubPrivate Sub Form_Load()
Check1.Value = 1
Check1_Click
frmdomainlogin.Combo1.AddItem MDIFrmmain.Winsock1.LocalHostName
Dim namespace As IADsContainer
Dim domain As IADs
'Loads Combo box1 with all the current domains
Set namespace = GetObject("WinNT:")For Each domain In namespace
frmdomainlogin.Combo1.AddItem domain.Name
Next
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command1_Click
DoEvents
End If
End SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command1_Click
DoEvents
End If
End Sub
--------------------------------------
VERSION 5.00
Begin VB.Form frmdomainlogin
BorderStyle = 0 'None
ClientHeight = 4665
ClientLeft = 0
ClientTop = 0
ClientWidth = 4425
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4665
ScaleWidth = 4425
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Caption = "Tip:"
Height = 1935
Left = 120
TabIndex = 11
Top = 2640
Width = 3135
Begin VB.Label Label2
Alignment = 2 'Center
Caption = $"frmdomainlogin.frx":0000
Height = 1575
Left = 120
TabIndex = 12
Top = 240
Width = 2895
End
End
Begin VB.OptionButton Option2
Caption = "Computer"
Height = 255
Left = 120
TabIndex = 9
Top = 480
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "Domain"
Height = 255
Left = 120
TabIndex = 8
Top = 120
Value = -1 'True
Width = 1215
End
Begin VB.Frame Frame2
Caption = "Administrator Credentials "
Height = 1455
Left = 120
TabIndex = 2
Top = 960
Width = 4215
Begin VB.CheckBox Check1
Caption = "Use Current Credentials"
Height = 255
Left = 240
TabIndex = 5
Top = 1080
Width = 2895
End
Begin VB.TextBox Text2
Height = 285
IMEMode = 3 'DISABLE
Left = 1560
PasswordChar = "*"
TabIndex = 4
Top = 720
Width = 2415
End
Begin VB.TextBox Text1
Height = 285
Left = 1560
TabIndex = 3
Text = "Administrator"
Top = 360
Width = 2415
End
Begin VB.Label lblAdminPassword
Caption = "Pass&word:"
Height = 255
Left = 240
TabIndex = 7
Top = 720
Width = 855
End
Begin VB.Label lblAdminName
Caption = "Use&r Name:"
Height = 255
Left = 225
TabIndex = 6
Top = 360
Width = 975
End
End
Begin VB.CommandButton Command1
Caption = "OK"
Height = 285
Left = 3360
TabIndex = 1
Top = 4320
Width = 975
End
Begin VB.ComboBox Combo1
Height = 315
Left = 1560
TabIndex = 0
Top = 480
Width = 2295
End
Begin VB.Label Label1
Caption = "Domain/Computer Name:"
Height = 255
Left = 1560
TabIndex = 10
Top = 240
Width = 2295
End
End
Attribute VB_Name = "frmdomainlogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Check1_Click()
If (Check1.Value = 1) Then
bCheck = False
Else
bCheck = True
End If
'Now set the controls based on the credential mode
Text1.Enabled = bCheck
lblAdminName.Enabled = bCheck
Text2.Enabled = bCheck
lblAdminPassword.Enabled = bCheck
End SubPrivate Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command1_Click
DoEvents
End If
End SubPrivate Sub Command1_Click()
frmdomainlogin.Hide
DoEvents
frmadmin.Show
frmadmin.Timer2.Enabled = True
End SubPrivate Sub Form_Load()
Check1.Value = 1
Check1_Click
frmdomainlogin.Combo1.AddItem MDIFrmmain.Winsock1.LocalHostName
Dim namespace As IADsContainer
Dim domain As IADs
'Loads Combo box1 with all the current domains
Set namespace = GetObject("WinNT:")For Each domain In namespace
frmdomainlogin.Combo1.AddItem domain.Name
Next
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command1_Click
DoEvents
End If
End SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command1_Click
DoEvents
End If
End Sub
---------------------------------
VERSION 5.00
Begin VB.Form frmgroupdesc
BorderStyle = 1 'Fixed Single
Caption = "Group Description"
ClientHeight = 1560
ClientLeft = 45
ClientTop = 330
ClientWidth = 5280
Icon = "frmgroupdesc.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 1560
ScaleWidth = 5280
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 500
Left = 4800
Top = 0
End
Begin VB.CheckBox Check1
Caption = "Check1"
Height = 255
Left = 3960
TabIndex = 4
Top = 600
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox Text1
Height = 1125
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 360
Width = 3735
End
Begin VB.CommandButton Command1
Caption = "Close"
Height = 375
Left = 3960
TabIndex = 2
Top = 1080
Width = 1215
End
Begin VB.Label Label2
Height = 255
Left = 1320
TabIndex = 1
Top = 120
Width = 3735
End
Begin VB.Label Label1
Caption = "Description for"
Height = 255
Left = 120
TabIndex = 0
Top = 120
Width = 1095
End
End
Attribute VB_Name = "frmgroupdesc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
MousePointer = vbHourglassDim dso As IADsOpenDSObject
username = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
groupname = Label2.Caption
groupdomain = frmdomainlogin.Combo1.TextIf Check1.Value = 0 Then
Else
If frmdomainlogin.Check1.Value = 1 Then
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")
Else
Set dso = GetObject("WinNT:")
Set group = dso.OpenDSObject("WinNT://" & groupdomain & "/" & groupname & ",group", username, password, 1)
End If
group.Description = Text1.Text
group.SetInfo
End If
MousePointer = 0
Err = 0
Unload Me
End SubPrivate Sub Timer1_Timer()
On Error Resume Next
MousePointer = vbHourglass
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim dso As IADsOpenDSObject
username = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
groupname = Label2.Caption
groupdomain = frmdomainlogin.Combo1.TextIf Check1.Value = 0 Then
If frmdomainlogin.Check1.Value = 1 Then
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")
Else
Set dso = GetObject("WinNT:")
Set group = dso.OpenDSObject("WinNT://" & groupdomain & "/" & groupname & ",group", username, password, 1)
End IfDim retval As String
retval = group.Description
Text1.Text = retval
Else
Command1.Caption = "Save && Close"
End If
MousePointer = 0
Err = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timer1.Enabled = False
End Sub
------------------------------------------
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frminternetdomain
BorderStyle = 1 'Fixed Single
Caption = "Internet Domain Name Lookup"
ClientHeight = 5250
ClientLeft = 45
ClientTop = 330
ClientWidth = 6180
Icon = "frminternetdomain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5250
ScaleWidth = 6180
Begin VB.TextBox txtResponse
BackColor = &H00000000&
ForeColor = &H00FFFFFF&
Height = 4815
Left = 23
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 2
Top = 360
Width = 6135
End
Begin VB.TextBox txtSearch
BackColor = &H80000014&
Height = 270
Left = 600
TabIndex = 1
Top = 0
Width = 4455
End
Begin VB.CommandButton Command4
Caption = "lookup"
Height = 285
Left = 5160
TabIndex = 0
Top = 0
Width = 975
End
Begin MSWinsockLib.Winsock Winsock1
Left = 5400
Top = 1800
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H80000013&
Caption = "www."
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 3
Top = 0
Width = 450
End
End
Attribute VB_Name = "frminternetdomain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()
txtSearch = ""
txtResponse = ""
End SubPrivate Sub Command4_Click()
MousePointer = vbHourglass
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
txtResponse = ""
Winsock1.Close
Winsock1.LocalPort = 0
If Right(txtSearch, 3) = ".tr" Then
Winsock1.Connect "whois.metu.edu.tr", 43
Else
Winsock1.Connect "rs.internic.net", 43
End If
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command4_Click
DoEvents
End If
End SubPrivate Sub Winsock1_Connect()
Winsock1.SendData txtSearch & vbCrLf
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String On Error Resume Next Winsock1.GetData strData
strData = Replace(strData, Chr$(10), vbCrLf)
txtResponse = txtResponse & strData
MousePointer = vbDefault
End SubPrivate Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
-----------------------------
VERSION 5.00
Begin VB.Form frmresolve
BorderStyle = 1 'Fixed Single
Caption = "Resolve a Host to a IP"
ClientHeight = 720
ClientLeft = 45
ClientTop = 330
ClientWidth = 6180
Icon = "frmresolve.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 720
ScaleWidth = 6180
Begin VB.TextBox Text1
Height = 285
Left = 863
TabIndex = 3
Top = 360
Width = 2655
End
Begin VB.TextBox Text11
Height = 285
Left = 3863
TabIndex = 2
Top = 360
Width = 495
End
Begin VB.TextBox Text21
Height = 285
Left = 4703
TabIndex = 1
Top = 360
Width = 1335
End
Begin VB.CommandButton Command4
Caption = "Do it"
Height = 255
Left = 143
TabIndex = 0
Top = 360
Width = 615
End
Begin VB.Label Label1
Caption = "Host Name/Computer Name"
Height = 255
Left = 1103
TabIndex = 6
Top = 0
Width = 2175
End
Begin VB.Label Label2
Caption = "Successful?"
Height = 255
Left = 3623
TabIndex = 5
Top = 0
Width = 975
End
Begin VB.Label Label3
Caption = "IP Address"
Height = 255
Left = 4943
TabIndex = 4
Top = 0
Width = 855
End
End
Attribute VB_Name = "frmresolve"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End TypePrivate Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End TypePrivate Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
Function HiByte(ByVal wParam As Integer)
HiByte = wParam \ &H100 And &HFF&
End FunctionFunction LoByte(ByVal wParam As Integer)
LoByte = wParam And &HFF&
End FunctionSub SocketsInitialize()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String
iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
If iReturn <> 0 Then
MsgBox "Winsock.dll is not responding."
End
End If
If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
sHighByte = Trim$(Str$(HiByte(WSAD.wVersion)))
sLowByte = Trim$(Str$(LoByte(WSAD.wVersion)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
sMsg = sMsg & " is not supported by winsock.dll "
MsgBox sMsg
End
End If
If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
sMsg = "This application requires a minimum of "
sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox sMsg
End
End If
End SubSub SocketsCleanup()
Dim lReturn As Long
lReturn = WSACleanup()
If lReturn <> 0 Then
MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If
End SubPrivate Sub Command4_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
If Text1.Text = "" Then
Else
hostent_addr = gethostbyname(Text1)If hostent_addr = 0 Then
Text11.Text = "NO"
Text21.Text = "0"
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Exit Sub
Else
End If
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
Text21.Text = ip_address
Text11.Text = "YES"
End If
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call Command4_Click
DoEvents
End IfEnd Sub
---------------------------
VERSION 5.00
Begin VB.Form frmuser
BorderStyle = 1 'Fixed Single
Caption = "Administer User"
ClientHeight = 5010
ClientLeft = 45
ClientTop = 330
ClientWidth = 7185
Icon = "frmuser.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5010
ScaleWidth = 7185
Begin VB.CommandButton Command10
Caption = "Add User"
Height = 255
Left = 3600
TabIndex = 26
Top = 4320
Width = 1695
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 6720
Top = 0
End
Begin VB.CommandButton Command9
Caption = "Delete User"
Height = 255
Left = 3600
TabIndex = 25
Top = 3960
Width = 1695
End
Begin VB.TextBox Text7
Alignment = 2 'Center
BackColor = &H8000000B&
Enabled = 0 'False
Height = 285
Left = 1560
TabIndex = 24
Top = 4080
Width = 1215
End
Begin VB.TextBox Text5
Alignment = 2 'Center
BackColor = &H8000000B&
Enabled = 0 'False
Height = 285
Left = 120
TabIndex = 23
Top = 4680
Width = 2655
End
Begin VB.TextBox Text4
Alignment = 2 'Center
BackColor = &H8000000B&
Enabled = 0 'False
Height = 285
Left = 120
TabIndex = 22
Top = 4080
Width = 1215
End
Begin VB.CommandButton Command8
Caption = "Close"
Height = 255
Left = 5400
TabIndex = 18
Top = 4680
Width = 1695
End
Begin VB.CommandButton Command7
Caption = "Save && Close"
Height = 255
Left = 5400
TabIndex = 17
Top = 4320
Width = 1695
End
Begin VB.CommandButton Command1
Caption = "Groups"
Height = 495
Left = 120
TabIndex = 16
Top = 3240
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "Profile"
Height = 495
Left = 1560
TabIndex = 15
Top = 3240
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "Account"
Height = 495
Left = 3000
TabIndex = 14
Top = 3240
Width = 1215
End
Begin VB.CommandButton Command6
Caption = "Rename Username"
Height = 255
Left = 5400
TabIndex = 13
Top = 3960
Width = 1695
End
Begin VB.CheckBox Check1
Caption = "User Must Change Password at Next Logon"
Height = 255
Left = 120
TabIndex = 7
Top = 2040
Width = 3615
End
Begin VB.CheckBox Check2
Caption = "User Cannot Change Password"
Enabled = 0 'False
Height = 255
Left = 3720
TabIndex = 6
Top = 2040
Width = 2655
End
Begin VB.CheckBox Check3
Caption = "Password Nevers Expires"
Height = 255
Left = 120
TabIndex = 5
Top = 2400
Width = 3615
End
Begin VB.CheckBox Check4
Caption = "Account Disabled"
Height = 255
Left = 3720
TabIndex = 4
Top = 2400
Width = 2655
End
Begin VB.CheckBox Check5
Caption = "Account Locked Out"
Enabled = 0 'False
Height = 255
Left = 120
TabIndex = 3
Top = 2760
Width = 3615
End
Begin VB.TextBox Text1
Height = 285
IMEMode = 3 'DISABLE
Left = 1440
TabIndex = 2
Top = 600
Width = 4935
End
Begin VB.TextBox Text2
Height = 285
Left = 1440
TabIndex = 1
Top = 1080
Width = 4935
End
Begin VB.TextBox Text3
Height = 285
Left = 1440
TabIndex = 0
Top = 1560
Width = 4935
End
Begin VB.Image Image1
Height = 480
Left = 6120
Picture = "frmuser.frx":0BC2
Top = 3240
Width = 480
End
Begin VB.Label Label8
Caption = "Last Logoff"
Height = 255
Left = 1560
TabIndex = 21
Top = 3840
Width = 1215
End
Begin VB.Label Label5
Caption = "Last Login"
Height = 255
Left = 120
TabIndex = 20
Top = 4440
Width = 1215
End
Begin VB.Label Label1
Caption = "Bad Login Count"
Height = 255
Left = 120
TabIndex = 19
Top = 3840
Width = 1215
End
Begin VB.Label Label2
Caption = "Full Name:"
Height = 255
Left = 120
TabIndex = 12
Top = 600
Width = 1215
End
Begin VB.Label Label3
Caption = "Description:"
Height = 255
Left = 120
TabIndex = 11
Top = 1080
Width = 1215
End
Begin VB.Label Label4
Caption = "Password:"
Height = 255
Left = 120
TabIndex = 10
Top = 1560
Width = 1215
End
Begin VB.Label Label6
Caption = "UserName:"
Height = 255
Left = 120
TabIndex = 9
Top = 0
Width = 1215
End
Begin VB.Label Label7
Height = 255
Left = 1560
TabIndex = 8
Top = 0
Width = 4815
End
End
Attribute VB_Name = "frmuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
frmusergroup.Show
frmusergroup.Label2.Caption = Label7.Caption
frmusergroup.Timer1.Enabled = True
End Sub
-----------------------------Private Sub Command10_Click()
frmadduser.Show
Unload Me
End SubPrivate Sub Command2_Click()
frmuserprofile.Show
frmuserprofile.Label2.Caption = Label7.Caption
frmuserprofile.Timer2.Enabled = True
End Sub
Private Sub Command5_Click()
frmuseraccount.Show
frmuseraccount.Label2.Caption = Label7.Caption
frmuseraccount.Timer1.Enabled = True
End SubPrivate Sub Command6_Click()
frmrenameuser.Show
frmrenameuser.Text1.Text = frmuser.Label7.Caption
frmrenameuser.Label3.Caption = frmdomainlogin.Combo1.Text
DoEvents
End SubPrivate Sub Command7_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim user As IADsUser
Dim username As String
Dim userdomian As Stringuserdomain = frmdomainlogin.Combo1.Text
username = Label7.Caption
If frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & DomainName & "/" & username & ",user", username2, password, 1)
End IfDim passwordexpired As Integer
Dim Flags As Long
Dim newvalue As Boolean
Dim newfullname As String
Dim newdescription As StringIf Text1.Text = "" Then
newfullname = ""
user.FullName = newfullname
user.SetInfo
Else
newfullname = Text1.Text
user.FullName = newfullname
user.SetInfo
End IfIf Text2.Text = "" Then
newdescription = ""
user.Description = newdescription
user.SetInfo
Else
newdescription = Text2.Text
user.Description = newdescription
user.SetInfo
End IfIf Check1.Value = 1 Then
user.Put "PasswordExpired", 1
user.SetInfo
Else
user.Put "PasswordExpired", 0
user.SetInfo
End If
If Check3.Value = 1 Then
Flags = user.Get("userflags")
user.Put "userflags", Flags Or &H10000
user.SetInfo
Else
Flags = user.Get("userflags")
user.Put "userflags", Flags Xor &H10000
user.SetInfo
End IfIf Check4.Value = 1 Then
newvalue = True
user.AccountDisabled = newvalue
user.SetInfo
Else
newvalue = False
user.AccountDisabled = newvalue
user.SetInfo
End IfErr = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Unload Me
End SubPrivate Sub Command8_Click()
Unload Me
End SubPrivate Sub Command9_Click()
On Error Resume Next
mouepointer = 11Dim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim container As IADsContainer
Dim containername As String
containername = frmdomainlogin.Combo1.TextIf frmdomainlogin.Check1.Value = 1 Then
Set container = GetObject("WinNT://" & containername)
Else
Set dso = GetObject("WinNT:")
Set container = dso.OpenDSObject("WinNT://" & containername, username2, password, 1)End IfDim usertoremove As String
usertoremove = Label7.Caption
Call container.Delete("User", usertoremove)Err = 0
MousePointer = 0
frmadmin.Timer2.Enabled = True
Unload Me
End SubPrivate Sub Timer1_Timer()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
MousePointer = vbHourglass
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
Check5.Value = 0Dim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim user As IADsUser
Dim username As String
Dim userdomian As Stringuserdomain = frmdomainlogin.Combo1.Text
username = Label7.CaptionIf frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & DomainName & "/" & username & ",user", username2, password, 1)
End IfDim retval As String
retval = user.FullName
Text1.Text = retvalretval = user.Description
Text2.Text = retvalDim Flags As Long
Flags = user.Get("userflags")
If (Flags And &H10000) <> 0 Then
Check3.Value = 1
End IfIf (Flags And &H10) <> 0 Then
Check5.Value = 1
End IfIf (Flags And &H2) <> 0 Then
Check4.Value = 1
End IfIf (Flags And &H40) <> 0 Then
Check2.Value = 1
End IfDim passwordexpired As Integer
passwordexpired = user.Get("passwordexpired")
If passwordexpired = 1 Then
Check1.Value = 1
End IfDim retval2 As Integer
retval2 = user.BadLoginCount
Text4.Text = retval2Dim retval3 As Date
retval3 = user.LastLogin
Text5.Text = retval3Dim retval4 As Date
retval4 = user.LastLogoff
Text7.Text = retval4Text3.Text = "**********"
Err = 0
MousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timer1.Enabled = False
End Sub
----------------------------
VERSION 5.00
Begin VB.Form ResetPwd
BorderStyle = 1 'Fixed Single
Caption = "Reset Password"
ClientHeight = 3705
ClientLeft = 45
ClientTop = 330
ClientWidth = 4650
Icon = "ResetPwd.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3705
ScaleWidth = 4650
Begin VB.Frame Frame1
Caption = "Administrator Credentials "
Height = 1455
Left = 240
TabIndex = 15
Top = 120
Width = 4215
Begin VB.CheckBox chcCredential
Caption = "Use Current Credentials"
Height = 255
Left = 240
TabIndex = 4
Top = 1080
Width = 2895
End
Begin VB.TextBox txtAdminPassword
Height = 285
IMEMode = 3 'DISABLE
Left = 1560
PasswordChar = "*"
TabIndex = 3
Top = 720
Width = 2415
End
Begin VB.TextBox txtAdminName
Height = 285
Left = 1560
TabIndex = 1
Text = "Administrator"
Top = 360
Width = 2415
End
Begin VB.Label lblAdminPassword
Caption = "Pass&word:"
Height = 255
Left = 240
TabIndex = 2
Top = 720
Width = 855
End
Begin VB.Label lblAdminName
Caption = "Use&r Name:"
Height = 255
Left = 240
TabIndex = 0
Top = 360
Width = 975
End
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Close"
Height = 375
Left = 2280
TabIndex = 14
Top = 3240
Width = 1095
End
Begin VB.CommandButton cmdOK
Caption = "OK"
Default = -1 'True
Height = 375
Left = 960
TabIndex = 13
Top = 3240
Width = 1095
End
Begin VB.TextBox txtConfirmPassword
Height = 285
IMEMode = 3 'DISABLE
Left = 2040
PasswordChar = "*"
TabIndex = 12
Top = 2760
Width = 2415
End
Begin VB.TextBox txtNewPassword
Height = 285
IMEMode = 3 'DISABLE
Left = 2040
PasswordChar = "*"
TabIndex = 10
Top = 2400
Width = 2415
End
Begin VB.TextBox txtDomain
Height = 285
Left = 2040
TabIndex = 8
Top = 2040
Width = 2415
End
Begin VB.TextBox txtUserName
Height = 285
Left = 2040
TabIndex = 6
Top = 1680
Width = 2415
End
Begin VB.Label Label5
Caption = "&Confirm New Password:"
Height = 255
Left = 240
TabIndex = 11
Top = 2760
Width = 1815
End
Begin VB.Label Label4
Caption = "&New Password:"
Height = 255
Left = 240
TabIndex = 9
Top = 2400
Width = 1455
End
Begin VB.Label Label2
Caption = "&Domain:"
Height = 255
Left = 240
TabIndex = 7
Top = 2040
Width = 855
End
Begin VB.Label Label1
Caption = "&User Name:"
Height = 255
Left = 240
TabIndex = 5
Top = 1680
Width = 975
End
End
Attribute VB_Name = "ResetPwd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub chcCredential_Click()
If (chcCredential.Value = 1) Then
bCheck = False
Else
bCheck = True
End If
'Now set the controls based on the credential mode
txtAdminName.Enabled = bCheck
lblAdminName.Enabled = bCheck
txtAdminPassword.Enabled = bCheck
lblAdminPassword.Enabled = bCheck
End SubPrivate Sub ResetFields()
txtNewPassword = ""
txtConfirmPassword = ""
txtUserName = ""
End SubPrivate Sub cmdCancel_Click()
Unload Me
End SubPrivate Sub cmdOK_Click()Dim o As IADsOpenDSObject
Dim usr As IADsUserOn Error GoTo ErrMsgIf (txtNewPassword <> txtConfirmPassword) Then
MsgBox "New and Confirm passwords must be the same"
txtConfirmPassword.SetFocus
Exit Sub
End If
If (chcCredential.Value = 1) Then
Set usr = GetObject("WinNT://" & txtDomain & "/" & txtUserName & ",user")
Else
Set o = GetObject("WinNT:")
Set usr = o.OpenDSObject("WinNT://" & txtDomain & "/" & txtUserName & ",user", txtAdminName, txtAdminPassword, 1)
End Ifusr.SetPassword txtNewPassword
MsgBox ("Password has been reset")
ResetFields
Exit SubErrMsg:
MsgBox ("Error: " & Err.Number & " " & Err.Description)
txtUserName.SetFocusEnd Sub
--------------------
Attribute VB_Name = "Helper"
'-----------------------------------------------
'---------Public Constants----------------------
'------------------------------------------------'----- Print Status ------------------
Public Const PRINTER_STATUS_PAUSED = &H1
Public Const PRINTER_STATUS_ERROR = &H2
Public Const PRINTER_STATUS_PENDING_DELETION = &H4
Public Const PRINTER_STATUS_PAPER_JAM = &H8
Public Const PRINTER_STATUS_PAPER_OUT = &H10
Public Const PRINTER_STATUS_MANUAL_FEED = &H20
Public Const PRINTER_STATUS_PAPER_PROBLEM = &H40
Public Const PRINTER_STATUS_OFFLINE = &H80
Public Const PRINTER_STATUS_IO_ACTIVE = &H100
Public Const PRINTER_STATUS_BUSY = &H200
Public Const PRINTER_STATUS_PRINTING = &H400
Public Const PRINTER_STATUS_OUTPUT_BIN_FULL = &H800
Public Const PRINTER_STATUS_NOT_AVAILABLE = &H1000
Public Const PRINTER_STATUS_WAITING = &H2000
Public Const PRINTER_STATUS_PROCESSING = &H4000
Public Const PRINTER_STATUS_INITIALIZING = &H8000
Public Const PRINTER_STATUS_WARMING_UP = &H10000
Public Const PRINTER_STATUS_TONER_LOW = &H20000
Public Const PRINTER_STATUS_NO_TONER = &H40000
Public Const PRINTER_STATUS_PAGE_PUNT = &H80000
Public Const PRINTER_STATUS_USER_INTERVENTION = &H100000
Public Const PRINTER_STATUS_OUT_OF_MEMORY = &H200000
Public Const PRINTER_STATUS_DOOR_OPEN = &H400000
Public Const PRINTER_STATUS_SERVER_UNKNOWN = &H800000
Public Const PRINTER_STATUS_POWER_SAVE = &H1000000
Public Const JOB_STATUS_PAUSED = &H1
Public Const JOB_STATUS_ERROR = &H2
Public Const JOB_STATUS_DELETING = &H4
Public Const JOB_STATUS_SPOOLING = &H8
Public Const JOB_STATUS_PRINTING = &H10
Public Const JOB_STATUS_OFFLINE = &H20
Public Const JOB_STATUS_PAPEROUT = &H40
Public Const JOB_STATUS_PRINTED = &H80
Public Const JOB_STATUS_DELETED = &H100
Public Const JOB_STATUS_BLOCKED_DEVQ = &H200
Public Const JOB_STATUS_USER_INTERVENTION = &H400
Public Const JOB_STATUS_RESTART = &H800Public Function GetPrintStatus(status As Long) As Strings = ""If (status = 0) Then
GetPrintStatus = "OK"
Exit Function
End IfIf (status And PRINTER_STATUS_PAUSED) Then
s = s + " Pause"
End IfIf (status And PRINTER_STATUS_PAUSED) Then
s = s + " Pause"
End IfIf (status And PRINTER_STATUS_ERROR) Then
s = s + " Error"
End IfIf (status And PRINTER_STATUS_PENDING_DELETION) Then
s = s + " Pending Deletion"
End If
If (status And PRINTER_STATUS_PENDING_DELETION) Then
s = s + " Pending Deletion"
End IfIf (status And PRINTER_STATUS_PAPER_JAM) Then
s = s + " Paper Jam"
End IfIf (status And PRINTER_STATUS_PAPER_OUT) Then
s = s + " Paper Out"
End IfIf (status And PRINTER_STATUS_MANUAL_FEED) Then
s = s + " Manual Feed"
End IfIf (status And PRINTER_STATUS_PAPER_PROBLEM) Then
s = s + " Paper Problem"
End IfIf (status And PRINTER_STATUS_OFFLINE) Then
s = s + " OffLine"
End IfIf (status And PRINTER_STATUS_IO_ACTIVE) Then
s = s + " IO Active"
End IfIf (status And PRINTER_STATUS_BUSY) Then
s = s + " Busy"
End IfIf (status And PRINTER_STATUS_PRINTING) Then
s = s + " Printing"
End IfIf (status And PRINTER_STATUS_OUTPUT_BIN_FULL) Then
s = s + " Output Bin Full"
End IfIf (status And PRINTER_STATUS_NOT_AVAILABLE) Then
s = s + " Not Available"
End IfIf (status And PRINTER_STATUS_WAITING) Then
s = s + " Waiting"
End IfIf (status And PRINTER_STATUS_PROCESSING) Then
s = s + " Processing"
End IfIf (status And PRINTER_STATUS_INITIALIZING) Then
s = s + " Initializing"
End If
If (status And PRINTER_STATUS_WARMING_UP) Then
s = s + " Warming up"
End IfIf (status And PRINTER_STATUS_TONER_LOW) Then
s = s + " Toner Low"
End IfIf (status And PRINTER_STATUS_NO_TONER) Then
s = s + " No Toner"
End IfIf (status And PRINTER_STATUS_PAGE_PUNT) Then
s = s + " Can print Current Page"
End IfIf (status And PRINTER_STATUS_USER_INTERVENTION) Then
s = s + " User Intervention"
End IfIf (status And PRINTER_STATUS_OUT_OF_MEMORY) Then
s = s + " Out of Memory"
End IfIf (status And PRINTER_STATUS_DOOR_OPEN) Then
s = s + " Door Open"
End IfIf (status And PRINTER_STATUS_SERVER_UNKNOWN) Then
s = s + " Server Unknown"
End IfIf (status And PRINTER_STATUS_POWER_SAVE) Then
s = s + " Power Save"
End IfGetPrintStatus = sEnd FunctionPublic Function GetJobStatus(status As Long) As Strings = ""If (status = 0) Then
GetJobStatus = "OK"
Exit Function
End If
If (status And JOB_STATUS_PAUSED) Then
s = s + " Paused"
End IfIf (status And JOB_STATUS_ERROR) Then
s = s + " Error"
End IfIf (status And JOB_STATUS_DELETING) Then
s = s + " Deleting"
End IfIf (status And JOB_STATUS_SPOOLING) Then
s = s + " Spooling"
End IfIf (status And JOB_STATUS_PRINTING) Then
s = s + " Printing"
End IfIf (status And JOB_STATUS_OFFLINE) Then
s = s + " Offline"
End IfIf (status And JOB_STATUS_PAPEROUT) Then
s = s + " Paper Out"
End IfIf (status And JOB_STATUS_PRINTED) Then
s = s + " Printed"
End IfIf (status And JOB_STATUS_DELETED) Then
s = s + " Deleted"
End If
If (status And JOB_STATUS_BLOCKED_DEVQ) Then
s = s + " Blocked"
End IfIf (status And JOB_STATUS_USER_INTERVENTION) Then
s = s + " User Intervention"
End IfIf (status And JOB_STATUS_RESTART) Then
s = s + " Restart"
End If
GetJobStatus = s
End Function
------------------
VERSION 5.00
Begin VB.Form frmAbout
BorderStyle = 3 'Fixed Dialog
Caption = "About CS Tools"
ClientHeight = 3045
ClientLeft = 2340
ClientTop = 1935
ClientWidth = 6105
ClipControls = 0 'False
Icon = "frmAbout.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2101.713
ScaleMode = 0 'User
ScaleWidth = 5732.911
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox picIcon
AutoSize = -1 'True
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 480
Left = 705
Picture = "frmAbout.frx":0E42
ScaleHeight = 337.12
ScaleMode = 0 'User
ScaleWidth = 337.12
TabIndex = 1
Top = 480
Width = 480
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "OK"
Default = -1 'True
Height = 345
Left = 4822
TabIndex = 0
Top = 2160
Width = 1260
End
Begin VB.CommandButton cmdSysInfo
Caption = "&System Info..."
Height = 345
Left = 4822
TabIndex = 2
Top = 2640
Width = 1245
End
Begin VB.Image Image1
Height = 990
Left = 0
Picture = "frmAbout.frx":1A04
Top = 2040
Width = 4755
End
Begin VB.Line Line1
BorderColor = &H00808080&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 84.515
X2 = 5634.311
Y1 = 1107.799
Y2 = 1107.799
End
Begin VB.Label lblDescription
Alignment = 2 'Center
Caption = "CS Tools is by Shane Croft of Crofts Software."
ForeColor = &H00000000&
Height = 330
Left = 1515
TabIndex = 3
Top = 1125
Width = 3885
End
Begin VB.Label lblTitle
Alignment = 2 'Center
Caption = "Application Title"
ForeColor = &H00000000&
Height = 480
Left = 1515
TabIndex = 5
Top = 240
Width = 3885
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Index = 0
X1 = 98.6
X2 = 5634.311
Y1 = 1118.153
Y2 = 1118.153
End
Begin VB.Label lblVersion
Alignment = 2 'Center
Caption = "Version"
Height = 225
Left = 1515
TabIndex = 6
Top = 780
Width = 3885
End
Begin VB.Label lblDisclaimer
Alignment = 2 'Center
Caption = "Copyright 2000"
ForeColor = &H00000000&
Height = 225
Left = 277
TabIndex = 4
Top = 1785
Width = 3870
End
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit numberConst gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End SubPrivate Sub cmdOK_Click()
Unload Me
End SubPrivate Sub Form_Load()
Me.Caption = "About " & App.Title
lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
lblTitle.Caption = App.Title
End SubPublic Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Error - File Can Not Be Found...
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub
----------------------------
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form frmuserdataview
BorderStyle = 3 'Fixed Dialog
Caption = "View/Clear/Modify Stored User Information"
ClientHeight = 4920
ClientLeft = 1095
ClientTop = 330
ClientWidth = 5820
Icon = "frmuserdataview.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4920
ScaleWidth = 5820
Begin VB.Timer Timer1
Interval = 100
Left = 0
Top = 0
End
Begin VB.PictureBox picButtons
Align = 2 'Align Bottom
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 300
Left = 0
ScaleHeight = 300
ScaleWidth = 5820
TabIndex = 22
Top = 4290
Width = 5820
Begin VB.CommandButton cmdClose
Caption = "&Close"
Height = 300
Left = 4675
TabIndex = 27
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdRefresh
Caption = "&Refresh"
Height = 300
Left = 3521
TabIndex = 26
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete"
Height = 300
Left = 2367
TabIndex = 25
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdUpdate
Caption = "&Update"
Height = 300
Left = 1213
TabIndex = 24
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
Height = 300
Left = 59
TabIndex = 23
Top = 0
Width = 1095
End
End
Begin VB.TextBox txtFields
DataField = "User Name"
DataSource = "datPrimaryRS"
Height = 285
Index = 10
Left = 2179
TabIndex = 21
Top = 360
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "User Must Change Password"
DataSource = "datPrimaryRS"
Height = 285
Index = 9
Left = 2179
TabIndex = 19
Top = 1080
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Profile Path"
DataSource = "datPrimaryRS"
Height = 285
Index = 8
Left = 2179
TabIndex = 17
Top = 2160
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Primary Group"
DataSource = "datPrimaryRS"
Height = 285
Index = 7
Left = 2179
TabIndex = 15
Top = 3960
Visible = 0 'False
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Password Never Expires"
DataSource = "datPrimaryRS"
Height = 285
Index = 6
Left = 2179
TabIndex = 13
Top = 1440
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Login Script"
DataSource = "datPrimaryRS"
Height = 285
Index = 5
Left = 2179
TabIndex = 11
Top = 2520
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Home Directory"
DataSource = "datPrimaryRS"
Height = 285
Index = 4
Left = 2179
TabIndex = 9
Top = 2880
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Discription"
DataSource = "datPrimaryRS"
Height = 285
Index = 3
Left = 2179
TabIndex = 7
Top = 720
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Account Type"
DataSource = "datPrimaryRS"
Height = 285
Index = 2
Left = 2179
TabIndex = 5
Top = 3600
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Account Expires"
DataSource = "datPrimaryRS"
Height = 285
Index = 1
Left = 2179
TabIndex = 3
Top = 3240
Width = 3375
End
Begin VB.TextBox txtFields
DataField = "Account Disabled"
DataSource = "datPrimaryRS"
Height = 285
Index = 0
Left = 2179
TabIndex = 1
Top = 1800
Width = 3375
End
----------------------------
Begin MSAdodcLib.Adodc datPrimaryRS
Align = 2 'Align Bottom
Height = 330
Left = 0
Top = 4590
Width = 5820
_ExtentX = 10266
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=User_Migration.mdb;"
OLEDBString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=User_Migration.mdb;"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = $"frmuserdataview.frx":0BC2
Caption = " "
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Label Label1
Alignment = 2 'Center
Height = 255
Left = 863
TabIndex = 28
Top = 0
Width = 4095
End
Begin VB.Label lblLabels
Caption = "User Name:"
Height = 255
Index = 10
Left = 270
TabIndex = 20
Top = 360
Width = 1815
End
Begin VB.Label lblLabels
Caption = "User Must Change Password:"
Height = 375
Index = 9
Left = 270
TabIndex = 18
Top = 960
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Profile Path:"
Height = 255
Index = 8
Left = 270
TabIndex = 16
Top = 2160
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Primary Group:"
Height = 255
Index = 7
Left = 270
TabIndex = 14
Top = 3960
Visible = 0 'False
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Password Never Expires:"
Height = 255
Index = 6
Left = 270
TabIndex = 12
Top = 1440
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Login Script:"
Height = 255
Index = 5
Left = 270
TabIndex = 10
Top = 2520
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Home Directory:"
Height = 255
Index = 4
Left = 270
TabIndex = 8
Top = 2880
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Discription:"
Height = 255
Index = 3
Left = 270
TabIndex = 6
Top = 720
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Account Type:"
Height = 255
Index = 2
Left = 270
TabIndex = 4
Top = 3600
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Account Expires:"
Height = 255
Index = 1
Left = 270
TabIndex = 2
Top = 3240
Width = 1815
End
Begin VB.Label lblLabels
Caption = "Account Disabled:"
Height = 255
Index = 0
Left = 270
TabIndex = 0
Top = 1800
Width = 1815
End
End
Attribute VB_Name = "frmuserdataview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = FalsePrivate Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
End SubPrivate Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
'This is where you would put error handling code
'If you want to ignore errors, comment out the next line
'If you want to trap them, add code here to handle them
MsgBox "Data error event hit err:" & Description
End SubPrivate Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This will display the current record position for this recordset
datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End SubPrivate Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This is where you put validation code
'This event gets called when the following actions occur
Dim bCancel As Boolean Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select If bCancel Then adStatus = adStatusCancel
End SubPrivate Sub cmdAdd_Click()
On Error GoTo AddErr
datPrimaryRS.Recordset.AddNew Exit Sub
AddErr:
MsgBox Err.Description
End SubPrivate Sub cmdDelete_Click()
On Error Resume Next
With datPrimaryRS.Recordset
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
End SubPrivate Sub cmdRefresh_Click()
'This is only needed for multi user apps
On Error GoTo RefreshErr
datPrimaryRS.Refresh
Exit Sub
RefreshErr:
MsgBox Err.Description
End SubPrivate Sub cmdUpdate_Click()
On Error GoTo UpdateErr datPrimaryRS.Recordset.UpdateBatch adAffectAll
Exit Sub
UpdateErr:
MsgBox Err.Description
End SubPrivate Sub cmdClose_Click()
Unload Me
End SubPrivate Sub Timer1_Timer()
Label1.Caption = "Total Entries: " & datPrimaryRS.Recordset.RecordCount
End Sub
-------------------------Private Sub Timer4_Timer()
On Error Resume Next
MousePointer = vbHourglassDim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = Combo1.TextDim user As IADsUser
Dim username As String
Dim userdomian As Stringuserdomain = Combo1.Text
username = List1.TextIf frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & DomainName & "/" & username & ",user", username2, password, 1)
End IftxtFields(10).Text = List1.Textretval = user.Description
txtFields(3).Text = retvalDim Flags As Long
Flags = user.Get("userflags")
If (Flags And &H10000) <> 0 Then
txtFields(6).Text = "Checked"
Else
txtFields(6).Text = "Unchecked"
End If
If (Flags And &H2) <> 0 Then
txtFields(0).Text = "Checked"
Else
txtFields(0).Text = "Unchecked"
End If
Dim passwordexpired As Integer
passwordexpired = user.Get("passwordexpired")
If passwordexpired = 1 Then
txtFields(9).Text = "Checked"
Else
txtFields(9).Text = "Unchecked"
End Ifretval = user.LoginScript
txtFields(5).Text = retval
DoEventsretval = user.Profile
txtFields(8).Text = retval
DoEventsretval = user.HomeDirectory
txtFields(4).Text = retvaltxtFields(7).Text = "N/A"Flags = user.Get("userflags")
If (Flags And &H100) <> 0 Then
txtFields(2).Text = "Local Account"
Else
txtFields(2).Text = "Global Account"
End IfDim date1 As Date
date1 = user.AccountExpirationDate
Text1.Text = date1If Text1.Text = "12:00:00 AM" Then
txtFields(1).Text = "Never"
Else
txtFields(1).Text = Text1.Text
End IfErr = 0
MousePointer = 0
Timer4.Enabled = False
Timer5.Enabled = True
End SubPrivate Sub Timer5_Timer()
On Error Resume Next
cmdUpdate_ClickList2.AddItem List1.Text
ProgressBar1.Value = ProgressBar1.Value + 1Err = 0Timer2.Enabled = True
Timer5.Enabled = FalseEnd Sub
http://www.csdn.net/expert/topic/548/548358.xml
http://www.csdn.net/expert/topic/548/548372.xml
http://www.csdn.net/expert/topic/548/548405.xml
全部发完，谢谢大家！！