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

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.

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 Improve String Concatenation Performance

Symptoms
When concatenating large strings on the order of 50kb or larger (for example, building an HTML table from a database), the length of time to complete can become quite long as the string gets larger. This article demonstrates an alternative to normal concatenation that can improve performance for large strings by 20 times or more.
Resolution
When performing repeated concatenations of the type:

For I = 1 To NDest = Dest & SourceNext N the length of time increases proportionally to N-squared. Therefore, 1000 iterations will take about 100 times longer than 100 iterations. This is because Visual Basic does not just add the Source characters to the end of the Dest string; it also performs the following operations:
Allocates temporary memory large enough to hold the result. Copies Dest to the start of the temporary area. Copies Source to the end of the temporary area. De-allocates the old copy of Dest. Allocates memory for Dest large enough to hold the result. Copies the temporary data to Dest. Steps 2 and 6 are very expensive and basically result in the entire concatenated result being copied twice with additional overhead to allocate and de-allocate memory.
This article details a method using the Mid$ statement and pre-allocating memory in larger chunks to eliminate all but step 3 above for most of the concatenation phase.
WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWN RISK. Microsoft provides this code “as is” without warranty of any kind, either express or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose.
Step-by-Step ExampleType the following code into a module:

Option Explicit’ For 16-bit products, uncomment the next three lines by removing the’ single quotes and add a single quote to comment out the following’ three lines.’Const ConcatStr = “ABC”‘Const ccIncrement = 15000′Declare Function GetTickCount Lib “USER” () As LongConst ConcatStr = “ABCDEFGHIJKLMNOPQRSTUVWXYZ”Const ccIncrement = 50000Private Declare Function GetTickCount Lib “KERNEL32″ () As LongDim ccOffset As LongSub StdConcat(ByVal LoopCount As Long)Dim BigStr As String, I As Long, StartTick As LongStartTick = GetTickCount()For I = 1 To LoopCountBigStr = BigStr & ConcatStrNext IDebug.Print LoopCount; “concatenations took”;Debug.Print GetTickCount() – StartTick; “ticks”End SubSub Test_Concat()Debug.Print “Using standard concatenation”StdConcat 1000StdConcat 2000StdConcat 3000StdConcat 4000StdConcat 5000Debug.PrintDebug.Print “Using pre-allocated storage and pseudo-concatenation”MidConcat 1000MidConcat 2000MidConcat 3000MidConcat 4000MidConcat 5000End SubSub Concat(Dest As String, Source As String)Dim L As LongL = Len(Source)If (ccOffset + L) >= Len(Dest) ThenIf L > ccIncrement ThenDest = Dest & Space$(L)ElseDest = Dest & Space$(ccIncrement)End IfEnd IfMid$(Dest, ccOffset + 1, L) = SourceccOffset = ccOffset + LEnd SubSub MidConcat(ByVal LoopCount As Long)Dim BigStr As String, I As Long, StartTick As LongStartTick = GetTickCount()ccOffset = 0For I = 1 To LoopCountConcat BigStr, ConcatStrNext IBigStr = Left$(BigStr, ccOffset)Debug.Print LoopCount; “pseudo-concatenations took”;Debug.Print GetTickCount() – StartTick; “ticks”End Sub In the Debug/Immediate Window, type Test_Concat, and hit the Enter key.
The results will look similar to:

Using standard concatenation1000 concatenations took 2348 ticks2000 concatenations took 8954 ticks3000 concatenations took 20271 ticks4000 concatenations took 35103 ticks5000 concatenations took 54453 ticksUsing pre-allocated storage and pseudo-concatenation1000 pseudo-concatenations took 82 ticks2000 pseudo-concatenations took 124 ticks3000 pseudo-concatenations took 165 ticks4000 pseudo-concatenations took 247 ticks5000 pseudo-concatenations took 289 ticks
Additional InformationThe code may take a couple of minutes to run. GetTickCount returns the number of milliseconds since Windows was started. Therefore, the output is in milliseconds. Performance improvement ranges from almost 30 times for the 1000-iteration case to almost 200 times for the 5000-iteration case. These times may vary depending on:
The product used. Your system configuration..The size of ccIncrement (larger size favors MidConcat).The number of iterations used (more iterations favors MidConcat).The size of the resultant string (larger size favors MidConcat).

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.

How To Call GetNetworkParams/GetAdaptersInfo From Visual Basic

Symptoms
This article illustrates how to programmatically retrieve IP configuration information similar to the IPCONFIG.EXE utility. It demonstrates how to use the IP Helper APIs GetNetworkParams() and GetAdaptersInfo() from Visual Basic.
The libraries called by the code sample in this article are only supportedon the following platforms:
Microsoft Windows 2000
Microsoft Windows 98
Microsoft Windows Millennium Edition (Me)Running it on any other platform results in an error.
Resolution
Start a new Visual Basic Standard EXE project. Form1 is created by default.On the Project menu, click Remove Form1.On the Project menu, click Add Module. Module1 is created by default.Paste the following code in the General Declarations section of Module1:

Public Const MAX_HOSTNAME_LEN = 132Public Const MAX_DOMAIN_NAME_LEN = 132Public Const MAX_SCOPE_ID_LEN = 260Public Const MAX_ADAPTER_NAME_LENGTH = 260Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132Public Const ERROR_BUFFER_OVERFLOW = 111Public Const MIB_IF_TYPE_ETHERNET = 6Public Const MIB_IF_TYPE_TOKENRING = 9Public Const MIB_IF_TYPE_FDDI = 15Public Const MIB_IF_TYPE_PPP = 23Public Const MIB_IF_TYPE_LOOPBACK = 24Public Const MIB_IF_TYPE_SLIP = 28Type IP_ADDR_STRINGNext As LongIpAddress As String * 16IpMask As String * 16Context As LongEnd TypeType IP_ADAPTER_INFONext As LongComboIndex As LongAdapterName As String * MAX_ADAPTER_NAME_LENGTHDescription As String * MAX_ADAPTER_DESCRIPTION_LENGTHAddressLength As LongAddress(MAX_ADAPTER_ADDRESS_LENGTH – 1) As ByteIndex As LongType As LongDhcpEnabled As LongCurrentIpAddress As LongIpAddressList As IP_ADDR_STRINGGatewayList As IP_ADDR_STRINGDhcpServer As IP_ADDR_STRINGHaveWins As BytePrimaryWinsServer As IP_ADDR_STRINGSecondaryWinsServer As IP_ADDR_STRINGLeaseObtained As LongLeaseExpires As LongEnd TypeType FIXED_INFOHostName As String * MAX_HOSTNAME_LENDomainName As String * MAX_DOMAIN_NAME_LENCurrentDnsServer As LongDnsServerList As IP_ADDR_STRINGNodeType As LongScopeIdAs String * MAX_SCOPE_ID_LENEnableRouting As LongEnableProxy As LongEnableDns As LongEnd TypePublic Declare Function GetNetworkParams Lib “IPHlpApi.dll” _(FixedInfo As Any, pOutBufLen As Long) As LongPublic Declare Function GetAdaptersInfo Lib “IPHlpApi.dll” _(IpAdapterInfo As Any, pOutBufLen As Long) As LongPublic Declare Sub CopyMemory Lib “kernel32″ Alias “RtlMoveMemory” _(Destination As Any, Source As Any, ByVal Length As Long)Sub main()Dim error As LongDim FixedInfoSize As LongDim AdapterInfoSize As LongDim i As IntegerDim PhysicalAddressAs StringDim NewTime As DateDim AdapterInfo As IP_ADAPTER_INFODim AddrStr As IP_ADDR_STRINGDim FixedInfo As FIXED_INFODim Buffer As IP_ADDR_STRINGDim pAddrStr As LongDim pAdapt As LongDim Buffer2 As IP_ADAPTER_INFODim FixedInfoBuffer() As ByteDim AdapterInfoBuffer() As Byte’ Get the main IP configuration information for this machine’ using a FIXED_INFO structure.FixedInfoSize = 0error = GetNetworkParams(ByVal 0&, FixedInfoSize)If error <> 0 ThenIf error <> ERROR_BUFFER_OVERFLOW ThenMsgBox “GetNetworkParams sizing failed with error ” & errorExit SubEnd IfEnd IfReDim FixedInfoBuffer(FixedInfoSize – 1)error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)If error = 0 ThenCopyMemory FixedInfo, FixedInfoBuffer(0), FixedInfoSizeMsgBox “Host Name:” & FixedInfo.HostNameMsgBox “DNS Servers:” & FixedInfo.DnsServerList.IpAddresspAddrStr = FixedInfo.DnsServerList.NextDo While pAddrStr <> 0CopyMemory Buffer, ByVal pAddrStr, LenB(Buffer)MsgBox “DNS Servers:” & Buffer.IpAddresspAddrStr = Buffer.NextLoopSelect Case FixedInfo.NodeTypeCase 1MsgBox “Node type: Broadcast”Case 2MsgBox “Node type: Peer to peer”Case 4MsgBox “Node type: Mixed”Case 8MsgBox “Node type: Hybrid”Case ElseMsgBox “Unknown node type”End SelectMsgBox “NetBIOS Scope ID:” & FixedInfo.ScopeIdIf FixedInfo.EnableRouting ThenMsgBox “IP Routing Enabled “ElseMsgBox “IP Routing not enabled”End IfIf FixedInfo.EnableProxy ThenMsgBox “WINS Proxy Enabled “ElseMsgBox “WINS Proxy not Enabled “End IfIf FixedInfo.EnableDns ThenMsgBox “NetBIOS Resolution Uses DNS “ElseMsgBox “NetBIOS Resolution Does not use DNS”End IfElseMsgBox “GetNetworkParams failed with error ” & errorExit SubEnd If’ Enumerate all of the adapter specific information using the’ IP_ADAPTER_INFO structure.’ Note:IP_ADAPTER_INFO contains a linked list of adapter entries.AdapterInfoSize = 0error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)If error <> 0 ThenIf error <> ERROR_BUFFER_OVERFLOW ThenMsgBox “GetAdaptersInfo sizing failed with error ” & errorExit SubEnd IfEnd IfReDim AdapterInfoBuffer(AdapterInfoSize – 1)’ Get actual adapter informationerror = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)If error <> 0 ThenMsgBox “GetAdaptersInfo failed with error ” & errorExit SubEnd If’ Allocate memoryCopyMemory AdapterInfo, AdapterInfoBuffer(0), AdapterInfoSizepAdapt = AdapterInfo.NextDoCopyMemory Buffer2, AdapterInfo, AdapterInfoSizeSelect Case Buffer2.TypeCase MIB_IF_TYPE_ETHERNETMsgBox “Adapter name: Ethernet adapter “Case MIB_IF_TYPE_TOKENRINGMsgBox “Adapter name: Token Ring adapter “Case MIB_IF_TYPE_FDDIMsgBox “Adapter name: FDDI adapter “Case MIB_IF_TYPE_PPPMsgBox “Adapter name: PPP adapter”Case MIB_IF_TYPE_LOOPBACKMsgBox “Adapter name: Loopback adapter “Case MIB_IF_TYPE_SLIPMsgBox “Adapter name: Slip adapter “Case ElseMsgBox “Adapter name: Other adapter “End SelectMsgBox “AdapterDescription: ” & Buffer2.DescriptionPhysicalAddress = “”For i = 0 To Buffer2.AddressLength – 1PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))If i < Buffer2.AddressLength – 1 ThenPhysicalAddress = PhysicalAddress & “-”End IfNextMsgBox “Physical Address: ” & PhysicalAddressIf Buffer2.DhcpEnabled ThenMsgBox “DHCP Enabled “ElseMsgBox “DHCP disabled”End IfMsgBox “IP Address: ” & Buffer2.IpAddressList.IpAddressMsgBox “Subnet Mask: ” & Buffer2.IpAddressList.IpMaskpAddrStr = Buffer2.IpAddressList.NextDo While pAddrStr <> 0CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)MsgBox “IP Address: ” & Buffer.IpAddressMsgBox “Subnet Mask: ” & Buffer.IpMaskpAddrStr = Buffer.NextIf pAddrStr <> 0 ThenCopyMemory Buffer2.IpAddressList, ByVal pAddrStr, _LenB(Buffer2.IpAddressList)End IfLoopMsgBox “Default Gateway: ” & Buffer2.GatewayList.IpAddresspAddrStr = Buffer2.GatewayList.NextDo While pAddrStr <> 0CopyMemory Buffer, Buffer2.GatewayList, LenB(Buffer)MsgBox “IP Address: ” & Buffer.IpAddresspAddrStr = Buffer.NextIf pAddrStr <> 0 ThenCopyMemory Buffer2.GatewayList, ByVal pAddrStr, _LenB(Buffer2.GatewayList)End IfLoopMsgBox “DHCP Server: ” & Buffer2.DhcpServer.IpAddressMsgBox “Primary WINS Server: ” & _Buffer2.PrimaryWinsServer.IpAddressMsgBox “Secondary WINS Server: ” & _Buffer2.SecondaryWinsServer.IpAddress’ Display time.NewTime = DateAdd(“s”, Buffer2.LeaseObtained, #1/1/1970#)MsgBox “Lease Obtained: ” & _CStr(Format(NewTime, “dddd, mmm d hh:mm:ss yyyy”))NewTime = DateAdd(“s”, Buffer2.LeaseExpires, #1/1/1970#)MsgBox “Lease Expires :” & _CStr(Format(NewTime, “dddd, mmm d hh:mm:ss yyyy”))pAdapt = Buffer2.NextIf pAdapt <> 0 ThenCopyMemory AdapterInfo, ByVal pAdapt, AdapterInfoSizeEnd IfLoop Until pAdapt = 0End Sub Press the F5 key to run the project, click OK on each of the message boxes that are displayed, and note the results.Running this sample as compiled, EXE gives the following error message at the end:

Runtime error 10: this array is fixed and temporary locked.Running this inside IDE generates IPF at VB6.EXE at the end.