高分求救 vb引用delqhi中的dll时 遇到的问题

[sakas]

如下 ：
Function SetOnFileArrive(Const p_Port :Integer;
Const p_OnFileArrive:TOnFileArrive):Boolean; stdcall; external 'JustPipe.Dll';
以上是delqhi中的函数

TOnFileArrive =Procedure(Const p_FileName:PChar);

以上是delqhi中的需要回调的函数

我在vb中是这样做的

Declare Function SetOnFileArriveOfObj Lib "JustPipe" (ByVal port As Integer, ByVal b As Long) As Boolean

Public Sub Hook()
a = SetOnFileArriveOfObj(2000, AddressOf gcb)
If a Then
MsgBox "ok"
End If
' lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf gcb)
End Sub

回调函数为
Public Sub gcb(ByRef fillname() As Byte)
MsgBox fillname
End Sub


现在的问题是 回调已经成功 并弹出ok对话框 但接着 程序运行终止刮掉

我估计是参数传递的问题 有什么解决发子

[yanlls]

//dll
uses
SysUtils,
Classes;

{$R *.res}
type
TOnFileArrive =procedure(MyChar:widestring);stdcall;
var
TempCallbackProc:TOnFileArrive;
function setOnFileArrive( p_Port :pchar; p_OnFileArrive: pointer):boolean; stdcall;export;
begin
@TempCallbackProc:=p_OnFileArrive;
if Assigned(TempCallbackProc) then
TempCallbackProc(p_port);
result:=true;
end;
exports
setOnFileArrive;
begin
end.

vb调用

Option Explicit
Public Const GWL_WNDPROC = (-4)

Declare Function setOnFileArrive Lib "Project1.dll" (ByVal port As String, ByVal b As Long) As Boolean
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Dim lpPrevWndProc As Long
Public Sub Hook()
Dim a As Boolean
a = setOnFileArrive("测试程序", AddressOf gcb)
If a Then
MsgBox "ok"
End If

' lpPrevWndProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf gcb)
End Sub

Public Sub gcb(ByVal Mychar As String)
Form1.Text1.Text = Mychar
End Sub

'需要注意参数的类型
vb中默认是byref
byref传递在delphi中应该用var ***来对应
如:
sub myTest(a as integer)
delphi中应该用procedure myTest(var a:longint);

[sendwb]

我也遇到了同样的问题,我的DLL函数是这样声明的:
function RFile_1(F_name:pchar):pchar;stdcall;export;

VB的调用声明是这样写的:
Public Declare Function RFile_1 Lib "RFile.dll" (ByVal F_name As String) As String

但是一调用,VB程序就会报内存错误后关闭.内存错误说****内存不能为读

[yanlls]

to sendwb(风间苍月)：
RFile_1返回了pchar类型吗

[kongguangming]

把pchar 和delphi 里特有的类型改成variant

[sendwb]

是的,我用delphi调用,就什么错也没有,但也不会返回我需要的值,用VB调用就会报错,并关闭程序

[sendwb]

variant是改参数的声明吗?

[sendwb]

pchar改成variant后错误更严重了,最开始声明成string还可以执行成功,但就是报错

[yanlls]

返回值用pchar转化一下

[yanlls]

如：
function RFile_1(F_name:pchar):pchar;stdcall;export;
var
strTemp:string;
begin
strtemp:='测试';
result:=pchar(strtemp);
end;

[sendwb]

function RFile_1(F_name:String):String;stdcall;export;
var
F_buf,F_buf1:string;

B_buf:array of byte;
F_hand,iFileLength,iBytesRead:integer;
i: Integer;
begin
Result := '';
F_buf:='';
try
F_hand:=fileopen(F_name,fmShareDenyWrite);
iFileLength := FileSeek(F_hand,0,2);
FileSeek(F_hand,0,0);
i:=iFileLength;
setlength(B_buf,i+1);
iBytesRead:=FileRead(F_hand,B_buf[0],iFileLength);
fileclose(F_hand);
for i := 0 to iFileLength-1 do
begin
F_buf1:=inttohex(B_buf[i],2);
F_buf:=F_buf+F_buf1;
end;
finally

end;
RFile_1:=F_buf;
end;


函数原码

[sendwb]

试过转PCHAR了,仍然不行,delphi调用没报错,但也不会返回我需要的值,按现在这种声明,会报一个错误,但还是会执行并返回我需要的值

[yanlls]

function RFile_1(F_name:String):String;stdcall;export;=>
function RFile_1(F_name:pchar):String;stdcall;export;

RFile_1:=F_buf;=>
RFile_1:=pchar(F_buf);

[yanlls]

function RFile_1(F_name:pchar):pchar;stdcall;export;

[sendwb]

????什么写法,不明白,请写明白一些,谢谢!

[sendwb]

上面的声明方式试过了,不行的,一样会报错

[yanlls]

function RFile_1(F_name:pchar):pchar;stdcall;export;
var
F_buf,F_buf1:string;

B_buf:array of byte;
F_hand,iFileLength,iBytesRead:integer;
i: Integer;
begin
Result := '';
F_buf:='';
try
F_hand:=fileopen(F_name,fmShareDenyWrite);
iFileLength := FileSeek(F_hand,0,2);
FileSeek(F_hand,0,0);
i:=iFileLength;
setlength(B_buf,i+1);
iBytesRead:=FileRead(F_hand,B_buf[0],iFileLength);
fileclose(F_hand);
for i := 0 to iFileLength-1 do
begin
F_buf1:=inttohex(B_buf[i],2);
F_buf:=F_buf+F_buf1;
end;
finally

end;
RFile_1:=pchar(F_buf);
end;

[sendwb]

我试过了,VB调用程序一样报错关闭

[yanlls]

to sendwb(风间苍月)
留下QQ，我发份源代码给你，我没发现问题

[sendwb]

QQ:415863929

[lyshw]

yanlls(拒绝日货(美女除外)) 说的没错 我测试过了 没问题
dll:
library Project1;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Classes;

{$R *.res}

type
TOnFileArrive = procedure(MyChar:PChar);stdcall;
var
TempCallbackProc:TOnFileArrive;

function SetOnFileArriveOfObj(p_Port :pchar; p_OnFileArrive: pointer):boolean; stdcall;export;
begin
@TempCallbackProc:=p_OnFileArrive;
if Assigned(TempCallbackProc) then
TempCallbackProc(p_Port);

result:=true;
end;

exports
SetOnFileArriveOfObj;

begin
end.


vb:

Private Sub Command1_Click()
Dim a As Boolean

a = SetOnFileArriveOfObj(2000, AddressOf gcb)
If a Then
MsgBox "ok"
End If
End Sub


Public Declare Function SetOnFileArriveOfObj Lib ".\Project1" (ByVal port As String, ByVal b As Long) As Boolean


'回调函数为
Public Sub gcb(ByVal fillname As String)
MsgBox fillname
End Sub