ODBC32 SQLColAttribute does not work, why? - vb.net

Ok, I'm writing a VB.Net application, and I'm using the ODBC32 DLL. Why? Because the ODBC interface classes cannot handle all of the field types from Informix databases, noteably the TimeSpan type.
I can successfully connect to ODBC databases, query the user for a DSN, and successfully pull data, so long as I just want the data returned as a string or a number. If, on the other hand, if I try to get some meta data about the columns I'm pulling in order to convert the returned data into specific data types, I get an error.
"vshost32.exe has stopped working" - I can look online for a solution, close the program or wait. There are no options to look at the code itself with live debugging.
When I do not get this error, I get a memory access violation, but I don't have any details there.
So my question is, why does the other stuff work, but this one, really important thing not work? Do I need to write this in something that isn't VB.Net? Will C# work?
Below is the contents of the class file. I apologize as it's a lot of stuff, but I didn't want to leave anything out. Kind of like going to the doctor and not telling them about all the donuts. The actual SQL doesn't seem to matter. "Select {any column} from {any table}" is what I've been using with a table that has 120 records. Without looking at the column meta data it seems to work fine.
Public Class ODBC32Interface
Public Declare Function SQLAllocEnv Lib "odbc32.dll" (ByRef env As Integer) As Short
Public Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal env As Integer, ByRef lHdbc As Integer) As Short
Public Declare Function SQLAllocHandle Lib "odbc32.dll" (ByVal handleType As Short, ByVal inputHandle As Integer, _
ByRef outputHandle As Integer) As Short
Public Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal connectionHandle As Integer, ByRef hStmt As Integer) As Short
Public Declare Function SQLDriverConnect Lib "ODBC32.DLL" (ByVal ConnectionHandle As Integer, _
ByVal WindowHandle As Integer, _
ByVal InConnectionString As String, _
ByVal StringLength1 As Short, _
ByVal OutConnectionString As String, _
ByVal BufferLength As Short, _
ByRef StringLength2Ptr As Short, _
ByVal DriverCompletion As Short) As Short
Public Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal lHdbc As Integer) As Short
Public Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal lHdbc As Integer) As Short
Public Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal env As Integer) As Short
Public Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal statementhandle As Integer, ByVal [option] As Short) As Short
Public Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal statementHandle As Integer, ByVal statementText As String, _
ByVal textLength As Short) As Short
Public Declare Function SQLFetch Lib "odbc32.dll" (ByVal statementhandle As Integer) As Short
Public Declare Function SQLGetData Lib "odbc32.dll" (ByVal statementhandle As Integer, ByVal columnnumber As Short, _
ByVal targetType As Short, ByVal targetValue As StringBuilder, _
ByVal bufferLength As Integer, ByRef strLen_or_Ind As Integer) As Short
Public Declare Function SQLRowCount Lib "odbc32.dll" (ByVal statementhandle As Integer, ByRef rowcount As Integer) As Short
'' http://msdn.microsoft.com/en-us/library/ms711683%28v=vs.85%29.aspx
Public Declare Function SQLColumns Lib "odbc32.dll" (ByVal statementhandle As Integer, _
ByVal catalogname As String, _
ByVal namelength1 As Integer, _
ByVal schemaname As String, _
ByVal namelength2 As Integer, _
ByVal tablename As String, _
ByVal namelength3 As Integer, _
ByVal columnname As String, _
ByVal namelength4 As Integer) As Short
'' http://msdn.microsoft.com/en-us/library/ms715393%28v=vs.85%29.aspx
Public Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal StatementHandle As Integer, _
ByRef ColumnCountPtr As Integer) As Short
'' http://msdn.microsoft.com/en-us/library/ms713558%28v=vs.85%29.aspx
'' see if column 10 for fieldidentifier returns the column name
Public Declare Function SQLColAttribute Lib "odbc32.dll" (ByVal StatementHandle As Integer, _
ByVal ColumnNumber As Integer, _
ByVal FieldIdentifier As Integer, _
ByRef CharacterAttributePtr As String, _
ByVal BufferLength As Integer, _
ByRef StringLengthPtr As Integer, _
ByRef NumericAttributePtr As Integer) As Short
' '' http://msdn.microsoft.com/en-us/library/ms716289%28v=vs.85%29.aspx
' '' this is causing an access violation, may not be usable
'Public Declare Function SQLDescribeCol Lib "odbc32.dll" (ByVal statementhandle As Integer, ByVal columnnumber As Integer, _
' ByRef columnname As String, ByVal bufferlength As Integer, _
' ByRef NameLengthPtr As Integer, ByRef DataTypePtr As Integer, _
' ByRef ColumnSize As Integer, ByRef DecimalDigitsPtr As Integer, _
' ByRef NullablePtr As Integer) As Short
Public Declare Function SQLError Lib "odbc32.dll" (ByVal environmentHandle As Integer, ByVal connectionHandle As Integer, ByVal statementHandle As Integer, _
ByVal sqlState As StringBuilder, ByRef nativeError As Integer, ByVal msgText As StringBuilder, _
ByVal bufferLength As Short, ByRef textLength As Short) As Short
Public ErrorFlag As Boolean = False
Public ErrorMessages As String = ""
'' save connection info/error messages here
'Public InfoMessage As String = ""
'Public ErrorMessage As String = ""
Const SQL_NTS = -3 'Null-terminated string
Const SQL_C_CHAR = 1
Const SQL_NOSCAN = 2
Const SQL_NOSCAN_ON = 1
Const SQL_NULL_HENV = 0
Const SQL_NULL_HDBC = 0
Const SQL_NULL_HSTMT = 0
Const SQL_SUCCESS = 0
Const MAXBUFLEN = 255
Const MAX_DATA_BUFFER = 255
Const SQL_HANDLE_ENV = 1
Const SQL_HANDLE_DBC = 2
Const SQL_HANDLE_STMT = 3
Const SQL_HANDLE_DESC = 4
Const SQL_CLOSE = 0
Const SQL_DROP = 1
Const SQL_UNBIND = 2
Const SQL_RESET_PARAMS = 3
Const SQL_DRIVER_PROMPT = 2
Const SQL_DRIVER_CONNECT = 0
Const SQL_COLUMN_COUNT = 0
Const SQL_COLUMN_NAME = 1
Const SQL_COLUMN_TYPE = 2
'' http://www.ncbi.nlm.nih.gov/IEB/ToolBox/CPP_DOC/lxr/source/include/dbapi/driver/odbc/unix_odbc/sqlext.h#L575
Const SQL_COLUMN_LENGTH = 3
Const COLUMN_PRECISION = 4
Const SQL_COLUMN_SCALE = 5
Const SQL_COLUMN_DISPLAY_SIZE = 6
Const SQL_COLUMN_NULLABLE = 7
Const SQL_COLUMN_UNSIGNED = 8
Const SQL_COLUMN_MONEY = 9
Const SQL_COLUMN_UPDATABLE = 10
Const SQL_COLUMN_AUTO_INCREMENT = 11
Const SQL_COLUMN_CASE_SENSITIVE = 12
Const SQL_COLUMN_SEARCHABLE = 13
Const SQL_COLUMN_TYPE_NAME = 14
Const SQL_COLUMN_TABLE_NAME = 15
Const SQL_COLUMN_OWNER_NAME = 16
Const SQL_COLUMN_QUALIFIER_NAME = 17
Const SQL_COLUMN_LABEL = 18
Const SQL_COLATT_OPT_MAX = SQL_COLUMN_LABEL
Const SQL_COLUMN_DRIVER_START = 1000
Const SQL_DESC_NAME = SQL_COLUMN_NAME
Const SQL_DESC_ARRAY_SIZE = 20
Const SQL_DESC_ARRAY_STATUS_PTR = 21
Const SQL_DESC_AUTO_UNIQUE_VALUE = SQL_COLUMN_AUTO_INCREMENT
Const SQL_DESC_BASE_COLUMN_NAME = 22
Const SQL_DESC_BASE_TABLE_NAME = 23
Const SQL_DESC_BIND_OFFSET_PTR = 24
Const SQL_DESC_BIND_TYPE = 25
Const SQL_DESC_CASE_SENSITIVE = SQL_COLUMN_CASE_SENSITIVE
Const SQL_DESC_CATALOG_NAME = SQL_COLUMN_QUALIFIER_NAME
Const SQL_DESC_CONCISE_TYPE = SQL_COLUMN_TYPE
Const SQL_DESC_DATETIME_INTERVAL_PRECISION = 26
Const SQL_DESC_DISPLAY_SIZE = SQL_COLUMN_DISPLAY_SIZE
Const SQL_DESC_FIXED_PREC_SCALE = SQL_COLUMN_MONEY
Const SQL_DESC_LABEL = SQL_COLUMN_LABEL
Const SQL_DESC_LITERAL_PREFIX = 27
Const SQL_DESC_LITERAL_SUFFIX = 28
Const SQL_DESC_LOCAL_TYPE_NAME = 29
Const SQL_DESC_MAXIMUM_SCALE = 30
Const SQL_DESC_MINIMUM_SCALE = 31
Const SQL_DESC_NUM_PREC_RADIX = 32
Const SQL_DESC_PARAMETER_TYPE = 33
Const SQL_DESC_ROWS_PROCESSED_PTR = 34
Const SQL_DESC_ROWVER = 35
Const SQL_DESC_SCHEMA_NAME = SQL_COLUMN_OWNER_NAME
Const SQL_DESC_SEARCHABLE = SQL_COLUMN_SEARCHABLE
Const SQL_DESC_TYPE_NAME = SQL_COLUMN_TYPE_NAME
Const SQL_DESC_TABLE_NAME = SQL_COLUMN_TABLE_NAME
Const SQL_DESC_UNSIGNED = SQL_COLUMN_UNSIGNED
Const SQL_DESC_UPDATABLE = SQL_COLUMN_UPDATABLE
'' ********************************************************************************
'' ** ODBC32.DLL database functions
'' ********************************************************************************
'' largely copied from http://www.vbexplorer.com/VBExplorer/viewcode.asp?SendText=files/Odbcmthd
'' here's another code sample - http://www.pinvoke.net/default.aspx/odbc32.SQLBindCol
'' with references to pinvoke.net - http://www.pinvoke.net/default.aspx/odbc32.SQLGetDiagField
Public Shared Function ODBC32Dialog(ByRef callingform As Form) As String
Dim Buf As String = New String(" "c, MAX_DATA_BUFFER)
Dim constr As String = ""
Dim outlen As Short
Dim Retcode As Short
Dim hEnv As Integer
Dim hDBC As Integer
If SQLAllocEnv(hEnv) = SQL_SUCCESS Then
If SQLAllocConnect(hEnv, hDBC) = SQL_SUCCESS Then
'' this pops up the ODBC driver window
'' how do we do this to not get the driver window, but rather use a specific driver?
'' SQLDriverConnect(hDBC, Screen.ActiveForm.hWnd, sConnect (connection string), Len(sConnect), _
'' Buf, MAXBUFLEN, iSize, SQL_DRIVER_CONNECT)
If SQLDriverConnect(hDBC, callingform.Handle.ToInt32, constr, Len(constr), Buf, MAX_DATA_BUFFER, outlen, SQL_DRIVER_PROMPT) = SQL_SUCCESS Then
Retcode = SQLDisconnect(hDBC)
End If
Retcode = SQLFreeConnect(hDBC)
End If
Retcode = SQLFreeEnv(hEnv)
Else
'' could not allocate memory for the connection handle
End If
Return Buf
End Function
'' return a connection pointer
Public Shared Function ODBC32SqlExecDirect(ByVal dsn As String, ByRef callingform As Form, ByVal sqlstatement As String) As Object
Dim Buf As String = New String(" "c, MAX_DATA_BUFFER)
Dim dsnlen As Integer = Len(dsn)
Dim constr As String = ""
Dim outlen As Short
Dim hEnv As Integer
Dim hDBC As Integer
Dim hStmt As Integer
'' SQLExecDirect & SQLError
Dim lRet As Integer
Dim sSqlState As StringBuilder = New StringBuilder(MAX_DATA_BUFFER)
Dim sErrorMsg As StringBuilder = New StringBuilder(MAX_DATA_BUFFER)
Dim lErrNo As Integer
Dim iLen As Integer
Dim sMsg As String
'' SQLFetch
Dim bPerform As Integer = 0
Dim iStatus As Integer = 0
Dim sData As StringBuilder = New StringBuilder(MAX_DATA_BUFFER)
Dim sData2 As String = New String(" "c, MAX_DATA_BUFFER)
Dim lOutLen As Integer = 0
Dim iColumn As Integer = 1
Dim iFieldColumn As Integer = 0
Dim numresultcols As Integer = 0
Dim describeresult As Integer = 0
'' I don't know if I should SQLFreeConnect and SQLFreeEnv here or not
'' I get the feeling that they should stick around for awhile, and disconnect all at once
'' Perhaps we should create an object that holds all three values and returns them
'' or just do everything in this one function - connect, pull data, disconnect since it all works with discrete functions
bPerform = SQLAllocEnv(hEnv)
If bPerform = SQL_SUCCESS Then
Debug.Print("* Initialized odbc drivers")
bPerform = SQLAllocConnect(hEnv, hDBC)
If bPerform = SQL_SUCCESS Then
Debug.Print("* Allocated connection handle")
Debug.Print("* DSN: " & dsn)
bPerform = SQLDriverConnect(hDBC, callingform.Handle.ToInt32, dsn, dsnlen, Buf, MAXBUFLEN, outlen, SQL_DRIVER_CONNECT)
If bPerform = SQL_SUCCESS Then
Debug.Print("* Connected to the driver")
If SQLAllocStmt(hDBC, hStmt) = SQL_SUCCESS Then
Debug.Print("* Allocated statement handle")
If SQLExecDirect(hStmt, sqlstatement, Len(sqlstatement)) = SQL_SUCCESS Then
Debug.Print("* Executed sql statement")
'' this is how many columns we have in our result set
SQLNumResultCols(hStmt, numresultcols)
'' go through all the column information and spit it out, let's see what we've got here
Debug.Print("* NumResultCols: " & numresultcols)
'iFieldColumn = CInt(InputBox("enter the ifieldcolumn integer value"))
iFieldColumn = SQL_DESC_LOCAL_TYPE_NAME
Try
'' trying to use SQLColAttribute
For i As Integer = 1 To numresultcols
Dim iStringLength As Integer = 0
Dim iNumericAttribute As Integer = 0
describeresult = SQLColAttribute(hStmt, i, iFieldColumn, sData2, MAX_DATA_BUFFER, iStringLength, iNumericAttribute)
Debug.Print("Column #: " & i & " / Describe Result: " & describeresult)
Debug.Print("** Field Identifier: " & iFieldColumn)
Debug.Print("** String Value: " & sData2)
Debug.Print("** String Length: " & iStringLength)
Debug.Print("** Numeric Attribute: " & iNumericAttribute)
Debug.Print(" ")
Next
Catch ex As Exception
Debug.Print("System Access Violation")
Debug.Print(ex.ToString())
If Not (ex.InnerException Is Nothing) Then
Debug.Print(ex.InnerException.ToString())
End If
End Try
'' this works just fine
'Try
' '' start pulling data from the database
' bPerform = SQLFetch(hStmt)
' Debug.Print("* Initial bPerform: " & bPerform)
' Do While (bPerform = SQL_SUCCESS)
' bPerform = SQLFetch(hStmt)
' Debug.Print("* bPerform: " & bPerform)
' If bPerform = SQL_SUCCESS Then
' '' how many columns exist in the statement results?
' iStatus = SQLGetData(hStmt, iColumn, 1, sData, MAX_DATA_BUFFER, lOutLen)
' Debug.Print("* iStatus: " & iStatus)
' Debug.Print("* sData: " & sData.ToString())
' End If
' Loop
' bPerform = SQLFreeStmt(hStmt, SQL_DROP)
'Catch ex As Exception
' Debug.Print("* " & ex.ToString())
' If Not (ex.InnerException Is Nothing) Then
' Debug.Print("* " & ex.InnerException.ToString())
' End If
'End Try
Else
'' execute query failed - check for error
lRet = SQLError(hEnv, hDBC, hStmt, sSqlState, lErrNo, sErrorMsg, MAX_DATA_BUFFER, iLen)
sMsg = "Error executing SQL statement" & vbCrLf
sMsg &= "ODBC State: " & Trim(Left(sSqlState.ToString(), InStr(sSqlState.ToString(), Chr(0)) - 1)) & vbCrLf
sMsg &= "ODBC Error Message: " & Left(sErrorMsg.ToString(), iLen)
Debug.Print("* " & sMsg)
End If
Else
'' could not allocate statement handle
Debug.Print("* Could not allocate statement handle")
End If
Else
'' unable to connect to the driver
Debug.Print("* Unable to connect to the driver")
Debug.Print("* bPerform: " & bPerform)
lRet = SQLError(hEnv, hDBC, hStmt, sSqlState, lErrNo, sErrorMsg, MAX_DATA_BUFFER, iLen)
sMsg = "Error executing SQL statement" & vbCrLf
'sMsg &= "ODBC State: " & Trim(Left(sSqlState.ToString(), InStr(sSqlState.ToString(), Chr(0)) - 1)) & vbCrLf
sMsg &= "ODBC State: " & Trim(sSqlState.ToString()) & vbCrLf
sMsg &= "ODBC Error Message: " & Left(sErrorMsg.ToString(), iLen)
Debug.Print("* " & sMsg)
End If
'Retcode = SQLDisconnect(hDBC)
Else
'' unable to allocate memory for connection handle
Debug.Print("* Unable to allocate memory for the connection handle")
End If
'Retcode = SQLFreeConnect(hDBC)
Else
'' unable to initialize odbc drivers
Debug.Print("* Unable to initialize the odbc drivers")
End If
'Retcode = SQLFreeEnv(hEnv)
SQLDisconnect(hDBC)
SQLFreeConnect(hDBC)
SQLFreeEnv(hEnv)
Return Nothing
'Return hDBC
End Function
End Class
For some reason, getting "End Class" in the code block is being problematic.

FIrstly, I should say I don't write VB and never have. I have however written a lot of stuff to ODBC and some ODBC drivers. The definition of SQLColAttribute (and probably a number of others) is suspect as SQLColAttribute is:
SQLRETURN SQLColAttribute (
SQLHSTMT StatementHandle,
SQLUSMALLINT ColumnNumber,
SQLUSMALLINT FieldIdentifier,
SQLPOINTER CharacterAttributePtr,
SQLSMALLINT BufferLength,
SQLSMALLINT * StringLengthPtr,
SQLLEN * NumericAttributePtr);
You are passing VB Integer as args for ColumnNumber and FieldIdentifier and BufferLength which might be ok but it contradicts the NumericAttributePointer which is double the size on 32 bit platforms (and 4* the size on 64 bit platforms) of a SQLUSMALLINT or SQLSMALLINT. So, I doubt you can use Integer for all those arguments.
If say VB Integer was 2 bytes then when you call SQLColAttribute the driver will write 4 bytes into the location pointed to by NumericAttributePtr. If VB Integer is 4 bytes then the values passed for the other args is wrong.

Related

Type mismatch Error / Privat Sub / VBA 32-bit and 64-bit

since I have relatively little experience with VBA programming, I hope that you might be able to help me. I have the following problem. We use a script that is only designed for 32 bit but does not work on 64 bit "PrtSafe Error". I have adjusted my code accordingly and now I keep getting a Type Mismatch Error when ** Private Sub getRawDataByMatDate () ** is shown highlighted in yellow. What could be the problem? See code:
Option Explicit
#If VBA7 Then
'64 bit declares here
Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long
#Else
'32 bit declares here
Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If
```
' Gibt angemeldeten Benutzernamen zurück
Private Function getCurrentUsername()
Dim Retval As Long
Dim Puffer As String * 256
Dim UserName As String
Retval = GetUserName(Puffer, Len(Puffer))
' Bei vbNullChar "abtrennen" und anzeigen
If Retval <> 0 Then
UserName = Left$(Puffer, InStr(1, Puffer, vbNullChar) - 1)
getCurrentUsername = UserName
Else
getCurrentUsername = ""
End If
End Function
**Mismatch Type error**
' Holt Rohdaten aus DB. Die Abfragekriterien sind Materialnummer
' und Start und Enddatum. Verwendet Stored Procedures:
' proc_BTG_GeRawDataByMatChrg, proc_BTG_GeRawDataByMat
```
Private Sub getRawDataByMatDate()
Dim rs As ADODB.Recordset
Dim sQuery As String
Dim row As Integer, iCountRecords As Integer
Dim rec As Integer, rowOutput As Integer
Dim sMatnr As String, sDateFrom As String, sDateTo As String
Dim sDB As String
rowOutput = ROW_OUTPUT_START
iCountRecords = 0
MsgBox "date"
For row = ROW_BEREICH_START To ROW_BEREICH_END ' über abzufragende Mat, chrgnr.
sMatnr = Cells(row, COL_MATNR).Value ' eingaben von Tabelle
sDateFrom = Range(RANGE_DATE_FROM).Value
sDateTo = Range(RANGE_DATE_TO).Value
If sMatnr <> "" Then
sQuery = "exec " + PROC_GETRAWDATABYMATDATE + " " + sMatnr + _
",'" + sDateFrom + "','" + sDateTo + "'"
Set rs = conn.Execute(sQuery)
' recordset auf tabelle kopieren, feld obenlinks wird angegeben
Call Cells(rowOutput, COL_OUT_MATNR).CopyFromRecordset(rs)
iCountRecords = iCountRecords + rs.RecordCount
rowOutput = rowOutput + rs.RecordCount ' erste Zeile für nächste abfrage
End If
Next row
' Anzahl Datensätze ausgeben
Range(RANGE_COUNT_RECORDS).Value = CStr(iCountRecords) + " Datensätze"
End Sub

How to find a displayversion for a specific installed program in vb.net

I'm trying get a displayversion for a specific program in uninstall registry path. I can get it from a direct path or get the whole uninstall listed, but I cannot get it to find a specific program based on displayname and returns displayversion. Thank you if you can help or provide instruction.
Public Function GetDisplayLink() As String
On Error Resume Next
Dim strRegPath As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{772811A3-D34B-4594-AF3E-A7C655013E62}\"
Dim regVersion64 As Microsoft.Win32.RegistryKey = Microsoft.Win32.RegistryKey.OpenRemoteBaseKey(Microsoft.Win32.RegistryHive.LocalMachine, strWorkstation, Microsoft.Win32.RegistryView.Registry64).OpenSubKey(strRegPath)
Dim strDisplayLink As String = regVersion64.GetValue("DisplayVersion")
GetDisplayLink = "DisplayLink Driver|" & strDisplayLink & "<BR>"
regVersion64 = Nothing
End Function
I cannot get it to find a specific program based on displayname and
returns displayversion.
There are several ways (WMI, Shell, Msi, ...)
WMI is the simplest one but slow
A sample with Msi, test with "Microsoft Silverlight" on Windows 10 =>
Dim sProductName As String = "Microsoft Silverlight"
Dim nResult As UInteger = 0
Dim sProductCode As StringBuilder = New StringBuilder(256)
Dim nIndex As Integer = 0
Do While (True)
nResult = MsiEnumProducts(nIndex, sProductCode)
If (nResult <> 0) Then
Exit Do
End If
Dim nSize As Integer = 256
Dim sbProductName As StringBuilder = New StringBuilder(nSize)
nResult = MsiGetProductInfo(sProductCode.ToString(), "InstalledProductName", sbProductName, nSize)
If (sbProductName.ToString() = sProductName) Then
nSize = 256
Dim sbVersionString As StringBuilder = New StringBuilder(nSize)
nResult = MsiGetProductInfo(sProductCode.ToString(), "VersionString", sbVersionString, nSize)
Console.WriteLine("Product: {0}", sProductName)
Console.WriteLine(vbTab + "Code: {0}", sProductCode.ToString())
Console.WriteLine(vbTab + "Version: {0}", sbVersionString.ToString())
Exit Do
End If
nIndex += 1
Loop
With declarations :
<DllImport("Msi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function MsiEnumProducts(iProductIndex As Integer, lpProductBuf As StringBuilder) As UInteger
End Function
<DllImport("Msi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function MsiGetProductInfo(szProduct As String, szAttribute As String, lpValueBuf As StringBuilder, ByRef pcchValueBuf As Integer) As UInteger
End Function

Converting ImageCombo from VB6 to Vb.Net shows simple non Editable Textbox

I have the following code written in Vb6 for ImageCombo control.
Begin MSComctlLib.ImageCombo dImageCombo
Height = 330
Index = 0
Left = 120
TabIndex = 10
Top = 3480
Visible = 0 'False
Width = 1815
_ExtentX = 3201
_ExtentY = 582
_Version = 393216
ForeColor = -2147483640
BackColor = -2147483643
Text = "ImageCombo1"
End
Then I have a RenderCombo function as follows. It goes through each and every line of function and get a proper value as well for ItemList in ImageCombo but doesn't display anything. It simply appear as a Non Editable Textview.
Private Sub RenderCombo(a_dbmgr As ObjectDBManager, _
ByRef a_X As Integer, ByRef a_Y As Integer, _
bnode As DataSetNode, fldname As String, _
MaxPixHeight As Integer, ColMaxWidth As Integer, _
hLevels As Integer, YStart As Integer, gHeight As Integer, _
padding As Integer, gInframe As Boolean, a_tooltip As String)
Dim tstr As String
Dim ltmp As ComboItem
Dim lseldata As String
Dim loldcolwidth As Integer
Load dImageCombo(nCombos + 1)
nCombos = nCombos + 1
tstr = bnode.GetLeafString("WIDTH")
If tstr <> "" Then
dImageCombo(nCombos).Width = SafeCLng(tstr)
End If
dImageCombo(nCombos).Visible = True
dImageCombo(nCombos).Left = a_X
dImageCombo(nCombos).Top = a_Y
lseldata = bnode.GetLeafString("SELTABLENAV") & "+" & _
bnode.GetLeafString("SELMATCHFIELD") & "+" & _
bnode.GetLeafString("SELMATCHNAV") & "+" & _
bnode.GetLeafString("SELLABELNAME") & "+" & _
bnode.GetLeafString("SELNOBLANK") & "+" & _
bnode.GetLeafString("SELVALCAPS") & "+"
dImageCombo(nCombos).Tag = fldname & "+" & lseldata
mMakeComboList a_dbmgr, bnode, nCombos, lseldata
SetNextXY a_X, a_Y, dImageCombo(nCombos).Width, dImageCombo(nCombos).Height, _
MaxPixHeight, gHeight, hLevels, YStart, ColMaxWidth, loldcolwidth, "COMBO", gInframe
If gInframe Then
dFrame(nFrames).Width = mBumpWidth(dFrame(nFrames).Width, dImageCombo(nCombos).Left + loldcolwidth + padding, "COMBO")
Set dImageCombo(nCombos).Container = dFrame(nFrames)
End If
dImageCombo(nCombos).ToolTipText = a_tooltip
End Sub
Code that I've got in VB.Net after migration is as follows:
Private Sub RenderCombo(ByRef a_dbmgr As ObjectDBManager, ByRef a_X As Short, ByRef a_Y As Short, ByRef bnode As DataSetNode, ByRef fldname As String, ByRef MaxPixHeight As Short, ByRef ColMaxWidth As Short, ByRef hLevels As Short, ByRef YStart As Short, ByRef gHeight As Short, ByRef padding As Short, ByRef gInframe As Boolean, ByRef a_tooltip As String)
Dim tstr As String = ""
Dim ltmp As MSComctlLib.ComboItem
Dim lseldata As String = ""
Dim loldcolwidth As Short
dImageCombo.Load(nCombos + 1)
nCombos = nCombos + 1
tstr = bnode.GetLeafString("WIDTH")
If tstr <> "" Then
dImageCombo(nCombos).Width = SafeCLng(tstr)
End If
dImageCombo(nCombos).Visible = True
dImageCombo(nCombos).Left = a_X
dImageCombo(nCombos).Top = a_Y
lseldata = bnode.GetLeafString("SELTABLENAV") & "+" & bnode.GetLeafString("SELMATCHFIELD") & "+" & bnode.GetLeafString("SELMATCHNAV") & "+" & bnode.GetLeafString("SELLABELNAME") & "+" & bnode.GetLeafString("SELNOBLANK") & "+" & bnode.GetLeafString("SELVALCAPS") & "+"
dImageCombo(nCombos).Tag = fldname & "+" & lseldata
mMakeComboList(a_dbmgr, bnode, nCombos, lseldata)
SetNextXY(a_X, a_Y, dImageCombo(nCombos).Width, dImageCombo(nCombos).Height, MaxPixHeight, gHeight, hLevels, YStart, ColMaxWidth, loldcolwidth, "COMBO", gInframe)
If gInframe Then
dFrame(nFrames).Width = mBumpWidth(dFrame(nFrames).Width, dImageCombo(nCombos).Left + loldcolwidth + padding, "COMBO")
dImageCombo(nCombos).Parent = dFrame(nFrames)
End If
ToolTip1.SetToolTip(dImageCombo(nCombos), a_tooltip)
End Sub
Designer code after migration:
Friend WithEvents dImageCombo As AxImageComboArray
Friend WithEvents _dImageCombo_0 As AxMSComctlLib.AxImageCombo
Me._dImageCombo_0 = New AxMSComctlLib.AxImageCombo
Me.dImageCombo = New AxImageComboArray(Me.components)
CType(Me._dImageCombo_0, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.dImageCombo, System.ComponentModel.ISupportInitialize).BeginInit()
Me.dImageCombo.SetIndex(Me._dImageCombo_0, CType(0, Short))
Me._dImageCombo_0.Location = New System.Drawing.Point(8, 232)
Me._dImageCombo_0.Name = "_dImageCombo_0"
Me._dImageCombo_0.OcxState = CType(resources.GetObject("_dImageCombo_0.OcxState"), System.Windows.Forms.AxHost.State)
Me._dImageCombo_0.Size = New System.Drawing.Size(121, 22)
Me._dImageCombo_0.TabIndex = 10
Me._dImageCombo_0.Visible = False
Me.Controls.Add(Me._dImageCombo_0)
CType(Me._dImageCombo_0, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.dImageCombo, System.ComponentModel.ISupportInitialize).EndInit()
Here is the screenshot of ImageCombo that display as a simple TextBox in Vb.Net.
Any help would be appreciated.

Failed to write multilined result to text file vb.net

I have this function which return all TCP connections for all proccess
Declare Auto Function GetExtendedTcpTable Lib "iphlpapi.dll" (ByVal pTCPTable As IntPtr, ByRef OutLen As Integer, ByVal Sort As Boolean, ByVal IpVersion As Integer, ByVal dwClass As Integer, ByVal Reserved As Integer) As Integer
Const TCP_TABLE_OWNER_PID_ALL As Integer = 5
<StructLayout(LayoutKind.Sequential)> _
Public Structure MIB_TCPTABLE_OWNER_PID
Public NumberOfEntries As Integer 'number of rows
Public Table As IntPtr 'array of tables
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure MIB_TCPROW_OWNER_PID
Public state As Integer 'state of the connection
Public localAddress As UInteger
Public LocalPort As Integer
Public RemoteAddress As UInteger
Public remotePort As Integer
Public PID As Integer 'Process ID
End Structure
Structure TcpConnection
Public State As TcpState
Public localAddress As String
Public LocalPort As Integer
Public RemoteAddress As String
Public remotePort As Integer
Public Proc As String
End Structure
Function GetAllTCPConnections() As MIB_TCPROW_OWNER_PID()
GetAllTCPConnections = Nothing
Dim cb As Integer
GetExtendedTcpTable(Nothing, cb, False, 2, TCP_TABLE_OWNER_PID_ALL, 0)
Dim tcptable As IntPtr = Marshal.AllocHGlobal(cb)
If GetExtendedTcpTable(tcptable, cb, False, 2, TCP_TABLE_OWNER_PID_ALL, 0) = 0 Then
Dim tab As MIB_TCPTABLE_OWNER_PID = Marshal.PtrToStructure(tcptable, GetType(MIB_TCPTABLE_OWNER_PID))
Dim Mibs(tab.NumberOfEntries - 1) As MIB_TCPROW_OWNER_PID
Dim row As IntPtr
For i As Integer = 0 To tab.NumberOfEntries - 1
row = New IntPtr(tcptable.ToInt32 + Marshal.SizeOf(tab.NumberOfEntries) + Marshal.SizeOf(GetType(MIB_TCPROW_OWNER_PID)) * i)
Mibs(i) = Marshal.PtrToStructure(row, GetType(MIB_TCPROW_OWNER_PID))
Next
GetAllTCPConnections = Mibs
End If
Marshal.FreeHGlobal(tcptable)
End Function
Function MIB_ROW_To_TCP(ByVal row As MIB_TCPROW_OWNER_PID) As TcpConnection
Dim tcp As New TcpConnection
tcp.State = DirectCast(row.state, TcpState) 'a State enum is better than an int
Dim ipad As New IPAddress(row.localAddress)
tcp.localAddress = ipad.ToString
tcp.LocalPort = row.LocalPort / 256 + (row.LocalPort Mod 256) * 256
ipad = New IPAddress(row.RemoteAddress)
tcp.RemoteAddress = ipad.ToString
tcp.remotePort = row.remotePort / 256 + (row.remotePort Mod 256) * 256
Dim p As Process = Process.GetProcessById(row.PID)
tcp.Proc = p.ProcessName
p.Dispose()
Return tcp
End Function
I wan't to store only the out going connections of certain processes in a text file so I used
Sub main()
For Each Row In GetAllTCPConnections()
Dim Tcp As TcpConnection = MIB_ROW_To_TCP(Row)
Dim RemoteAddress As String = Tcp.RemoteAddress.ToString
Dim process As String = Tcp.Proc
If (process = "chrome" Or process = "Viber" Or process = "ddns") And (RemoteAddress <> "127.0.0.1") And (RemoteAddress <> "0.0.0.0") Then
Dim myFile As String = "C:\TCP.txt"
Using sw As StreamWriter = New StreamWriter(myFile)
Dim line As String = Tcp.RemoteAddress & "|" & Tcp.localAddress & "|" & Tcp.LocalPort & "|" & Tcp.Proc
sw.WriteLine(line)
MsgBox(line)
End Using
End If
Next
End Sub
msgbox works fine showing every process and out going connections that established by it but when I open
TCP.txt
file I only find one line.
So how to write the entire results (Each process with its out going connections) to the text file?
You need to set the append to text file.
You need to change:
Using sw As StreamWriter = New StreamWriter(myFile)
To
Using sw As StreamWriter = New StreamWriter(myFile, True)
By setting the true you set the append to file to true

HTTP Post/Upload From Visual Basic 6

I'm using Visual Basic 6 and want to do an HTTP POST to a server (it runs Java code) by sending a custom input field along with a PDF file. the PDF file would have to be base 64 bit encoded or use the normal way that HTTP POST work over the Internet when uploading a file. Basically, I just want to upload a file from my Visual Basic 6 program.
How do I do this? Any example source code?
Assuming you know how to load the PDF in to a byte array you've got to get it Base64 encoded and then post that to server using MIME multipart encoding.
You can utilise the MSXML libraries ability to perform Base64 encoding. See this link for details.
Once you have the PDF as a Bas64 string you need to package that as MIME multipart. You can use XMLHTTP object from MSXML to perform that posting for you:-
sEntityBody = "----boundary" & vbCrLf
sEntityBody = sEntityBody & "Content-Disposition: form-data; name=fileInputElementName; filename=""" + sFileName + """" & vbCrLf
sEntityBody = sEntityBody & "Content-Transfer-Encoding: base64" & vbCrLf
sEntityBody = sEntityBody & "Content-Type: application/pdf" & vbCrLf & vbCrLf
sEntityBody = sEntityBody & sPDFBase64 & vbCrLf
sEntityBody = sEntityBody & "-----boundary--" & vbCrLf & vbCrLf
Set xhr = New MSXML2.XMLHTTP30
xhr.setRequestHeader("Content-Type", "multipart/form-data; boundary=-----boundary")
xhr.Open "POST", sUrl, False
xhr.send sEntityBody
Perhaps not elegant or efficient but it should it work.
Here's the code to handle base 64
Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
Private Declare Function CryptStringToBinary Lib "Crypt32.dll" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
Public Function Base64Decode(sBase64Buf As String) As String
Const CRYPT_STRING_BASE64 As Long = 1
Dim bTmp() As Byte, lLen As Long, dwActualUsed As Long
If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen, 0&, dwActualUsed) = 0 Then Exit Function 'Get output buffer length
ReDim bTmp(lLen - 1)
If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, VarPtr(bTmp(0)), lLen, 0&, dwActualUsed) = 0 Then Exit Function 'Convert Base64 to binary.
Base64Decode = StrConv(bTmp, vbUnicode)
End Function
Public Function Base64Encode(Text As String) As String
Const CRYPT_STRING_BASE64 As Long = 1
Dim lLen As Long, m_bData() As Byte, sBase64Buf As String
m_bData = StrConv(Text, vbFromUnicode)
If CryptBinaryToString(m_bData(0), UBound(m_bData) + 1, CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen) = 0 Then Exit Function 'Determine Base64 output String length required.
sBase64Buf = String$(lLen - 1, Chr$(0)) 'Convert binary to Base64.
If CryptBinaryToString(m_bData(0), UBound(m_bData) + 1, CRYPT_STRING_BASE64, StrPtr(sBase64Buf), lLen) = 0 Then Exit Function
Base64Encode = sBase64Buf
End Function