Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)
-   -   Una DLL Delphi para usar desde Visual Fox Pro (https://www.clubdelphi.com/foros/showthread.php?t=63110)

sitrico 29-01-2009 21:57:15

Una DLL Delphi para usar desde Visual Fox Pro
 
Tengo que unificar una serie de calculos en varias aplicaciones hechas n Delphi y VFP, la manera mas practica que se me ocurrio fue crear una dll y llamarla desde las distintas aplicaciones.

Tengo Esta DLL:

Código Delphi [-]
library ToolsProfit;

uses
  SysUtils,
  Classes,
  Forms,
  UtilidadGeneral in '..\..\Unidades\UtilidadGeneral.pas';

{$R *.res}

Procedure Informa(x : PChar); StdCall; Export;
begin
MessageBoxStr(x,'Tipo');
End;

Function StrMontoGringo(c:Currency):Pchar;
Var
m : String;
begin
m := Trim(fs(c,15,4));
m := StrReplace(m,'.',#0);
Result := Pchar(Trim(StrReplace(m,',','.')));
end;

Procedure DecodeAux02(Aux02:Pchar; Var Piezas,Largo,Alto:Double; Var Ubicacion:Pchar);
Var
s : ShortString;
Aux : String;
begin
//MessageBoxStr(Aux02),'');
Aux  := StrReplace(aux02,'.',',');
Piezas := 0;
Largo := 0;
Alto := 0;
Ubicacion := '';
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Piezas := StrToCurr(s);
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Largo := StrToCurr(s);
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Alto := StrToCurr(s);
Ubicacion := AnsiStrUpper(Pchar(Aux));
end;

Function  EncodeAux02(Piezas,Largo,Alto:Double; Ubicacion:Pchar):Pchar;
Begin
Result := PChar(Trim(StrMontoGringo(Piezas)+';'+
               StrMontoGringo(Largo)+';'+
               StrMontoGringo(Alto)+';'+
               AnsiStrUpper(Ubicacion)));
End;

Function StockEnFactores(Piezas,Largo,Alto:Double):Double;
Const
Factor = 10000;
begin
Result := Trunc(Piezas*Largo*Alto*Factor)/Factor; 
End;

Function StockEnAux02(Aux02:PChar):Double;
Var
Piezas,Largo,Alto:Double;
Ubicacion:PChar;
begin
DecodeAux02(Aux02,Piezas,Largo,Alto,Ubicacion);
Result := StockEnFactores(Piezas,Largo,Alto);
End;

Exports
  DecodeAux02,
  EncodeAux02,
  StockEnFactores,
  StockEnAux02,
  Informa;

begin
end.

y en VFP la declaro:

Código:

DECLARE SINGLE DecodeAux02 IN 'P:\Profit_a\reporadi\ToolsProfit';
String, Double, Double, Double, String

DECLARE Informa IN 'P:\Profit_a\reporadi\ToolsProfit';
String

El problema es con los datos tipo STRING vs PCHAR Al llamar las rutinas desde VFP (estoy probando con Procedure Informa(x : PChar); StdCall; Export;) que debería mostrar un mensaje con el texto del parametro me genera un error:

Data type mistmach - Es un problema de tipos

si cambio la variable por un texto constante ('xxxxx') si me muestra el mensaje.

1.- Que tipo de datos puedo usar para recibir un String desde VFP como parametro?

probe: ShortString,String (con shareMem) y pChar y todosdan mas o menos lo mismo

sitrico 30-01-2009 00:09:02

Listo ya esta solucionado

Código Delphi [-]
library ToolsProfit;

uses
  SysUtils,
  Classes,
  Forms;

{$R *.res}

{function MessageBoxStr(const Text, Caption: String; Flags: Longint = 0): Integer;
Var
bText,bCaption : PChar;
Begin
getMem(bText,Length(text)+1);
StrCopy(bText, PChar(text));
getMem(bCaption,Length(Caption)+1);
StrCopy(bCaption, PChar(Caption));
Result := Application.MessageBox(bText,bcaption,Flags);
FreeMem(bText);
FreeMem(bCaption);
End;
}

Procedure Informa(x : PChar); StdCall;
begin
With tForm.Create(nil) do
   Begin
   Try
      Caption := x;
      ShowModal;
   Finally
      free;
      End;
   End;
End;

// Utilitarios

function ExtraerSTRDelimitada(var s : String; Delimitador : String):String;

Begin
result := s;
If s = '' Then exit;
If Pos(Delimitador,s) <> 0 Then
   Result := copy(s,1,Pos(Delimitador,s)-1);
Delete(s,1,Pos(Delimitador,s));
End;

Function StrReplace(s:String;ChrAct,ChrNew:Char):String;
Var
p : Integer;
Begin
If ChrNew <> #0 then
   Begin
   Repeat
      p := Pos(ChrAct,s);
      If p <> 0 Then
         Begin
         Delete(s,p,1);
         Insert(ChrNew,s,p);
         End;
   Until p = 0;
   End
Else
   Begin
   While Pos(ChrAct,s) <> 0 do
      Delete(s,Pos(ChrAct,s),1);
   End;
Result := s;
End;

Function StrExpandR(s:String;lon:Integer):String;

Begin
s := Trim(s);
s := Copy(s,1,lon);
While Length(s) < lon do
   s := ' ' + s;
Result := s;
End;


Function fs(Num: Double;e,d:Integer;al:Boolean=False):String; Overload;
Var
s : String;
Begin
s := FloatToStrF(Num,ffNumber,E,d);
While (Length(s) > e) And (Pos('.',s) <> 0) do
   Delete(s,Pos('.',s),1);
If not al then
   s := StrExpandR(s,e);
Result := s;
End;

Function fs(Num: Double;al:Boolean=True):String; Overload;
Begin
Result := fs(Num,20,2);
End;


Function StrMontoGringo(c:Currency):Pchar;
Var
m : String;
begin
m := Trim(fs(c,15,4));
m := StrReplace(m,'.',#0);
Result := Pchar(Trim(StrReplace(m,',','.')));
end;

Procedure DecodeAux02(Aux02:Pchar; Var Piezas,Largo,Alto: Double; Var Ubicacion:Pchar); StdCall;
Var
s : ShortString;
Aux : String;
begin
//Informa(Aux02);
Aux := aux02;
Aux  := StrReplace(aux,'.',',');
Piezas := 0;
Largo := 0;
Alto := 0;
Ubicacion := '';
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Piezas := StrToFloat(s);
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Largo := StrToFloat(s);
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Alto := StrToFloat(s);
Ubicacion := AnsiStrUpper(Pchar(Aux));
end;

Function Redondeo(v:Double): Double;
Const
Factor = 10000;
begin
Result := Trunc(v*Factor)/Factor;
End;

// Funciones ------------------

Function DecodePiezas(Aux02:Pchar): Double; StdCall;
 Var Piezas,Largo,Alto: Double;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Piezas;
End;

Function DecodeLargo(Aux02:Pchar): Double; StdCall;
 Var Piezas,Largo,Alto:Double;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Largo;
End;

Function DecodeAlto(Aux02:Pchar): Double; StdCall;
 Var Piezas,Largo,Alto:Double;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Alto;
End;

Function DecodeUbicacion(Aux02:Pchar): PChar; StdCall;
 Var Piezas,Largo,Alto:Double;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Ubicacion;
End;

Function  EncodeAux02(var Piezas,Largo,Alto:Double; Ubicacion:Pchar):Pchar;  StdCall;
Begin
Result := PChar(Trim(StrMontoGringo(Piezas)+';'+
                     StrMontoGringo(Largo)+';'+
                     StrMontoGringo(Alto)+';'+
                     AnsiStrUpper(Ubicacion)));
End;

Function StockEnFactores(Var Piezas,Largo,Alto:Double):Double;  StdCall;
begin
Result := Redondeo(Piezas*Largo*Alto);
End;

Function StockEnAux02(Aux02:PChar):Double;  StdCall;
Var
Piezas,Largo,Alto:Double;
Ubicacion:PChar;
begin
DecodeAux02(Aux02,Piezas,Largo,Alto,Ubicacion);
Result := StockEnFactores(Piezas,Largo,Alto);
End;



Exports
  DecodeAux02,
  DecodePiezas,
  DecodeLargo,
  DecodeAlto,
  DecodeUbicacion,
  EncodeAux02,
  StockEnFactores,
  StockEnAux02,
  Informa;

begin
end.


La franja horaria es GMT +2. Ahora son las 19:02:51.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi