LEITORES BIOMÉTRICOS DELPHI XE6

14/11/2014

0

Migrei uma ERP de Delphi 7 para XE6 e aconteceu que o XE6 passou a não reconhecer mais a biometria. Já procurei no forum da griaule biometrics, pórem, não consequi solucionar o problema, então estou pedindo ajuda. Consigo gravar a biometria, mas, não consigo verificar a biometria capturada com a biometria gravada do banco de dados.
Inclusive troquei as variáveis PCHAR para PANSICHAR, STRING para ANSISTRING. Estou postando o código fonte das duas units relacionadas.


{
-------------------------------------------------------------------------------
GrFinger Sample
(c) 2005 Griaule Tecnologia Ltda.
http://www.griaule.com
-------------------------------------------------------------------------------

This sample is provided with "GrFinger Fingerprint Recognition Library" and
can't run without it. It's provided just as an example of using GrFinger
Fingerprint Recognition Library and should not be used as basis for any
commercial product.

Griaule Tecnologia makes no representations concerning either the merchantability
of this software or the suitability of this sample for any particular purpose.

THIS SAMPLE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL GRIAULE BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

You can download the free version of GrFinger directly from Griaule website.

These notices must be retained in any copies of any part of this
documentation and/or sample.

-------------------------------------------------------------------------------
}

// -----------------------------------------------------------------------------------
// Support and fingerprint management routines
// -----------------------------------------------------------------------------------

unit grfinger_util;

interface

uses
Classes, StdCtrls, ExtCtrls, CheckLst, SysUtils, grfinger_dbclass, Forms,
GrFinger, ADODB, Dialogs, Windows, Graphics, grfinger_callbacks;

type
TRawImage = record
img: PChar;
Width: Integer;
Height: Integer;
Res: Integer;
end;

const
ERR_CANT_OPEN_BD = -999;
ERR_INVALID_ID = -998;
ERR_INVALID_TEMPLATE = -997;

procedure WriteLog(msg: String);
procedure WriteEvent(idSensor: Pchar; event: GRCAP_STATUS_EVENTS);
procedure WriteError(err: Integer);

function InitializeGrFinger: Integer;
procedure FinalizeGrFinger;
procedure CheckParameters(var IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
procedure LoadParameters(var IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
procedure SaveParameters(IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
procedure SetParameters;
procedure PrintBiometricDisplay(biometricDisplay: boolean; context: Integer);
procedure SaveTemplateUsuario(UsuId, Index: Integer);
procedure SaveTemplateFuncionario(CliId, Index: Integer);
function ExtractTemplate: Integer;
function IdentifyFuncionario(var Id: Integer): Boolean;
function IdentifyUsuario(var Id: Integer): Boolean;
function VerifyUsuario(Id: Integer): Boolean;
function VerifyFuncionario(Id: Integer): Boolean;
//procedure MessageVersion();

var
raw : TRawImage; // informacoes da ultima img capturada
Template: TTemplate; // template da ultima img capturada
DB: TDBClass; // classe p/ acesso ao banco

implementation

uses
CapturaDigital;

// Exibe os logs, msgs no "memo" do formulario "frmCapturaDigital"
procedure WriteLog(msg: String);
begin
if not Assigned(fCapturaDigital) then Exit;
fCapturaDigital.memoLog.Lines.Add(msg);
end;

// Mensagens p/ serem exibidas no "memo" qdo ocorre algum evento do leitor
procedure WriteEvent(idSensor: Pchar; event: GRCAP_STATUS_EVENTS);
begin
// optei por nao exibir, p/ nao "poluir" o memo
Exit;

case event of
GR_PLUG: WriteLog('Sensor: '+idSensor+'. Event: Plugged.');
GR_UNPLUG: WriteLog('Sensor: '+idSensor+'. Event: Unplugged.');
GR_FINGER_DOWN: WriteLog('Sensor: '+idSensor+'. Event: Finger Placed.');
GR_FINGER_UP: WriteLog('Sensor: '+idSensor+'. Event: Finger Removed.');
GR_IMAGE: WriteLog('Sensor: '+idSensor+'. Event: Image Captured.');
else
WriteLog('Sensor: '+idSensor+'. Event:('+IntToStr(event)+')');
end;
end;

// Mensagens quando ocorre algum erro p/ serem exibidas no memo
procedure WriteError(err: Integer);
begin
case err of
GR_ERROR_INITIALIZE_FAIL:
WriteLog('Fail to Initialize GrFinger. (Error:'+IntToStr(err)+')');
GR_ERROR_NOT_INITIALIZED:
WriteLog('The GrFinger Library is not initialized. (Error:'+IntToStr(err)+')');
GR_ERROR_FAIL_LICENSE_READ:
begin
WriteLog('License not found. See manual for troubleshooting. (Error:'+IntToStr(err)+')');
ShowMessage('License not found. See manual for troubleshooting.');
end;
GR_ERROR_NO_VALID_LICENSE:
begin
WriteLog('The license is not valid. See manual for troubleshooting. (Error:'+IntToStr(err)+')');
ShowMessage('The license is not valid. See manual for troubleshooting.');
end;
GR_ERROR_NULL_ARGUMENT:
WriteLog('The parameter have a null value. (Error:'+IntToStr(err)+')');
GR_ERROR_FAIL:
WriteLog('Fail to create a GDI object. (Error:'+IntToStr(err)+')');
GR_ERROR_ALLOC:
WriteLog('Fail to create a context. Cannot allocate memory. (Error:'+IntToStr(err)+')');
GR_ERROR_PARAMETERS:
WriteLog('One or more parameters are out of bound. (Error:'+IntToStr(err)+')');
GR_ERROR_WRONG_USE:
WriteLog('This function cannot be called at this time. (Error:'+IntToStr(err)+')');
GR_ERROR_EXTRACT:
WriteLog('Template Extraction failed. (Error:'+IntToStr(err)+')');
GR_ERROR_SIZE_OFF_RANGE:
WriteLog('Image is too larger or too short. (Error:'+IntToStr(err)+')');
GR_ERROR_RES_OFF_RANGE:
WriteLog('Image have too low or too high resolution. (Error:'+IntToStr(err)+')');
GR_ERROR_CONTEXT_NOT_CREATED:
WriteLog('The Context could not be created. (Error:'+IntToStr(err)+')');
GR_ERROR_INVALID_CONTEXT:
WriteLog('The Context does not exist. (Error:'+IntToStr(err)+')');

// Capture error codes

GR_ERROR_CONNECT_SENSOR:
WriteLog('Error while connection to sensor. (Error:'+IntToStr(err)+')');
GR_ERROR_CAPTURING:
WriteLog('Error while capturing from sensor. (Error:'+IntToStr(err)+')');
GR_ERROR_CANCEL_CAPTURING:
WriteLog('Error while stop capturing from sensor. (Error:'+IntToStr(err)+')');
GR_ERROR_INVALID_ID_SENSOR:
WriteLog('The idSensor is invalid. (Error:'+IntToStr(err)+')');
GR_ERROR_SENSOR_NOT_CAPTURING:
WriteLog('The sensor is not capturing. (Error:'+IntToStr(err)+')');
GR_ERROR_INVALID_EXT:
WriteLog('The File have a unknown extension. (Error:'+IntToStr(err)+')');
GR_ERROR_INVALID_FILENAME:
WriteLog('The filename is invalid. (Error:'+IntToStr(err)+')');
GR_ERROR_INVALID_FILETYPE:
WriteLog('The file type is invalid. (Error:'+IntToStr(err)+')');
GR_ERROR_SENSOR:
WriteLog('The sensor raise an error. (Error:'+IntToStr(err)+')');

// Our error codes

ERR_INVALID_TEMPLATE:
WriteLog('Invalid Template. (Error:'+IntToStr(err)+')');
ERR_INVALID_ID:
WriteLog('Invalid ID. (Error:'+IntToStr(err)+')');
ERR_CANT_OPEN_BD:
WriteLog('Unable to connect to DataBase. (Error:'+IntToStr(err)+')');
else
WriteLog('Error:('+IntToStr(err)+')');
end;
end;

// verifica se eh um template valido
function TemplateIsValid: Boolean;
begin
TemplateIsValid := ((template.size > 0) and (template.tpt <> nil));
end;

// inicializa a DLL (grfinger) e os utilitarios
function InitializeGrFinger: Integer;
var
err: Integer;
begin
DB := TDBClass.Create;
Template := TTemplate.Create;

if raw.img = nil then
raw.img := AllocMem(GR_MAX_IMAGE_HEIGHT * GR_MAX_IMAGE_WIDTH);
err := GrFinger.GrInitialize;
if err < 0 then // se houve algum erro na inicializacao
begin
Result := err;
Exit;
end;

// definindo os parametros
SetParameters;

// inicializando funcoes de captura
Result := grfinger_callbacks.InitializeGrCap;
end;

// finaliza o grfinger, libera os recursos
procedure FinalizeGrFinger();
begin
GrFinger.GrFinalize;
GrFinger.GrCapFinalize;
DB.Free;
Template.Free;
FreeMemory(raw.img);
raw.img := nil; // importante, senao na segunda liberacao da erro!!!
end;

// verifica se os parametros estao dentro do intervalo permitido, senao ajusta-os
procedure CheckParameters(var IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance: Integer);
begin
if (IdentifyThreshold < GR_MIN_THRESHOLD) then IdentifyThreshold := GR_MIN_THRESHOLD;
if (IdentifyThreshold > GR_MAX_THRESHOLD) then IdentifyThreshold := GR_MAX_THRESHOLD;
if (VerifyThreshold < GR_MIN_THRESHOLD) then VerifyThreshold := GR_MIN_THRESHOLD;
if (VerifyThreshold > GR_MAX_THRESHOLD) then VerifyThreshold := GR_MAX_THRESHOLD;
if (IdentifyRotationTolerance < GR_ROT_MIN) then IdentifyRotationTolerance := GR_ROT_MIN;
if (IdentifyRotationTolerance > GR_ROT_MAX) then IdentifyRotationTolerance := GR_ROT_MAX;
if (VerifyRotationTolerance < GR_ROT_MIN) then VerifyRotationTolerance := GR_ROT_MIN;
if (VerifyRotationTolerance > GR_ROT_MAX) then VerifyRotationTolerance := GR_ROT_MAX;
end;

// carrega os parametros do banco de dados
procedure LoadParameters(var IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance: Integer);
begin
DB.LoadParameters(IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance);

CheckParameters(IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance);
end;

// salva os parametros no banco de dados
procedure SaveParameters(IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
begin
CheckParameters(IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance);

DB.SaveParameters(IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance);
end;

// obtem os parametros do banco de dados e define na biblioteca
procedure SetParameters;
var
IdentifyThreshold, IdentifyRotationTolerance,
VerifyThreshold, VerifyRotationTolerance: Integer;
begin
// carregando os parametros
LoadParameters(IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance);

// definindo os parametros na lib
GrSetIdentifyParameters(IdentifyThreshold, IdentifyRotationTolerance, GR_DEFAULT_CONTEXT);
GrSetVerifyParameters(VerifyThreshold, VerifyRotationTolerance, GR_DEFAULT_CONTEXT);
end;

// exibe a imagem da impressao digital no objeto image
procedure PrintBiometricDisplay(biometricDisplay: boolean; context: Integer);
var
handle: HBitmap;
hdc: LongInt;
begin
if not Assigned(fCapturaDigital) then Exit;

// liberando imagem anterior
fCapturaDigital.image.Picture.Bitmap.FreeImage();
handle := fCapturaDigital.image.Picture.Bitmap.ReleaseHandle();
DeleteObject(handle);

{If range checking is on - turn it off for now
we will remember if range checking was on by defining
a define called CKRANGE if range checking is on.
We do this to access array members past the arrays
defined index range without causing a range check
error at runtime. To satisfy the compiler, we must
also access the indexes with a variable. ie: if we
have an array defined as a: array[0..0] of byte,
and an integer i, we can now access a[3] by setting
i := 3; and then accessing a[i] without error}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
hdc := GetDC(HWND(nil));

if biometricDisplay then
// pegando a imagem da impressao digital apos extrair o template
// com informacoes dos pontos analisados
GrBiometricDisplay(template.tpt,raw.img, raw.width, raw.height,raw.Res, hdc,
handle, context)
else
// pegando a imagem da impressao digital
GrCapRawImageToHandle(raw.img, raw.width, raw.height, hdc, handle);

// desenhando a imagem
if handle <> 0 then
begin
fCapturaDigital.image.Picture.Bitmap.Handle := handle;
//frmCapturaDigital.image.Width := formMain.Bevel1.Width;
//frmCapturaDigital.image.Height := formMain.Bevel1.Height;
fCapturaDigital.image.Repaint();
end;

ReleaseDC(HWND(nil), hdc);

{Turn range checking back on if it was on when we started}
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;

// salva o template do usuario no banco
procedure SaveTemplateUsuario(UsuId, Index: Integer);
begin
if TemplateIsValid then
DB.SaveTemplateUsuario(UsuId, Index, template);
end;

// salva o template do cliente no banco
procedure SaveTemplateFuncionario(CliId, Index: Integer);
Begin
if TemplateIsValid() then
DB.SaveTemplateFuncionario(CliId, Index, template);
end;

// extrai o template da imagem da digital atual
function ExtractTemplate(): Integer;
var
ret: Integer;
begin
// set current buffer size for extract template
Template.size := GR_MAX_SIZE_TEMPLATE;
ret := GrFinger.GrExtract(raw.img, raw.width, raw.height, raw.res, template.tpt,
template.size, GR_DEFAULT_CONTEXT);

// se ocorreu algum erro
if (ret < 0 ) then Template.size := 0;

Result := ret;
end;

// metodo de "identificacao" p/ funcionario
function IdentifyFuncionario(var Id: Integer): Boolean;
var
score, ret, i: Integer;
tptRef: TTemplate;
bFinish: Boolean;
begin
Result := False;

// se nao for um template valido
if not TemplateIsValid then
begin
WriteError(ERR_INVALID_TEMPLATE);
Exit;
end;

// preparando p/ iniciar as comparacoes
ret := GrFinger.GrIdentifyPrepare(template.tpt, GR_DEFAULT_CONTEXT);

// se ocorreu algum erro
if ret < 0 then
begin
WriteError(ret);
Exit;
end;

// abrindo a query c/ os templates do cliente
DB.OpenQueryTemplatesFuncionario();

try
bFinish := False;
repeat

// loop nos 3 templates do cliente
for i := 1 to 3 do
begin
// pegando o template (1, 2 ou 3)
tptRef := DB.GetTemplate('FUN_CODIGO', 'FUN_TEMPLATE_' + IntToStr(i));
// fazendo a comparacao
ret := GrFinger.GrIdentify(tptRef.tpt, score, GR_DEFAULT_CONTEXT);
// se o template confere com o que esta no banco
if ret = GR_MATCH then
begin
Result := True;
Id := tptRef.Id;
Break;
end
else if ret < 0 then // se ocorreu algum erro
begin
WriteError(ret);
bFinish := True;
Break;
end;
end;

// soh vai parar se achou ou deu algum erro ou acabaram os templates
until (Result) or (bFinish) or (not DB.NextRecord);

finally
// fechando a query
DB.CloseQuery();
end;
end;

// metodo de "identificacao" p/ funcionario
function IdentifyUsuario(var Id: Integer): Boolean;
var
score, ret, i: Integer;
tptRef: TTemplate;
bFinish: Boolean;
begin
Result := False;

// se nao for um template valido
if not TemplateIsValid then
begin
WriteError(ERR_INVALID_TEMPLATE);
Exit;
end;

// preparando p/ iniciar as comparacoes
ret := GrFinger.GrIdentifyPrepare(template.tpt, GR_DEFAULT_CONTEXT);

// se ocorreu algum erro
if ret < 0 then
begin
WriteError(ret);
Exit;
end;

// abrindo a query c/ os templates do cliente
DB.OpenQueryTemplatesUsuario();
try
bFinish := False;
repeat

// loop nos 3 templates do cliente
for i := 1 to 3 do
begin
// pegando o template (1, 2 ou 3)
tptRef := DB.GetTemplate('USU_CODIGO', 'USU_TEMPLATE_' + IntToStr(i));
// fazendo a comparacao
ret := GrFinger.GrIdentify(tptRef.tpt, score, GR_DEFAULT_CONTEXT);
// se o template confere com o que esta no banco
if ret = GR_MATCH then
begin
Result := True;
Id := tptRef.Id;
Break;
end
else if ret < 0 then // se ocorreu algum erro
begin
WriteError(ret);
bFinish := True;
Break;
end;
end;

// soh vai parar se achou ou deu algum erro ou acabaram os templates
until (Result) or (bFinish) or (not DB.NextRecord);

finally
// fechando a query
DB.CloseQuery();
end;
end;



// metodo de "verificacao" p/ o usuario
function VerifyUsuario(Id: Integer): Boolean;
var
tptRef: TTemplate;
ret: Integer;
i, score: Integer;
begin
Result := False;
// se nao for um template valido
if not TemplateIsValid then
begin
WriteError(ERR_INVALID_TEMPLATE);
Exit;
end;

// abrindo a query com os 3 templates do usuario
DB.OpenQueryTemplateUsuario(Id);
try
// loop nos 3 templates
for i := 1 to 3 do
begin
tptRef := DB.GetTemplate('USU_CODIGO', 'USU_TEMPLATE_' + IntToStr(i));

// se nao ha template associado, continua
if ((tptRef.tpt = nil) or (tptRef.size <= 0)) then Continue;

// fazendo a comparacao
ret := GrFinger.GrVerify(template.tpt, tptRef.tpt, score, GR_DEFAULT_CONTEXT);

if ret < 0 then // se houve algum erro
WriteError(ret)
else
// se o template confere com o que esta no banco
if ret = GR_MATCH then
begin
Result := True;
Break;
end;

end;
finally
// fechando a query
DB.CloseQuery;
end;
end;

// metodo de "verificacao" p/ o cliente
// usado apenas p/ teste na tela de cadastro
function VerifyFuncionario(Id: Integer): Boolean;
var
tptRef: TTemplate;
ret: Integer;
i, score: Integer;
begin
Result := False;

if not TemplateIsValid then
begin
WriteError(ERR_INVALID_TEMPLATE);
Exit;
end;

DB.OpenQueryTemplateFuncionario(Id);
try
for i := 1 to 3 do
begin
tptRef := DB.GetTemplate('FUN_CODIGO', 'FUN_TEMPLATE_' + IntToStr(i));

if ((tptRef.tpt = nil) or (tptRef.size <= 0)) then Continue;

ret := GrFinger.GrVerify(template.tpt, tptRef.tpt, score, GR_DEFAULT_CONTEXT);

if ret < 0 then
WriteError(ret)
else
if ret = GR_MATCH then
begin
Result := True;
Break;
end;
end;
finally
DB.CloseQuery;
end;

end;

end.

{
-------------------------------------------------------------------------------
GrFinger Sample
(c) 2005 Griaule Tecnologia Ltda.
http://www.griaule.com
-------------------------------------------------------------------------------

This sample is provided with "GrFinger Fingerprint Recognition Library" and
can't run without it. It's provided just as an example of using GrFinger
Fingerprint Recognition Library and should not be used as basis for any
commercial product.

Griaule Tecnologia makes no representations concerning either the merchantability
of this software or the suitability of this sample for any particular purpose.

THIS SAMPLE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL GRIAULE BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

You can download the free version of GrFinger directly from Griaule website.

These notices must be retained in any copies of any part of this
documentation and/or sample.

-------------------------------------------------------------------------------
}

// -----------------------------------------------------------------------------------
// Database routines
// -----------------------------------------------------------------------------------

unit grfinger_dbclass;

interface

uses
Classes, SysUtils, GrFinger, SqlExpr, DB;

type
TTemplate = class
public
tpt: Pchar;
size: Integer;
id: Integer;
constructor Create;
destructor Destroy; override;
end;

TDBClass = class
private
qryTemplates: TSQLQuery;
tptBlob: TTemplate;
public
constructor Create;
destructor Destroy; override;

procedure LoadParameters(var IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
procedure SaveParameters(IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);

procedure SaveTemplateUsuario(UsuId, Index: Integer; Template: TTemplate);
procedure SaveTemplateFuncionario(CliId, Index: Integer; Template: TTemplate);
procedure OpenQueryTemplatesFuncionario();
procedure OpenQueryTemplateFuncionario(Id: Integer);

procedure OpenQueryTemplatesUsuario();
procedure OpenQueryTemplateUsuario(Id: Integer);
procedure CloseQuery;
function GetTemplate(const CampoId, CampoTemplate: string): TTemplate;
function NextRecord: Boolean;
end;

implementation

uses
dmBasico, DmConex;

// constructor do template
constructor TTemplate.Create;
begin
// alocando memoria p/ o template
tpt := AllocMem(GR_MAX_SIZE_TEMPLATE);
size := 0;
end;

// destructor do template
destructor TTemplate.Destroy;
begin
FreeMemory(tpt);
end;

// constructor do dbclass
constructor TDBClass.Create;
begin
// criando a query e o template
qryTemplates := TSQLQuery.Create(nil);
qryTemplates.SQLConnection := dmConexao.SQLConexao;
tptBlob := TTemplate.Create;
end;

// destructor do dbclass
destructor TDBClass.Destroy();
begin
// liberando recursos
qryTemplates.Free;
tptBlob.Free;
end;

// carrega os parametros do banco de dados
procedure TDBClass.LoadParameters(var IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
begin
with TSQLQuery.Create(nil) do
try
SqlConnection := dmConexao.SQLConexao;
Sql.Add('SELECT');
Sql.Add(' IDENTIFY_THRESHOLD,');
Sql.Add(' IDENTIFY_ROTATION_TOLERANCE,');
Sql.Add(' VERIFY_THRESHOLD,');
Sql.Add(' VERIFY_ROTATION_TOLERANCE');
Sql.Add('FROM');
Sql.Add(' CONFIG');
Open;
try
IdentifyThreshold := FieldByName('IDENTIFY_THRESHOLD').AsInteger;
IdentifyRotationTolerance := FieldByName('IDENTIFY_ROTATION_TOLERANCE').AsInteger;
VerifyThreshold := FieldByName('VERIFY_THRESHOLD').AsInteger;
VerifyRotationTolerance := FieldByName('VERIFY_ROTATION_TOLERANCE').AsInteger;
finally
Close;
end;
finally
Free;
end;
end;

// salva os parametros no banco de dados
procedure TDBClass.SaveParameters(IdentifyThreshold, IdentifyRotationTolerance, VerifyThreshold, VerifyRotationTolerance: Integer);
begin
with TSQLQuery.Create(nil) do
try
SqlConnection := dmConexao.SQLConexao;
Sql.Add('UPDATE CONFIG SET');
Sql.Add(' IDENTIFY_THRESHOLD = :IDENTIFY_THRESHOLD,');
Sql.Add(' IDENTIFY_ROTATION_TOLERANCE = :IDENTIFY_ROTATION_TOLERANCE,');
Sql.Add(' VERIFY_THRESHOLD = :VERIFY_THRESHOLD,');
Sql.Add(' VERIFY_ROTATION_TOLERANCE = :VERIFY_ROTATION_TOLERANCE');
ParamByName('IDENTIFY_THRESHOLD').AsInteger := IdentifyThreshold;
ParamByName('IDENTIFY_ROTATION_TOLERANCE').AsInteger := IdentifyRotationTolerance;
ParamByName('VERIFY_THRESHOLD').AsInteger := VerifyThreshold;
ParamByName('VERIFY_ROTATION_TOLERANCE').AsInteger := VerifyRotationTolerance;
ExecSql;
finally
Free;
end;
end;

// salva o template do usuario no banco
procedure TDBClass.SaveTemplateUsuario(UsuId, Index: Integer; Template: TTemplate);
var
tptStream: TMemoryStream;
sCampo: string;
begin
sCampo := 'usu_template_' + IntToStr(Index);

tptStream := TMemoryStream.Create;
try
// passando p/ tptStream o conteudo do template
tptStream.Write(template.tpt^, template.size);

with TSqlQuery.Create(nil) do
try
SqlConnection := dmConexao.SQLConexao;

Sql.Text := 'update usuarios set ' + sCampo + ' = :' + sCampo + ' where usu_codigo = :id';

with ParamByName('id') do
begin
DataType := ftInteger;
Value := UsuId;
end;

with ParamByName(sCampo) do
begin
DataType := ftMemo;
LoadFromStream(tptStream, ftMemo);
end;
ExecSql;
finally
Free;
end;
finally
tptStream.Free;
end;
end;

// salva o template do funcionario no banco
procedure TDBClass.SaveTemplateFuncionario(CliId, Index: Integer; Template: TTemplate);
var
tptStream: TMemoryStream;
sCampo: string;
begin
sCampo := 'fun_template_' + IntToStr(Index);

tptStream := TMemoryStream.Create;
try
// passando p/ tptStream o conteudo do template
tptStream.Write(template.tpt^, template.size);

with TSqlQuery.Create(nil) do
try
SqlConnection := dmConexao.SQLConexao;

Sql.Text := 'update funcionarios set ' + sCampo + ' = :' + sCampo + ' where fun_codigo = :id';

with ParamByName('id') do
begin
DataType := ftInteger;
Value := CliId;
end;

with ParamByName(sCampo) do
begin
DataType := ftMemo;
LoadFromStream(tptStream, ftMemo);
end;
ExecSql;
finally
Free;
end;
finally
tptStream.Free;
end;
end;

// abre a query com templates dos funcionario
procedure TDBClass.OpenQueryTemplatesFuncionario();
begin
with qryTemplates do
begin
Close;
Sql.Text := ' SELECT FUN_CODIGO, FUN_TEMPLATE_1, FUN_TEMPLATE_2, '+
' FUN_TEMPLATE_3 FROM FUNCIONARIOS ';
Open;
end;
end;

procedure TDBClass.OpenQueryTemplatesUsuario();
begin
with qryTemplates do
begin
Close;
Sql.Text := ' SELECT USU_CODIGO, USU_TEMPLATE_1, USU_TEMPLATE_2, '+
' USU_TEMPLATE_3 FROM USUARIOS ';
Open;
end;
end;

// abre a query com template do usuario especifico
procedure TDBClass.OpenQueryTemplateUsuario(Id: Integer);
begin
with qryTemplates do
begin
Close;
Sql.Text := 'SELECT USU_CODIGO, USU_TEMPLATE_1, USU_TEMPLATE_2, '+
' USU_TEMPLATE_3 FROM USUARIOS WHERE USU_CODIGO = ' + IntToStr(Id);
Open;
end;
end;

// abre a query com template do cliente especifico
procedure TDBClass.OpenQueryTemplateFuncionario(Id: Integer);
begin
with qryTemplates do
begin
Close;
Sql.Text := 'SELECT FUN_CODIGO, FUN_TEMPLATE_1, FUN_TEMPLATE_2, '+
' FUN_TEMPLATE_3 FROM FUNCIONARIOS WHERE FUN_CODIGO = ' + IntToStr(Id);
Open;
end;
end;

// fecha a query
procedure TDBClass.CloseQuery;
begin
qryTemplates.Close;
end;

// retorna o template do registro atual da query, do campo passado no param
function TDBClass.GetTemplate(const CampoId, CampoTemplate: string): TTemplate;
Var
tmp: String;
begin
with qryTemplates do
begin
// se nao ha template associado
if FieldByName(CampoTemplate).IsNull then
begin
//tptBlob.tpt := nil;
tptBlob.size := -1;
Result := tptBlob;
end
else
begin
// pego o id de acordo com o nome do campo passado no param
tptBlob.id := qryTemplates.FieldByName(CampoId).AsInteger;
// pego o template de acordo com o nome do campo passado no param
tmp := qryTemplates.FieldByName(CampoTemplate).AsString;
// tamanho do template
tptBlob.size := Length(tmp);
// movendo o conteudo p/ o objeto template
Move(PChar(tmp)^, tptBlob.tpt^, tptBlob.size);

Result := tptBlob;
end;
end;
end;

// avanca o cursor da query
function TDBClass.NextRecord: Boolean;
begin
with qryTemplates do
begin
Next;
Result := not Eof;
end;
end;

end.
Francisco Costa

Francisco Costa

Responder

Post mais votado

16/10/2019

Segue a solução para o problema referente a utilização do SDK da Griaule ( GrFinger ) SDK 2009 com utilização na versões mais novas do Delphi

O erro apresentado na Identificação da uma digital quando utilizando a partir do Delphi XE

One or more parameters are out of bound. (Error:-8)

Eu tive o problema e depois de muito pesquisar, sofrer e não encontrar nada referente a solução do problema, eu resolvi ir mapeando passo a passo, linha a linha e encontrei a solução.

Gostaria de compartilhar neste post, para que a solução atinja o máximo de pessoas possíveis.

No método GetTemplate do fonte listado acima (e do fonte exemplo da Griaule), basta alterar o tipo da variável tmp : String para tmp : AnsiString;

O problema esta exatamente quando recupera-se o template do banco de dados para a variável tmp para fazer a conversão para dentro do template a ser comparado.

Espero ter ajudado.

Rodrigo Dutra Rubes

Alfonso Silva

Alfonso Silva
Responder

Mais Posts

29/01/2021

Osman.siqueira


Prezado Sr. Rodrigo Dutra Rubes,

Gostaria imensamente de agradecer por compartilhar o seu conhecimento e sua pesquisa com todo mundo. Estava justamente fazendo um cliente para a o SDK da Griaule ( GrFinger ) SDK 2009 , usando o Delphi CE 10.3 e no momento de checar o fingertip estava dando este mesmo erro: "One or more parameters are out of bound. (Error:-8)". Acabei de resolver isto com a dica que você gentilmente forneceu.

Mais uma vez obrigado,
Osman Siqueira Jr.
Responder

Assista grátis a nossa aula inaugural

Assitir aula

Saiba por que programar é uma questão de
sobrevivência e como aprender sem riscos

Assistir agora

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar