Visual Basic Q&A

As a software engineer, I focus on .NET, especially asp.net, C#, WCF and so on, and I am also very interested in Search Engine Optimization.

Entries Tagged ‘declarations section’

How To Find and Highlight Text in the RichTextBox Control

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.

Error message occurs when you run commands on a command object: “Unhandled exception of type ‘System.InvalidOperationException’”

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.

How To Use ADOX to Create an OLE Object Field in an Access Database

Symptoms
This article describes how to use ActiveX Data Objects Extensibility (ADOX) to create an OLE Object field in a Microsoft Access Database (.mdb file). You must use the adLongVarBinary constant to create the field. You do not have to specify a field size in the field definition.
Resolution
Step-by-Step ExampleCreate a new Standard EXE project in Visual Basic. Form1 is created by default.From the Project menu, click References. From the list of available components, click Microsoft ADO Ext. 2.1 for DDL and Security.Add a CommandButton control to Form1.Paste the following code onto the Declarations section of Form1:

Private Sub Command2_Click()Set cat = New ADOX.CatalogSet tbl = New ADOX.Tablecat.ActiveConnection = _”Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\nwind2.mdb;”tbl.Name = “OleObjTable”tbl.Columns.Append “Column1″, adIntegertbl.Columns.Append “Column2″, adIntegertbl.Columns.Append “Column3″, adVarWChar, 50′ Please note adLongVarBinary = 205tbl.Columns.Append “MyOleObject”, adLongVarBinarycat.Tables.Append tblEnd Sub Modify the cat.ActiveConnection assignment to point to a valid Microsoft Access Database file.Run the project, and click Command1. Notice that a table named OleObjTable is created in the database. When you view the table in Design Mode, the Column3 field definition is displayed as OLE Object.

How To Use ADOMD to Return Out of Process Cellset

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

How To Retrieve Bitmap from Access and Display It in Web Page

Symptoms
This article shows by example how to extract the bitmap photos in theMicrosoft Access 97 Nwind.mdb database, and view them from a Webbrowser using Active Server Pages (ASP). In order to accomplish this task,an ActiveX DLL must be created that strips the Access and OLE headers fromthe field. This article shows how to create this ActiveX DLL, and how toimplement it.
Resolution
WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWNRISK. Microsoft provides this code “as is” without warranty of any kind,either express or implied, including but not limited to the impliedwarranties of merchantability and/or fitness for a particular purpose.
This article demonstrates how to use Visual Basic to retrieve a bitmapstored in an OLE Object field. Because the definition of OLE object storageis not documented, the following code searches the object’s OLE header forcharacters consistent with the start of the graphic. This method may notwork in all circumstances.
Be aware that Internet Explorer 3.0 is unable to display true colorbitmaps. For this reason, the bitmaps stored in the Access database shouldbe no higher than 256 colors.
Step-by-Step Example to Extract the PhotosCreate a new project in Visual Basic and make the project an ActiveXDLL.Add a reference to ActiveX Data Objects (ADO) by clicking the Projectmenu and selecting References. Select “Microsoft OLE DB ActiveX DataObjects 1.0 Library” and click OK.Add a new module to the project by selecting the Project menu andclicking Add Module. Select Module and click Open.Place the following code in the (general) (declarations) section ofMODULE1.BAS:

‘ Enter the following Declare statement as one single line:Public Declare Sub CopyMemory Lib “kernel32″ Alias “RtlMoveMemory”(lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)Type PTWidth As IntegerHeight As IntegerEnd TypeType OBJECTHEADERSignature As IntegerHeaderSize As IntegerObjectType As LongNameLen As IntegerClassLen As IntegerNameOffset As IntegerClassOFfset As IntegerObjectSize As PTOleInfo As String * 256End Type Place the following code in the (general) (declarations) section ofCLASS1.CLS:

Function DisplayBitmap(ByVal OleField As Variant)Dim Arr() As ByteDim ObjHeader As OBJECTHEADERDim Buffer As StringDim ObjectOffset As LongDim BitmapOffset As LongDim BitmapHeaderOffset As IntegerDim ArrBmp() As ByteDim i As Long’Resize the array, then fill it with’the entire contents of the fieldReDim Arr(OleField.ActualSize)Arr() = OleField.GetChunk(OleField.ActualSize)’Copy the first 19 bytes into a variable’of the OBJECTHEADER user defined type.CopyMemory ObjHeader, Arr(0), 19′Determine where the Access Header ends.ObjectOffset = ObjHeader.HeaderSize + 1′Grab enough bytes after the OLE header to get the bitmap header.Buffer = “”For i = ObjectOffset To ObjectOffset + 512Buffer = Buffer & Chr(Arr(i))Next i’Make sure the class of the object is a Paint Brush objectIf Mid(Buffer, 12, 6) = “PBrush” ThenBitmapHeaderOffset = InStr(Buffer, “BM”)If BitmapHeaderOffset > 0 Then’Calculate the beginning of the bitmapBitmapOffset = ObjectOffset + BitmapHeaderOffset – 1′Move the bitmap into its own arrayReDim ArrBmp(UBound(Arr) – BitmapOffset)CopyMemory ArrBmp(0), Arr(BitmapOffset), UBound(Arr) -BitmapOffset + 1′Return the bitmapDisplayBitmap = ArrBmpEnd IfEnd IfEnd Function Rename the Project by selecting the Project menu, and clicking on”Project1 Properties” and type your new name in the “Project Name”field. This example assumes that you named the project “MyProject” andwill refer to that name in future steps.Select the”Unattended Execution” check box. Click OK.Rename the Class in the Property Pane. This example assumes that younamed the class “MyClass” and refers to that name in future steps.Compile the DLL by clicking the File menu and selecting “MakeMyProject.dll.”Create an ASP page named “bitmap.asp” that contains thefollowing code:

<%@ LANGUAGE=”VBSCRIPT” %><%’You need to set up a System DSN named ‘NWind’ that points to’the Northwind.mdb databaseSet DataConn = Server.CreateObject(“ADODB.Connection”)DataConn.Open “DSN=NWind”, “admin”, “”Set cmdTemp = Server.CreateObject(“ADODB.Command”)Set RS = Server.CreateObject(“ADODB.Recordset”)cmdTemp.CommandText = “SELECT Photo FROM EmployeesWHERE EmployeeID = 1″cmdTemp.CommandType = 1Set cmdTemp.ActiveConnection = DataConnRS.Open cmdTemp, , 0, 1Response.ContentType = “image/bmp”Set Bitmap = Server.CreateObject(“MyProject.MyClass”)Response.BinaryWrite Bitmap.DisplayBitmap(RS(“Photo”))RS.Close%> Create an HTML page named “BitmapTest.htm” that containsthe following code:

<HTML><HEAD><TITLE>Bitmap Test</TITLE></HEAD><BODY><HR><img src=”Bitmap.asp”><HR></BODY></HTML>

How To Load and Unload a User Profile into the Registry with Visual Basic

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.