经典参考（1）一定对你有用的代码！！

Question

BROWSDLG.bas
-----------------------------
Attribute VB_Name = "Module1"
Option Explicit
Type SHITEMID
    cb As Long
    abID As Byte
End Type
Type ITEMIDLIST
    mkid As SHITEMID
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Const NOERROR = 0
Public Const CSIDL_DESKTOP = &H0
Public Const CSIDL_PROGRAMS = &H2
Public Const CSIDL_CONTROLS = &H3
Public Const CSIDL_PRINTERS = &H4
Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_STARTUP = &H7
Public Const CSIDL_RECENT = &H8
Public Const CSIDL_SENDTO = &H9
Public Const CSIDL_BITBUCKET = &HA
Public Const CSIDL_STARTMENU = &HB
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const CSIDL_DRIVES = &H11
Public Const CSIDL_NETWORK = &H12
Public Const CSIDL_NETHOOD = &H13
Public Const CSIDL_FONTS = &H14
Public Const CSIDL_TEMPLATES = &H15
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
CS_tools.vbp
-----------------------------
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{97D25DB0-0363-11CF-ABC4-02608C9E7553}#1.0#0#C:\WINNT\System32\activeds.tlb#Active DS Type Library
Reference=*\G{565783C6-CB41-11D1-8B02-00600806D9B6}#1.1#0#C:\WINNT\system32\wbemdisp.tlb#Microsoft WMI Scripting V1.1 Library
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#C:\Program Files\Common Files\System\ADO\msado15.dll#Microsoft ActiveX Data Objects 2.0 Library
Reference=*\G{56BF9020-7A2F-11D0-9482-00A0C91110ED}#1.0#0#C:\WINNT\system32\MSBIND.DLL#Microsoft Data Binding Collection VB 6.0 (SP4)
Form=frmdomainlogin.frm
Form=MDIFrmmain.frm
Form=frmadmin.frm
Form=frmbulkuser.frm
Form=frmuser.frm
Form=frmbulkgroup.frm
Form=frmgroup.frm
Form=frmcomputer.frm
Form=frmrenameuser.frm
Form=frmusergroup.frm
Form=frmuserprofile.frm
Form=frmuseraccount.frm
Form=frmadduser.frm
Form=frmgroupdesc.frm
Form=frmremotecommand.frm
Form=frmservices.frm
Form=frmprocesses.frm
Form=frmshortcut.frm
Form=frmresolve.frm
Module=Module1; BROWSDLG.BAS
Form=frmping.frm
Form=frminternetdomain.frm
Module=pingmod; ping.bas
Form=frmAbout.frm
Form=ResetPwd.frm
Form=frmbulkshortcut.frm
Form=frmprintstat.frm
Module=Helper; Helper.bas
Form=frmuserbackup.frm
Form=frmuserdata.frm
Object={67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0; MSADODC.OCX
Form=frmuserdataview.frm
Form=frmuserrestoredata.frm
Form=frmsplash.frm
IconForm="MDIFrmmain"
Startup="frmsplash"
HelpFile=""
Title="CS Tools 2.0"
ExeName32="CS_Tools.exe"
Command32=""
Name="CS_Tools"
HelpContextID="0"
Description="CS Tools 2.0"
CompatibleMode="0"
MajorVer=2
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionComments="By Shane Croft of Crofts Software"
VersionCompanyName="Crofts Software"
VersionProductName="CS Tools 2.0"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0[MS Transaction Server]
AutoRefresh=1

Answer 1

frmbulkgroup.frm
------------------------------------------
VERSION 5.00
Begin VB.Form frmbulkgroup 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Bulk Adminstration for Groups"
   ClientHeight    =   5730
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7515
   Icon            =   "frmbulkgroup.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5730
   ScaleWidth      =   7515
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   6960
      Top             =   3120
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   6480
      Top             =   3120
   End
   Begin VB.ListBox List3 
      Height          =   450
      Left            =   6240
      TabIndex        =   7
      Top             =   2640
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Timer Timerload 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   2880
      Top             =   0
   End
   Begin VB.CommandButton Command2 
      Caption         =   "View Decription on all Groups"
      Height          =   255
      Left            =   4920
      TabIndex        =   6
      Top             =   3480
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Close"
      Height          =   375
      Left            =   6120
      TabIndex        =   5
      Top             =   120
      Width           =   1215
   End
   Begin VB.ListBox List2 
      Height          =   1815
      Left            =   120
      TabIndex        =   3
      Top             =   3840
      Width           =   7335
   End
   Begin VB.Timer timertotal 
      Interval        =   100
      Left            =   120
      Top             =   3120
   End
   Begin VB.ListBox List1 
      Height          =   2790
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   3735
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   5400
      Picture         =   "frmbulkgroup.frx":27A2
      Top             =   1440
      Width           =   480
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "Decription on all Groups"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   3600
      Width           =   1815
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "Total Groups:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   3240
      Width           =   2535
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "Current Groups - Local and Global"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2535
   End
End
Attribute VB_Name = "frmbulkgroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Unload Me
End SubPrivate Sub Command2_Click()
List1.ListIndex = 0
List2.Clear
List3.Clear
Timer2.Enabled = True
End SubPrivate Sub Timer1_Timer()
On Error Resume Next
If List3.ListCount = List1.ListCount Then
Timer1.Enabled = False
Else
List1.ListIndex = List1.ListIndex + 1
Timer2.Enabled = True
Timer1.Enabled = False
End If
Err = 0
End SubPrivate Sub Timer2_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.Text
Dim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
groupname = List1.Text
groupdomain = frmdomainlogin.Combo1.TextIf 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
Dim retval As String
retval = group.Description
List2.AddItem "Group Name: " & List1.Text
List2.AddItem "Decription: " & retval
List2.AddItem ""List3.AddItem List1.TextMousePointer = 0
Err = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timer1.Enabled = True
Timer2.Enabled = False
End SubPrivate Sub Timerload_Timer()
On Error Resume Next
MousePointer = vbHourglass
List1.Clear
List2.Clear
List3.ClearMDIFrmmain.StatusBar1.Panels(1).Text = "Status: Please Wait Loading Users, Groups, OUS, and Computers..."Dim dso As IADsOpenDSObject
username = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim container As IADsContainer
Dim containername As String
containername = frmdomainlogin.Combo1.Text
If frmdomainlogin.Check1.Value = 1 Then
Set container = GetObject("WinNT://" & containername)
Else
Set dso = GetObject("WinNT:")
Set container = dso.OpenDSObject("WinNT://" & DomainName, username, password, 1)
End Ifcontainer.Filter = Array("Group")
Dim group As IADsGroup
For Each group In container
List1.AddItem group.Name
Next
Err = 0DoEvents
MousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timerload.Enabled = FalseEnd SubPrivate Sub timertotal_Timer()
Label2.Caption = "Total Groups: " & List1.ListCount
End Sub

Answer 2

frmping.frm
------------------------
VERSION 5.00
Begin VB.Form frmping 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Ping a IP"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3990
   Icon            =   "frmping.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   3990
   Begin VB.CommandButton Command2 
      Caption         =   "Stop"
      Enabled         =   0   'False
      Height          =   255
      Left            =   2048
      TabIndex        =   5
      Top             =   2760
      Width           =   855
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   3480
      Top             =   2760
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Ping"
      Height          =   255
      Left            =   1088
      TabIndex        =   4
      Top             =   2760
      Width           =   855
   End
   Begin VB.ListBox List1 
      Height          =   2400
      Left            =   128
      TabIndex        =   3
      Top             =   360
      Width           =   3735
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Ping Continuously"
      Height          =   255
      Left            =   2288
      TabIndex        =   2
      Top             =   0
      Width           =   1575
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   368
      TabIndex        =   1
      Top             =   0
      Width           =   1815
   End
   Begin VB.Label Label1 
      Caption         =   "IP:"
      Height          =   255
      Left            =   128
      TabIndex        =   0
      Top             =   0
      Width           =   255
   End
End
Attribute VB_Name = "frmping"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If Check1.Value = 1 Then
Timer1.Enabled = True
Command2.Enabled = True
Exit Sub
Else
End If
   List1.Clear
   Dim ECHO As ICMP_ECHO_REPLY
   Dim pos As Integer
   Dim i As String
   i = Text1.Text
   
   Call Ping(i, ECHO)
   
  'display the results from the ECHO structure
   List1.AddItem "Status: " & vbTab & vbTab & GetStatusCode(ECHO.status)
   List1.AddItem "Address: " & vbTab & vbTab & ECHO.Address
   List1.AddItem "Round Trip Time: " & vbTab & ECHO.RoundTripTime & " ms"
   List1.AddItem "Data Size: " & vbTab & ECHO.DataSize & " bytes"
   
   If Left$(ECHO.Data, 1) <> Chr$(0) Then
      pos = InStr(ECHO.Data, Chr$(0))
      List1.AddItem Left$(ECHO.Data, pos - 1)
   End If   List1.AddItem "Data Pointer: " & vbTab & ECHO.DataPointer
   List1.AddItem ""
End SubPrivate Sub Command2_Click()
Check1.Value = 0
Timer1.Enabled = False
Command2.Enabled = False
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command1_Click
 DoEvents
 End If
End SubPrivate Sub Timer1_Timer()
   Dim ECHO As ICMP_ECHO_REPLY
   Dim pos As Integer
   Dim i As String
   i = Text1.Text
   
   Call Ping(i, ECHO)
   
  'display the results from the ECHO structure
   List1.AddItem "Status: " & vbTab & vbTab & GetStatusCode(ECHO.status)
   List1.AddItem "Address: " & vbTab & vbTab & ECHO.Address
   List1.AddItem "Round Trip Time: " & vbTab & ECHO.RoundTripTime & " ms"
   List1.AddItem "Data Size: " & vbTab & ECHO.DataSize & " bytes"
   
   If Left$(ECHO.Data, 1) <> Chr$(0) Then
      pos = InStr(ECHO.Data, Chr$(0))
      List1.AddItem Left$(ECHO.Data, pos - 1)
   End If   List1.AddItem "Data Pointer: " & vbTab & ECHO.DataPointer
   List1.AddItem ""End Sub

Answer 3

frmrenameuser.frm
-------------------------------------
VERSION 5.00
Begin VB.Form frmrenameuser 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Rename User Account"
   ClientHeight    =   1320
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   3495
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   1320
   ScaleWidth      =   3495
   Begin VB.CommandButton Command2 
      Caption         =   "Cancel"
      Height          =   405
      Left            =   2160
      TabIndex        =   5
      Top             =   840
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Ok"
      Height          =   405
      Left            =   2160
      TabIndex        =   4
      Top             =   240
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   120
      TabIndex        =   3
      Top             =   960
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Enabled         =   0   'False
      Height          =   285
      Left            =   120
      Locked          =   -1  'True
      TabIndex        =   1
      Top             =   360
      Width           =   1815
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      Height          =   255
      Left            =   1200
      TabIndex        =   6
      Top             =   480
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "New User Account Name:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   1935
   End
   Begin VB.Label Label1 
      Caption         =   "Old User Account Name:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1815
   End
End
Attribute VB_Name = "frmrenameuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
If Text2.Text = "" Then
MsgBox "You must specify a new account name"
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Exit Sub
Else
End If
Dim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim container As IADsContainer
Dim containername As String
Dim oldname As String
Dim user As IADsUser
Dim newuser As IADsUser
Dim newname As Stringoldname = Text1.Text
newname = Text2.Text
containername = Label3.CaptionIf frmdomainlogin.Check1.Value = 1 Then
Set container = GetObject("WinNT://" & containername)
Set user = GetObject("WinNT://" & containername & "/" & oldname & ",user")
Else
Set dso = GetObject("WinNT:")
Set container = dso.OpenDSObject("WinNT://" & containername, username2, password, 1)
Set user = dso.OpenDSObject("WinNT://" & containername & "/" & oldname & ",user", username2, password, 1)
End IfSet newuser = container.MoveHere(user.ADsPath, newname)
Set user = Nothing
frmuser.Label7.Caption = Text2.Text
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Unload Me
End SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command1_Click
 DoEvents
 End If
End Sub

Answer 4

frmremotecommand.frm
_______________________________________
VERSION 5.00
Begin VB.Form frmremotecommand 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Remote Command"
   ClientHeight    =   3045
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6540
   Icon            =   "frmremotecommand.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3045
   ScaleWidth      =   6540
   Begin VB.TextBox Text3 
      Enabled         =   0   'False
      Height          =   285
      Left            =   4403
      Locked          =   -1  'True
      TabIndex        =   10
      Top             =   0
      Width           =   2055
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   83
      TabIndex        =   7
      Top             =   240
      Width           =   2775
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Do It"
      Height          =   255
      Left            =   3683
      TabIndex        =   5
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   83
      TabIndex        =   4
      Text            =   "C:\WINNT\Notepad.exe"
      Top             =   840
      Width           =   4815
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Close"
      Height          =   375
      Left            =   5280
      TabIndex        =   2
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Remote Restart"
      Height          =   255
      Left            =   83
      TabIndex        =   1
      Top             =   2640
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Remote Shut Down"
      Height          =   255
      Left            =   83
      TabIndex        =   0
      Top             =   2280
      Width           =   1695
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Caption         =   "Extra:"
      Height          =   255
      Left            =   83
      TabIndex        =   9
      Top             =   2040
      Width           =   1695
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "NOTE:  You must have the RemoteShutdown privilege to successfully invoke the Reboot or Shut Down method."
      Height          =   855
      Left            =   1883
      TabIndex        =   8
      Top             =   2040
      Width           =   2895
   End
   Begin VB.Label Label2 
      Caption         =   "Please type the computer name:"
      Height          =   255
      Left            =   83
      TabIndex        =   6
      Top             =   0
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "Command to run on remote computer:"
      Height          =   255
      Left            =   83
      TabIndex        =   3
      Top             =   600
      Width           =   2775
   End
End
Attribute VB_Name = "frmremotecommand"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim computername As String
computername = Text2.Text
Set OpSysSet = GetObject("winmgmts:{(Debug,RemoteShutdown)}//" & computername & "/root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")For Each OpSys In OpSysSet
    Call OpSys.Shutdown
Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Command3_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim computername As String
computername = Text2.Text
Set OpSysSet = GetObject("winmgmts:{(RemoteShutdown)}//" & computername & "/root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")For Each OpSys In OpSysSet
    Call OpSys.Reboot
Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Command4_Click()
Unload Me
End SubPrivate Sub Command5_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim servername As String
Dim Command2 As String
Dim username2 As String
Dim password As String
username2 = txtAdminName
password = txtAdminPassw
Command2 = Text1.Text
servername = Text2.TextIf frmdomainlogin.Check1.Value = 1 Then
Set Process = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & servername & "\root\cimv2:Win32_Process")
Else
Set Process = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & servername & "\root\cimv2:Win32_Process")
End If
result = Process.Create(Text1.Text, Null, Null, processid)If Err <> 0 Then
    Text3.Text = "Error: " & Err.Description & " 0x" & Hex(Err.Number)
    Else
    Text3.Text = "Successful"
End If
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command5_Click
 DoEvents
 End If
End SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command5_Click
 DoEvents
 End If
End Sub

Answer 5

frmbulkshortcut.frm(1)
--------------------------------------------
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmbulkshortcut 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Bulk Shortcut Maker"
   ClientHeight    =   3765
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7500
   Icon            =   "frmbulkshortcut.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3765
   ScaleWidth      =   7500
   Begin VB.ListBox List2 
      Height          =   255
      Left            =   2400
      TabIndex        =   21
      Top             =   3480
      Width           =   3375
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   4320
      Top             =   3240
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   3720
      Top             =   3240
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Refresh"
      Height          =   255
      Left            =   1283
      TabIndex        =   19
      Top             =   600
      Width           =   855
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Remove From List"
      Height          =   255
      Left            =   83
      TabIndex        =   18
      Top             =   3480
      Width           =   2055
   End
   Begin VB.ListBox List1 
      Height          =   2595
      Left            =   83
      TabIndex        =   17
      Top             =   840
      Width           =   2055
   End
   Begin VB.TextBox Text4 
      Height          =   285
      Left            =   83
      TabIndex        =   14
      Top             =   240
      Width           =   2055
   End
   Begin VB.CommandButton Command6 
      Caption         =   "Create ShortCut"
      Height          =   255
      Left            =   6000
      TabIndex        =   10
      Top             =   3120
      Width           =   1455
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Close"
      Height          =   255
      Left            =   5963
      TabIndex        =   9
      Top             =   3480
      Width           =   1455
   End
   Begin VB.CheckBox Check5 
      Caption         =   "Start Menu"
      Height          =   255
      Left            =   2363
      TabIndex        =   8
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CheckBox Check3 
      Caption         =   "Programs"
      Height          =   255
      Left            =   2363
      TabIndex        =   7
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CheckBox Check2 
      Caption         =   "Startup"
      Height          =   255
      Left            =   2363
      TabIndex        =   6
      Top             =   2760
      Width           =   1215
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Desktop"
      Height          =   255
      Left            =   2363
      TabIndex        =   5
      Top             =   2040
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "..."
      Height          =   255
      Left            =   7043
      TabIndex        =   4
      Top             =   240
      Width           =   375
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   2363
      TabIndex        =   3
      Top             =   960
      Width           =   4575
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   2363
      TabIndex        =   2
      Top             =   240
      Width           =   4575
   End
   Begin VB.TextBox Text3 
      Height          =   285
      Left            =   2363
      TabIndex        =   1
      Top             =   1560
      Width           =   4575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "..."
      Height          =   255
      Left            =   7043
      TabIndex        =   0
      Top             =   1560
      Width           =   375
   End
   Begin MSComDlg.CommonDialog CD1 
      Left            =   6923
      Top             =   2040
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      Caption         =   $"frmbulkshortcut.frx":0BC2
      Height          =   1455
      Left            =   3600
      TabIndex        =   20
      Top             =   1920
      Width           =   3255
   End
   Begin VB.Label Label5 
      Caption         =   "Users"
      Height          =   255
      Left            =   83
      TabIndex        =   16
      Top             =   600
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "Computer or Domain:"
      Height          =   255
      Left            =   83
      TabIndex        =   15
      Top             =   0
      Width           =   1575
   End
   Begin VB.Label Label4 
      Caption         =   "Where would you like to place your Shortcut?"
      Height          =   255
      Left            =   2363
      TabIndex        =   13
      Top             =   1320
      Width           =   5055
   End
   Begin VB.Label Label2 
      Caption         =   "What do you want to name your shortcut?"
      Height          =   255
      Left            =   2363
      TabIndex        =   12
      Top             =   720
      Width           =   4575
   End
   Begin VB.Label Label1 
      Caption         =   "Command Line  (What do you want the the shortcut to open?)"
      Height          =   255
      Left            =   2363
      TabIndex        =   11
      Top             =   0
      Width           =   4575
   End
End
Attribute VB_Name = "frmbulkshortcut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Answer 6

frmbulkshortcut.frm(2)
----------------------------------------
Option Explicit
Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String '  only used if FOF_SIMPLEPROGRESS
End TypePrivate Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
   (lpFileOp As SHFILEOPSTRUCT) As Long' // Shell File OperationsConst FO_MOVE = &H1
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_RENAME = &H4
Const FOF_MULTIDESTFILES = &H1
Const FOF_CONFIRMMOUSE = &H2
Const FOF_SILENT = &H4                      '  don't create progress/report
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMATION = &H10             '  Don't prompt the user.
Const FOF_WANTMAPPINGHANDLE = &H20          '  Fill in SHFILEOPSTRUCT.hNameMappings
                                      '  Must be freed using SHFreeNameMappings
Const FOF_ALLOWUNDO = &H40
Const FOF_FILESONLY = &H80                  '  on *.*, do only files - not directories
Const FOF_SIMPLEPROGRESS = &H100            '  means don't show names of files
Const FOF_NOCONFIRMMKDIR = &H200            '  don't confirm making any needed dirsConst PO_DELETE = &H13           '  printer is being deleted
Const PO_RENAME = &H14           '  printer is being renamed
Const PO_PORTCHANGE = &H20       '  port this printer connected to is being changed
                                '  if this id is set, the strings received by
                                '  the copyhook are a doubly-null terminated
                                '  list of strings.  The first is the printer
                                '  name and the second is the printer port.
Const PO_REN_PORT = &H34         '  PO_RENAME and PO_PORTCHANGE at same time.
Private Declare Function fCreateShellLink Lib "VB5STKIT.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Private Sub Command1_Click()
CD1.ShowOpen
Text1.Text = CD1.FileName
End SubPrivate Sub Command2_Click()
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
  
  '  the calling app
  bi.hOwner = Me.hwnd
  
 
 
  '  set the banner text
  bi.lpszTitle = "Browsing"
  
  '  set the type of folder to return
  '  play with these option constants to see what can be returned
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
  
  '  show the browse folder dialog
  pidl& = SHBrowseForFolder(bi)
  
  '  if displaying the return value, get the selected folder
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
      
      '  parce & display the folder selection
      pos% = InStr(path$, Chr$(0))
      Text3.Text = Left(path$, pos - 1)
    Else
      MsgBox "Dialog was cancelled", vbInformation
    End IfEnd SubPrivate Sub Command3_Click()
On Error Resume Next
List1.RemoveItem List1.ListIndex
Err = 0
End SubPrivate Sub Command4_Click()
On Error Resume Next
MousePointer = vbHourglass
List1.Clear
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Please Wait Loading Users..."Dim container As IADsContainer
Dim containername As String
containername = Text4.TextSet container = GetObject("WinNT://" & containername)container.Filter = Array("User")
Dim user As IADsUser
For Each user In container
List1.AddItem user.Name
NextDoEventsErr = 0MousePointer = 0DoEvents
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Command5_Click()
Unload Me
End SubPrivate Sub Command6_Click()
List2.Clear
Timer2.Enabled = TrueEnd SubPrivate Sub Form_Load()
CD1.CancelError = False
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Text2.SetFocus
 DoEvents
 End IfEnd SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Text3.SetFocus
 DoEvents
 End If
End SubPrivate Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command6_Click
 DoEvents
 End If
End Sub

Answer 7

frmbulkshortcut.frm(3)
--------------------------------------Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command4_Click
 DoEvents
 End IfEnd SubPrivate Sub Timer1_Timer()
On Error Resume Next
If List2.ListCount = List1.ListCount Then
Timer1.Enabled = False
Else
List1.ListIndex = List1.ListIndex + 1
Timer2.Enabled = True
Timer1.Enabled = False
End If
Err = 0End SubPrivate Sub Timer2_Timer()
Dim lReturn As LongIf Text3.Text = "" Then
Else
lReturn = fCreateShellLink("..\..\..\..\", _
Text2.Text, Text1.Text, "")
Dim lResult As Long, SHF As SHFILEOPSTRUCT
SHF.hwnd = hwnd
SHF.wFunc = FO_COPY
SHF.pFrom = "C:\" & Text2.Text & ".lnk"
SHF.pTo = Text3.Text & "\" & List1.Text
SHF.fFlags = FOF_FILESONLY
lResult = SHFileOperation(SHF)
DoEvents
Kill "C:\" & Text2.Text & ".lnk"
End IfIf Check1.Value = 1 Then
lReturn = fCreateShellLink("..\..\Desktop", _
Text2.Text, Text1.Text, "")
End IfIf Check2.Value = 1 Then
lReturn = fCreateShellLink("\Startup", Text2.Text, _
Text1.Text, "")
End IfIf Check3.Value = 1 Then
lReturn = fCreateShellLink("", Text2.Text, _
Text1.Text, "")
End IfIf Check5.Value = 1 Then
lReturn = fCreateShellLink("..\..\Start Menu", _
Text2.Text, Text1.Text, "")
End IfDoEvents
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check5.Value = 0
List2.AddItem List1.Text
Timer1.Enabled = True
Timer2.Enabled = False
End Sub

Answer 8

frmshortcut.frm(2)
---------------------------Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
   (lpFileOp As SHFILEOPSTRUCT) As Long' // Shell File OperationsConst FO_MOVE = &H1
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_RENAME = &H4
Const FOF_MULTIDESTFILES = &H1
Const FOF_CONFIRMMOUSE = &H2
Const FOF_SILENT = &H4                      '  don't create progress/report
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMATION = &H10             '  Don't prompt the user.
Const FOF_WANTMAPPINGHANDLE = &H20          '  Fill in SHFILEOPSTRUCT.hNameMappings
                                      '  Must be freed using SHFreeNameMappings
Const FOF_ALLOWUNDO = &H40
Const FOF_FILESONLY = &H80                  '  on *.*, do only files - not directories
Const FOF_SIMPLEPROGRESS = &H100            '  means don't show names of files
Const FOF_NOCONFIRMMKDIR = &H200            '  don't confirm making any needed dirsConst PO_DELETE = &H13           '  printer is being deleted
Const PO_RENAME = &H14           '  printer is being renamed
Const PO_PORTCHANGE = &H20       '  port this printer connected to is being changed
                                '  if this id is set, the strings received by
                                '  the copyhook are a doubly-null terminated
                                '  list of strings.  The first is the printer
                                '  name and the second is the printer port.
Const PO_REN_PORT = &H34         '  PO_RENAME and PO_PORTCHANGE at same time.
Private Declare Function fCreateShellLink Lib "VB5STKIT.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Private Sub Command1_Click()
CD1.ShowOpen
Text1.Text = CD1.FileName
End SubPrivate Sub Command2_Click()
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
  
  '  the calling app
  bi.hOwner = Me.hwnd
  
 
 
  '  set the banner text
  bi.lpszTitle = "Browsing"
  
  '  set the type of folder to return
  '  play with these option constants to see what can be returned
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
  
  '  show the browse folder dialog
  pidl& = SHBrowseForFolder(bi)
  
  '  if displaying the return value, get the selected folder
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
      
      '  parce & display the folder selection
      pos% = InStr(path$, Chr$(0))
      Text3.Text = Left(path$, pos - 1)
    Else
      MsgBox "Dialog was cancelled", vbInformation
    End IfEnd Sub
Private Sub Command5_Click()
Unload Me
End SubPrivate Sub Command6_Click()
Dim lReturn As LongIf Text3.Text = "" Then
Else
lReturn = fCreateShellLink("..\..\..\..\", _
Text2.Text, Text1.Text, "")
Dim lResult As Long, SHF As SHFILEOPSTRUCT
SHF.hwnd = hwnd
SHF.wFunc = FO_COPY
SHF.pFrom = "C:\" & Text2.Text & ".lnk"
SHF.pTo = Text3.Text
SHF.fFlags = FOF_FILESONLY
lResult = SHFileOperation(SHF)
DoEvents
Kill "C:\" & Text2.Text & ".lnk"
End IfIf Check1.Value = 1 Then
lReturn = fCreateShellLink("..\..\Desktop", _
Text2.Text, Text1.Text, "")
End IfIf Check2.Value = 1 Then
lReturn = fCreateShellLink("\Startup", Text2.Text, _
Text1.Text, "")
End IfIf Check3.Value = 1 Then
lReturn = fCreateShellLink("", Text2.Text, _
Text1.Text, "")
End IfIf Check5.Value = 1 Then
lReturn = fCreateShellLink("..\..\Start Menu", _
Text2.Text, Text1.Text, "")
End IfDoEvents
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check5.Value = 0
MsgBox "DONE"End SubPrivate Sub Form_Load()
CD1.CancelError = False
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Text2.SetFocus
 DoEvents
 End IfEnd SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Text3.SetFocus
 DoEvents
 End If
End SubPrivate Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Command6_Click
 DoEvents
 End If
End Sub

Answer 9

frmservice.frm(1)
-----------------------------
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmservices 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Services"
   ClientHeight    =   4920
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7695
   Icon            =   "frmservices.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4920
   ScaleWidth      =   7695
   Begin VB.Timer Timer2 
      Interval        =   100
      Left            =   5520
      Top             =   120
   End
   Begin VB.CommandButton Start 
      Caption         =   "Start"
      Height          =   375
      Left            =   6360
      TabIndex        =   5
      Top             =   840
      Width           =   1215
   End
   Begin VB.CommandButton Pause 
      Caption         =   "Pause"
      Height          =   375
      Left            =   6360
      TabIndex        =   4
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton Stop 
      Caption         =   "Stop"
      Height          =   375
      Left            =   6360
      TabIndex        =   3
      Top             =   1320
      Width           =   1215
   End
   Begin VB.CommandButton Exit 
      Caption         =   "Exit"
      Height          =   495
      Left            =   3240
      TabIndex        =   2
      Top             =   8640
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   250
      Left            =   5040
      Top             =   120
   End
   Begin VB.TextBox Server 
      Height          =   285
      Left            =   0
      TabIndex        =   1
      Top             =   240
      Width           =   3375
   End
   Begin VB.CommandButton Connect 
      Caption         =   "Connect"
      Height          =   285
      Left            =   3600
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   3975
      Left            =   0
      TabIndex        =   6
      Top             =   840
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   7011
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   0   'False
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   3
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Service Name"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "Service Description"
         Object.Width           =   5468
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "Service State"
         Object.Width           =   2293
      EndProperty
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Height          =   255
      Left            =   0
      TabIndex        =   8
      Top             =   600
      Width           =   6135
   End
   Begin VB.Label Label1 
      Caption         =   "Server"
      Height          =   255
      Left            =   0
      TabIndex        =   7
      Top             =   0
      Width           =   1215
   End
End
Attribute VB_Name = "frmservices"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Locator As SWbemLocator
Public services As SWbemServices
Public TimerCount
Public Item As ListItemDim WithEvents eventSink As SWbemSink
Attribute eventSink.VB_VarHelpID = -1
    
Public Sub InitialiseView()
    ListView1.ListItems.Clear
End SubPrivate Sub Server_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
 Call Connect_Click
 DoEvents
 End IfEnd SubPrivate Sub Timer1_Timer()TimerCount = TimerCount + 1
If TimerCount > 10 Then
    Item.Bold = False
    Timer1.Enabled = False
    TimerCount = 0
Else
    Item.Bold = Not Item.Bold
End IfEnd SubPrivate Sub eventSink_OnObjectReady(ByVal Object As WbemScripting.ISWbemObject, ByVal AsyncContext As WbemScripting.ISWbemNamedValueSet)Dim ServiceName
Dim ServiceStatusServiceName = Object.TargetInstance.Name
ServiceStatus = Object.TargetInstance.State
Set Item = ListView1.FindItem(ServiceName)
Item.SubItems(2) = ServiceStatus
Item.Bold = True
Timer1.Enabled = True
TimerCount = 0End Sub

Answer 10

frmservice.frm(2)
--------------------------------
Public Sub LoadView()
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
    Dim Enumerator As SWbemObjectSet
    Dim Object As SWbemObject
    Dim Item As ListItem
    
    On Error Resume Next
        
    SavePointer = Form1.MousePointer
    Form1.MousePointer = vbHourglass
    Form1.Enabled = False
    ListView1.ListItems.Clear
    
    eventSink.Cancel
    
    Set services = Locator.ConnectServer(Server.Text)
    services.ExecNotificationQueryAsync eventSink, "Select * from __InstanceModificationEvent Within 2.0 Where TargetInstance Isa 'Win32_Service'"
    Set Enumerator = services.ExecQuery("Select * From Win32_Service")
    
    For Each Object In Enumerator
    
        Set Item = ListView1.ListItems.Add(, Object.Name, Object.Name)
        Item.SubItems(1) = Object.Description
        Item.SubItems(2) = Object.State
        
    Next
    
    Form1.Enabled = True
    Form1.MousePointer = SavePointer
    MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Form_Load()    Set Locator = New SWbemLocator
    Set eventSink = New SWbemSink
    
    InitialiseViewEnd SubPrivate Sub Connect_Click()
    
    LoadViewEnd SubPrivate Sub Exit_Click()    End
    
End SubPrivate Sub Pause_Click()
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
    Dim ServiceObject As SWbemObject
    Dim ServiceName
    
    On Error Resume Next
    ServiceName = ListView1.SelectedItem.Text
    If Err.Number = 0 Then
    
        Set ServiceObject = services.Get("Win32_Service='" & ServiceName & "'")
        
        ' Note how the CIM method "PauseService" of Win32_Service
        ' is executed as if it were an automation method of SWbemObject
        ServiceObject.PauseService
    End If
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Start_Click()
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
    Dim ServiceObject As SWbemObject
    Dim ServiceName
    
    On Error Resume Next
    ServiceName = ListView1.SelectedItem.Text
    If Err.Number = 0 Then
    
        ' Note how the CIM method "StartService" of Win32_Service
        ' is executed as if it were an automation method of SWbemObject
        Set ServiceObject = services.Get("Win32_Service='" & ServiceName & "'")
        ServiceObject.StartService
    End If
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Stop_Click()
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
    Dim ServiceObject As SWbemObject
    Dim ServiceName
    
    On Error Resume Next
    ServiceName = ListView1.SelectedItem.Text
    If Err.Number = 0 Then
    
        ' Note how the CIM method "StopService" of Win32_Service
        ' is executed as if it were an automation method of SWbemObject
        Set ServiceObject = services.Get("Win32_Service='" & ServiceName & "'")
        ServiceObject.StopService
    End If
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End Sub
Private Sub Timer2_Timer()
Label2.Caption = "Total Services: " & ListView1.ListItems.Count
End Sub

Answer 11

frmresolve.frm
------------------------
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

Answer 12

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

Answer 13

frmgroup.frm
----------------------------
VERSION 5.00
Begin VB.Form frmgroup 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Administer A Group"
   ClientHeight    =   4665
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6270
   Icon            =   "frmgroup.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4665
   ScaleWidth      =   6270
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   2400
      Top             =   480
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Close"
      Height          =   375
      Left            =   4920
      TabIndex        =   9
      Top             =   4080
      Width           =   1215
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Change Group Description"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   4320
      Width           =   2175
   End
   Begin VB.CommandButton Command3 
      Caption         =   "View Group Description"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   3960
      Width           =   2175
   End
   Begin VB.ListBox List2 
      Height          =   3570
      Left            =   3960
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   360
      Width           =   2175
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Remove User -->"
      Height          =   375
      Left            =   2400
      TabIndex        =   3
      Top             =   1920
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "<-- Add User"
      Height          =   375
      Left            =   2400
      TabIndex        =   2
      Top             =   1200
      Width           =   1455
   End
   Begin VB.ListBox List1 
      Height          =   3570
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin VB.Label Label3 
      Height          =   255
      Left            =   1080
      TabIndex        =   6
      Top             =   120
      Width           =   2535
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "All Users"
      Height          =   255
      Left            =   3720
      TabIndex        =   4
      Top             =   120
      Width           =   2175
   End
   Begin VB.Label Label1 
      Caption         =   "Members of"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "frmgroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
If List2.Text = "" Then
MsgBox "Please select a group to add"
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Exit Sub
Else
MousePointer = vbHourglass
Dim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
Dim user As IADsUser
Dim username As String
Dim userdomain As Stringgroupname = Label3.Caption
groupdomain = frmdomainlogin.Combo1.Text
username = List2.Text
userdomain = frmdomainlogin.Combo1.TextIf frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & userdomain & "/" & username & ",user", username2, password, 1)
Set group = dso.OpenDSObject("WinNT://" & groupdomain & "/" & groupname & ",group", username2, password, 1)
End Ifgroup.Add (user.ADsPath)
group.SetInfo
List1.AddItem List2.TextErr = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
MousePointer = 0
End If
End SubPrivate Sub Command2_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
If List1.Text = "" Then
MsgBox "Please select a User to remove"
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Exit Sub
Else
MousePointer = vbHourglassDim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
Dim user As IADsUser
Dim username As String
Dim userdomain As Stringgroupname = Label3.Caption
groupdomain = frmdomainlogin.Combo1.Text
username = List1.Text
userdomain = frmdomainlogin.Combo1.TextIf frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & userdomain & "/" & username & ",user", username2, password, 1)
Set group = dso.OpenDSObject("WinNT://" & groupdomain & "/" & groupname & ",group", username2, password, 1)
End Ifgroup.Remove (user.ADsPath)List1.RemoveItem List1.ListIndexErr = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
MousePointer = 0
End If
End SubPrivate Sub Command3_Click()
frmgroupdesc.Show
frmgroupdesc.Label2.Caption = Label3.Caption
frmgroupdesc.Timer1.Enabled = True
End SubPrivate Sub Command4_Click()
frmgroupdesc.Show
frmgroupdesc.Label2.Caption = Label3.Caption
frmgroupdesc.Check1.Value = 1
frmgroupdesc.Timer1.Enabled = True
End SubPrivate Sub Command5_Click()
Unload Me
End SubPrivate Sub Timer1_Timer()
On Error Resume Next
MousePointer = vbHourglass
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim 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://" & DomainName, username2, password, 1)
End Ifcontainer.Filter = Array("User")
Dim user As IADsUser
For Each user In container
List2.AddItem user.Name
NextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As Stringgroupname = Label3.Caption
groupdomain = frmdomainlogin.Combo1.Text
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")For Each member In group.Members
List1.AddItem member.Name
NextErr = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
MousePointer = 0
Timer1.Enabled = False
End Sub

Answer 14

frmuseraccount.frm(1)
-----------------------------------
VERSION 5.00
Begin VB.Form frmuseraccount 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Account"
   ClientHeight    =   2700
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6555
   Icon            =   "frmuseraccount.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2700
   ScaleWidth      =   6555
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   240
      Top             =   480
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Close"
      Height          =   375
      Left            =   5280
      TabIndex        =   12
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Save"
      Height          =   375
      Left            =   5280
      TabIndex        =   11
      Top             =   120
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "Account Type"
      Height          =   1575
      Left            =   2880
      TabIndex        =   6
      Top             =   1080
      Width           =   3615
      Begin VB.OptionButton Option4 
         Caption         =   "Local Account"
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   960
         Width           =   1815
      End
      Begin VB.OptionButton Option3 
         Caption         =   "Global Account"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   360
         Value           =   -1  'True
         Width           =   2175
      End
      Begin VB.Label Label3 
         Caption         =   "for regular user accounts in this domain"
         Height          =   255
         Left            =   600
         TabIndex        =   8
         Top             =   600
         Width           =   2895
      End
      Begin VB.Label Label4 
         Caption         =   "for users from untrusted domains"
         Height          =   255
         Left            =   600
         TabIndex        =   10
         Top             =   1200
         Width           =   2775
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Account Expires"
      Height          =   1575
      Left            =   120
      TabIndex        =   2
      Top             =   1080
      Width           =   2535
      Begin VB.TextBox Text1 
         Alignment       =   2  'Center
         Height          =   285
         Left            =   1200
         TabIndex        =   5
         Text            =   "01/01/2000"
         Top             =   960
         Width           =   1215
      End
      Begin VB.OptionButton Option2 
         Caption         =   "End of"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   960
         Width           =   855
      End
      Begin VB.OptionButton Option1 
         Caption         =   "Never"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Value           =   -1  'True
         Width           =   1455
      End
   End
   Begin VB.Label Label2 
      Height          =   255
      Left            =   720
      TabIndex        =   1
      Top             =   120
      Width           =   4215
   End
   Begin VB.Label Label1 
      Caption         =   "User:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   495
   End
End
Attribute VB_Name = "frmuseraccount"
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 = vbHourglass
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
Dim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.Text

Answer 15

frmuseraccount,frm(2)
----------------------------------------Dim user As IADsUser
Dim username As String
Dim userdomain As Stringuserdomain = frmdomainlogin.Combo1.Text
username = Label2.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 date1 As Date
Dim Flags As LongIf Option1.Value = True Then
date1 = #12:00:00 AM#
user.AccountExpirationDate = date1
user.SetInfo
Else
End IfIf Option2.Value = True Then
date1 = Text1.Text
user.AccountExpirationDate = date1
user.SetInfo
Else
End IfIf Option3.Value = True Then
Flags = user.Get("userflags")
user.Put "userflags", Flags Xor &H100
user.SetInfo
Flags = user.Get("userflags")
user.Put "userflags", Flags Xor &H200
user.SetInfo
Else
End IfIf Option4.Value = True Then
Flags = user.Get("userflags")
user.Put "userflags", Flags Xor &H200
user.SetInfo
Flags = user.Get("userflags")
user.Put "userflags", Flags Xor &H100
user.SetInfo
Else
End IfErr = 0
MousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Unload Me
End SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Timer1_Timer()
On Error Resume Next
MousePointer = vbHourglass
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 userdomain As Stringuserdomain = frmdomainlogin.Combo1.Text
username = Label2.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 Flags As Long
Flags = user.Get("userflags")
If (Flags And &H100) <> 0 Then
Option4.Value = True
Else
Option3.Value = True
End IfDim date1 As Date
date1 = user.AccountExpirationDate
Text1.Text = date1If Text1.Text = "12:00:00 AM" Then
Option1.Value = True
Text1.Text = "01/01/2000"
Else
Option2.Value = True
End IfErr = 0
MousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timer1.Enabled = False
End Sub

Answer 16

frmusergroup.frm
---------------------
VERSION 5.00
Begin VB.Form frmusergroup 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Groups"
   ClientHeight    =   3600
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7020
   Icon            =   "frmusergroup.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3600
   ScaleWidth      =   7020
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   5040
      Top             =   0
   End
   Begin VB.ListBox List1 
      Height          =   2205
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   4
      Top             =   1320
      Width           =   2655
   End
   Begin VB.CommandButton Command1 
      Caption         =   "<- Add"
      Height          =   375
      Left            =   3000
      TabIndex        =   3
      Top             =   1920
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Remove ->"
      Height          =   375
      Left            =   3000
      TabIndex        =   2
      Top             =   2520
      Width           =   975
   End
   Begin VB.ListBox List2 
      Height          =   2205
      Left            =   4200
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   1320
      Width           =   2655
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Close"
      Height          =   255
      Left            =   5520
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "User:"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label2 
      Height          =   255
      Left            =   720
      TabIndex        =   7
      Top             =   120
      Width           =   2895
   End
   Begin VB.Label Label3 
      Caption         =   "Members of:"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "Groups                     (Local && Global)"
      Height          =   255
      Left            =   4200
      TabIndex        =   5
      Top             =   1080
      Width           =   2655
   End
End
Attribute VB_Name = "frmusergroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
If List2.Text = "" Then
MsgBox "Please select a group to add"
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Exit Sub
Else
MousePointer = vbHourglassDim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
Dim user As IADsUser
Dim username As String
Dim userdomain As Stringgroupname = List2.Text
groupdomain = frmdomainlogin.Combo1.Text
username = Label2.Caption
userdomain = frmdomainlogin.Combo1.TextIf frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & userdomain & "/" & username & ",user", username2, password, 1)
Set group = dso.OpenDSObject("WinNT://" & groupdomain & "/" & groupname & ",group", username2, password, 1)
End Ifgroup.Add (user.ADsPath)
group.SetInfo
List1.AddItem List2.TextErr = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
MousePointer = 0
End If
End SubPrivate Sub Command2_Click()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
If List1.Text = "" Then
MsgBox "Please select a group to remove"
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Exit Sub
Else
MousePointer = vbHourglassDim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim group As IADsGroup
Dim groupname As String
Dim groupdomain As String
Dim user As IADsUser
Dim username As String
Dim userdomain As Stringgroupname = List1.Text
groupdomain = frmdomainlogin.Combo1.Text
username = Label2.Caption
userdomain = frmdomainlogin.Combo1.TextIf frmdomainlogin.Check1.Value = 1 Then
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Set group = GetObject("WinNT://" & groupdomain & "/" & groupname & ",group")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & userdomain & "/" & username & ",user", username2, password, 1)
Set group = dso.OpenDSObject("WinNT://" & groupdomain & "/" & groupname & ",group", username2, password, 1)
End Ifgroup.Remove (user.ADsPath)List1.RemoveItem List1.ListIndexErr = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
MousePointer = 0
End If
End SubPrivate Sub Command4_Click()
Unload Me
End SubPrivate Sub Timer1_Timer()
On Error Resume Next
MDIFrmmain.StatusBar1.Panels(1).Text = "Status: Working..."
MousePointer = vbHourglass
List1.Clear
List2.ClearDim dso As IADsOpenDSObject
username2 = frmdomainlogin.Text1.Text
password = frmdomainlogin.Text2.Text
DomainName = frmdomainlogin.Combo1.TextDim user As IADsUser
Dim username As String
Dim userdomain As String
Dim group As IADsGroup
Dim container As IADsContainer
Dim containername As String
containername = frmdomainlogin.Combo1.Text
userdomain = frmdomainlogin.Combo1.Text
username = Label2.CaptionIf frmdomainlogin.Check1.Value = 1 Then
Set container = GetObject("WinNT://" & containername)
Set user = GetObject("WinNT://" & userdomain & "/" & username & ",user")
Else
Set dso = GetObject("WinNT:")
Set user = dso.OpenDSObject("WinNT://" & DomainName & "/" & username & ",user", username2, password, 1)
Set container = dso.OpenDSObject("WinNT://" & DomainName, username, password, 1)
End IfFor Each group In user.Groups
List1.AddItem group.Name
Next
container.Filter = Array("Group")
For Each group In container
List2.AddItem group.Name
NextErr = 0
MousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timer1.Enabled = False
End Sub

Answer 17

midfrmmain.frm
-----------------------
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.MDIForm MDIFrmmain 
   BackColor       =   &H8000000C&
   Caption         =   "CS Tools 2.0"
   ClientHeight    =   6555
   ClientLeft      =   165
   ClientTop       =   -45
   ClientWidth     =   8940
   Icon            =   "MDIFrmmain.frx":0000
   LinkTopic       =   "MDIForm1"
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   6180
      Width           =   8940
      _ExtentX        =   15769
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   5
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   9499
            Text            =   "Status:"
            TextSave        =   "Status:"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            Alignment       =   1
            Object.Width           =   1764
            MinWidth        =   1764
            TextSave        =   "2:53 PM"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            Alignment       =   1
            Object.Width           =   1764
            MinWidth        =   1764
            TextSave        =   "11/3/2000"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   1
            Alignment       =   1
            Enabled         =   0   'False
            Object.Width           =   1058
            MinWidth        =   1058
            TextSave        =   "CAPS"
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   2
            Alignment       =   1
            Enabled         =   0   'False
            Object.Width           =   1058
            MinWidth        =   1058
            TextSave        =   "NUM"
         EndProperty
      EndProperty
   End
   Begin VB.Menu menufile 
      Caption         =   "&File"
      Begin VB.Menu c 
         Caption         =   "-"
      End
      Begin VB.Menu menuselect 
         Caption         =   "Select Domain or Computer"
         Shortcut        =   {F12}
      End
      Begin VB.Menu menuline 
         Caption         =   "-"
      End
      Begin VB.Menu menuexit 
         Caption         =   "Exit"
         Shortcut        =   ^X
      End
      Begin VB.Menu d 
         Caption         =   "-"
      End
   End
   Begin VB.Menu menutools 
      Caption         =   "&Extra Tools"
      Begin VB.Menu a 
         Caption         =   "-"
      End
      Begin VB.Menu menuremotec 
         Caption         =   "Remote Command"
         Shortcut        =   {F1}
      End
      Begin VB.Menu menuservices 
         Caption         =   "Services"
         Shortcut        =   {F2}
      End
      Begin VB.Menu menuprocesses 
         Caption         =   "Processes"
         Shortcut        =   {F3}
      End
      Begin VB.Menu menushortcutmaker 
         Caption         =   "Shortcut Maker"
         Shortcut        =   {F4}
      End
      Begin VB.Menu menubulkshortcut 
         Caption         =   "Bulk Shortcut Maker"
         Shortcut        =   {F5}
      End
      Begin VB.Menu menuresolve 
         Caption         =   "Resolve a Host to a IP"
         Shortcut        =   {F6}
      End
      Begin VB.Menu menuping 
         Caption         =   "Ping a IP"
         Shortcut        =   {F7}
      End
      Begin VB.Menu menuinternetdomain 
         Caption         =   "Internet Domain Name Lookup"
         Shortcut        =   {F8}
      End
      Begin VB.Menu menureset 
         Caption         =   "Reset Users Password"
         Shortcut        =   {F9}
      End
      Begin VB.Menu menuprintstat 
         Caption         =   "Printer Status && Queue"
         Shortcut        =   {F11}
      End
      Begin VB.Menu menuusermig 
         Caption         =   "User Migration/Backup"
         Shortcut        =   ^{F1}
      End
      Begin VB.Menu b 
         Caption         =   "-"
      End
   End
   Begin VB.Menu menuhelp 
      Caption         =   "&Help"
      Begin VB.Menu z 
         Caption         =   "-"
      End
      Begin VB.Menu menuabout 
         Caption         =   "About"
         Shortcut        =   ^A
      End
      Begin VB.Menu menusupport 
         Caption         =   "Help"
         Shortcut        =   ^H
      End
      Begin VB.Menu menuweb 
         Caption         =   "Web Page"
         Shortcut        =   ^W
      End
      Begin VB.Menu x 
         Caption         =   "-"
      End
   End
End
Attribute VB_Name = "MDIFrmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub MDIForm_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
frmdomainlogin.Show
End SubPrivate Sub menuabout_Click()
frmAbout.Show
End SubPrivate Sub menubulkshortcut_Click()
frmbulkshortcut.Show
End SubPrivate Sub menuexit_Click()
End
End SubPrivate Sub menuinternetdomain_Click()
frminternetdomain.Show
End SubPrivate Sub menuping_Click()
frmping.Show
End SubPrivate Sub menuprintstat_Click()
frmprintstat.Show
End SubPrivate Sub menuprocesses_Click()
frmprocesses.Show
End SubPrivate Sub menuremotec_Click()
frmremotecommand.Show
End SubPrivate Sub menureset_Click()
ResetPwd.Show
End SubPrivate Sub menuresolve_Click()
frmresolve.Show
End SubPrivate Sub menuselect_Click()
frmdomainlogin.Show
End SubPrivate Sub menuservices_Click()
frmservices.Show
End SubPrivate Sub menushortcutmaker_Click()
frmshortcut.Show
End SubPrivate Sub menusupport_Click()
On Error Resume Next
Call ShellExecute(hwnd, "Open", App.path & "\Help\Help.htm", "", App.path, 1)
End SubPrivate Sub menuusermig_Click()
frmuserbackup.Show
End SubPrivate Sub menuweb_Click()
On Error Resume Next
Call ShellExecute(hwnd, "Open", "http://www.croftssoftware.com", "", App.path, 1)End Sub

Answer 18

frmuserprofile.frm(1)
------------------------------
VERSION 5.00
Begin VB.Form frmuserprofile 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Profile"
   ClientHeight    =   3375
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7710
   Icon            =   "frmuserprofile.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3375
   ScaleWidth      =   7710
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   4320
      Top             =   0
   End
   Begin VB.Frame Frame1 
      Caption         =   "User Profiles"
      Height          =   1215
      Left            =   0
      TabIndex        =   9
      Top             =   600
      Width           =   6375
      Begin VB.TextBox Text1 
         Height          =   285
         Left            =   1800
         TabIndex        =   11
         Top             =   360
         Width           =   4455
      End
      Begin VB.TextBox Text2 
         Height          =   285
         Left            =   1800
         TabIndex        =   10
         Top             =   840
         Width           =   4455
      End
      Begin VB.Label Label3 
         Caption         =   "User Profile Path:"
         Height          =   255
         Left            =   240
         TabIndex        =   13
         Top             =   360
         Width           =   1575
      End
      Begin VB.Label Label4 
         Caption         =   "Logon Scipt Name:"
         Height          =   255
         Left            =   240
         TabIndex        =   12
         Top             =   840
         Width           =   1455
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Save"
      Height          =   375
      Left            =   6480
      TabIndex        =   8
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   6480
      TabIndex        =   7
      Top             =   2880
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "Home Directory"
      Height          =   1335
      Left            =   0
      TabIndex        =   0
      Top             =   1920
      Width           =   6375
      Begin VB.OptionButton Option1 
         Caption         =   "Local Path:"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   360
         Value           =   -1  'True
         Width           =   1215
      End
      Begin VB.TextBox Text3 
         Height          =   285
         Left            =   1440
         TabIndex        =   4
         Top             =   360
         Width           =   4815
      End
      Begin VB.OptionButton Option2 
         Caption         =   "Connect"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   840
         Width           =   975
      End
      Begin VB.ComboBox Combo1 
         Height          =   315
         Left            =   1200
         TabIndex        =   2
         Top             =   840
         Width           =   615
      End
      Begin VB.TextBox Text4 
         Height          =   285
         Left            =   2280
         TabIndex        =   1
         Top             =   840
         Width           =   3975
      End
      Begin VB.Label Label5 
         Caption         =   "To"
         Height          =   255
         Left            =   1920
         TabIndex        =   6
         Top             =   840
         Width           =   255
      End
   End
   Begin VB.Label Label1 
      Caption         =   "User:"
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   0
      Width           =   495
   End
   Begin VB.Label Label2 
      Height          =   255
      Left            =   720
      TabIndex        =   14
      Top             =   0
      Width           =   2895
   End
End
Attribute VB_Name = "frmuserprofile"
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 = vbHourglass
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 userdomain As String
userdomain = frmdomainlogin.Combo1.Text
username = Label2.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 If

Answer 19

frmuserprofile.frm(2)
-------------------------------Dim newvalue As StringIf Text2.Text = "" Then
newvalue = ""
user.LoginScript = newvalue
user.SetInfo
Else
newvalue = Text2.Text
user.LoginScript = newvalue
user.SetInfo
End IfIf Text1.Text = "" Then
newvalue = ""
user.Profile = newvalue
user.SetInfo
Else
newvalue = Text1.Text
user.Profile = newvalue
user.SetInfo
End IfIf Option1.Value = True Then
    If Text3.Text = "" Then
    newvalue = ""
    Call user.Put("HomeDirDrive", "")
    user.HomeDirectory = newvalue
    user.SetInfo
    Else
    newvalue = Text3.Text
    Call user.Put("HomeDirDrive", "")
    user.HomeDirectory = newvalue
    user.SetInfo
    End If
    Else
    End IfIf Option2.Value = True Then
    newvalue2 = Combo1.Text
    Call user.Put("HomeDirDrive", newvalue2)
    user.HomeDirectory = Text4.Text
    user.SetInfo
    Else
    End If
    Err = 0
MousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
End SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Form_Load()
Combo1.AddItem "D:"
Combo1.AddItem "E:"
Combo1.AddItem "F:"
Combo1.AddItem "G:"
Combo1.AddItem "H:"
Combo1.AddItem "I:"
Combo1.AddItem "J:"
Combo1.AddItem "K:"
Combo1.AddItem "L:"
Combo1.AddItem "M:"
Combo1.AddItem "N:"
Combo1.AddItem "O:"
Combo1.AddItem "P:"
Combo1.AddItem "Q:"
Combo1.AddItem "R:"
Combo1.AddItem "S:"
Combo1.AddItem "T:"
Combo1.AddItem "U:"
Combo1.AddItem "V:"
Combo1.AddItem "W:"
Combo1.AddItem "X:"
Combo1.AddItem "Y:"
Combo1.AddItem "Z:"
End SubPrivate Sub Timer2_Timer()
On Error Resume Next
MousePointer = vbHourglass
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 userdomain As String
userdomain = frmdomainlogin.Combo1.Text
username = Label2.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 retval As String
retval = user.LoginScript
Text2.Text = retval
DoEventsretval = user.Profile
Text1.Text = retval
DoEventsretval = user.Get("homedirdrive")
Combo1.Text = retvalIf Combo1.Text = "" Then
retval = user.HomeDirectory
Text3.Text = retval
Else
retval = user.HomeDirectory
Text4.Text = retval
End IfMousePointer = 0
MDIFrmmain.StatusBar1.Panels(1).Text = "Status:"
Timer2.Enabled = False
End Sub

Answer 20

http://www.csdn.net/expert/topic/548/548353.xml
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
全部发完，谢谢大家！！

Answer 21

请到
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=23594&lngWId=1
查找CS_tools
即可以下载此源代码！！

Answer 22

下载后，一运行，frmuserdata.frm就报错：
Private 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 Sub
中，说这句：
Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
编译错误：
过程声明与同名事件或过程的描述不匹配怎么回事？？？？？

Answer 23

回复人： Richard2001(Richard) 
要在NT或2000中运行！！