bueno, hace ya tempo que no ocupo estos componentes que desarrolle para algunas aplicaciones de huellas digitales.
Las desarrolle debido a que el uso de un lector biometrico es medio engorroso y las funciones son siempre las mismas, por ello tam,bien invito a mejorar el codigo, debido que aunque se POO el desarrollo aun se puede mejorar, espero que esas mejoras tambien sean posteadas.
Las unit faltantes vienen todas con las SDK's
Slds desde chile
PD:ojalá les sea de utilidad.
Código Delphi
[-]
unit BioLector;
interface
uses
SysUtils, Classes,VFImage,VFControls,VFOptions,VFFeatures,VFinger,ScanMan,UIDHuella,Dialogs,DB;
type
TOn_Captura = procedure(ScannerID: string; Width,Height: Integer; Image: PByte; Resolution: Integer)of object;
TON_CambioEstado = procedure(ScannerID: string; State: LongWord) of object;
TBioLector = class(TComponent)
private
FActive:Boolean;
FN_Scaner:Integer;
FIds:TStringList;
FImage,FImageAfter:TVFImage;
FResolucion:Integer;
FScannerID: string;
FFingerID: string;
FView:TVFView;
FOn_Captura:TOn_Captura;
FON_CambioEstado:TON_CambioEstado;
Features:TVFFeatures;
FTipo_Scaner:String;
procedure SetActive(Estado:Boolean);
procedure SetIDScaner(Scaner:Integer);
procedure SetTipoScaner(Tipo:String);
protected
public
property Active:Boolean read FActive write SetActive;
property Huella:TVFFeatures read Features;
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
procedure OnScannerImage(ScannerID: string; Width,Height: Integer; Image: PByte; Resolution: Integer);
procedure OnScannerState(ScannerID: string; State: LongWord);
procedure AsignaHuella(var PHuella:TVFFeatures);
function comparar(huella_externa:TVFFeatures):boolean;
function Buscar_en_DataSet(Dataset:TDataSet;campo:String;buscado:TVFFeatures):boolean;
function Asignar_a_Blob(var campo:TBlobFIeld):boolean;
published
property N_Scaner:Integer read FN_Scaner write SetIDScaner;
property View:TVFView read fView write FView;
property On_Captura:TOn_Captura read FOn_Captura write FOn_Captura;
property ON_CambioEstado:TON_CambioEstado read FON_CambioEstado write FON_CambioEstado;
property TipoScaner:String read FTipo_Scaner write SetTipoScaner;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('BioPack', [TBioLector]);
end;
procedure TBioLector.SetTipoScaner(Tipo:String);
Begin
if uppercase(Tipo) <> FTipo_Scaner
then
begin
if Tipo = 'GENERICO'
then VFSetParameter(VFP_MODE, LongWord(VF_MODE_GENERAL),nil)
else
if Tipo = 'U.ARE.U'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_DIGITALPERSONA_URU),nil)
else
if Tipo = 'BIOMETRIKAFX2000'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_BIOMETRIKA_FX2000),nil)
else
if Tipo = 'KEYTRONIC_SECUREDESKTOP'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_KEYTRONIC_SECUREDESKTOP),nil)
else
if Tipo = 'IDENTIX_TOUCHVIEW'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_IDENTIX_TOUCHVIEW),nil)
else
if Tipo = 'PRECISEBIOMETRICS_100CS'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_PRECISEBIOMETRICS_100CS),nil)
else
if Tipo = 'STMICROELECTRONICS_TOUCHCHIP'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_STMICROELECTRONICS_TOUCHCHIP),nil)
else
if Tipo = 'IDENTICATORTECHNOLOGY_DF90'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_IDENTICATORTECHNOLOGY_DF90),nil)
else
if Tipo = 'AUTHENTEC_AFS2'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_AUTHENTEC_AFS2),nil)
else
if Tipo = 'AUTHENTEC_AES4000'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_AUTHENTEC_AES4000),nil)
else
if Tipo = 'ATMEL_FINGERCHIP'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_ATMEL_FINGERCHIP),nil)
else
if Tipo = 'BMF_BLP100'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_BMF_BLP100),nil)
else
if Tipo = 'SECUGEN_HAMSTER'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_SECUGEN_HAMSTER),nil)
else
if Tipo = 'ETHENTICA'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_ETHENTICA),nil)
else
if Tipo = 'CROSSMATCH_VERIFIER300'
Then VFSetParameter(VFP_MODE, LongWord(VF_MODE_CROSSMATCH_VERIFIER300),nil)
else VFSetParameter(VFP_MODE, LongWord(VF_MODE_GENERAL),nil);
FTipo_Scaner:=Tipo;
end;
end;
function TBioLector.Buscar_en_DataSet(Dataset:TDataSet;campo:String;buscado:TVFFeatures):boolean;
var encontrado:Boolean;
MD: TVFMatchDetails;
Stream: TStream;
PLEIDO,PBUSCADO:array[0..VF_MAX_FEATURES_SIZE] of Byte;
size,resultado:Integer;
Begin
encontrado:=false;
if buscado <> nil
then
Begin
buscado.GetData(@PBUSCADO[0]);
end
else Features.GetData(@PBUSCADO[0]);
MD.Size := SizeOf(MD);
Dataset.First;
while (not Dataset.Eof) and (Not encontrado) do
Begin
TRY
Stream:=dataset.CreateBlobStream(dataset.Fieldbyname(campo), bmRead);
Size := Stream.Read(PLeido[0], VF_MAX_FEATURES_SIZE);
resultado:=VFVerify(@PLeido[0],@PBUSCADO[0], @MD, nil);
if VFSucceeded(Resultado) or (Resultado = VFE_FAILED)
then
begin
if Resultado <> VFE_FAILED
then
Begin
encontrado:=true;
end;
end;
FINALLY
Stream.Free;
END;
if not encontrado then Dataset.Next;
end;
result:=encontrado;
end;
function TBioLector.Asignar_a_Blob(var campo:TBlobFIeld):boolean;
var Stream: TStream;
x:array[0..VF_MAX_FEATURES_SIZE] of Byte;
Begin
result:=false;
if (campo.DataSet.State = dsInsert) or (campo.DataSet.State = dsEdit)
then
Begin
try
stream:=campo.DataSet.CreateBlobStream(campo,bmWrite);
Features.GetData(@x[0]);
Stream.Write(x, Sizeof(x));
result:=true;
finally
Stream.Free;
end;
end;
end;
procedure SMImageProc(const ScannerID: PAnsiChar; Width, Height: Integer;
const Image: PByte; Resolution: Integer; Param: Pointer); stdcall;
begin
TBioLector(Param).OnScannerImage(ScannerID, Width, Height, Image, Resolution);
end;
procedure SMStateProc(const ScannerID: PAnsiChar; State: LongWord; Param: Pointer); stdcall;
begin
TBioLector(Param).OnScannerState(ScannerID, State);
end;
function TBioLector.comparar(huella_externa:TVFFeatures):boolean;
var MD: TVFMatchDetails;
uno,dos:array[0..VF_MAX_FEATURES_SIZE] of Byte;
resultado:Integer;
Begin
try
MD.Size := SizeOf(MD);
Features.GetData(@dos[0]);
huella_externa.GetData(@uno[0]);
resultado:=VFVerify(@uno[0],@dos[0], @MD, nil);
if VFSucceeded(Resultado) or (Resultado = VFE_FAILED)
then
begin
Result:= (Resultado <> VFE_FAILED);
end
else Result:=false;
except
showmessage('Datos a comparar Vacios!');
Result:=false;
end;
end;
procedure TBioLector.OnScannerState(ScannerID: string; State: LongWord);
begin
if Assigned(ON_CambioEstado)
then ON_CambioEstado(ScannerID,State);
end;
procedure TBioLector.OnScannerImage(ScannerID: string; Width,
Height: Integer; Image: PByte; Resolution: Integer);
var huella:array[0..VF_MAX_FEATURES_SIZE] of Byte;
FFeaturesSize: LongWord;
begin
FScannerID := ScannerID;
FResolucion := Resolution;
FFingerID := EmptyStr;
FImage.Assign(Width, Height, Image);
VFExtract(FImage.Width, FImage.Height,FImage.bits,Resolution,@huella[0],FFeaturesSize, nil);
if Features = nil
then Features:=TVFFeatures.CreateFromData(@huella[0])
else Features.SetData(@huella[0]);
if Assigned(FView)
then
BEGIN
FView.Resolution:=Resolution;
if FView.Features <> nil
then FView.Features.SetData(@huella[0])
else FView.Features:=Features;
if FView.Image = nil
then FView.Image:=TVFImage.Create;
FView.Image.Assign(FImage);
FView.UpdateImage;
END;
if Assigned(On_Captura)
then On_Captura(ScannerID,Width,Height,Image,Resolution);
end;
procedure TBioLector.SetActive(Estado:Boolean);
Begin
if fActive <> Estado then
Begin
fActive:=Estado;
if (fActive) and (FN_Scaner > 0)
then
Begin
VFCheckResult(VFInitialize);
SMCheckResult(SMInitialize);
SMGetScannerIds(FIds);
try
SMStartCapturing(FIDs[FN_Scaner-1], SMImageProc, SMStateProc,Self);
except
SMCheckResult(SMFinalize);
VFCheckResult(VFFinalize);
end;
end
else
Begin
SMCheckResult(SMFinalize);
VFCheckResult(VFFinalize);
end;
end;
end;
procedure TBioLector.SetIDScaner(Scaner:Integer);
Begin
if (Scaner <> FN_Scaner) and (Scaner >= 0) and (Scaner < 3)
then
Begin
FN_Scaner:=Scaner;
end;
end;
procedure TBioLector.AsignaHuella(var PHuella:TVFFeatures);
var Dato:array[0..VF_MAX_FEATURES_SIZE] of Byte;
Begin
Features.GetData(@Dato[0]);
if PHuella = nil
then PHuella:=TVFFeatures.CreateFromData(@Dato[0]);
end;
constructor TBioLector.Create(AOwner: TComponent);
Begin
inherited;
FIds:=TStringList.Create;
fActive:=false;
FImage:=TVFImage.Create;
Features:=TVFFeatures.Create;
FTipo_Scaner:='GENERICO';
end;
destructor TBioLector.Destroy;
Begin
FIds.Free;
FImage.Free;
FImageAfter.Free;
if FActive
then
Begin
Active:=false;
end;
inherited;
end;
end.