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 ‘amp’

INFO: Jet OLE DB Provider Version 4.0 Supports SELECT @@Identity

Symptoms
The Jet OLE DB version 4.0 provider supports the SELECT @@Identity query that allows you to retrieve the value of the auto-increment field generated on your connection. Auto-increment values used on other connections to your database do not affect the results of this specialized query. This feature works with Jet 4.0 databases but not with older formats.
Resolution
The following code demonstrates using the SELECT @@Identity to retrieve the value of the newly inserted auto-increment field. The code snippet also includes code to create the table for the query.

Dim cnDatabase As ADODB.ConnectionDim rsNewAutoIncrement As ADODB.RecordsetDim strConn As StringDim strSQL As StringDim strPathToMDB As StringstrPathToMDB = “C:\NewJet4.MDB”strConn = “Provider=Microsoft.Jet.OLEDB.4.0;” & _”Data Source=” & strPathToMDB & “;”Set cnDatabase = New ADODB.ConnectioncnDatabase.Open strConnstrSQL = “CREATE TABLE AutoIncrementTest ” & _”(ID int identity, Description varchar(40), ” & _”CONSTRAINT AutoIncrementTest_PrimaryKey PRIMARY KEY (ID))”cnDatabase.Execute strSQL, , adCmdText + adExecuteNoRecordsstrSQL = “INSERT INTO AutoIncrementTest ” & _”(Description) VALUES (‘AutoIncrement Test’)”cnDatabase.Execute strSQL, , adCmdText + adExecuteNoRecordsstrSQL = “SELECT @@Identity”Set rsNewAutoIncrement = New ADODB.RecordsetrsNewAutoIncrement.Open strSQL, cnDatabase, adOpenForwardOnly, _adLockReadOnly, adCmdTextMsgBox “New Auto-increment value is: ” & rsNewAutoIncrement(0).ValuersNewAutoIncrement.CloseSet rsNewAutoIncrement = NothingstrSQL = “DROP TABLE AutoIncrementTest”cnDatabase.Execute strSQL, , adCmdText + adExecuteNoRecordscnDatabase.CloseSet cnDatabase = Nothing Thanks to this newly added functionality, you can see the newly added auto-increment values in your client-side ActiveX Data Objects (ADO) recordsets in ADO 2.1 and later. When you submit the new row to the Jet provider by calling Update or UpdateBatch (depending on your choice of LockType), the ADO cursor engine generates an INSERT INTO query to create the new row in the table. If the recordset contains an auto-increment field, ADO will also generate a SELECT @@Identity query to retrieve the value generated for that auto-increment field. The following code demonstrates this feature:

Dim cnDatabase As ADODB.ConnectionDim rsNewAutoIncrement As ADODB.RecordsetDim strConn As StringDim strSQL As StringDim strPathToMDB As StringstrPathToMDB = “C:\NewJet4.MDB”strConn = “Provider=Microsoft.Jet.OLEDB.4.0;” & _”Data Source=” & strPathToMDB & “;”Set cnDatabase = New ADODB.ConnectioncnDatabase.Open strConnstrSQL = “CREATE TABLE AutoIncrementTest ” & _”(ID int identity, Description varchar(40), ” & _”CONSTRAINT AutoIncrementTest_PrimaryKey PRIMARY KEY (ID))”cnDatabase.Execute strSQL, , adCmdText + adExecuteNoRecordsstrSQL = “SELECT ID, Description FROM AutoIncrementTest”Set rsNewAutoIncrement = New ADODB.RecordsetrsNewAutoIncrement.CursorLocation = adUseClientrsNewAutoIncrement.Open strSQL, cnDatabase, adOpenStatic, _adLockOptimistic, adCmdTextrsNewAutoIncrement.AddNewrsNewAutoIncrement(“Description”).Value = “AutoIncrement Test”rsNewAutoIncrement.UpdateMsgBox “New Auto-increment value is: ” & rsNewAutoIncrement(0).ValuersNewAutoIncrement.CloseSet rsNewAutoIncrement = NothingstrSQL = “DROP TABLE AutoIncrementTest”cnDatabase.Execute strSQL, , adCmdText + adExecuteNoRecordscnDatabase.CloseSet cnDatabase = Nothing You can create a new Jet 4.0 database using Microsoft Access 2000 or using the ADOX library that is included with MDAC 2.1. To use this library in your Visual Basic project, create a reference to Microsoft ADO Ext. 2.1 for DDL and Security. You can then use code like the following to create a new Jet 4.0 database:

Dim strPathToMDB As StringDim catNewDatabase As ADOX.CatalogstrPathToMDB = “C:\NewJet4.MDB”If Dir(strPathToMDB) <> “” ThenKill strPathToMDBEnd IfstrConn = “Provider=Microsoft.Jet.OLEDB.4.0;” & _”Data Source=” & strPathToMDB & “;”Set catNewDatabase = New ADOX.CatalogcatNewDatabase.Create strConnSet catNewDatabase = Nothing To determine the format of your Microsoft Access database, check the dynamic “Jet OLEDB:Engine Type” property in the Connection object’s Properties collection. The property will return a value of 5 for Jet 4.x databases. The following code snippet demonstrates using the property:

Dim cnDatabase As ADODB.ConnectionDim strConn As StringDim strPathToMDB As StringstrPathToMDB = “C:\NewJet4.MDB”strConn = “Provider=Microsoft.Jet.OLEDB.4.0;” & _”Data Source=” & strPathToMDB & “;”Set cnDatabase = New ADODB.ConnectioncnDatabase.Open strConnIf cnDatabase.Properties(“Jet OLEDB:Engine Type”).Value = 5 ThenMsgBox “Jet 4.0 database”ElseMsgBox “Not a Jet 4.0 database”End IfcnDatabase.CloseSet cnDatabase = Nothing

ImportText.exe Importing Text into Access with ADO/RDO/DAO/Filesys/Automation

Symptoms
The ImportText.exe sample demonstrates various ways to import text files into a Microsoft Access database. There are many ways to import text data to an Access database, and typically the best option is determined by the task requirements.
ADORDODAOFilesysAutomation The sample application attached details the above coding options.
Resolution
The following files are available for download from the Microsoft Download Center:
TextImport.exe(http://download.microsoft.com/download/vb60pro/sample/1/w9xnt4/en-us/textimport.exe)
For additional information about how to download Microsoft Support files, click the following article number to view the article in the Microsoft Knowledge Base:
119591?(http://support.microsoft.com/kb/119591/EN-US/) How to Obtain Microsoft Support Files from Online Services Microsoft scanned this file for viruses. Microsoft used the most current virus-detection software that was available on the date that the file was posted. The file is stored on security-enhanced servers that help to prevent any unauthorized changes to the file.

Collapse this tableExpand this table
FileNameSizeImportText.vbp1,464ImportText.vbw56Sample.out3,346Sample.txt3,346Sample_Header.txt3,708Schema.ini422Schema_Header.ini420TextImport.frm28,678TextImport.frx84TextImport.mdb108,544
All files should reside in the same folder. Run the sample application ImportText.vbp and examine the different import/export options. The sample TextImport.mdb is used and should reside in the application path. The default sample text file is Sample.txt. A Sample_Header.txt file is included and contains the column header for the text file. An alternate schema file, Schema_Header.ini, may be used to demonstrate using the ColNameHeader=True option in the schema file corresponding to the Sample_Header.txt file.
Among the data import options demonstrated, DAO is probably the most efficient (fewest layers) or with the smallest memory footprint; especially if importing to an Access database.
Refer to the following list for an overview of the libraries loaded for each data access method. The FileSys objects sample: Scripting Runtime + DAO libraries + Jet librariesThe RDO sample: RDO libraries + ODBC libraries + ODBC Jet library + Jet libraries + Text ISAM driverThe ADO (the default example): ADO libraries (OLEDB + MSDASQL) + ODBC libraries + ODBC Jet library + Jet libraries + Text ISAM driverThe Automation sample: MSOffice Runtime library. For the DAO sample: DAO libraries + Jet libraries + Text ISAM driver The following function is the DAO object sample in the TextImport.vbp application. This code is used in the application when you click the DAO radio button before importing. You can modify the DAO sample by adding a recordset and a loop for data manipulation just as in the FileSys objects example.

Sub DAOOpenTextFileImport()On Error GoTo ErrHandlerlblAction.Caption = “DAO Import…”Dim daoDB As DAO.DatabaseDim strSQL As StringIf chkCreateTbl.Value = 1 ThenDBEngine.IniPath = App.Path & “\Schema_Header.ini”ElseDBEngine.IniPath = App.Path & “\Schema.ini”End IfSet daoDB = OpenDatabase(App.Path, False, False, _”Text;Database=” & App.Path & “;table=” & txtFile.Text)If chkCreateTbl.Value = 1 Then’Use this if you do not already have a table created in Access.’Creates and appends the data in one step.strSQL = “SELECT * INTO [" & txtTable.Text & "] IN ‘” & _App.Path & “\” & txtDatabase.Text & ” ‘”strSQL = strSQL & “FROM ” & txtFile.TextdaoDB.Execute strSQLElse’Delete data before importing – use if necessary.strSQL = “DELETE FROM [" & txtTable.Text & "] IN ‘” & _App.Path & “\” & txtDatabase.Text & “‘”daoDB.Execute strSQL’Append data to Access table.strSQL = “INSERT INTO [" & txtTable.Text & "] IN ‘” & _App.Path & “\” & txtDatabase.Text & “‘”strSQL = strSQL & “SELECT * FROM ” & txtFile.TextdaoDB.Execute strSQLEnd IfGoTo ExitSubErrHandler:lblAction.Caption = “DAO Import – Error.”MsgBox “Error: ” & Err.Number & vbCrLf & Err.DescriptionExitSub:lblAction.Caption = “Complete…”daoDB.CloseSet daoDB = NothingEnd Sub The following function is the FileSys object sample in the TextImport.vbp application. This code is used in the application when you select the FileSys radio button before importing. Notice in the sample code that to create the table layout in Access, based on the Schema_Header.ini file, there is no need to loop through the header file and create the table manually if you use the Text ISAM driver. Although, if you are using the Text ISAM driver then there is no need to use the FileSystemObject (and that is part of the point) unless you must use the FileSystemObject to import, then use DAO and do it in one as shown in the DAO sample code. Since you must use DAO anyway (to create the recordset object) even if you are doing data manipulation on import, then use DAO for the entire process since you already have it loaded in memory to create the recordset.

Private Sub FileSysImport()On Error GoTo ErrHandlerlblAction.Caption = “FileSys Import…”Dim daoDB As DAO.DatabaseDim daoRs As DAO.RecordsetDim fs As FileSystemObjectDim ts As TextStreamDim inLine As VariantDim strSQL As StringDim i As IntegerIf chkCreateTbl.Value = 1 Then’This is an eazy way to create the Table layout in Access based on the Schema_Header.ini file.DBEngine.IniPath = App.Path & “\Schema_Header.ini”Set daoDB = OpenDatabase(App.Path, False, False, “Text;Database=” & App.Path & “;table=” & txtFile.Text)strSQL = “SELECT * INTO [" & txtTable.Text & "] IN ‘” & App.Path & “\” & txtDatabase.Text & ” ‘”strSQL = strSQL & “FROM ” & txtFile.Text & ” WHERE 1=0″daoDB.Execute strSQLSet daoDB = NothingSet daoDB = OpenDatabase(App.Path & “\” & txtDatabase.Text, False, False)ElseDBEngine.IniPath = App.Path & “\Schema.ini”Set daoDB = OpenDatabase(App.Path & “\” & txtDatabase.Text, False, False)strSQL = “DELETE * FROM [" & txtTable.Text & "] IN ‘” & App.Path & “\” & txtDatabase.Text & “‘”daoDB.Execute strSQL, dbFailOnErrorEnd IfstrSQL = “SELECT * FROM [" & txtTable.Text & "] WHERE 1=0″Set daoRs = daoDB.OpenRecordset(strSQL, dbOpenDynaset, dbAppendOnly)Set fs = New FileSystemObjectSet ts = fs.OpenTextFile(App.Path & “\” & txtFile.Text, ForReading, False, TristateUseDefault)’This skips the column header.If chkColHeader.Value = 1 TheninLine = Split(ts.ReadLine, “,”)End IfWhile Not ts.AtEndOfStreaminLine = Split(ts.ReadLine, “,”)daoRs.AddNewFor i = 0 To UBound(inLine) – 1daoRs.Fields(i).Value = Left(inLine(i), daoRs.Fields(i).Size)Next idaoRs.UpdateWendGoTo ExitSubErrHandler:lblAction.Caption = “FileSys Import – Error.”MsgBox “Error: ” & Err.Number & vbCrLf & Err.DescriptionExitSub:lblAction.Caption = “Complete…”If Not ts Is Nothing Then ts.CloseIf Not daoRs Is Nothing Then daoRs.ClosedaoDB.CloseSet daoRs = NothingSet daoDB = NothingSet ts = NothingSet fs = NothingEnd Sub The simplest example is the Automation sample. A sample TextImport.mdb is used and the example import/export specifications have been created in the sample .mdb file: Sample and sample w/columns. You can find the specification property setting on the Properties tab of the Tab control. To import with or without the column names in the first row create another import/export specification and put the name of that specification in the text box txtSpecName on the tab control. An example specification is included in the sample .mdb file: Sample w/columns. To import the text file with Access Automation you can simply execute the DoCmd.TransferText method of the Access object.

Private Sub AccessAutomateImport()’Assumes table already exists.On Error GoTo ErrHandlerlblAction.Caption = “Access Automation…”Dim AccessApp As access.ApplicationDim strDB As StringstrDB = App.Path & “\” & txtDatabase.TextSet AccessApp = New access.ApplicationAccessApp.OpenCurrentDatabase strDB’To Import with/without Column names in first row create another Import/Export Specification’and put the name of that specification in the Text box ‘txtSpecName’ on the Tab Control.’An example Specification is included in the sample MDB – ‘Sample w/columns’.AccessApp.DoCmd.TransferText acImportDelim, txtSpecName.Text, txtTable.Text, App.Path & “\” & txtFile.TextAccessApp.CloseCurrentDatabaseGoTo ExitSubErrHandler:lblAction.Caption = “Access Automation – Error.”MsgBox “Error: ” & Err.Number & vbCrLf & Err.DescriptionExitSub:lblAction.Caption = “Complete…”appAccess.QuitSet appAccess = NothingEnd Sub For additional details and code refer to the sample application TextImport.exe.

How To Use GUIDs w/ Access, SQL 6.5 and SQL 7

Symptoms
AdoGUIDz.exe is a self-extracting executable that contains a sample project that demonstrates using the globally unique identifier datatype (GUID) with Microsoft Access, SQL 6.5 and SQL 7.0. The sample code may be particularly helpful if you are attempting to manipulate GUIDs with ODBC versions 3.51 and below because those versions of ODBC do not support a native GUID datatype. ODBC versions 3.6 and above include the GUID datatype. Consequently, the methods for manipulating GUIDs with ODBC 3.6 are simpler.
NOTE: SQL 6.5 does not support a native GUID datatype so in order to store/retrieve GUIDs in SQL 6.5 you must use the VarBinary datatype and Byte Arrays.
Resolution
The following files are available for download from the Microsoft Download Center:
Adoguidz.exe(http://download.microsoft.com/download/vb60pro/sample/1/win98/en-us/adoguidz.exe) Release Date: DEC-29-1998
For additional information about how to download Microsoft Support files, click the following article number to view the article in the Microsoft Knowledge Base:
119591?(http://support.microsoft.com/kb/119591/EN-US/)How to Obtain Microsoft Support Files from Online Services Microsoft scanned this file for viruses. Microsoft used the most current virus-detection software that was available on the date that the file was posted. The file is stored on security-enhanced servers that help to prevent any unauthorized changes to the file.

FileNameSize———————————————————AdoGUID.bas3KBAdoGUID.exe60KBAdoGUID.frm25KBAdoGUID.frx1KBAdoGUID.mdb80KBAdoGUID.vbp2KBReadme.txt4KB Microsoft Access has a ReplicationID AutoNumber field that is a 16-byte (128 bit) Globally Unique Identifier (GUID) that uniquely identifies each record in the database. Please reference the sample project for the code that demonstrates how to SELECT specific GUIDs and Insert GUIDs using the AutoNumber field with Microsoft Access. The following function is a code snippet from the sample that demonstrates how to SELECT a specific GUID from an Access table using Microsoft ActiveX Data Objects (ADO):
Sample Code

Sub AccessReQueryADO()On Error GoTo ErrorMessageDim adoCn As adoDb.ConnectionDim adoRs As adoDb.RecordsetDim strCn As StringDim strSQL As StringstrCn = App.Path & “\adoGUID.mdb”Set adoCn = New adoDb.ConnectionWith adoCn.Provider = “Microsoft.JET.OLEDB.3.51″.CommandTimeout = 500.ConnectionTimeout = 500.Open strCn, “admin”, “”End WithIf Option7.Value = True ThenstrSQL = “SELECT * FROM GUIDtable WHERE ” & _”Instr(1,[colGUID],’” & strGUID & “‘)”ElsestrSQL = “SELECT * FROM GUIDtable”End IfSet adoRs = New adoDb.RecordsetWith adoRsSet .ActiveConnection = adoCn.LockType = adLockOptimistic.CursorLocation = adUseServer.CursorType = adOpenForwardOnlyEnd WithadoRs.Open strSQLtxtMessage.Text = “”While Not adoRs.EOFtxtMessage.Text = txtMessage.Text & _adoRs.Fields(“colGUID”).Value & “|”txtMessage.Text = txtMessage.Text & _adoRs.Fields(“colDescription”).Value & vbCrLfadoRs.MoveNextWendGoTo ExitSubErrorMessage:MsgBox Err.Number & ” : ” & vbCrLf & Err.DescriptionExitSub:Label6.Caption = “- ReQueried AccessADO GUID Table…”Set adoCn = NothingSet adoRs = NothingEnd Sub
Unlike SQL 6.5, SQL 7.0 supports a GUID datatype known as UNIQUEIDENTIFIER. This datatype is a 16-byte GUID stored in the same format as the Microsoft Access AutoNumber (GUID) datatype. There are subtle differences concerning how to Insert and Retrieve the GUIDs among the different database engines. Since SQL 6.5 does not support a native GUID datatype the methods used for storing/retrieving GUIDs are much different than SQL 7.0 or Microsoft Access. SQL 7.0 with the OLEDB provider is almost the same as Microsoft Access with or without the OLEDB provider (SQLOLEDB), as you will see in the sample code. With SQL 6.5 you must store the GUID as a VarBinary(16) datatype. Consequently, to retrieve the GUID with SQL65 you must use a stored procedure and build a Command object with the appropriate ByteArray parameter to pass to the stored procedure SELECT statement.
NOTE: You must use the same code techniques with SQL 7.0 as with SQL 6.5 if you are using the ODBC provider (MSDASQL) since in ODBC 3.51 and below the GUID datatype is not recognized.
The 16-byte (128 bit) data structure of a GUID:

typedef struct _GUID{unsigned longData1;unsigned shortData2;unsigned shortData3;unsigned charData4[8];} GUID;

* Data1An unsigned long integer data value.* Data2An unsigned short integer data value.* Data3An unsigned short integer data value.* Data4An array of unsigned characters. To demonstrate GUIDs with SQL 7.0 or SQL 6.5 in the sample project you must specify a valid (test) SQL 7.0/SQL 6.5 server and database. To do so, navigate to the Connection Info tab and change the Server and Database reference. The defaults are (local) Server and the Pubs database. Also, to use the native GUID datatype for SQL 7.0, you must change to the OLEDB provider (SQLOLEDB) by clicking the appropriate option button in the Provider frame at the top of the Form. If you select ODBC as the provider for SQL 7.0 then the application uses the same code as with SQL 6.5.
NOTE: The Connection Info tab has no bearing on Microsoft Access. The default database for Microsoft Access is included with the sample project AadoGUID.mdb as should reside in the Application path.
For each database you select in the sample project you must run Create Table to create the GUID test table and then Insert to automatically generate some test GUID data before running a ReQuery.
NOTE: CoCreateGUID() is called in the Insert sample code to generate the test GUID values.
In the sample application there is a ByteArray2GUID() function that is used to convert the VarBinary(16) byte array to a GUID string for display. Also, the function is used to convert the GUID string to a byte array for storage in the SQLServer VarBinary(16) datatype column. Note that the function is needed when using the GUIDs interchangeably between Microsoft Access and SQL 6.5. If you Export the Microsoft Access table to SQL 6.5 you will see that the bytes are not stored in the same order in which they display in the Microsoft Access table view. For example:

Reversed…Not Reversed…>—————-<|>—————<20C68F83-9593-0011-BFBB-00C04F8F8347 ‘SQLServer view after table Export.838FC620-9395-1100-BFBB-00C04F8F8347 ‘Microsoft Access view. NOTE: The bytes are in (DWord and Word) reverse order after Exporting the Microsoft Access table.
Because the Microsoft Access Upsizing Wizard results in the same storage of the bytes in SQL 6.5, you must use the ByteArray2GUID() and GUID2ByteArray() functions to remain compatible with the storage of the GUIDs in Microsoft Access. If you do not need to Export the Microsoft Access table to SQL 6.5 or upsize the Microsoft Access database to SQL 6.5 then you need only store the bytes in a straightforward fashion.
The following is a code snippet from the code sample that demonstrates the storage of the GUID in the byte format of Microsoft Access.
Sample Code

Sub SQL65InsertGUID()’Insert GUID record.On Error GoTo ErrorMessageDim adoCn As adoDb.ConnectionDim adoRs As adoDb.RecordsetDim strGUIDtmp As StringDim bytGUID() As ByteDim strCn As StringDim strSQL As StringstrCn = “Provider=” & strProvider & _”;Driver={SQL Server}” & _”;Server=” & txtServer & _”;Database=” & txtDatabase & _”;Uid=” & txtUserID & _”;Pwd=” & txtPasswordSet adoCn = New adoDb.ConnectionWith adoCn.ConnectionString = strCn.CommandTimeout = 500.ConnectionTimeout = 500.OpenEnd WithstrGUIDtmp = strGUIDbytGUID = GUID2ByteArray(FilterGUID(strGUIDtmp))strSQL = “SELECT * FROM GUIDtable WHERE 1=0″Set adoRs = New adoDb.RecordsetWith adoRsSet .ActiveConnection = adoCn.LockType = adLockOptimistic.CursorLocation = adUseServer.CursorType = adOpenForwardOnlyEnd WithadoRs.Open strSQLadoRs.AddNewadoRs.Fields(“colGUID”).Value = bytGUIDadoRs.Fields(“colDescription”).Value = “This is a test GUID”adoRs.UpdateGoTo ExitSubErrorMessage:MsgBox Err.Number & ” : ” & vbCrLf & Err.DescriptionExitSub:Label6.Caption = “[ASCII 176] Inserted SQL65 GUID Record…”Set adoCn = NothingSet adoRs = NothingEnd Sub’======================Function GUID2ByteArray(ByVal strGUID As String) As Byte()Dim i As IntegerDim j As IntegerDim sPos As IntegerDim OffSet As IntegerDim sGUID(0 To 2) As ByteDim bytArray() As ByteReDim bytArray(0 To 15) As BytesGUID(0) = 7sGUID(1) = 11sGUID(2) = 15OffSet = 0sPos = 0′AABBCCDD-AABB-CCDD-XXXX-XXXXXXXXXXXX ‘Microsoft Access view.’DDCCBBAA-BBAA-DDCC-XXXX-XXXXXXXXXXXX ‘SQLServer view.’Need to loop through to build the GUID byte array in the Microsoft’Access storage format since the first eight bytes are reversed.For i = 0 To UBound(sGUID)For j = sGUID(i) To (OffSet + 1) Step -2bytArray(sPos) = “&H” & Mid$(strGUID, j, 2)sPos = sPos + 1Next jOffSet = sGUID(i)Next iFor i = 17 To 31 Step 2bytArray(sPos) = “&H” & Mid$(strGUID, i, 2)sPos = sPos + 1Next iGUID2ByteArray = bytArray()End Function

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

How to call the EnumJobs function from a Visual Basic .NET application

Symptoms
The EnumJobs function is available in the Winspool.drv print spool interface. You can use the EnumJobs function to retrieve the status of the jobs that are queued in a local print queue. The EnumJobs function enumerates the number of jobs, the job identification, the job status, and other parameters based on your requirements.
When you try to print any document, the print job is queued in the local print queue until the printer performs that job. The port monitor communicates with the printer to obtain information about a print job and then communicates the information to the local print queue. Therefore, you can monitor the local print queue to retrieve the status of your print job.
The local print queue accepts any number of jobs, even if the printer hardware is in an error state. Therefore, the Ready state of the print queue does not determine whether the job will print.Many statuses are available to report. However, many of them are not supported. The printer hardware and the port monitor determine the status that appears.
Resolution
This step-by-step article describes how to use Microsoft Windows API functions in Microsoft Visual Basic .NET to determine the printer status or the print job status programmatically. Although an application does not typically have to examine the status of a printer before the printer prints, it may be useful to determine the status of a printer or a print job programmatically.

Technical descriptionThe following information will help you use the sample application to obtain information about your printer status: The term printer refers to a hardware device, a queue, a driver, or a port. Here, the term printer status refers to the status of a local print queue.The sample code in the “Step-by-step sample” section returns the status that the operating system reports. This is the same status that the spooler reports. You can verify this status by monitoring the local print queue. The application continuously monitors the printer status.
To view the local print queue on a computer that is running the Microsoft Windows XP operating system, follow these steps: Click Start, point to Settings, and then click Printers and Faxes.In the Printers and Faxes window, double-click the icon for the printer whose queue you want to view. You cannot communicate directly with the physical printer. We recommend that you do not do this because the operating system controls access to the hardware. The “Step-by-step sample” section examines the local print queue that obtains the information from the port monitor.The port monitor communicates with the physical device. The sample code in the “Step-by-step sample” section reports the printer status and the job statuses.The queue is considered to be in a Ready state because it can accept jobs, even if the hardware is in an error state. For example, if the last job that printed used the last sheet of paper, the operating system cannot determine that the printer is out of paper until the system tries to print again.Although many statuses can be reported, many statuses are not supported in practice. The printer hardware and the port monitor determine the status to report. For example, if the printer is out of paper and is offline, the status may be reported as Printing because that is what the job is trying to do. Therefore, regardless of whether a local print queue displays the Ready status, the print job may not be completed successfully.The sample code in the “Step-by-step sample” section examines only the local print queue. This information may be sufficient for most applications. However, when you connect to remote printers, the process to obtain sufficient information may become complex. You may have a chain of print queues, and the port for the local print queue may be another queue. You may also use printer pooling. In printer pooling, multiple printers work from a common super queue. When the architecture becomes more complex, the code to retrieve a meaningful status also becomes more complex, and the usefulness of the status is reduced.
Step-by-step sampleStart Microsoft Visual Studio .NET. On the File menu, point to New, and then click Project. The New Project dialog box appears.Under Project Types, click Visual Basic Projects. Under Templates, click Windows Application.In the Name box, type PrinterStatus, and then click OK. By default, a form that is named Form1 is created.On the Project menu, click Add Module. The Add New Item – PrinterStatus dialog box appears. Under Templates, click Module, and then click Open. By default, a file that is named Module1.vb is created.In the Module1.vb file, replace the existing code with the following sample code.

Option Explicit On Imports System.Drawing.Printing.PrinterSettingsImports System.Runtime.InteropServicesModule Module1Public Class WINAPIDeclare Auto Function GetPrinter Lib “winspool.drv” (ByVal hPrinter As _IntPtr, ByVal Level As Integer, ByRef pPrinter As Byte, ByVal cbBuf _As Integer, ByRef pcbNeeded As Integer) As BooleanDeclare Auto Function lstrcpy Lib “Kernel32.Lib” Alias “lstrcpyA” _(<OutAttribute(), MarshalAs(UnmanagedType.LPStr)> ByVal lpString1 As String, _<MarshalAs(UnmanagedType.LPStr)> ByVal lpString2 As String) As LongDeclare Auto Function ClosePrinter Lib “winspool.drv” Alias “ClosePrinter” (ByVal hPrinter As IntPtr) As LongPublic Declare Function EnumJobs Lib “winspool.drv” Alias “EnumJobsA” _(ByVal hPrinter As IntPtr, _ByVal FirstJob As Int32, _ByVal NoJobs As Int32, _ByVal Level As Int32, _ByVal pJob As Byte(), _ByVal cdBuf As Int32, _ByRef pcbNeeded As Int32, _ByRef pcReturned As Int32) _As LongDeclare Function OpenPrinter Lib “winspool.drv” Alias “OpenPrinterA” (ByVal pPrinterName As String, _ByRef phPrinter As IntPtr, ByVal pDefault As PRINTER_DEFAULTS) As LongEnd Class’Constants for the PRINTER_DEFAULTS structurePublic Const PRINTER_ACCESS_USE = &H8Public Const PRINTER_ACCESS_ADMINISTER = &H4′Constants for the DEVMODE structurePublic Const CCHDEVICENAME = 32Public Const CCHFORMNAME = 32Public API As New WINAPI<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> Structure SYSTEMTIMEPublic wYear As ShortPublic wMonth As ShortPublic wDayOfWeek As ShortPublic wDay As ShortPublic wHour As ShortPublic wMinute As ShortPublic wSecond As ShortPublic wMilliseconds As ShortEnd Structure<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> Structure JOB_INFO_2Public PrinterJobId As IntegerPublic pPrinterName As IntegerPublic PrinterName As IntegerPublic PrinterUserName As IntegerPublic PrinterDocument As IntegerPublic PrinterNotifyName As IntegerPublic PrinterDatatype As IntegerPublic PrintProcessor As IntegerPublic PrinterParameters As IntegerPublic PrinterDriverName As IntegerPublic PrinterDevMode As IntegerPublic PrinterStatus As IntegerPublic PrinterSecurityDescriptor As IntegerPublic pStatus As IntegerPublic PrinterPriority As IntegerPublic Position As IntegerPublic StartTime As IntegerPublic UntilTime As IntegerPublic TotalPages As IntegerPublic Size As IntegerPublic Submitted As SYSTEMTIMEPublic time As IntegerPublic PagesPrinted As IntegerEnd Structure<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> Structure PRINTER_INFO_2Public pServerName As IntegerPublic pPrinterName As IntegerPublic pShareName As IntegerPublic pPortName As IntegerPublic pDriverName As IntegerPublic pComment As IntegerPublic pLocation As IntegerPublic pDevMode As IntegerPublic pSepFile As IntegerPublic pPrintProcessor As IntegerPublic pDatatype As IntegerPublic pParameters As IntegerPublic pSecurityDescriptor As IntegerPublic Attributes As IntegerPublic Priority As IntegerPublic DefaultPriority As IntegerPublic StartTime As IntegerPublic UntilTime As IntegerPublic Status As IntegerPublic cJobs As IntegerPublic AveragePPM As IntegerEnd StructurePublic Function Pointer_to_String(ByVal Add As Long) As StringDim Temp_var As StringTemp_var = New String(CChar(“”), 512)Dim x As Longx = API.lstrcpy(Temp_var, Add)If (InStr(1, Temp_var, Chr(0)) = 0) ThenPointer_to_String = “”ElsePointer_to_String = Left(Temp_var, InStr(1, Temp_var, Chr(0)) – 1)End IfEnd FunctionPublic Function DatatoDeserial(ByVal datas() As Byte, ByVal type_to_change As Type, _ByVal NumJub As Long) As Object’Returns the size of the JOB_INFO_2 structureDim Data_to_Size As Long = Marshal.SizeOf(type_to_change)If Data_to_Size > datas.Length ThenReturn NothingEnd IfDim buffer As IntPtr = Marshal.AllocHGlobal(Data_to_Size)Dim startindex As LongDim i As IntegerFor i = 0 To NumJub – 1If i = 0 Thenstartindex = 0Elsestartindex = startindex + Data_to_SizeEnd IfNext’Copy data from the datas array to the unmanaged memory pointer.Marshal.Copy(datas, startindex, buffer, Data_to_Size)’Marshal data from the buffer pointer to a managed object.Dim result_obj As Object = Marshal.PtrToStructure(buffer, type_to_change)’Free the memory that is allocated from the unmanaged memory.Marshal.FreeHGlobal(buffer)Return result_objEnd Function<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _Structure PRINTER_DEFAULTSPublic pDatatype As StringPublic pDevMode As LongPublic DesiredAccess As LongEnd Structure’Define the printer status constants.Public Const ERROR_INSUFFICIENT_BUFFER = 122Public Const PRINTER_STATUS_BUSY = &H200Public Const PRINTER_STATUS_DOOR_OPEN = &H400000Public Const PRINTER_STATUS_ERROR = &H2Public Const PRINTER_STATUS_INITIALIZING = &H8000Public Const PRINTER_STATUS_IO_ACTIVE = &H100Public Const PRINTER_STATUS_MANUAL_FEED = &H20Public Const PRINTER_STATUS_NO_TONER = &H40000Public Const PRINTER_STATUS_NOT_AVAILABLE = &H1000Public Const PRINTER_STATUS_OFFLINE = &H80Public Const PRINTER_STATUS_OUT_OF_MEMORY = &H200000Public Const PRINTER_STATUS_OUTPUT_BIN_FULL = &H800Public Const PRINTER_STATUS_PAGE_PUNT = &H80000Public Const PRINTER_STATUS_PAPER_JAM = &H8Public Const PRINTER_STATUS_PAPER_OUT = &H10Public Const PRINTER_STATUS_PAPER_PROBLEM = &H40Public Const PRINTER_STATUS_PAUSED = &H1Public Const PRINTER_STATUS_PENDING_DELETION = &H4Public Const PRINTER_STATUS_PRINTING = &H400Public Const PRINTER_STATUS_PROCESSING = &H4000Public Const PRINTER_STATUS_TONER_LOW = &H20000Public Const PRINTER_STATUS_USER_INTERVENTION = &H100000Public Const PRINTER_STATUS_WAITING = &H2000Public Const PRINTER_STATUS_WARMING_UP = &H10000′Define the job status constants.Public Const JOB_STATUS_PAUSED = &H1Public Const JOB_STATUS_ERROR = &H2Public Const JOB_STATUS_DELETING = &H4Public Const JOB_STATUS_SPOOLING = &H8Public Const JOB_STATUS_PRINTING = &H10Public Const JOB_STATUS_OFFLINE = &H20Public Const JOB_STATUS_PAPEROUT = &H40Public Const JOB_STATUS_PRINTED = &H80Public Const JOB_STATUS_DELETED = &H100Public Const JOB_STATUS_BLOCKED_DEVQ = &H200Public Const JOB_STATUS_USER_INTERVENTION = &H400Public Const JOB_STATUS_RESTART = &H800Public Function GetString(ByVal PtrStr As Long) As StringDim StrBuff As StringStrBuff = New String(CChar(“”), 256)’Determine if a zero address is used.If PtrStr = 0 ThenGetString = ” “Exit FunctionEnd If’Copy data from PtrStr to the buffer.Dim PtrInt As IntPtr = New IntPtr(PtrStr)StrBuff = Marshal.PtrToStringAuto(PtrInt)’Remove any trailing nulls from the string.GetString = StripNulls(StrBuff)End FunctionPublic Function StripNulls(ByVal OriginalStr As String) As String’Remove any trailing nulls from the input string.If (InStr(OriginalStr, Chr(0)) > 0) ThenOriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) – 1)End If’Return the modified string.StripNulls = OriginalStrEnd FunctionPublic Function CheckPrinterStatus(ByVal PI2Status As Long) As StringDim tempStr As StringIf PI2Status = 0 Then’ Return the “Ready” status.CheckPrinterStatus = “Printer Status = Ready” & vbCrLfElsetempStr = “”‘Determine the printer state.If (PI2Status And PRINTER_STATUS_BUSY) ThentempStr = tempStr & “Busy”End IfIf (PI2Status And PRINTER_STATUS_DOOR_OPEN) ThentempStr = tempStr & “Printer Door Open”End IfIf (PI2Status And PRINTER_STATUS_ERROR) ThentempStr = tempStr & “Printer Error”End IfIf (PI2Status And PRINTER_STATUS_INITIALIZING) ThentempStr = tempStr & “Initializing”End IfIf (PI2Status And PRINTER_STATUS_IO_ACTIVE) ThentempStr = tempStr & “I/O Active”End IfIf (PI2Status And PRINTER_STATUS_MANUAL_FEED) ThentempStr = tempStr & “Manual Feed”End IfIf (PI2Status And PRINTER_STATUS_NO_TONER) ThentempStr = tempStr & “No Toner”End IfIf (PI2Status And PRINTER_STATUS_NOT_AVAILABLE) ThentempStr = tempStr & “Not Available”End IfIf (PI2Status And PRINTER_STATUS_OFFLINE) ThentempStr = tempStr & “Off Line”End IfIf (PI2Status And PRINTER_STATUS_OUT_OF_MEMORY) ThentempStr = tempStr & “Out of Memory”End IfIf (PI2Status And PRINTER_STATUS_OUTPUT_BIN_FULL) ThentempStr = tempStr & “Output Bin Full”End IfIf (PI2Status And PRINTER_STATUS_PAGE_PUNT) ThentempStr = tempStr & “Page Punt”End IfIf (PI2Status And PRINTER_STATUS_PAPER_JAM) ThentempStr = tempStr & “Paper Jam”End IfIf (PI2Status And PRINTER_STATUS_PAPER_OUT) ThentempStr = tempStr & “Paper Out”End IfIf (PI2Status And PRINTER_STATUS_OUTPUT_BIN_FULL) ThentempStr = tempStr & “Output Bin Full”End IfIf (PI2Status And PRINTER_STATUS_PAPER_PROBLEM) ThentempStr = tempStr & “Page Problem”End IfIf (PI2Status And PRINTER_STATUS_PAUSED) ThentempStr = tempStr & “Paused”End IfIf (PI2Status And PRINTER_STATUS_PENDING_DELETION) ThentempStr = tempStr & “Pending Deletion”End IfIf (PI2Status And PRINTER_STATUS_PRINTING) ThentempStr = tempStr & “Printing”End IfIf (PI2Status And PRINTER_STATUS_PROCESSING) ThentempStr = tempStr & “Processing”End IfIf (PI2Status And PRINTER_STATUS_TONER_LOW) ThentempStr = tempStr & “Toner Low”End IfIf (PI2Status And PRINTER_STATUS_USER_INTERVENTION) ThentempStr = tempStr & “User Intervention”End IfIf (PI2Status And PRINTER_STATUS_WAITING) ThentempStr = tempStr & “Waiting”End IfIf (PI2Status And PRINTER_STATUS_WARMING_UP) ThentempStr = tempStr & “Warming Up”End IfIf Len(tempStr) = 0 ThentempStr = “Unknown Status of ” & PI2StatusEnd If’Return the status.CheckPrinterStatus = “Printer Status = ” & tempStr & vbCrLfEnd IfEnd FunctionEnd ModuleIn Solution Explorer, right-click the Form1.vb file, and then click View Code.In the Form1.vb file, replace the existing code with the following sample code.

Imports System.Diagnostics.DebugImports System.Drawing.PrintingImports System.Runtime.InteropServicesPublic Class Form1Inherits System.Windows.Forms.Form#Region ” Windows Form Designer generated code “Public Sub New()MyBase.New()’This call is required by the Windows Form Designer.InitializeComponent()’Add any initialization after the InitializeComponent() callEnd Sub’Form overrides dispose to clean up the component list.Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)If disposing ThenIf Not (components Is Nothing) Thencomponents.Dispose()End IfEnd IfMyBase.Dispose(disposing)End Sub’Required by the Windows Form DesignerPrivate components As System.ComponentModel.IContainer’NOTE: The following procedure is required by the Windows Form Designer’It can be modified using the Windows Form Designer.’Do not modify it using the code editor.Friend WithEvents TextBox1 As System.Windows.Forms.TextBoxFriend WithEvents TextBox2 As System.Windows.Forms.TextBoxFriend WithEvents Command1 As System.Windows.Forms.ButtonFriend WithEvents Command2 As System.Windows.Forms.ButtonFriend WithEvents Command3 As System.Windows.Forms.ButtonFriend WithEvents Timer1 As System.Windows.Forms.TimerFriend WithEvents TextBox3 As System.Windows.Forms.TextBox<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()Me.components = New System.ComponentModel.ContainerMe.Command1 = New System.Windows.Forms.ButtonMe.Command2 = New System.Windows.Forms.ButtonMe.Command3 = New System.Windows.Forms.ButtonMe.TextBox1 = New System.Windows.Forms.TextBoxMe.TextBox2 = New System.Windows.Forms.TextBoxMe.Timer1 = New System.Windows.Forms.Timer(Me.components)Me.TextBox3 = New System.Windows.Forms.TextBoxMe.SuspendLayout()”Command1′Me.Command1.Location = New System.Drawing.Point(352, 24)Me.Command1.Name = “Command1″Me.Command1.Size = New System.Drawing.Size(136, 23)Me.Command1.TabIndex = 0Me.Command1.Text = “Button1″”Command2′Me.Command2.Location = New System.Drawing.Point(360, 112)Me.Command2.Name = “Command2″Me.Command2.Size = New System.Drawing.Size(128, 23)Me.Command2.TabIndex = 1Me.Command2.Text = “Button2″”Command3′Me.Command3.Location = New System.Drawing.Point(360, 224)Me.Command3.Name = “Command3″Me.Command3.Size = New System.Drawing.Size(128, 23)Me.Command3.TabIndex = 2Me.Command3.Text = “Button3″”TextBox1′Me.TextBox1.Location = New System.Drawing.Point(8, 24)Me.TextBox1.Multiline = TrueMe.TextBox1.Name = “TextBox1″Me.TextBox1.Size = New System.Drawing.Size(320, 80)Me.TextBox1.TabIndex = 3Me.TextBox1.Text = “TextBox1″”TextBox2′Me.TextBox2.Location = New System.Drawing.Point(8, 120)Me.TextBox2.Multiline = TrueMe.TextBox2.Name = “TextBox2″Me.TextBox2.Size = New System.Drawing.Size(320, 80)Me.TextBox2.TabIndex = 4Me.TextBox2.Text = “TextBox2″”Timer1′Me.Timer1.Enabled = True”TextBox3′Me.TextBox3.Location = New System.Drawing.Point(8, 216)Me.TextBox3.Multiline = TrueMe.TextBox3.Name = “TextBox3″Me.TextBox3.ScrollBars = System.Windows.Forms.ScrollBars.VerticalMe.TextBox3.Size = New System.Drawing.Size(320, 80)Me.TextBox3.TabIndex = 5Me.TextBox3.Text = “TextBox3″”Form1′Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)Me.ClientSize = New System.Drawing.Size(504, 317)Me.Controls.Add(Me.TextBox3)Me.Controls.Add(Me.TextBox2)Me.Controls.Add(Me.TextBox1)Me.Controls.Add(Me.Command3)Me.Controls.Add(Me.Command2)Me.Controls.Add(Me.Command1)Me.Name = “Form1″Me.Text = “Form1″Me.ResumeLayout(False)End Sub#End RegionPublic Shared Sub main()Dim PrntInfo As New Form1PrntInfo.ShowDialog()End SubPrivate Sub Command1_Click(ByVal sender As System.Object, _ByVal e As System.EventArgs) Handles Command1.Click’Enable the timer to start printer status checks.Timer1.Enabled = TrueTimer1.Start()’Enable and disable the start and stop buttons.Command1.Enabled = FalseCommand2.Enabled = TrueCommand3.Enabled = TrueEnd SubPrivate Sub Command2_Click(ByVal sender As System.Object, _ByVal e As System.EventArgs) Handles Command2.Click’Disable the timer to stop additional printer checks.Timer1.Enabled = False’Enable and disable the start and stop buttons.Command1.Enabled = TrueCommand2.Enabled = FalseCommand3.Enabled = TrueAPI = NothingEnd SubPrivate Sub Command3_Click(ByVal sender As System.Object, _ByVal e As System.EventArgs) Handles Command3.Click’Clear the text boxes to display the printer status.TextBox1.Text = “”TextBox2.Text = “”TextBox3.Text = “”End SubPrivate Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) _Handles MyBase.Load’Initialize captions for the buttons.Command1.Text = “Start”Command2.Text = “Stop”Command3.Text = “Clear”‘Clear the text boxes to display the printer status.TextBox1.Text = “”TextBox2.Text = “”TextBox3.Text = “”Command1.Enabled = True’Disable the stop and clear buttons.Command2.Enabled = FalseCommand3.Enabled = False’Set the timer interval to 500 milliseconds to examine the printer status.Timer1.Enabled = FalseTimer1.Interval = 500End SubPrivate Sub Timer1_Tick(ByVal sender As System.Object, _ByVal e As System.EventArgs) Handles Timer1.TickDim PrinterStatus As StringDim JobStatus As StringDim ErrorInfo As String’Clear the text boxes to display the status.TextBox1.Text = “”TextBox2.Text = “”TextBox3.Text = “”‘Call the CheckPrinter function.TextBox1.Text = CheckPrinter(PrinterStatus, JobStatus)TextBox2.Text = PrinterStatusTextBox3.Text = JobStatusEnd SubPublic Function CheckPrinter(ByRef PrinterStr As String, _ByRef JobStr As String) As StringDim hPrinter As IntPtrDim ByteBuf As LongDim BytesNeeded As Int32Dim PI2 As New PRINTER_INFO_2Dim intCount As LongDim JI2(intCount) As JOB_INFO_2Dim PrinterInfo() As ByteDim JobInfo() As ByteDim result As LongDim LastError As LongDim PrinterName As StringDim tempStr As StringDim NumJI2 As Int32Dim pDefaults As PRINTER_DEFAULTS’Set a default return value if no errors occur.CheckPrinter = “Printer info retrieved!”Dim PD As New PrintDocumentPrinterName = PD.PrinterSettings.PrinterName’Set the access security setting that you want.pDefaults.DesiredAccess = PRINTER_ACCESS_USE’Call the API to obtain a handle to the printer.’If an error occurs, display the error.result = API.OpenPrinter(PrinterName, hPrinter, pDefaults)If result = 0 ThenCheckPrinter = “Cannot open printer ” & PrinterName & _”, Error: ” & Marshal.GetLastWin32Error()Exit FunctionEnd If’Initialize the BytesNeeded variable.BytesNeeded = 0′Clear the error object.Err.Clear()’Determine the buffer size that is required to obtain the printer information.result = API.GetPrinter(hPrinter, 2, 0&, 0, BytesNeeded)’Display the error message that you receive when you call the GetPrinter function,’and then close the printer handle.If Marshal.GetLastWin32Error() <> ERROR_INSUFFICIENT_BUFFER ThenCheckPrinter = ” > GetPrinter Failed on initial call! <”API.ClosePrinter(hPrinter)Exit FunctionEnd IfReDim PrinterInfo(BytesNeeded)ByteBuf = BytesNeeded’Call the GetPrinter function to obtain the status.result = API.GetPrinter(hPrinter, 2, PrinterInfo(0), ByteBuf, _BytesNeeded)’Check for any errors.If result = 0 Then’Get the error.LastError = Marshal.GetLastWin32Error()’Display the error message, and then close the printer handle.CheckPrinter = “Could not get Printer Status!Error = ” _& LastErrorAPI.ClosePrinter(hPrinter)Exit FunctionEnd If’Copy the contents of the printer status byte array into a’PRINTER_INFO_2 structure.PI2 = CType(DatatoDeserial(PrinterInfo, GetType(PRINTER_INFO_2), 1), PRINTER_INFO_2)PrinterStr = CheckPrinterStatus(PI2.Status)’Add the printer name, the driver, and the port to the text box.PrinterStr = PrinterStr & “Printer Name = ” & _GetString(PI2.pPrinterName) & vbCrLfPrinterStr = PrinterStr & “Printer Driver Name = ” & _GetString(PI2.pDriverName) & vbCrLfPrinterStr = PrinterStr & “Printer Port Name = ” & _GetString(PI2.pPortName) & vbCrLf’Call the API to obtain the buffer size that is required.result = API.EnumJobs(hPrinter, 0, &HFFFFFFFF, 2, JobInfo, 0, BytesNeeded, NumJI2)If result = 0 Then’Display the error, and then close the printer handle.LastError = Marshal.GetLastWin32Error()CheckPrinter = ” > EnumJobs Failed on initial call! <Error = ” _& LastErrorAPI.ClosePrinter(hPrinter)Exit FunctionEnd If’If no current jobs exist, display the message.If BytesNeeded = 0 ThenJobStr = “No Print Jobs!”Else’Resize the byte array to hold information about the print jobs.ReDim JobInfo(BytesNeeded – 1)’Call the API to obtain the print job information.result = API.EnumJobs(hPrinter, 0, &HFFFFFFFF, 2, JobInfo, _BytesNeeded, BytesNeeded, NumJI2)’Check for errors.If result = 0 Then’Display the error, and then close the printer handle.LastError = Marshal.GetLastWin32Error()CheckPrinter = ” > EnumJobs Failed on second call! <Error = ” _& LastErrorAPI.ClosePrinter(hPrinter)Exit FunctionEnd IfReDim JI2(NumJI2)’Copy the contents of print job info byte array into a’JOB_INFO_2 structure.TryFor intCount = 0 To NumJI2 – 1 ‘ Loop through jobs and obtain the job information.Dim test As ObjectJI2(intCount) = CType(DatatoDeserial(JobInfo, _GetType(JOB_INFO_2), intCount + 1), JOB_INFO_2)JobStr = JobStr & “Job ID = ” & JI2(intCount).PrinterJobId & _vbCrLf & “Total Pages = ” & JI2(intCount).TotalPages & vbCrLftempStr = “”‘Check for a ready state.If JI2(intCount).pStatus = 0& Then’ If pStatus is Null, check Status.If JI2(intCount).pStatus = 0 ThentempStr = tempStr & “Ready!” & vbCrLfElse’Check for the various print job states.If (JI2(intCount).pStatus And JOB_STATUS_SPOOLING) ThentempStr = tempStr & “Spooling”End IfIf (JI2(intCount).pStatus And JOB_STATUS_OFFLINE) ThentempStr = tempStr & “Off line”End IfIf (JI2(intCount).pStatus And JOB_STATUS_PAUSED) ThentempStr = tempStr & “Paused”End IfIf (JI2(intCount).pStatus And JOB_STATUS_ERROR) ThentempStr = tempStr & “Error”End IfIf (JI2(intCount).pStatus And JOB_STATUS_PAPEROUT) ThentempStr = tempStr & “Paper Out”End IfIf (JI2(intCount).pStatus And JOB_STATUS_PRINTING) ThentempStr = tempStr & “Printing”End IfIf (JI2(intCount).pStatus And JOB_STATUS_USER_INTERVENTION) ThentempStr = tempStr & “User Intervention Needed”End IfIf Len(tempStr) = 0 ThentempStr = “Unknown Status of ” & JI2(intCount).PrinterStatusEnd IfEnd IfElsetempStr = Pointer_to_String(JI2(intCount).pStatus)End If’Report the job status.JobStr = JobStr & tempStr & vbCrLfNext intCountCatch ex As ExceptionMessageBox.Show(ex.Message)End TryEnd If’Close the printer handle.API.ClosePrinter(hPrinter)End FunctionEnd ClassOn the Build menu, click Build Solution.Click Start, and then click Printers and Faxes.
Note On a computer that is running Microsoft Windows 2000, click Start, point to Settings, and then click Printers.In the Printers and Faxes window, double-click the icon for the printer whose queue you want to view.
Note In the Printers window on a computer that is running Windows 2000, double-click the icon for the printer whose queue you want to view.On the Printer menu in the PrinterName dialog box, click Pause Printing.
Note You may not be able to pause the print queue on a network printer.On the Debug menu in Visual Studio .NET, click Start to run the application.In the Form1 form, click Start to obtain the printer information and the list of jobs in the queue.
TroubleshootingOnly a specific device driver can obtain accurate printer status information. This sample code obtains the same status that the Windows spooler reports.
The exact status that is reported may vary for different printers and for different drivers.