It is probably really easy for you but i'm a beginner and I don't find how to save the mofifications in my database after an bulkcopy.
The situation i'm trying to import a .csv file into my database using this code :
Public Sub ImportCSV2SQL(ByVal fileName As String, ByRef sqlTable As DataTable, ByVal column2Import() As Integer)
' Préparation des variables SQL
Dim sqlConxtion As SqlConnection = New SqlConnection(My.Resources.sqlHQSdbConxtion)
Dim sqlAction As SqlBulkCopy = New SqlBulkCopy(My.Resources.sqlHQSdbConxtion)
Dim sqlCommand As New SqlCommand("DELETE FROM dbo." & sqlTable.TableName, sqlConxtion)
' Préparation des variables StreamReader et CsvReader
Dim stream As StreamReader = New StreamReader(fileName) : Dim streamCount As StreamReader = New StreamReader(fileName)
Dim csvCopy As CsvReader = New CsvReader(stream, True, ";"c)
' Décompte du nombre de lignes dans le fichier *.CSV
Dim nbrLines As Integer = 0
While streamCount.Peek <> -1
nbrLines += 1
Dim line As String = streamCount.ReadLine()
End While
' Comparaison avec la table existante dans SQL et le nombre de lignes est plus conséquente
' dans le *.CSV alors remplacement de la table sinon demande à l'utilisateur s'il veut la
' remplacer(1) ou annuler l'action (2)
If sqlTable.Rows.Count <= nbrLines - 1 And sqlTable.Rows.Count <> 0 Then
If MsgBox("The number of rows of the CCList that you are trying to import is higher than those of those of the already existing " & _
"CCList. Do you want to replace the old table or abort the importation?", MessageBoxButtons.OKCancel) = 1 Then
Exit Sub
End If
End If
' Tentative de se conecter au serveur SQL
Try
sqlCommand.Connection.Open()
Catch myerror As SqlException
MsgBox("Error connection SQL")
sqlCommand.Connection.Close()
Exit Sub
End Try
' Suppression de la table afin de pouvoir y introduire de nouvelles données
sqlCommand.ExecuteNonQuery()
sqlCommand.Connection.Close()
' Mappings des colonnes entre le fichier *.CSV et la table de destination
For i = 0 To column2Import.Length - 1
sqlAction.ColumnMappings.Add(column2Import(i), i)
Next
' Transfère des données des données du fichier *.CSV à la table de destination
sqlAction.DestinationTableName = sqlTable.TableName
sqlAction.WriteToServer(csvCopy)
End Sub
But even if i know that it does what it have to it does not save the datas in my database. What am I doing wrong?
Related
I'm writing a script to help myself with my work and I've never coded with VBA before this. Actually, i wrote this (partially, got a couple functions from other macros) but i don't understand it perfectly.
So the script is supposed to get some values from the equation manager table, display them in a textbox and when the user presses Go the values are updated with the new input values. The values are being transformed from "4.5" to "45" in one of the input boxes
the code is
Attribute VB_Name = "Modulo"
Option Explicit
Dim swApp As SldWorks.SldWorks 'Declara Variavel da Aplicação
Dim swModel As SldWorks.ModelDoc2 'Declara Variavel do Modelo
Public Larg, Comp, Alt As Double 'Declara Variavel Publica para os valores atuais do Modelo
Public AltT, RaioT, QntdPrat As Double 'Declara variaveis para testeira e pirulito
Public EspessuraEstrutural As Double 'Declara Variaveis para Espessura
Public NLarg, NComp, NAlt As Double 'Declara Variavel Publica para os Novos Valores
Public NAltT, NRaioT, NQntdPrat As Double 'Declara Variaveis para Novos valores
Public NEspessuraEstrutural As Double 'Declara Variaveis para Novos valores
Public contadorDeParametros 'numero de parametros
Sub main()
Set swApp = Application.SldWorks 'Atribui A aplicação atual à variavel
Set swModel = swApp.ActiveDoc 'Atribui A Modelo atual à variavel
If Not swModel Is Nothing Then 'Checa se o modelo não está vazio
Dim swEqMgr As SldWorks.EquationMgr 'Declara Variavel para a tabela de equações
Set swEqMgr = swModel.GetEquationMgr 'Atribui a tabela de equações Para a Variavel
Comp = swEqMgr.value(1) 'Atribui o valor atual para a variavel
Larg = swEqMgr.value(0) 'Atribui o valor atual para a variavel
Alt = swEqMgr.value(2) 'Atribui o valor atual para a variavel
AltT = swEqMgr.value(10) 'Atribui o valor atual para a variavel
RaioT = swEqMgr.value(15) 'Atribui o valor atual para a variavel
EspessuraEstrutural = swEqMgr.value(3) 'Atribui o valor atual para a variavel
QntdPrat = swEqMgr.value(11)
UserForm1.TextComp.Text = Comp 'Exibe o valor atual na interface
UserForm1.TextLarg.Text = Larg 'Exibe o valor atual na interface
UserForm1.TextAlt.Text = Alt 'Exibe o valor atual na interface
UserForm1.TextAltT.Text = AltT 'Exibe o valor atual na interface
UserForm1.TextRaioT.Text = RaioT 'Exibe o valor atual na interface
UserForm1.TextEspessuraEstrutural.Text = EspessuraEstrutural 'Exibe o valor atual na interface
UserForm1.TextQntdPrat.Text = QntdPrat 'Exibe o valor atual na interface
End If
UserForm1.Show vbModeless 'Exibe a inteface com a opção de não travar o foco
End Sub
Public Sub AlteraEq() 'Função publica para alterar as dimensões se elas forem diferentes da dimensão original
Dim modelo As SldWorks.ModelDoc2 'Declara Variavel da Aplicação da funcao
Dim aplicacao As SldWorks.SldWorks 'Declara Variavel da Aplicação da funcao
Dim tabelaEQ As SldWorks.EquationMgr 'Declara Variavel da Aplicação da funcao
Set aplicacao = Application.SldWorks 'Atribui A aplicação atual à variavel da funcao
Set modelo = aplicacao.ActiveDoc 'Atribui o Modelo atual à variavel da funcao
Set tabelaEQ = modelo.GetEquationMgr 'Atribui A tabela de equações atual à variavel da funcao
NullCatch Comp, NComp, "Comprimento", tabelaEQ
NullCatch Larg, NLarg, "Largura", tabelaEQ
NullCatch Alt, NAlt, "Altura", tabelaEQ
NullCatch AltT, NAltT, "AlturaTesteira", tabelaEQ
NullCatch RaioT, NRaioT, "FilletTesteira", tabelaEQ
NullCatch EspessuraEstrutural, CStr(NEspessuraEstrutural), "EspessuraChapa", tabelaEQ
NullCatch QntdPrat, NQntdPrat, "QuantidadePrateleiras", tabelaEQ
End Sub
Sub NullCatch(valor, novoValor, Parametro As String, Tabela As SldWorks.EquationMgr)
If Not novoValor = valor Then 'Checa se O novo valor e o valor anterior são iguais
If SetEquationValue(Tabela, Parametro, CDbl(novoValor)) Then 'executa a função que altera a Tabela com os novos parametros
swModel.ForceRebuild3 True 'Força o modelo a ser reconstruido com os novos parametros
Else 'Senao
MsgBox "Failed to find the equation " & Parametro 'Exibe mensagem de erro
End If
End If
End Sub
Function SetEquationValue(eqMgr As SldWorks.EquationMgr, name As String, value As Double) As Boolean 'Funcao para alterar valor de uma equacao
Dim index As Integer 'Declara Variavel para index como integer
index = GetEquationIndexByName(eqMgr, name) 'Atribui o index da equacao usando o nome atraves de outra funcao
If index <> -1 Then 'Checa se o index é valido
eqMgr.Equation(index) = """" & name & """=" & value 'Altera o valor da equação
SetEquationValue = True 'Retorna Verdadeiro para a função
Else 'Senao
SetEquationValue = False 'Retorna falso para a função
End If
End Function
Function GetEquationIndexByName(eqMgr As SldWorks.EquationMgr, name As String) As Integer 'Funcao para obter index por nome
Dim i As Integer 'Declara uma variavel para usar no loop
GetEquationIndexByName = -1 'define o retorno da funcao para -1(valor invalido usado para sinalizar o fim da lista)
For i = 0 To eqMgr.GetCount - 1 'Loop que vai de 0 ao fim da lista de equações
Dim eqName As String 'Declara Variavel para o nome da equação atual do loop
eqName = Trim(Split(eqMgr.Equation(i), "=")(0)) 'remove tudo após o = na função
eqName = Mid(eqName, 2, Len(eqName) - 2) 'Remove os paranteses do nome
If UCase(eqName) = UCase(name) Then 'Compara o nome dado como parametro da função com o nome da equacao atual do loop
GetEquationIndexByName = i 'Se é igual retorna o valor do index para a função
Exit Function
End If
Next
End Function
And the code for the userform is
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1
Caption = "UserForm1"
ClientHeight = 4815
ClientLeft = 120
ClientTop = 465
ClientWidth = 4230
OleObjectBlob = "UserForm1.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "UserForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Private Sub UserForm_Activate()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
End Sub
Public Sub Butao_Click()
Modulo.NComp = UserForm1.TextComp.Text
Modulo.NLarg = UserForm1.TextLarg.Text
Modulo.NAlt = UserForm1.TextAlt.Text
Modulo.NRaioT = UserForm1.TextRaioT.Text
Modulo.NAltT = UserForm1.TextAltT.Text
Modulo.NEspessuraEstrutural = UserForm1.TextEspessuraEstrutural.value
Modulo.NQntdPrat = UserForm1.TextQntdPrat.Text
Call Modulo.AlteraEq
UserForm1.Hide
End Sub
The var that is giving me trouble is the "EspessuraEstrutural" but all variables are set up the same so i don't know if this info is useful
I am verifying the trace I receive from a SQL Server DB, the Data type is varbinary (MAX) but I receive this exception and I have no idea what it may be, I leave you the code of the query where I bring the data and the method it processes
Exception:
Exception From HRESULT: 0xFFFFFFE3
Log from the exception (This be in spanish):
Consulte el final de este mensaje para obtener más detalles sobre cómo invocar a la depuración
Just-In-Time (JIT) en lugar de a este cuadro de diálogo.
************** Texto de la excepción **************
DPFP.Error.SDKException: Event Handler has generated an Exception ---> System.Runtime.InteropServices.COMException: Excepción de HRESULT: 0xFFFFFFE3
en DPFP.Verification.Verification.MC_verifyFeaturesEx(SafeHandle mcContext, Int32 templateSize, Byte[] templatePt, Int32 featureSetSize, Byte[] featureSet, Int32 reserved0, IntPtr reserved1, IntPtr reserved2, IntPtr reserved3, Double& achievedFar)
en DPFP.Verification.Verification.Verify(FeatureSet FeatureSet, Template Template, Int32 FARRequested)
en DPFP.Verification.Verification.Verify(FeatureSet FeatureSet, Template Template, Result& Result)
en VerifyEnrollerApp.VerifyFinger.Process(Sample Sample) en c:\users\desarrollo 02\documents\visual studio 2012\Projects\VerifyEnrollerApp\VerifyEnrollerApp\Form1.vb:línea 322
en VerifyEnrollerApp.VerifyFinger.OnComplete(Object Capture, String ReaderSerialNumber, Sample Sample) en c:\users\desarrollo 02\documents\visual studio 2012\Projects\VerifyEnrollerApp\VerifyEnrollerApp\Form1.vb:línea 246
en DPFP.Capture.Capture.MessageReceived(Message& m)
--- Fin del seguimiento de la pila de la excepción interna ---
en DPFP.Capture.Capture.MessageReceived(Message& m)
en DPFP.Capture.Capture.MessageEvents.MessageWindow.WndProc(Message& m)
************** Ensamblados cargados **************
mscorlib
Versión del ensamblado: 4.0.0.0
Versión Win32: 4.6.1087.0 built by: NETFXREL4STAGE
Código base: file:///C:/Windows/Microsoft.NET/Framework/v4.0.30319/mscorlib.dll
----------------------------------------
Microsoft.VisualStudio.HostingProcess.Utilities
Versión del ensamblado: 11.0.0.0
Versión Win32: 11.0.50727.1
Código base: file:///C:/Windows/assembly/GAC_MSIL/Microsoft.VisualStudio.HostingProcess.Utilities/11.0.0.0__b03f5f7f11d50a3a/Microsoft.VisualStudio.HostingProcess.Utilities.dll
----------------------------------------
System.Windows.Forms
Versión del ensamblado: 4.0.0.0
Versión Win32: 4.6.1087.0 built by: NETFXREL4STAGE
Código base: file:///C:/Windows/Microsoft.Net/assembly/GAC_MSIL/System.Windows.Forms/v4.0_4.0.0.0__b77a5c561934e089/System.Windows.Forms.dll
----------------------------------------
Select to the DataBase
Private Template As DPFP.Template
Public Function CargarHuella()
Dim conexion As New SqlConnection(Cadena_Conexion)
Dim a As Byte()
Dim Result As String = ""
Dim sql As String
Try
conexion.Open()
sql = "SELECT H_1 FROM HUELLAS WHERE H_Nit_ID = '11' AND H_TypeDocument_ID = '1' AND H_Document_ID = '1032494911'"
Dim cmd As New SqlCommand(sql, conexion)
Dim reader As SqlDataReader = cmd.ExecuteReader()
If reader.Read Then
a = reader.GetValue(0)
End If
reader.Close()
cmd.Dispose()
conexion.Dispose()
Dim str As New MemoryStream
str = New MemoryStream(a) 'Convertirmos los bites en Memory
Dim template As New DPFP.Template(str) 'Volvemos el Memory en Template para verificar
CargarTemplate(template)
Result = "Exito"
Catch ex As Exception
Result = "Error: " & ex.ToString
End Try
Return Result
End Function
Protected Sub CargarTemplate(ByVal template As DPFP.Template)
If Me.TXTMensajes.InvokeRequired Then
Dim d As New AddTemplateCallBack(AddressOf CargarTemplate)
Me.Invoke(d, New Object() {template})
Else
Me.Template = template
End If
End Sub
Verification Process
Private Verificator As DPFP.Verification.Verification
Protected Sub ProcessSample(ByVal Sample As DPFP.Sample)
DibujarMapa(Sample)
Dim caracteristicas As DPFP.FeatureSet = ExtraerCaracteristicas(Sample, DPFP.Processing.DataPurpose.Enrollment)
If (Not caracteristicas Is Nothing) Then
' Comparamos las caracteristicas de la huella tomada con las del template que tenemos
Dim result As DPFP.Verification.Verification.Result = New DPFP.Verification.Verification.Result()
Verificator.Verify(caracteristicas, Template, result) '<----HERE IS WHERE THE EXCEPTION IS SHOW
If result.Verified Then
SendMensaje("Ok", "Ok", 3)
Else
SendMensaje("KO", "KO", 1)
End If
End If
End Sub
What may be failing, or what am I failing?
PD: Sorry for my bad english :(
SOLUTION
Ok I solved it in the following way, I'll explain it first.
Apparently I had to instantiate as a new object the features that are extracted, I crawled with a try-catch to get the error code issued by the SDK on the failed process, the error is the -29 and in the documentation explain that it is when there is a Error in the features and can not be converted correctly I leave the code with the correction, it works perfectly for me.
''' <summary>
''' Todo el proceso que se encarga de validar la captura de la huella
''' </summary>
''' <param name="Sample"></param>
''' <remarks></remarks>
Protected Sub ProcessSample(ByVal Sample As DPFP.Sample)
Try
DibujarMapa(Sample)
Dim caracteristicas As DPFP.FeatureSet = New DPFP.FeatureSet '<---- I added this line and ready, it was fixed
caracteristicas = ExtraerCaracteristicas(Sample, DPFP.Processing.DataPurpose.Verification)
If (Not caracteristicas Is Nothing) Then
' Comparamos las caracteristicas de la huella tomada con las del template que tenemos
Dim result As DPFP.Verification.Verification.Result = New DPFP.Verification.Verification.Result()
CodesErrors.GetTypeCode()
Verificator.Verify(caracteristicas, Template, result)
If result.Verified Then
Huella = True
UpdateCalidad("Mensaje: " & vbCrLf & vbCrLf & "Huella verificada")
SendMensaje("Ok", "Ok...", 3)
Else
Huella = False
UpdateCalidad("Mensaje: " & vbCrLf & vbCrLf & "Huella no coincide")
SendMensaje("KO", "KO...", 1)
End If
End If
Catch ex As Exception
If ex.HResult = -29 Then '<-- This is the error code from de SDK exception
SendMensaje("Lo sentimos, ocurrió un error durante la validación de la huella." & vbCrLf & vbCrLf & "• Message: 'Invalid Feature Set Type'" & vbCrLf & "• Exception Code: " & ex.HResult, "Disculpenos :( - Error Número (" & ex.HResult & ")", 1)
Else
SendMensaje("• Exception Message: " & ex.Message & vbCrLf & vbCrLf & "• Exception Code: " & ex.HResult, "Error al Verificar", 1)
End If
End Try
End Sub
I will be very grateful for your help on this.
I am trying to populate a treeview to show only a directory as its main root and its sub directories. Other codes and tutorials online show drives and other special folders.
I wan to show only a folder path like:
C:\Main Folder\Subdirectory1\Subdirectory2 etc. in the nodes
This is all I have and its not helping.
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs)
'Get a list of drives
Dim drives As DriveInfo() = DriveInfo.GetDrives()
Dim rootDir As String = String.Empty
'Now loop thru each drive and populate the treeview
For i As Integer = 0 To drives.Length - 1
rootDir = drives(i).Name
'Add this drive as a root node
TreeView1.Nodes.Add(rootDir)
'Populate this root node
PopulateTreeView(rootDir, TreeView1.Nodes(i))
Next
End Sub
Private Sub PopulateTreeView(dir As String, parentNode As TreeNode)
Dim folder As String = String.Empty
Try
Dim folders As String() = System.IO.Directory.GetDirectories(dir)
If folders.Length <> 0 Then
Dim childNode As TreeNode = Nothing
For Each folder_loopVariable As String In folders
folder = folder_loopVariable
childNode = New TreeNode(folder)
childNode.Nodes.Add("")
parentNode.Nodes.Add(childNode)
Next
End If
Dim files As String() = System.IO.Directory.GetFiles(dir)
If files.Length <> 0 Then
Dim childNode As TreeNode = Nothing
For Each file As String In files
childNode = New TreeNode(file)
parentNode.Nodes.Add(childNode)
Next
End If
Catch ex As UnauthorizedAccessException
parentNode.Nodes.Add(folder & Convert.ToString(": Access Denied"))
End Try
End Sub
He tomado como base tu código y he hecho algunas modificaciones para poder adaptarlo a mis necesidades.
Si necesitas crear una lista de todos los archivos por unidades, la funcion ActualizaTV es la encargada de Actualizar el TreeView que, en mi caso, se llama tvDir
Te dejo el resultado por si te viene bien:
Sub ActualizaTV(workpath As String)
If workpath Is Nothing Then Exit Sub
With tvDir
.Nodes.Clear()
'Creating the root node
.Nodes.Add(New TreeNode(workpath))
PopulateTreeView(workpath, .Nodes(0))
End With
End Sub
Sub PopulateTreeView(dir As String, parentNode As TreeNode)
Try
'Se añada en primer lugar los archivos del directorio
For Each file In System.IO.Directory.GetFiles(dir)
If file.Length = 0 Then Continue For
parentNode.Nodes.Add(New TreeNode(file.Replace(dir & "\", "")))
Next
'Se buscan las posibles carpetas nuevas del directorio y se añadem
For Each folder As String In System.IO.Directory.GetDirectories(dir)
If folder.Length = 0 Then Continue For
parentNode.Nodes.Add(New TreeNode(folder))
'En caso de que haya subcarpetas, se repite la operación
If UBound(System.IO.Directory.GetDirectories(folder)) > 0 Or _
UBound(System.IO.Directory.GetFiles(folder)) > 0 Then _
PopulateTreeView(folder, parentNode.LastNode)
Next
Catch ex As UnauthorizedAccessException
parentNode.Nodes.Add(dir & Convert.ToString(": Access Denied"))
End Try
End Sub
Un saludo
I think the title says it all. I can send emails using outlook but now we switched to Gmail and lost all of our notification functionality in our databases.
Yes, you can send mails from Access using gmail accounts. You need CDO library-reference. Search for it ("cdo"+"access"+"send" "mail")
Then, you send them with a function like this (comments in spanish):
Function Enviar_Mail_CDO(Para As String, _
De As String, _
Asunto As String, _
Mensaje As String, _
Usuario As String, _
Password As String, _
Optional Path_Adjunto As String) As Boolean
'Me.MousePointer = vbHourglass
' Variable de objeto Cdo.Message
Dim Obj_Email As CDO.Message
Dim SerVidor_SMTP As String
Dim Puerto As String
Dim Usar_Autentificacion As Boolean
Dim usar_ssl As Boolean
SerVidor_SMTP = "smtp.gmail.com"
Puerto = "465"
Usar_Autentificacion = True
usar_ssl = True
' Crea un Nuevo objeto CDO.Message
Set Obj_Email = New CDO.Message
' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _
del servidor o su dirección IP )
Obj_Email.Configuration.Fields(cdoSMTPServer) = SerVidor_SMTP
Obj_Email.Configuration.Fields(cdoSendUsingMethod) = 2
' Puerto. Por defecto se usa el puerto 25, en el caso de Gmail se usan los puertos _
465 o el puerto 587 ( este último me dio error )
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(Puerto)
' Indica el tipo de autentificación con el servidor de correo _
El valor 0 no requiere autentificarse, el valor 1 es con autentificación
Obj_Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(Usar_Autentificacion)
' Tiempo máximo de espera en segundos para la conexión
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
' Configura las opciones para el login en el SMTP
If Usar_Autentificacion Then
' Id de usuario del servidor Smtp ( en el caso de gmail, debe ser la dirección de correro _
mas el #gmail.com )
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usuario
' Password de la cuenta
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password
' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = usar_ssl
End If
' *********************************************************************************
' Estructura del mail
'**********************************************************************************
' Dirección del Destinatario
Obj_Email.To = Para
' Dirección del remitente
Obj_Email.From = De
' Asunto del mensaje
Obj_Email.Subject = Asunto
' Cuerpo del mensaje
Obj_Email.TextBody = Mensaje
'Ruta del archivo adjunto
If Path_Adjunto <> vbNullString Then
Obj_Email.AddAttachment (Path_Adjunto)
End If
' Actualiza los datos antes de enviar
Obj_Email.Configuration.Fields.Update
On Error Resume Next
' Envía el email
Obj_Email.Send
If Err.Number = 0 Then
Enviar_Mail_CDO = True
Else
MsgBox Err.Description, vbCritical, " Error al enviar el amil "
End If
' Descarga la referencia
If Not Obj_Email Is Nothing Then
Set Obj_Email = Nothing
End If
On Error GoTo 0
'Me.MousePointer = vbNormal
End Function
I'm using the zxing C# port to decode a QR barcode.
The code is simple and based on an example I found online (see below).
The problem is, it always throws an "Index was outside the bounds of the array" exception.
My code sample happen to be in VB.NET, but the zxing library is implemented in C#
Dim re As qrcode.QRCodeReader
re = New qrcode.QRCodeReader()
Dim Img As New Bitmap("<image file path here>")
Dim res As com.google.zxing.Result
Dim bufimg As com.google.zxing.client.j2se.BufferedImageMonochromeBitmapSource
bufimg = New client.j2se.BufferedImageMonochromeBitmapSource(Img, False)
res = re.decode(bufimg)
Dim ret As String = res.getText()
I have seen multiple people complaining about the same issue in different forums, but haven't found any suggested solution.
UPDATE If anyone knows of a different good QR reader that can easily integrate with a .NET application, please recommend
Dont know if this gonna help u, but i paste my code if u want to use:
Imports Zxing = com.google.zxing
Imports System.Drawing
Public Class Decodificador
'Para leer todo tipo de codigos soportados por el proyecto zxing
Private Reader As New Zxing.MultiFormatReader
'Private Reader As New Zxing.qrcode.QRCodeReader
Private Result As Zxing.Result
Private Imagen As Bitmap
Private Bitm As Zxing.BinaryBitmap
Private HBin As Zxing.common.HybridBinarizer
Private Lumin As RGBLuminanceSource
'El orden para poder funcionar es:
'DetectarCodigoEnImagen (Obligatorio) >> PintarLocalizacion [opcional] >> DecodificarImagen (Obligatorio para sacar info).
''' <summary>
''' Devuelve True si ha localizado un QRCODE
''' </summary>
''' <param name="img"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function DetectarCodigoEnImagen(ByRef img As Image) As Boolean
Try
Imagen = New Bitmap(img)
'Creamos un Mapa binario con la imagen y su tamaño
Lumin = New RGBLuminanceSource(Imagen, Imagen.Width, Imagen.Height)
HBin = New Zxing.common.HybridBinarizer(Lumin)
Bitm = New Zxing.BinaryBitmap(HBin)
'Decodificamos el mapa binario y guardamos todos los datos en Result
Result = Reader.decode(Bitm)
'Si ha encontrado un QRCode provocará una excepción y devolverá False
'Si hay un QRCode, devolverá True
Return True
Catch ex As Exception
Return False
End Try
End Function
''' <summary>
''' Dibuja cuadros rojos y amarillos en la localización del Codigo QR, ralentiza mucho el sistema.
''' Debe haberse detectado un codigo en la imagen para poder pintar.
''' Devuelve la imagen con el Codigo QR y la localización pintada
''' </summary>
''' <param name="img"></param>
''' <remarks></remarks>
Public Function PintarLocalizacionQrCode(ByRef img As Image) As Image
Try
'Archivamos en una matriz todos los puntos de localización del QRcode
Dim Puntos() As Zxing.ResultPoint = Result.ResultPoints
'Creamos Graficos desde la imagen y poder pintar posteriormente
Dim gr As Graphics = Graphics.FromImage(Imagen)
'Dim gr As Graphics = Graphics.FromImage(Imagen)
'Declaramos el tamaño del pincel para pintar y pintar2
Dim TamPincel As Integer = 4
Dim Pintar As New Pen(Color.Yellow, TamPincel)
Dim Pintar2 As New Pen(Color.Red, TamPincel)
'Declaramos una variable del mismo tipo que el arreglo Puntos() para poder navera por ella
Dim PuntoAuxiliar As com.google.zxing.ResultPoint
'Por cada punto en puntos() dibujamos 2 rectangulos en los indicadores de posición del QRCode
For Each PuntoAuxiliar In Puntos
gr.DrawRectangle(Pintar, New Rectangle(PuntoAuxiliar.X - 10, PuntoAuxiliar.Y - 10, 20, 20))
gr.DrawRectangle(Pintar2, New Rectangle(PuntoAuxiliar.X - 13, PuntoAuxiliar.Y - 13, 26, 26))
Next
'Liberamos la memoria
gr.Dispose()
Return Imagen
Catch ex As Exception
Throw ex
End Try
End Function
End Class