Respuesta: problema al llamar una funcion de una DLL de delphi desde un exe de visual hola... si estoy usando stdcall. aqui te coloco un codigo de una de las funciones que uso.
function leebanda:PChar;stdcall;
var
sTmp:String;
PCharString: array[0..255] of Char;
c1,rebut: integer;
chBuffer: array[0..150] of char;
NumberOfBytesRead: dword;
begin
Result:='';
//abro el puerto
configurapuerto;
//mensaje de solicitud de lectura
banda;
frmShowMessage:=TfrmShowMessage.create(nil);
frmshowMessage.LMensaje.Caption:='DESLICE TARGETA CUANDO INDIQUE PINPAD';
frmShowMessage.ShowModal;
repeat
rebut:=0;
repeat
if ComFile=INVALID_HANDLE_VALUE then
break;
if not ReadFile(ComFile, chBuffer[rebut],1, NumberOfBytesRead, nil) then
raise Exception.Create('Imposible leer datos desde el puerto');
for c1:= 0 to NumberOfBytesRead - 1 do
sTmp:= sTmp+chBuffer[c1];
until rebut<100 ;
if (chBuffer[rebut]=chr(04)) or (chBuffer[rebut]=chr(03)) then
begin
//libero memoria
ReadFile(ComFile, chBuffer[rebut],1, NumberOfBytesRead, nil);
for c1:= 0 to NumberOfBytesRead - 1 do
sTmp:= sTmp+chBuffer[c1];
CerrarPuerto;
break;
end;
until rebut=100;
stmp := trim(sTmp);
sTmp:=copy(sTmp,7,(length(sTmp)-9));
Result := StrPCopy(PCharString, sTmp);
freeandnil(frmShowMessage);
end;
ademas como te decia funciona hasta una parte de la funcion, en esta funcion solo se ejecuta hasta una parte de la lectura del puerto.
y en esta otra funcion:
function buscabin(track1,track2:string):PChar;stdcall;
var
TS:TStringList;
I,x,z,j:Integer;
Str,Inicio,Fin,Tipo,Tarjeta,t1,t2:String;
P1:array [0..255] of char;
begin
Result:='';
Z:=0;
if (track1='') or (track2='') then
begin
messagedlg('No hay tracks!! verifique.',mtinformation,[mbok],1);
end
else
begin
track1:=copy(track1,2,6);
track2:=copy(track2,1,6);
TS := TStringList.Create;
TS.LoadFromFile('c:\pnp\Bines.txt');
if TS.Count<>0 then
begin
// bloque de proteccion
try
for x := 0 to TS.Count -3 do begin
inicio:='';
fin:='';
tipo:='';
tarjeta:='';
Str := TS.Strings[x];
Inicio:= copy(Str,1,12);
Fin:= copy(Str,14,12);
for I := 1 to length (Inicio) div 2 do
begin
tipo:= tipo+Char(StrToInt('$'+Copy(Inicio,(I-1)*2+1,2)));
end;
for I := 1 to length (Fin) div 2 do
begin
Tarjeta:= Tarjeta+Char(StrToInt('$'+Copy(Fin,(I-1)*2+1,2)));
end;
inicio:=tipo;
fin:=tarjeta;
if (strtoint(Fin)>=strtoint(track1)) and (strtoint(Inicio)<=strtoint(track1)) then
begin
t1:='';
t2:='';
str := copy(str,27,length(TS.Strings[x])-26);
j:=pos(';',str);
Tipo:=copy(str,1,j-1);
Tarjeta:=copy(str,j+1,(length(str)+1)-j);
for I := 1 to length (Tipo) div 2 do
begin
t1:= t1+Char(StrToInt('$'+Copy(Tipo,(I-1)*2+1,2)));
end;
for I := 1 to length (Tarjeta) div 2 do
begin
t2:= t2+Char(StrToInt('$'+Copy(tarjeta,(I-1)*2+1,2)));
end;
z:=1;
end
else
begin
if (strtoint(Fin)>=strtoint(track2)) and (strtoint(Inicio)<=strtoint(track2)) then
begin
t1:='';
t2:='';
str := copy(str,27,length(TS.Strings[x])-26);
j:=pos(';',str);
Tipo:=copy(str,1,j-1);
Tarjeta:=copy(str,j+1,(length(str)+1)-j);
for I := 1 to length (Tipo) div 2 do
begin
t1:= t1+Char(StrToInt('$'+Copy(Tipo,(I-1)*2+1,2)));
end;
for I := 1 to length (Tarjeta) div 2 do
begin
t2:= t2+Char(StrToInt('$'+Copy(tarjeta,(I-1)*2+1,2)));
end;
Z:=2;
end;
end;
end;
finally
TS.Free;
end;
showmessage(inttostr(z)+','+t1+','+t2);
end
else
begin
messagedlg('archivo Bines vacio o no existe!! verifique.',mtinformation,[mbok],1);
end;
end;
Result:=StrPcopy(P1,inttostr(z)+','+t1+','+t2);
end;
se ejecuta hasta el showmessage(inttostr(z)+','+t1+','+t2)); |