Zoals beloofd hier de volledige code.
Eerst de code om een afbeelding te bewaren
Visual Basic Code:
Option Compare Database
'---------------------------------------------------------------------------------------
' Module : z_Convert_byte
' Author : Charlizenne ... and some websites with necessary info
' Date : 19/06/2010
' Purpose : Convert a picture in the byte format in a format to be able to save
'---------------------------------------------------------------------------------------
Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, _
ByVal fDeleteonresume As Long, _
ByRef ppstr As Any) As Long
Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, _
ByVal lSize As Long, _
ByVal fRunMode As Long, _
ByRef riid As GUID, _
ByRef lplpObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As GUID) As Long
Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
' convert a byte array containing a resource to IPicture
'---------------------------------------------------------------------------------------
' Procedure : PictureFromRes
' Author : Charlizenne ... and some websites with necessary info
' Date : 19/06/2010
' Purpose : the actual function to do the conversion
'---------------------------------------------------------------------------------------
'
Public Function PictureFromRes(ByRef b() As Byte) As IPicture
On Error GoTo errorhandler
Dim istrm As IUnknown
Dim tGuid As GUID
If Not CreateStreamOnHGlobal(b(LBound(:?), False, istrm) Then
CLSIDFromString StrPtr(SIPICTURE), tGuid
OleLoadPicture istrm, UBound(:? - LBound(;) + 1, False, tGuid, PictureFromRes
End If
Set istrm = Nothing
Exit Function
errorhandler:
Debug.Print "Could not convert to IPicture!"
End Function
Dan de code om de eID te lezen en de gegevens naar een tabel te sturen (via bound controls op mijn form).
Visual Basic Code:
Private Sub cmdEID_Click()
Dim EIDlib1 As New EIDLIBCTRLLib.EIDlib
Dim lhandle As Long
Dim RetStatus As New EIDLIBCTRLLib.RetStatus
Dim MapColPicture As New EIDLIBCTRLLib.MapCollection
Dim MapColID As New EIDLIBCTRLLib.MapCollection
Dim MapColAddress As New EIDLIBCTRLLib.MapCollection
Dim CertifCheck As New EIDLIBCTRLLib.CertifCheck
Dim strName As String
Dim strFirstName1 As String
Dim strBirthPlace As String
Dim strBirthDate As String
Dim strGender As String
Dim strNationality As String
Dim strNationalNumber As String
Dim strStreet As String
Dim strZipCode As String
Dim strMunicipality As String
Dim strFileName As String
Dim strEIDStartValidDate As String
Dim strEIDEndValidDate As String
Dim Pasfoto_Temp() As Byte
' Omdat het uitlezen wel even durut zet ik de cursor even op de zandloper.
' Ik denk er over om een mogelijkheid te zoeken om hier een progressbar in de plaats te zetten.
DoCmd.Hourglass True
Set RetStatus = EIDlib1.Init("", 0, 0, lhandle)
Set RetStatus = EIDlib1.GetID(MapColID, CertifCheck)
strName = MapColID.GetValue("Name")
strFirstName1 = MapColID.GetValue("FirstName1")
strBirthDate = MapColID.GetValue("BirthDate")
strGender = MapColID.GetValue("Gender")
strNationalNumber = MapColID.GetValue("NationalNumber")
strEIDStartValidDate = MapColID.GetValue("BeginValidityDate")
strEIDEndValidDate = MapColID.GetValue("EndValidityDate")
Set RetStatus = EIDlib1.GetAddress(MapColAddress, CertifCheck)
strStreet = MapColAddress.GetValue("Street")
strZipCode = MapColAddress.GetValue("ZIPCode")
strMunicipality = MapColAddress.GetValue("Municipality")
'Haal eID foto op
Set RetStatus = EIDlib1.GetPicture(MapColPicture, CertifCheck)
Pasfoto_Temp = MapColPicture.GetValue("Picture")
'Schrijf eID foto weg naar een bestand
FileName = GetPath & "\Images\eID\" & strNationalNumber & ".jpg"
SavePicture PictureFromRes(Pasfoto_Temp), FileName
'Laad bestand in image control
imgPhoto.Picture = FileName
Set RetStatus = EIDlib1.Exit
If Me.NewRecord Then
Me.Naam = strName
Me.Voornaam = strFirstName1
Me.Adres = strStreet
Me.Woonplaats = GetZipCodeRecNo(strZipCode, strMunicipality)
Me.Woonplaats.Requery
Me.Geslacht = strGender
Me.Geboortedatum = CreaDate(strBirthDate)
Me.NationaalNummer = strNationalNumber
Me.EidGeldigheid = CreaDate(strEIDEndValidDate)
Me.CreateDate = CreaDate(strEIDStartValidDate)
Me.Telefoon.SetFocus
Else ' Update record information with new info from eID
If Me.NationaalNummer = strNationalNumber Then
Me.Naam = strName
Me.Voornaam = strFirstName1
Me.Adres = strStreet
Me.Woonplaats = GetZipCodeRecNo(strZipCode, strMunicipality)
Me.Woonplaats.Requery
Me.Geslacht = strGender
Me.Geboortedatum = CreaDate(strBirthDate)
Me.EidGeldigheid = CreaDate(strEIDEndValidDate)
Me.CreateDate = CreaDate(strEIDStartValidDate)
Else
If Me.Naam = strName And Me.Voornaam = strFirstName1 Then
Me.Adres = strStreet
Me.Woonplaats = GetZipCodeRecNo(strZipCode, strMunicipality)
Me.Woonplaats.Requery
Me.Geslacht = strGender
Me.NationaalNummer = strNationalNumber
Me.Geboortedatum = CreaDate(strBirthDate)
Me.EidGeldigheid = CreaDate(strEIDEndValidDate)
Me.CreateDate = CreaDate(strEIDStartValidDate)
Else
DoCmd.Hourglass False
If strName = "" Then
MsgBox "Geen eID kaart in lezer!" & _
vbCrLf & "Plaats de eID van de patient in de lezer.", vbCritical, "FOUT"
Else
MsgBox "De patientenfiche en de eID kaart komen niet overeen!" & _
vbCrLf & "Zoek de juiste fiche die bij deze kaart hoort of maak een nieuwe fiche.", vbCritical, "FOUT"
End If
End If
End If
End If
DoCmd.Hourglass False
End Sub
Omdat ik mijn bestanden op een specifieke locatie wil hebben (vertrekkende van de locatie van mijn db) heb ik ook nog die kleine routinetje nodig
Visual Basic Code:
Function GetPath()
'Returns the path to currently opened MDB or ADP
GetPath = CurrentProject.Path
End Function
Deze topic kan op "Solved" gezet worden.
Zo nu nog hopen dat men de interne veldnamen van de SIS kaart vrijgeeft zodat ik ook die gegevens kan uitlezen. Blijkbaar is deze info nog niet publiek beschikbaar maar enkel aan een aantal ontwikkelaars gegeven
2
Inzender
