请问我在dll中使用了spcomm控件，现在是如何在dll中spcomm的WriteCommData方法里写代码，以及如何在onReceiveData事件中写代码？

[yikeshu_888]

关于发送指令，我现在在dll中是这样写的：
function sendcommdata(scomm:pchar):LongBool;stdcall;
var
sinit6:string;
begin
try
comm1.CommName:=scomm;
sinit6:=HexToStr('6899999999999968050161CD16');
Comm1.WriteCommData(Pchar(sinit6),Length(sinit6));
Result:=true;
except
Result:=false;
end;
end;

在调用程序的按扭上是这样写的：
procedure TFCOMM.btnrestoreClick(Sender: TObject);
begin
if sendcommdata(slt_com.Text) then
//showmessage('复位卡的初始化指令发送成功);
else
messagedlg('复位卡的初始化指令发送失败!',mterror,[mbyes],0);
end;
现在的问题是:
1.上述的发送指令的方法和思路是否正确，各位是如何将发送指令的代码放在dll中的？
2.发送指令后，如何在dll中写代码来触发onReceiveData事件？
我之前在窗体上放个spcomm控件，然后再在onReceiveData事件知道如何写代码，但现在不知道在dll中如何写触发onReceiveData事件的代码。

请各位高手指点，非常感谢。

[anime_jin]

1.思路是对的，在dll中封装函数，外部参数调用
2.要得到onReceiveData返回事件的内容，是通过时间等待，判断是否符合你想要得到的数据包格式。

[yikeshu_888]

谢谢anime_jin朋友，
对于2，我的意思是如何在dll中写onReceiveData返回事件?
事件内容的代码我会写，之前把spcomm控件放到窗体上时我是这样写的，如：
procedure TFCOMM.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var s,sinit2;
begin
//接收RS232的数据并显示Memo1上。
SetLength(S,BufferLength);
Move(Buffer^,PChar(S)^,BufferLength);
Memo1.Lines.Add(StrToHex(S));
Memo1.Invalidate;

//如果”初始化1“成功，则进入下一步初始化2。
if (StrToHex(S)='68 FF FF FF FF FF FF 68 C5 01 62 F2 16') and (jstimes=1) then
begin
sinit2:=HexToStr('68999999999999680301016B16');
Comm1.WriteCommData(Pchar(sinit2),Length(sinit2));
end;
end;

但现在是将spcomm放到dll中，我就不知道如何在dll中来编写这个触发事件（不是指编写事件的内容）。

请问有没有相关的代码例子，谢谢。

[yikeshu_888]

楼上朋友，我把你的例子作了测试，点击button1没有任何反应呀。

[anime_jin]

ms dll不支持事件的吧，可以封装成com组件

[withcsharp]

我自己写的 可以 运行的
你可以 +我qq 253377572

[plax0850]

这个东西我经常做！我先说说我的做法，一般情况我是写一个类，如
type
TMydllClass = class
private
myComm : TComm;
procedure RecvData(sender : TObject;Buffer : Pointer; BufferLength : word);
public
constructor Create;
destructor Destroy; override;
function OpenComm(ComName : PChar; Baud : word) : Boolean;
function SendBuffer(Buffer : PChar; BufferLength : integer) : integer;
end;
现在我只简单介绍构造函数和就可以了
constructor TMydllClass.Create;
begin
myComm := TComm.Create(nil);
myComm.onrecevicedata := RecvData;
end;
这样串口只要收到数据就直接调用RecvData处理数据了

如果你想在Dll外面处理，你可以将这个作为一个回调函数，让外面的类过程来处理。

[小呆之家]

type
TMyComm=class(TComm)
public
procedure MyReceDataProc(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
end;

var
mycomm:Tmycomm;

imp.....
procedure TMYComm.MyReceDataProc(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
begin
//enter the code here... for recevice the data....

end;


-----------------------------------------------------------------
//create a dynimac comm object to send data and recevice data....

mycomm:=tmycomm.create(nil);
mycomm.commname:='com1';
//---set up the params...

mycomm.onrecevicedata:=mycomm.myrecedataproc;
-----------------------------------------------------------------

//send data...
var
psendpoint:pchar;
senddata:string;
sendlen:integer;


senddata:='send data to device.';
psendpoint:=@senddata[1];
sendlen:=length(senddata);
mycomm.writeCommdata(psendpoint,sendlen);
....

[yikeshu_888]

谢谢楼上朋友，我是想将数据的发送，以及接收返回数据的处理等都放在dll中，调用程序仅传递几个必要的参数给dll进行处理。

我的dll文件大致是这样的：
library Project1;
uses
SysUtils,
Classes,
dialogs,
spcomm;
var
comm1:TComm;
{$R *.res}


function opencomm(scomm:pchar):LongBool;stdcall;
begin
comm1:=TComm.Create(nil);
try
try
comm1.CommName:=scomm;
Comm1.StartComm;
Result:=true;
except
Result:=false;
end;
finally
//comm1.Free;
end;

end;

function closecomm(scomm:pchar):LongBool;stdcall;
begin
try
comm1.CommName:=scomm;
Comm1.stopComm;
Result:=true;
except
Result:=false;
end;
end;

procedure myComm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
begin
showmessage('测试看能不能执行到这里。');
end;

function sendcommdata(scomm:pchar):LongBool;stdcall;
var
sinit6:string;
begin
try
comm1.CommName:=scomm;
sinit6:=HexToStr('6899999999999968050161CD16');
Comm1.WriteCommData(Pchar(sinit6),Length(sinit6));
Result:=true;
except
Result:=false;
end;

comm1.OnReceiveData:=myComm1ReceiveData;
//此行编译时通不过，提示：[Error] Project1.dpr(202): Incompatible types: 'method pointer and regular procedure' 我现在不知道如何调用这个过程，给这个过程传参。
end;

exports
opencomm,closecomm,sendcommdata;
begin
end.

请指点，非常感谢。

[withcsharp]

我写的dll中 触发 主窗体的事件的例子
直接 传事件

//////////////////dll 部分

library Project1;

uses
SysUtils,
Classes,
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.res}
procedure setEvent(i:Tmyp);stdcall;
begin
Form1:=TForm1.Create(Application);
Form1.myEvent:=i;
//Form1.Show;
end;
exports
setEvent index 1; //
begin
end.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
Tmyp = procedure(buf: Pchar; len: integer) of object;
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
myEvent: Tmyp;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
str: string;

begin
str := formatdatetime('yyyy-mm-dd hh:nn:ss zzz', now) + ' 爱吃猪脚';
if assigned(myEvent) then
myEvent(pchar(str), length(str));
end;

end.


主程序

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
Tmyp = procedure(buf: Pchar; len: integer) of object;
tset = procedure(i: Tmyp); stdcall;

TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;

procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
myEvent: Tmyp;
procedure myp(buf: Pchar; len: integer);
end;

var
Form1: TForm1;
temp: tset;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
DllHandle: Thandle;
begin
DllHandle := LoadLibrary(pchar('Project1.dll'));
if DllHandle = 0 then
begin
ShowMessage('找不到指定的连接库');
Exit;
end;
@temp := getprocaddress(DllHandle, pchar('setEvent'));
myEvent := myp;
temp(myEvent);
end;

procedure TForm1.myp(buf: Pchar; len: integer);

var
str: string;
begin
setlength(str, len);
Move(buf[0], str[1], len);
memo1.Lines.Add(str);
str := '';
end;

end.

[Dhammacakkhu]

mark

[xiaocai800322]

楼主的函数指针错误我也遇到,我摸索了很久最后只是觉得对象里面的procedure 跟面向过程的procedure 不太一样,对了很长时间还是初现你遇到的错误提示,最后就用笨办法,就是像(红辣椒)和(博克)那样写得那样,将一个类的Procedure RecvData(sender : TObject;Buffer : Pointer; BufferLength : word)方法付给那个过程.当然那个类不一定继承于Tcomm继承别的类也行

[plax0850]

unit UnitComm;
uses
classes, spcomm;
interface

type
TMydllClass = class
private
myComm : TComm;
CommOpen : boolean;
procedure RecvData(sender : TObject;Buffer : Pointer; BufferLength : word);
public
constructor Create;
destructor Destroy; override;
function OpenComm(ComName : PChar; Baud : word) : Boolean;
function SendBuffer(Buffer : PChar; BufferLength : integer) : integer;
function CloseComm : Boolean;
function IsOpen : Boolean;
end;

implemention
constructor TMydllClass.Create;
begin
myComm := TComm.Create(nil);
myComm.onrecevicedata := RecvData;
end;

destructor TMydllClass.Destroy;
begin
if commOpen then
myComm.stopcomm;
end;

function TMydllClass.OpenCom(ComName : PChar; Baud : word) : boolean;
begin
try
myComm.CommName := ComName;
myComm.BaudRate := Baud;
myComm.StartComm;
CommOpen := True;
except
CommOpen := False;
end;
Result := CommOpen;
end;

function TMydllClass.SendBuffer(Buffer : PChar; BufferLength : integer) : integer;
begin
Result := 0;
if CommOpen then
begin
try
myComm.WriteCommData(Buffer, BufferLength);
Result := BufferLength;
except
Result := 0;
end;
end;
end;

function TMydllclass.CloseComm : Boolean;
begin
Result := False;
if CommOpen then
begin
myComm.StopComm;
CommOpen := False;
Result := True;
end
end;

procedure TMydllclass.RecvData(sender : TObject;Buffer : Pointer; BufferLength : word);
begin
ShowMessage('测试看能不能执行到这里。');
end;

function TMydllclass.IsOpen : Boolean;
begin
Result := ComOpen;
end;

end.

上面是类的实现，是随意写的，不一定正确，你自己琢磨一下，调试一下，下面是dll部分
library Project1;
uses
SysUtils,
Classes;
var
ComClass : TMydllClass;

function opencomm(scomm:pchar; Baud : word):LongBool;stdcall;
begin
Result := false;
if ComClass = nil then
begin
ComClass := TMydllClass.create;
end;
if ComClass.IsOpen then

end;

[plax0850]

按错了键，重新写dll部分
library Project1;
uses
SysUtils,
Classes;
var
ComClass : TMydllClass;

function opencomm(scomm:pchar; Baud : word):LongBool;stdcall;
begin
if ComClass = nil then
begin
ComClass := TMydllClass.create;
end;
if ComClass.IsOpen then
ComClass.CloseComm;
Result := ComClass.OpenCom(scomm, Baud);
end;

function closecomm(scomm:pchar):LongBool;stdcall;
begin
Result := True;
if ComClass <> nil then
begin
ComClass.CloseComm;
end;
end;

function sendcommdata(scomm:pchar):LongBool;stdcall;
var
sinit6:string;
begin
Result := False;
sinit6:=HexToStr('6899999999999968050161CD16');
if (ComClass <> nil) and (ComClass.IsOpen) then
begin
Result := (ComClass.SendBuffer(PChar(sinit6), Length(sinit6)) > 0);

end;
end;

[yikeshu_888]

多谢博克兄，我现在正在试。

[yikeshu_888]

plax0850,你好，
能不能按你的方法帮把我的dll改一下呀。

我的dll:
library Project1;
uses
SysUtils,
Classes,
dialogs,
spcomm;
var
comm1:TComm;
{$R *.res}


function opencomm(scomm:pchar):LongBool;stdcall;
begin
comm1:=TComm.Create(nil);
try
try
comm1.CommName:=scomm;
Comm1.StartComm;
Result:=true;
except
Result:=false;
end;
finally
//comm1.Free;
end;

end;

function closecomm(scomm:pchar):LongBool;stdcall;
begin
try
comm1.CommName:=scomm;
Comm1.stopComm;
Result:=true;
except
Result:=false;
end;
end;

procedure myComm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
begin
showmessage('测试看能不能执行到这里。');
end;

function sendcommdata(scomm:pchar):LongBool;stdcall;
var
sinit6:string;
begin
try
comm1.CommName:=scomm;
sinit6:=HexToStr('6899999999999968050161CD16');
Comm1.WriteCommData(Pchar(sinit6),Length(sinit6));
Result:=true;
except
Result:=false;
end;

comm1.OnReceiveData:=myComm1ReceiveData;
//此行编译时通不过，提示：[Error] Project1.dpr(202): Incompatible types: 'method pointer and regular procedure' 我现在不知道如何调用这个过程，给这个过程传参。
end;

exports
opencomm,closecomm,sendcommdata;
begin
end.


我现在是要将发送和处理返回数据都放到dll中进行处理，调用程序只传一个串口号这个参数。

请帮忙给我这个dll改一下。

谢，谢。

[yikeshu_888]

博克,你好，按你写的类，我调试了一下，现在基本上搞定了。

但现在还有2个问题：
我先将我调试后的dll代码贴出：
以下是dll主文件:
library Project1;
uses
SysUtils,
Classes,
dialogs,
Unit1 in 'Unit1.pas';
type
//定义函数类型
P_FormFun = Function (log : String) : Integer;

var
ComClass : TMydllClass;


function opencomm(scomm:pchar):boolean;stdcall;
begin
if ComClass = nil then
begin
ComClass := TMydllClass.create;
end;
if ComClass.IsOpen then
ComClass.CloseComm(scomm);
Result := ComClass.OpenComm(scomm);
end;

function closecomm(scomm:pchar):boolean;stdcall;
begin
Result := True;
if ComClass <> nil then
begin
ComClass.CloseComm(scomm);
end;
end;

function HexToStr( //十六进制字符串处理成字符串
mHex: string //十六进制字符串
): string;//返回处理后的字符串
var
I: Integer;
begin
Result := '';
mHex := StringReplace(mHex, #32, '', [rfReplaceAll]);
for I := 1 to Length(mHex) div 2 do
Result := Result + Chr(StrToIntDef('$' + Copy(mHex, I * 2 - 1, 2), 0));
end; { HexToStr }

function StrToHex( //字符串处理成十六进制字符串
mStr: string; //字符串
//mSpace: Boolean = False //是否用空格分开
mSpace: Boolean = True //是否用空格分开
): string; //返回处理后的十六进制字符串
const
cSpaceStr: array[Boolean] of string = ('', #32);
var
I: Integer;
begin
Result := '';
for I := 1 to Length(mStr) do
Result := Format('%s%s%.2x', [Result, cSpaceStr[mSpace], Ord(mStr[I])]);
if mSpace then Delete(Result, 1, 1);
end; { StrToHex }

function sendrestoredata(scomm:string;sedtold:string;sedtnew1:string):boolean;stdcall;
var
srestore_init11:string; //复位卡的第一步：初始化指令。
begin
Result := False;
srestore_init11:=HexToStr('6899999999999968050161CD16');
if (ComClass <> nil) and (ComClass.IsOpen) then
begin
Result := (ComClass.SendBuffer(PChar(srestore_init11), Length(srestore_init11)) > 0);
jstimes:=11;

myedtold:=sedtold;
myedtnew1:=sedtnew1;
end;
end;

Function fun_Test ( pfun:P_FormFun) : integer ; stdcall ;
begin
pfun(StrToHex(S_recv));
Result := 0;
end ;

exports
opencomm,closecomm,sendrestoredata,fun_Test;

begin
end.

以下是dll中的单元：
unit Unit1;

interface

uses
SysUtils,classes,spcomm,dialogs;

type
TMydllClass = class
private
myComm : TComm;
CommOpen : boolean;
procedure RecvData(sender : TObject;Buffer : Pointer; BufferLength : word);
public
constructor Create;
destructor Destroy; override;
function OpenComm(ComName : PChar) : boolean;
function SendBuffer(Buffer : PChar; BufferLength : integer) : integer;
function CloseComm(ComName : PChar) : boolean;
function IsOpen : Boolean;
end;
var
S_recv:string;
jstimes:integer;
myedtold,myedtnew1:string;
implementation
constructor TMydllClass.Create;
begin
myComm := TComm.Create(nil);
myComm.OnReceiveData := RecvData;
end;

destructor TMydllClass.Destroy;
begin
if commOpen then
myComm.stopcomm;
end;

function TMydllClass.SendBuffer(Buffer : PChar; BufferLength : integer) : integer;
begin
Result := 0;
if CommOpen then
begin
try
myComm.WriteCommData(Buffer, BufferLength);
Result := BufferLength;
except
Result := 0;
end;
end;
end;

function TMydllClass.OpenComm(ComName : PChar) : boolean;
begin
try
myComm.CommName := ComName;
myComm.BaudRate:=2400;
myComm.StartComm;
CommOpen := True;
except
CommOpen := False;
end;
Result := CommOpen;
end;

function TMydllclass.CloseComm(ComName : PChar) : boolean;
begin
Result := False;
if CommOpen then
begin
myComm.CommName := ComName;
myComm.StopComm;
CommOpen := False;
Result := True;
end
end;

function HexToStr( //十六进制字符串处理成字符串
mHex: string //十六进制字符串
): string; //返回处理后的字符串
var
I: Integer;
begin
Result := '';
mHex := StringReplace(mHex, #32, '', [rfReplaceAll]);
for I := 1 to Length(mHex) div 2 do
Result := Result + Chr(StrToIntDef('$' + Copy(mHex, I * 2 - 1, 2), 0));
end; { HexToStr }


function StrToHex( //字符串处理成十六进制字符串
mStr: string; //字符串
//mSpace: Boolean = False //是否用空格分开
mSpace: Boolean = True //是否用空格分开
): string; //返回处理后的十六进制字符串
const
cSpaceStr: array[Boolean] of string = ('', #32);
var
I: Integer;
begin
Result := '';
for I := 1 to Length(mStr) do
Result := Format('%s%s%.2x', [Result, cSpaceStr[mSpace], Ord(mStr[I])]);
if mSpace then Delete(Result, 1, 1);
end; { StrToHex }

procedure TMydllclass.RecvData(sender : TObject;Buffer : Pointer; BufferLength : word);
var srestore_writeinit12,srestore_writebackinit13,srestore14:string;
soldps,sd1,sd2,sd3,sd4,snewps,sn1,sn2,sn3,sn4: string;
srestore:string;
begin

//----计算出原密码，新密码的字符串------
sd1:=copy(myedtold,7,2);
sd2:=copy(myedtold,5,2);
sd3:=copy(myedtold,3,2);
sd4:=copy(myedtold,1,2);
soldps:=inttohex((strtoint('$'+sd1)+51),2)+inttohex((strtoint('$'+sd2)+51),2)+inttohex((strtoint('$'+sd3)+51),2)+inttohex((strtoint('$'+sd4)+51),2);

sn1:=copy(myedtnew1,7,2);
sn2:=copy(myedtnew1,5,2);
sn3:=copy(myedtnew1,3,2);
sn4:=copy(myedtnew1,1,2);
snewps:=inttohex((strtoint('$'+sn1)+51),2)+inttohex((strtoint('$'+sn2)+51),2)+inttohex((strtoint('$'+sn3)+51),2)+inttohex((strtoint('$'+sn4)+51),2);
{
//接收RS232的数据并显示Memo1上。
SetLength(S,BufferLength);
Move(Buffer^,PChar(S)^,BufferLength);
Memo1.Lines.Add(StrToHex(S));
Memo1.Invalidate;
}
SetLength(S_recv,BufferLength);
Move(Buffer^,PChar(S_recv)^,BufferLength);

//**********点击了复位卡按纽。**********************************
//如果第一步"初始化"成功，则进入第二步:写数据初始化。
if (StrToHex(S_recv)='68 FF FF FF FF FF FF 68 C5 01 62 F2 16') and (jstimes=11) then
begin
srestore_writeinit12:=HexToStr('68999999999999680301016B16');
mycomm.WriteCommData(Pchar(srestore_writeinit12),Length(srestore_writeinit12));
jstimes:=12;
end;

//如果第二步"写数据初始化"成功，则进入第三步:写返写区初始化。
if (StrToHex(S_recv)='68 FF FF FF FF FF FF 68 83 00 4D 16') and (jstimes=12) then
begin
srestore_writebackinit13:=HexToStr('68999999999999680301026C16');
mycomm.WriteCommData(Pchar(srestore_writebackinit13),Length(srestore_writebackinit13));
jstimes:=13;
end;

//如果第三步"写返写区初始化"成功，则进入最后一步第四步:复位卡。
if (StrToHex(S_recv)='68 FF FF FF FF FF FF 68 83 00 4D 16') and (jstimes=13) then
begin
srestore:='6899999999999968041534339B4341CCCCCCCCCCCC'+soldps+snewps+'F349AD16';
srestore14:=HexToStr(srestore);
//srestore14:=HexToStr('6899999999999968041534339B4341CCCCCCCCCCCC3334353633343536F349AD16');
mycomm.WriteCommData(Pchar(srestore14),Length(srestore14));
jstimes:=14;
end;

//如果第四步：复位卡成功，则提示复位卡制作成功。
if (StrToHex(S_recv)='68 FF FF FF FF FF FF 68 83 00 4D 16') and (jstimes=14) then
begin
showmessage('复位卡的制作成功!');
jstimes:=15;
end;
//复位卡的异常处理,第一步发送指令后的返回结果不正确。
if (StrToHex(S_recv)='68 FF FF FF FF FF FF 68 C5 01 32 C2 16') and (jstimes=11)then
messagedlg('复位卡的操作失败，请将卡拿开，再放上去!',mterror,[mbyes],0) ;
end;

function TMydllclass.IsOpen : Boolean;
begin
Result := CommOpen;
end;

end.

[yikeshu_888]

以下是调用程序exe的相关代码：
procedure Tuseprog.btnrestoreClick(Sender: TObject);
var pfun :P_FormFun;
begin
if sendrestoredata(slt_com.Text,edtold.text,edtnew1.text) then
else
messagedlg('复位卡的初始化指令发送失败!',mterror,[mbyes],0);


pfun := @fun_addlog;
//将这个函数的指针传递给dll,就可以在dll中调用外面的函数
fun_Test(pfun);
end;

相关代码：
function opencomm(scomm:string):boolean;stdcall;external 'project1.dll';
function closecomm(scomm:string):boolean;stdcall;external 'project1.dll';
function sendrestoredata(scomm:string;sedtold:string;sedtnew1:string):boolean;stdcall;external 'project1.dll';

//定义Dll输出的函数类型
Function fun_Test ( pfun:P_FormFun) : integer ; stdcall ;External 'Project1.dll';

implementation

function fun_addlog(log: string): integer;
begin
useprog.Memo1.Lines.Add(log);
useprog.Memo1.Invalidate;
end;

现有两个问题：
1.如何才能将返回指令及时显示在exe上memo1上面？我现在的程序不能正常显示在memo1上。
2.showmessage('复位卡的制作成功!'); 这条提示信息会出现两个。是什么原因？

请博克兄和各位大虾指点一下，非常感谢。
分不够再加。

[plax0850]

客气了，定义一个回调函数就可以了，就可以了，就相当于写控件的事件一样。
回调函数也是函数指针。只不过你没有经常使用而已。

回调函数类型的定义，Delphi已经定义了很多。如大部分事件类型，其实就是回调函数类型。
在这儿我要指出的是你在dll中写Function fun_Test ( pfun:P_FormFun) : integer ; stdcall;函数的时候，为何不在dll中定义P_FormFun的一个全局变量，专门来存储这个pfun回调函数啦。然后在mydllclass类中的串口接收事件中调用这个函数指针，那么这时候只要接收到数据就会调用你写的fun_addlog函数了。这个fun_addlog函数就是传说中的回调函数。能够及时响应串口事件哟！