Visual Basic Q&A

Symptoms
In many applications there is a function to search and highlight keywordsin a text window. The RichTextBox control in Visual Basic can be madeto provide this functionality, as shown in the sample code below.
Resolution
Start a new project in Visual Basic. Form1 is created by default.Place a Command button and a RichTextBox on Form1. Set the Text propertyof the RichTextBox to “This is an example of finding text in a richtext box.”Add the following code to the General Declarations section of Form1:

Option ExplicitPrivate Sub Command1_Click()HighlightWords RichTextBox1, “text”, vbRedEnd SubPrivate Function HighlightWords(rtb As RichTextBox, _sFindString As String, _lColor As Long) _As IntegerDim lFoundPos As Long’Position of first character’of matchDim lFindLength As Long’Length of string to findDim lOriginalSelStart As LongDim lOriginalSelLength As LongDim iMatchCount As Integer’Number of matches’Save the insertion points current location and lengthlOriginalSelStart = rtb.SelStartlOriginalSelLength = rtb.SelLength’Cache the length of the string to findlFindLength = Len(sFindString)’Attempt to find the first matchlFoundPos = rtb.Find(sFindString, 0, , rtfNoHighlight)While lFoundPos > 0iMatchCount = iMatchCount + 1rtb.SelStart = lFoundPos’The SelLength property is set to 0 as’soon as you change SelStartrtb.SelLength = lFindLengthrtb.SelColor = lColor’Attempt to find the next matchlFoundPos = rtb.Find(sFindString, _lFoundPos + lFindLength, , rtfNoHighlight)Wend’Restore the insertion point to its original’location and lengthrtb.SelStart = lOriginalSelStartrtb.SelLength = lOriginalSelLength’Return the number of matchesHighlightWords = iMatchCountEnd Function Choose Start from the Run menu, or press the F5 key to start theproject. Click the Command button and you should see that bothoccurrences of the word “text” are now shown in red.

Symptoms
If you run commands or call methods of the SqlCommand or OleDbCommand object, you receive the following error message if a connection is not open:

An unhandled exception of type ‘System.InvalidOperationException’ occurred in system.data.dll
Additional information: ExecuteReader requires an open and available Connection (state=Closed).
Resolution
The DataAdapter object does not require that you explicitly open a connection to run some of its methods. Therefore, you can call the Update or Fill method of the DataAdapter object when the connection is closed. The Connection object that is associated with the SELECT statement must be valid, but it does not need to be open. If you close the connection before you call Fill, the connection is opened to retrieve the data and then closed. If the connection is open before you call Fill, it remains open.
Steps to Reproduce the BehaviorStart Microsoft Visual Studio .NET.Create a new Windows Application project in Visual Basic .NET. Form1 is added to the project by default.Make sure that your project contains a reference to the System.Data namespace, and add a reference to this namespace if it does not.Place two Button controls and one DataGrid control on Form1. Button1, Button2, and DataGrid1 are created by default.Change the Name property of Button1 to btnDataAdapter and the Text property to DataAdapter.
Change the Name property of Button2 to btnCommand and the Text property to Command.Use the Imports statement on the System and System.Data namespaces so that you are not required to qualify declarations in those namespaces later in your code. Add the following code to the “General Declarations” section of Form1:

Imports SystemImports System.Data.OleDbImports System.Data.SqlClient In the Code window, copy and paste the following code after the “Windows Form Designer generated code” region:

Private Sub btnDataAdapter(ByVal sender As System.Object, _ByVal e As System.EventArgs) Handles btnDataAdapter.ClickDim myConnString As String = _”User ID=sa;password=sa;Initial Catalog=Northwind;Data Source=myServer”Dim mySelectQuery As String = _”Select * From Customers Where CustomerID Like ‘A%’”Dim con As New SqlConnection(myConnString)’The code works fine even if you comment out the next line (to open the connection).con.Open()Dim daCust As New SqlDataAdapter(mySelectQuery, con)Dim ds As New DataSet()daCust.Fill(ds, “Cust”)DataGrid1.DataSource = dsDataGrid1.DataMember = “Cust”End SubPrivate Sub btnCommand(ByVal sender As System.Object, _ByVal e As System.EventArgs) Handles btnCommand.ClickDim myConnString As String = _”User ID=sa;password=sa;Initial Catalog=Northwind;Data Source=myServer”Dim mySelectQuery As String = _”Select * From Customers Where CustomerID Like ‘A%’”Dim con As New SqlConnection(myConnString)Dim myCommand As New SqlCommand(mySelectQuery, con)’An exception is thrown if you comment out the next line (to open the connection).con.Open()Dim myReader As SqlDataReader = myCommand.ExecuteReader()While myReader.Read()’Process data.End WhilemyReader.Close()con.Close()End Sub Modify the connection string (myConnString) as appropriate for your environment.Save your project. On the Debug menu, click Start to run your project.Comment out the line of code that opens the connection. Notice that DataAdapter.Fill works as expected, but Command.ExecuteReader fails with the above-mentioned exception.

Symptoms
You may use ADOMD with the MSOLAP provider to return an Out of Process Cellset. This is useful with DCOM/MTS business objects. This code sample requires the MSOLAP OLEDB provider on the client computer and the Food Mart OLAP database on SQL Server OLAP Services computer. The MSOLAP OLEDB provider is installed when you install OLAP client components from SQL Server 7.0 CD.
Resolution
ServerSteps to AccomplishCreate a new Visual Basic ActiveX EXE Project. Class 1 is created by default.Set a Project Reference to the Microsoft ActiveX Data Objects (Multi-Dimensional) 1.0 Object Library.Change the name of the Project to ADOBusObj.Paste the following code into Class1:

Private strSQL As StringPrivate strConnect As StringDim adoCat As New ADOMD.CatalogPublic Function GetRs() As ADOMD.CellSetDim adoCst As New ADOMD.CellSetWith adoCstSet adoCst.ActiveConnection = adoCat.ActiveConnection.Source = strSQL.OpenEnd WithSet GetRs = adoCstEnd FunctionPrivate Property Get ConnectStr() As StringConnectStr = strConnectEnd PropertyPrivate Property Let ConnectStr(strCn As String)strConnect = strCnEnd PropertyPublic Property Get SQL() As StringSQL = strSQLEnd PropertyPublic Property Let SQL(nSQL As String)strSQL = nSQLEnd PropertyPublic Sub ADOMDConnect(strConnect As String, Optional CmdTimeOut As Integer = 20)adoCat.ActiveConnection = strConnectConnectStr = adoCnEnd Sub
ClientCreate a new Visual Basic Standard EXE Project. Form1 is created by default.Set a Project Reference to the Microsoft ActiveX Data Objects (version 2.0 or later) Library.Set a Project Reference to the ActiveX EXE ADOBusObj created earlier. Change the connection string and the SQL string to reflect your OLAP server’s configuration.Paste the following code into the General Declarations section of Form1:
NOTE: A cube query (MDX query) has the following layout that defines the number of Axes in the query. The count of the fields referenced between SELECT and FROM in the MDX statement are the number of Axes in the query.

SELECT <axis_specification> [, <axis_specification>...] FROM <cube_specification>WHERE <slicer_specification>

Option ExplicitConst strConnect = “Data Source=<DataSource>;PROVIDER=MSOLAP;INITIAL CATALOG=FoodMart”Private Sub Form_Click()On Error GoTo ErrorHandlerDim adoCst As ADOMD.CellsetDim objAdoData As ADOBusObj.Class1Dim strOutput As StringDim intStrLen As IntegerDim intDC0 As IntegerDim intDC1 As IntegerDim intPC0 As IntegerDim intPC1 As IntegerDim i As IntegerDim j As IntegerDim k As IntegerSet objAdoData = CreateObject(“ADOBusObj.Class1″)With objAdoData.SQL = “Select {[Measures].members} On Columns,” & _”Non Empty [Store].[Store City].members ” & _”Properties [Store].[Store Type], [Store].[Store Manager] ” & _”On Rows From Sales”.ADOMDConnect strConnect, 20 ‘Establish connection.End With’Return the Cellset from MD Data Object.Set adoCst = objAdoData.GetRs’it is known up front there are two axes for this query so,’just check each axis for number of dimensions.intDC0 = adoCst.Axes(0).DimensionCount – 1intDC1 = adoCst.Axes(1).DimensionCount – 1intPC0 = adoCst.Axes(0).Positions.Count – 1intPC1 = adoCst.Axes(1).Positions.Count – 1For i = 0 To intDC0For j = 0 To intPC0intStrLen = Len(adoCst.Axes(0).Positions(j).Members(i).Caption)If intStrLen > 15 Then intStrLen = 0strOutput = strOutput & “[" & adoCst.Axes(0).Positions(j).Members(i).Caption & "]” & _String(3, vbTab) & Space(15 – intStrLen)Next jNext iDebug.Print strOutput & vbCrLfFor i = 0 To intPC1strOutput = “”For j = 0 To intDC1Debug.Print “– ” & adoCst.Axes(1).Positions(i).Members(j).Caption & ” –”Next jFor k = 0 To intPC0intStrLen = Len(adoCst(k, i).FormattedValue)If intStrLen > 15 Then intStrLen = 0strOutput = strOutput & adoCst(k, i).FormattedValue & _Space(15 – intStrLen) & String(4, vbTab)Next kDebug.Print strOutputNext iMsgBox “Success”, vbOKOnly, “MD Data Object”Exit SubErrorHandler:MsgBox “Change Failed:” & vbCrLf & _Err.Number & _vbCrLf & Err.Description, _vbOKOnly, “Data Object”Exit SubEnd Sub

Symptoms
With Microsoft Visual Basic versions 4.0, 5.0, and 6.0 for Windows, you canspecify your ODBC (Open Database Connectivity) driver and server in yourconnect string when using RDO (Remote Data Object) and DAO (Data AccessObjects) which eliminates the need to set up a DSN (Data Source Name). Wecall this a “DSN- Less” ODBC connection because you do not need to set up aDSN in order to access your ODBC database server.
To do this, you specify a “driver=” and “server=” parameter in your connectstring as in the following example.
Note You must change Username= <username> and PWD =<strong password> to the correct values before you run this code. Make sure that Username has the appropriate permissions to perform this operation on the database.

cnstr = “driver={SQL Server};server=myserver;” & _”database=mydb;Username=<username>;PWD=<strong password>;dsn=;”Set cn = en.OpenConnection(“”, False, False, cnstr)
NOTE: The driver name must be surrounded by curly brackets. For example:”{SQL Server}.”
(CAUTION: DSN-Less connections will not work in Visual Basic 4.0 16-bit. Ifyou try to use them you will get a General Protection Fault in moduleODBC.DLL at 0006:080F.)
Resolution
In Microsoft Visual Basic version 3.0 for Windows, you had to create a DSNthat added an extra step when distributing your application because eachworkstation had to have the DSN created in order to access the specifiedserver and database. This was done either manually with the ODBC Adminutility, through code with the RegisterDatabase function, or through codewith the SQLConfigDatasource API function. For additional information onhow to do this setup manually, please see the following articles in theMicrosoft Knowledge Base:
123008?(http://support.microsoft.com/kb/123008/EN-US/)TITLE: How to Set Up ODBC Data Sources When Distributing an App
126940?(http://support.microsoft.com/kb/126940/EN-US/): RegisterDatabase Fails After ODBC Version 2.x Installed
132329?(http://support.microsoft.com/kb/132329/EN-US/): RegisterDatabase Method Does Not Modify ODBC.INI File
Sample ProgramThe following RDO example uses a “DSN-less” ODBC connection so you do notneed to set up a DSN with the ODBC Admin utility beforehand.
Start a new project in Visual Basic. Form1 is created by default.Add a command button to Form1, Command1 by default.Paste the following code into the General Declarations section of Form1.
Note You must change Username= <username> and PWD =<strong password> to the correct values before you run this code. Make sure that Username has the appropriate permissions to perform this operation on the database.

Dim en As rdoEnvironmentDim cn As rdoConnectionPrivate Sub Form_Load()MousePointer = vbHourglassDim strConnect As String’ Change the next line to reflect your driver and server.strConnect = “driver={SQL Server};server=jonfo5;” & _”database=pubs;Username=<username>;PWD=<strong password>;”Set en = rdoEngine.rdoEnvironments(0)Set cn = en.OpenConnection( _dsName:=”", _Prompt:=rdDriverNoPrompt, _ReadOnly:=False, _Connect:=strConnect)cn.QueryTimeout = 600MousePointer = vbNormalEnd SubPrivate Sub Command1_Click()MousePointer = vbHourglassDim rs As rdoResultsetSet rs = cn.OpenResultset(Name:=”Select * from authors”, _Type:=rdOpenForwardOnly, _LockType:=rdConcurReadOnly, _Options:=rdExecDirect)Debug.Print rs(0), rs(1), rs(2)MousePointer = vbNormalEnd Sub Note that you must change your DRIVER, SERVER, DATABASE, UID, and PWDparameters in the OpenConnection method. You also need to modify the SQLstatement contained in the Command1_Click event to match your own SQLdata source.Check the Microsoft Remote Data Object in the Project References.Start the program or press the F5 key.Click the Command1 button to create a rdoResultset and display the firstrow of data in the debug window.

Symptoms
There are important issues to consider when attempting to retrieveRAISERROR/PRINT/RETURN values from SQL Server stored procedures throughActiveX Data Objects (ADO). Here are three issues:RAISERROR statements in SQL Server must be a severity level of 11-18.PRINT statements in SQL Server can also populate the ADO errorscollection. However, PRINT statements are severity level zero (0) so, atleast one RAISERROR statement is required in the stored procedure toretrieve a PRINT statement with ADO through the Errors collection.RETURN values in a stored procedure must be associated with at least oneresultset.
Resolution
The following code sample demonstrates browsing the ADO Errors collectionto access the RAISERROR/PRINT/RETURN detail from a SQL Server storedprocedure returning multiple resultsets:Paste and execute the following code in the ISQL_W window to create thestored procedure used for the ADO sample in step 4:

use pubsGOif exists (select * from sysobjects where id =object_id(‘dbo.ADOTestRPE’) and sysstat & 0xf = 4)drop procedure dbo.ADOTestRPEGOcreate procedure ADOTestRPE(@SetRtnINT=0 OUTPUT,@R1NumINT=1,@P1NumINT=1,@E1NumINT=1,@R2NumINT=2,@P2NumINT=2,@E2NumINT=2)ASDECLARE @iLoopINTDECLARE @PrintText VARCHAR(255)DECLARE @iErrNumINT/*Check for no Resultsets – needed to get the RETURN value back */IF @R1Num + @R2Num = 0 SELECT NULL/*Resultset 1******************************* */IF @R1Num > 0BEGINSET ROWCOUNT @R1NumSELECT ‘Resultset 1′ RsNum, TitleFROM Pubs..TitlesSET ROWCOUNT 0END/* Must raise a default error context in which to return the PRINT *//*statement *//* (if none present) since PRINT statements are a severity level of *//*0. */IF (@P1Num > 0) AND (@E1Num = 0) RAISERROR (“RAISERROR.PError1″,11, 2)IF @P1Num > 0BEGINSELECT @iLoop = 0WHILE @iLoop < @P1NumBEGINSELECT @iLoop = @iLoop + 1SELECT @PrintText = ‘PRINT.Resultset.1: Line ‘ +CONVERT(char(2), @iLoop)PRINT @PrintTextENDENDIF @E1Num > 0BEGINSELECT @iLoop = 0WHILE @iLoop < @E1NumBEGINSELECT @iLoop = @iLoop + 1SELECT @iErrNum = @iLoop + 201000RAISERROR (“RAISERROR.Resultset.1″, 11, 2)ENDEND/*Resultset 2******************************* */IF @R2Num > 0BEGINSET ROWCOUNT @R2NumSELECT ‘Resultset 2′ RsNum, TitleFROM Pubs..TitlesSET ROWCOUNT 0END/* Must raise a default error context in which to return the PRINT *//*statement *//* (if none present) since PRINT statements are a severity level of *//*0. */IF (@P2Num > 0) AND (@E2Num = 0) RAISERROR (“RAISERROR.PError2″,11, 2)IF @P2Num > 0BEGINSELECT @iLoop = 0WHILE @iLoop < @P2NumBEGINSELECT @iLoop = @iLoop + 1SELECT @PrintText = ‘PRINT.Resultset.2: Line ‘ +CONVERT(char(2), @iLoop)PRINT @PrintTextENDENDIF @E2Num > 0BEGINSELECT @iLoop = 0WHILE @iLoop < @E2NumBEGINSELECT @iLoop = @iLoop + 1SELECT @iErrNum = @iLoop + 202000RAISERROR (“RAISERROR.Resultset.2″, 11, 2)ENDEND/*Return & Output ************************************ */select @SetRtn = -1RETURN @SetRtnGO Create a Standard .EXE project in Visual Basic. Form1 is created bydefault.From the Project menu, choose References and select the MicrosoftActiveX Data Objects Library.NOTE: You must use ADO version 2.0 or later for the code to work correctly. You can obtain the latest Microsoft Data Access Components (MDAC) components on the Web at the following URL:
http://msdn.microsoft.com/en-us/data/aa937729.aspx(http://msdn.microsoft.com/en-us/data/aa937729.aspx)Place a Command button on the Form, and then paste the following code inthe General Declarations section of the Form:NOTE: You may need to change the database connect string for yourenvironment.

‘This Code demonstrates RAISERROR/PRINT/RETURN values with ADO and’multiple resultsets.Sub CreateParms()Dim ADOCmd As New ADODB.CommandDim ADOPrm As New ADODB.ParameterDim ADOCon As ADODB.ConnectionDim ADORs As ADODB.RecordsetDim sParmName As StringDim strConnect As StringDim rStr As StringOn Error GoTo ErrHandlerstrConnect = “driver={SQLServer};server=(local);uid=sa;pwd=;database=pubs”Set ADOCon = New ADODB.ConnectionWith ADOCon.Provider = “MSDASQL”.CursorLocation = adUseServer’Must use Server side cursor..ConnectionString = strConnect.OpenEnd WithSet ADOCmd.ActiveConnection = ADOConWith ADOCmd.CommandType = adCmdStoredProc.CommandText = “ADOTestRPE”End With’Parameter 0 is the stored procedure Return code.sParmName = “Return”Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamReturnValue, , 0)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = -1′Parameter 1 is the setting for the stored procedure Output’ parameter.sParmName = “Output”Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamOutput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 999′Parameter 2sParmName = “R1Num”‘Number of rows to return in Resultset 1.Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamInput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 1′Parameter 3sParmName = “P1Num”‘Number of PRINT statements in Resultset 1.Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamInput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 0′Parameter 4sParmName = “E1Num”‘Number of RAISERROR statements in Resultset’1.Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamInput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 0′Parameter 5sParmName = “R2Num”‘Number of rows to return in Resultset 2.Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamInput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 2′Parameter 6sParmName = “P2Num”‘Number of PRINT statements in Resultset 2.Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamInput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 0′Parameter 7sParmName = “E2Num”‘Number of RAISERROR statements in Resultset’ 2.Set ADOPrm = ADOCmd.CreateParameter(sParmName, adInteger, _adParamInput)ADOCmd.Parameters.Append ADOPrmADOCmd.Parameters(sParmName).Value = 0Set ADORs = ADOCmd.ExecuteDo While (Not ADORs Is Nothing)If ADORs.State = adStateClosed Then Exit DoWhile Not ADORs.EOFFor i = 0 To ADORs.Fields.Count – 1rStr = rStr & ” : ” & ADORs(i)Next iDebug.Print Mid(rStr, 3, Len(rStr))ADORs.MoveNextrStr = “”WendDebug.Print “———————-”Set ADORs = ADORs.NextRecordsetLoopDebug.Print “Return: ” & ADOCmd.Parameters(“Return”).ValueDebug.Print “Output: ” & ADOCmd.Parameters(“Output”).ValueGoTo ShutdownErrHandler:Call ErrHandler(ADOCon)Resume NextShutdown:Set ADOCmd = NothingSet ADOPrm = NothingSet ADORs = NothingSet ADOCon = NothingEnd SubPrivate Sub Command1_Click()Call CreateParmsEnd SubSub ErrHandler(objCon As Object)Dim ADOErr As ADODB.ErrorDim strError As StringFor Each ADOErr In objCon.ErrorsstrError = “Error #” & ADOErr.Number & vbCrLf & ADOErr.Description _& vbCr & _”(Source: ” & ADOErr.Source & “)” & vbCr & _”(SQL State: ” & ADOErr.SQLState & “)” & vbCr & _”(NativeError: ” & ADOErr.NativeError & “)” & vbCrIf ADOErr.HelpFile = “” ThenstrError = strError & “No Help file available” & vbCr & vbCrElsestrError = strError & “(HelpFile: ” & ADOErr.HelpFile & “)” _& vbCr & _”(HelpContext: ” & ADOErr.HelpContext & “)” & _vbCr & vbCrEnd IfDebug.Print strErrorNextobjCon.Errors.ClearEnd Sub Change the value of parameters two through seven to alter the number ofPRINT statements and/or RAISERROR statements generated by the storedprocedure and returned through ADO. Run the Visual Basic code sampleagain and note that the RAISERROR and PRINT statements are returnedthrough the ADO errors collection. Change the values to experiment withdifferent combinations of PRINT/RAISERROR statements with differentresultsets. Please refer to the SQL stored procedures for specificworkarounds for special cases.
NOTE: To retrieve a RETURN value in ADO with a stored procedure theremust be at least one resultset. In order to work around this problem,when no resultsets are specified (in the ADO sample code) the storedprocedure executes a SELECT NULL to return a null resultset to ADOthereby populating the RETURN value. In addition, to work around theissue of specifying no RAISERROR statements and a combination of PRINTstatements, default RAISERROR statements are generated in order toprovide a context for returning the PRINT statement via ADO. You mustcode RAISERROR statements in the format shown in the stored procedurebecause only severity levels of 11-18 return through the ADO errorscollection.

Symptoms
This article describes how to use the RegLoadKey registry function to load a user profile into the registry and, subsequently, how to use RegUnLoadKey to unload the user profile. Because RegLoadKey requires the SE_RESTORE_NAME privilege to be successful, this article also uses the OpenProcessToken, LookupPrivilegeValue, and AdjustTokenPrivileges functions.
Resolution
In part, the registry consists of files that store information about a user profile. When this file is loaded, it maps to the HKEY_USERS or HKEY_LOCAL_MACHINE key, whichever is specified in the call to RegLoadKey.
To retrieve user profile-specific information, you can load the NtUser.dat file that is located in the profile path of the user profile that you want to load. It may be necessary to load a hive (user profile) when you try to provide profile-specific data. For example, either the ImpersonateLoggedOnUser function or the CreateProcessAsUser function is generally used to run under a different security context and does not load the profile of that user.
The following steps illustrate how to load NtUser.dat and unload it when finished. These methods are not a threat to security because they only succeed if the calling process and the impersonated user have sufficient privileges.
Step-by-Step ExampleWARNING: If you use Registry Editor incorrectly, you may cause serious problems that may require you to reinstall your operating system. Microsoft cannot guarantee that you can solve problems that result from using Registry Editor incorrectly. Use Registry Editor at your own risk.
Create a new Standard EXE project in Visual Basic. Form1 is created by default.Add a TextBox control (Text1) and two CommandButton controls (Command1 and Command2) to Form1.Paste the following code into the General Declarations section of Form1:

Option ExplicitPrivate Type LUIDLowPart As LongHighPart As LongEnd TypePrivate Type LUID_AND_ATTRIBUTESpLuid As LUIDAttributes As LongEnd TypePrivate Type TOKEN_PRIVILEGESPrivilegeCount As LongPrivileges(1) As LUID_AND_ATTRIBUTESEnd TypePrivate Const TOKEN_ADJUST_PRIVLEGES = &H20Private Const TOKEN_QUERY = &H8Private Const SE_PRIVILEGE_ENABLED = &H2Private Const HKEY_USERS = &H80000003Private Const SE_RESTORE_NAME = “SeRestorePrivilege”Private Const SE_BACKUP_NAME = “SeBackupPrivilege”Private Declare Function GetCurrentProcess Lib “kernel32″ () As LongPrivate Declare Function OpenProcessToken Lib “advapi32.dll” _(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _TokenHandle As Long) As LongPrivate Declare Function LookupPrivilegeValue Lib “advapi32.dll” Alias _”LookupPrivilegeValueA” (ByVal lpSystemName As String, _ByVal lpName As String, lpLuid As LUID) As LongPrivate Declare Function AdjustTokenPrivileges Lib “advapi32.dll” _(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _ByVal PreviousState As Long, ByVal ReturnLength As Long) As LongPrivate Declare Function RegLoadKey Lib “advapi32.dll” Alias “RegLoadKeyA” _(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As String) _As LongPrivate Declare Function RegUnLoadKey Lib “advapi32.dll” Alias “RegUnLoadKeyA” _(ByVal hKey As Long, ByVal lpSubKey As String) As LongPrivate Retval As LongPrivate strKeyName As StringPrivate MyToken As LongPrivate TP As TOKEN_PRIVILEGESPrivate RestoreLuid As LUIDPrivate BackupLuid As LUIDPrivate Sub Form_Load()strKeyName = “keyLoaded”‘ Path to file on Windows NT: C:\WinNT\Profiles\<Profile Name>\NtUser.Dat’ Path to file on Windows 2000: C:\Documents and Settings\<Profile Name>\NtUser.DatText1.Text = “<Path to File>”Command2.Enabled = FalseRetval = OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVLEGES _Or TOKEN_QUERY, MyToken)If Retval = 0 Then MsgBox “OpenProcess: ” & Err.LastDllErrorRetval = LookupPrivilegeValue(vbNullString, SE_RESTORE_NAME, _RestoreLuid)If Retval = 0 Then MsgBox “LookupPrivileges: ” & Err.LastDllErrorRetval = LookupPrivilegeValue(vbNullString, SE_BACKUP_NAME, BackupLuid)If Retval = 0 Then MsgBox “LookupPrivileges: ” & RetvalTP.PrivilegeCount = 2TP.Privileges(0).pLuid = RestoreLuidTP.Privileges(0).Attributes = SE_PRIVILEGE_ENABLEDTP.Privileges(1).pLuid = BackupLuidTP.Privileges(1).Attributes = SE_PRIVILEGE_ENABLEDRetval = AdjustTokenPrivileges(MyToken, vbFalse, TP, Len(TP), 0&, 0&)If Retval = 0 Then MsgBox “AdjustTokenPrivileges: ” & Err.LastDllErrorEnd SubPrivate Sub Command1_Click()Retval = RegLoadKey(HKEY_USERS, strKeyName, Text1.Text)If Retval <> 0 Then MsgBox “RegLoadKey: ” & RetvalCommand2.Enabled = TrueEnd SubPrivate Sub Command2_Click()Retval = RegUnLoadKey(HKEY_USERS, strKeyName)If Retval <> 0 Then MsgBox “RegUnloadKey: ” & RetvalEnd SubPrivate Sub Form_Unload(Cancel As Integer)Retval = AdjustTokenPrivileges(MyToken, vbTrue, TP, Len(TP), 0&, 0&)If Retval = 0 Then MsgBox “AdjustTokenPrivileges: ” & Err.LastDllErrorEnd Sub Save the project, and then press the F5 key to run it.Type the path to a specific user profile .dat file, for example:
C:\WinNT\Profiles\Administrator\NtUser.dat and then click Command1.Click Start, click Run, type regedit (on Windows NT) or regedt32 (on Windows 2000), and then click OK.Locate the HKEY_USERS subtree. Notice that this subtree includes the new key, KeyLoaded.In the Visual Basic project, click Command2 to remove this key from the registry.