VB中如何调用DLL中的二级指针，下面有DELPHI的DEMO，有没有哪位大虾能帮我把红色部分改成VB6的，万分感谢！
VB中如何调用DLL中的二级指针，下面有DELPHI的DEMO，有没有哪位大虾能帮我把红色部分改成VB6的，万分感谢！
库函数说明
1.1 int __stdcall TestPort(unsigned char PortNo,unsigned long BaudRate)
/******************************************************************************
参数入口：
PortNo：所要测试的串口号，1代表COM1，2代表COM2，以此类推。
BaudRate：通信所用的比特率，如9600,19200等，RFP-08型万能机为9600。
返回值：测试成功为0，否则为一个非0的值。
函数功能：测试通信端口是否能与试验机联机。
*****************************************************************************/
1.2 void __stdcall SetRecDataProc(void ** Proc)
/******************************************************************************
参数入口：
Proc：指向数据接收函数的指针的指针（二级指针），其函数据参数列表如下所示：
void __stdcall (*RecItemProc)(double Force,double Displacement,double Extend)；
Force指力值，Displacement指位移，Extend指变形。
返回值：无返回值。
函数功能：设置一个回调函数，当接收到试验机的数据时，调用此函数，传送力值、位移与变形给客户程序。 *****************************************************************************/
1.3 int __stdcall Connect(unsigned char PortNo,unsigned long BaudRate)
/******************************************************************************
参数入口：
PortNo：所要联机的串口号，1代表COM1，2代表COM2，以此类推。
BaudRate：通信所用的比特率，如9600,19200等，RFP-08型万能机为9600。
返回值：联机成功为0，否则为一个非0的值。
函数功能：使试验机进入联机检测状态，试验机定时发送数，RFComm32接收到数据后转发给客户程序。
*****************************************************************************/
1.4 int __stdcall Disconnect()
/******************************************************************************
参数入口：无参数
返回值：脱机成功为0，否则为一个非0的值。
函数功能：使试验机进入脱机状态。
*****************************************************************************/
1.5 int __stdcall SensorZero(int Style)
/******************************************************************************
参数入口：
Style：所要清零的传感器，0指力值传感器,1指变形传感器,2指位移传感器
返回值：联机成功为0，否则为一个非0的值。
函数功能：传感器清零。
*****************************************************************************/
1.6 int __stdcall Inline()
/******************************************************************************
参数入口：
返回值：联机成功为0，否则为一个非0的值。
函数功能：计算是否在线。15秒之内必需发送一次。建义每7秒发送一次。
*****************************************************************************/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TRecItemProc = procedure(Force:Double;Displacement:Double;Extend:Double);stdcall;
PRecItemProc = ^TRecItemProc;
TTestPortProc = function(PortNo:Byte;Baud: DWORD):Integer;stdcall;
TSetRecDataProc = procedure(var Proc:PRecItemProc);stdcall;
TConnectProc = function(PortNo:Byte;Baud:DWORD):Integer;stdcall;
TDisconnectProc = function():Integer;stdcall;
TSensorZeroProc = function(Style:Integer):Integer;stdcall;
TInlineProc = function():Integer;stdcall;
type
TForm1 = class(TForm)
lbl1: TLabel;
cbbPortNo: TComboBox;
btn4: TButton;
grp1: TGroupBox;
edtForce: TEdit;
btn1: TButton;
grp2: TGroupBox;
edtDisplacement: TEdit;
btn2: TButton;
grp3: TGroupBox;
edtExtend: TEdit;
btn3: TButton;
btnStop: TButton;
btnStart: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btn4Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
hInst: THandle;
TestPortProc: TTestPortProc;
SetRecDataProc: TSetRecDataProc;
ConnectProc: TConnectProc;
DisconnectProc: TDisconnectProc;
SensorZeroProc: TSensorZeroProc;
InlineProc: TInlineProc;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure RecItemProc(Force:Double;Displacement:Double;
Extend:Double);stdcall;
begin
with Form1 do
begin
edtForce.Text := FloatToStrF(Force,ffFixed,8,3);
edtDisplacement.Text := FloatToStrF(Displacement,ffFixed,8,3);
edtExtend.Text := FloatToStrF(Extend,ffFixed,8,3);
end;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
SensorZeroProc(0);
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
SensorZeroProc(2);
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
SensorZeroProc(1);
end;
procedure TForm1.btn4Click(Sender: TObject);
var PortNo:Byte;
begin
PortNo := cbbPortNo.ItemIndex + 1;
if TestPortProc(PortNo,9600) = 0 then
MessageBox(Handle,'串口测试成功！','信息',MB_OK)
else
MessageBox(Handle,'此串口不能使用！','信息',MB_OK);
end;
procedure TForm1.btnStartClick(Sender: TObject);
var PortNo:Integer;
begin
PortNo := cbbPortNo.ItemIndex + 1;
if ConnectProc(PortNo,9600) = 0 then
begin
btnStop.Enabled := true;
btnStart.Enabled := false;
Timer1.Enabled := true;
btn1.Enabled := true;
btn2.Enabled := true;
btn3.Enabled := true;
end;
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
if (DisconnectProc() = 0) then
begin
btnStop.Enabled := false;
btnStart.Enabled := true;
Timer1.Enabled := false;
btn1.Enabled := false;
btn2.Enabled := false;
btn3.Enabled := false;
end
end;
procedure TForm1.FormCreate(Sender: TObject);
var pFunProc:PRecItemProc;
begin
hInst := LoadLibrary('RFComm32.dll');
@TestPortProc := GetProcAddress(hInst,'TestPort');
@SetRecDataProc := GetProcAddress(hInst,'SetRecDataProc');
@ConnectProc := GetProcAddress(hInst,'Connect');
@DisconnectProc := GetProcAddress(hInst,'Disconnect');
@SensorZeroProc := GetProcAddress(hInst,'SensorZero');
@InlineProc := GetProcAddress(hInst,'Inline');
if Assigned(@SetRecDataProc) then
begin
pFunProc := @RecItemProc;
SetRecDataProc(pFunProc);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeLibrary(hInst);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
InlineProc();
end;
end.
[解决办法]
看看这个行不行：
http://topic.csdn.net/u/20100404/21/44771915-0b4c-45ac-ab3d-e43a48ae5a79.html?32741
[解决办法]
Declare Sub SetRecDataProc Lib "unknown.dll" (Proc As Long)'必须在bas模块中声明Sub RecItemProc(ByVal Force As Double, ByVal Displacement As Double, ByVal Extend As Double)End SubFunction GetFuncPtr(ByVal Ptr As Long) As Long GetFuncPtr = PtrEnd FunctionPrivate Sub Command1_Click() SetRecDataProc GetFuncPtr(AddressOf RecItemProc)End Sub
[解决办法]
帮顶一下.....
