读书人

delphi 调用DLL出现有关问题请各位

发布时间: 2012-03-21 13:33:14 作者: rapoo

delphi 调用DLL,出现问题,请各位看看 。。。。急急急
有一个USB设备的DLL文件 ,VB调用一切正常,现在需要改到delphi 下调用,程序编译没问题,但执行数据读取时出现错误

具体代码如下:

unit Unit_Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Unit_LKIF, Buttons,typinfo;
type LKIF_FLOATRESULT=(LKIF_FLOATRESULT_VALID, //' valid data
LKIF_FLOATRESULT_RANGEOVER_P, //' over range at positive (+) side
LKIF_FLOATRESULT_RANGEOVER_N, //' over range at negative (-) side
LKIF_FLOATRESULT_WAITING); //' comparator result

type LKIF_FLOATVALUE=record
x_FloatResult:LKIF_FLOATRESULT; //' valid or invalid data
x_Value:Single; //' measurement value during LKIF_FLOATRESULT_VALID.
//' Any other times will return an invalid value
end;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
//function LKIF_GetCalcData(CalcData1:LKIF_FLOATVALUE;CalcData2:LKIF_FLOATVALUE):longint;stdcall;external 'LkIF.dll';
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=cafree;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
type TLongIntFunc=function(CalcData1:LKIF_FLOATVALUE;CalcData2:LKIF_FLOATVALUE):longint;stdcall;
var
Th:Thandle;
Tf:TLongIntFunc;
Tp:TFarProc;
CalcData1:LKIF_FLOATVALUE;
CalcData2:LKIF_FLOATVALUE;
begin
Th:=LoadLibrary('LkIF.dll'); {装载DLL}
if Th>0 then
try
Tp:=GetProcAddress(Th,PChar('LKIF_GetCalcData'));
if Tp<>nil then
begin
try
Tf:=TLongIntFunc(Tp);
If Tf(CalcData1,CalcData2)=1 Then
//If LKIF_GetCalcData(CalcData1,CalcData2)=1 Then
begin
If CalcData1.x_FloatResult=LKIF_FLOATRESULT_VALID Then label1.Caption:=format('''%s''',[CalcData1.x_Value]);
If CalcData2.x_FloatResult=LKIF_FLOATRESULT_VALID Then label2.Caption:=format('''%s''',[CalcData1.x_Value]);
end
Else
showmessage('LKIF_GetCalcData terminated abnormally.');
except
raise ;
end;
end
else
ShowMessage('TestC函数没有找到');
Finally
FreeLibrary(Th);
end
else
ShowMessage('LkIF.dll没有找到');
end;

end.

//---------------------------------------------------
//vb 相关代码如下
//-------------------------------------------------
' Measurement value structures
Public Enum LKIF_FLOATRESULT
LKIF_FLOATRESULT_VALID ' valid data
LKIF_FLOATRESULT_RANGEOVER_P ' over range at positive (+) side
LKIF_FLOATRESULT_RANGEOVER_N ' over range at negative (-) side
LKIF_FLOATRESULT_WAITING ' comparator result
End Enum

Public Type LKIF_FLOATVALUE


FloatResult As LKIF_FLOATRESULT ' valid or invalid data
Value As Single ' measurement value during LKIF_FLOATRESULT_VALID.
' Any other times will return an invalid value

Public Declare Function LKIF_GetCalcMethod Lib "LkIF.dll" (ByVal OutNo As Long, ByRef CalcMethod As LKIF_CALCMETHOD, ByRef CalcTarget As LKIF_CALCTARGET) As Long

Private Sub GetCalcMethod_Click()
Dim CalcMethod As LKIF_CALCMETHOD
Dim CalcTarget As LKIF_CALCTARGET

If LKIF_GetCalcMethod(GetCalcMethodParam1.ListIndex, CalcMethod, CalcTarget) = 1 Then
If CalcMethod = LKIF_CALCMETHOD_HEADA Then
GetCalcMethodParam2 = "Head A"
ElseIf CalcMethod = LKIF_CALCMETHOD_HEADB Then
GetCalcMethodParam2 = "Head B"
ElseIf CalcMethod = LKIF_CALCMETHOD_HEAD_HEADA_PLUS_HEADB Then
GetCalcMethodParam2 = "Head A + Head B"
ElseIf CalcMethod = LKIF_CALCMETHOD_HEAD_HEADA_MINUS_HEADB Then
GetCalcMethodParam2 = "Head A - Head B"
ElseIf CalcMethod = LKIF_CALCMETHOD_HEAD_HEADA_TRANSPARENT Then
GetCalcMethodParam2 = "head A transparent object"
ElseIf CalcMethod = LKIF_CALCMETHOD_HEAD_HEADB_TRANSPARENT Then
GetCalcMethodParam2 = "head B transparent object"
Else
MsgBox "Illegal value returned by LKIF_GetCalcMethod." & CalcMethod
End If
If CalcTarget = LKIF_CALCTARGET_PEAK_1 Then
GetCalcMethodParam3 = "peak 1"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_2 Then
GetCalcMethodParam3 = "peak 2"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_3 Then
GetCalcMethodParam3 = "peak 3"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_4 Then
GetCalcMethodParam3 = "peak 4"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_1_2 Then
GetCalcMethodParam3 = "peak 1-peak 2"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_1_3 Then
GetCalcMethodParam3 = "peak 1-peak 3"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_1_4 Then
GetCalcMethodParam3 = "peak 1-peak 4"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_2_3 Then
GetCalcMethodParam3 = "peak 2-peak 3"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_2_4 Then
GetCalcMethodParam3 = "peak 2-peak 4"
ElseIf CalcTarget = LKIF_CALCTARGET_PEAK_3_4 Then
GetCalcMethodParam3 = "peak 3-peak 4"
Else
MsgBox "Illegal value returned by LKIF_GetCalcMethod." & CalcTarget
End If
ResultText = "LKIF_GetCalcMethod terminated normally."
Else
SetErrorResult ("LKIF_GetCalcMethod terminated abnormally.")
End If
End Sub
End Type



[解决办法]
delphi中LKIF_FLOATVALUE类型参数应该传递指针类型吧,你改成指针试试
[解决办法]
type TLongIntFunc=function(var CalcData1:LKIF_FLOATVALUE;var CalcData2:LKIF_FLOATVALUE):longint;stdcall;

If Tf(CalcData1,CalcData2)=1 Then

或者
type
PLKIF_FLOATVALUE=^LKIF_FLOATVALUE;
TLongIntFunc=function(CalcData1:PLKIF_FLOATVALUE;CalcData2:PLKIF_FLOATVALUE):longint;stdcall;



If Tf(@CalcData1,@CalcData2)=1 Then

读书人网 >.NET

热点推荐