全部博文(788)
分类:
2008-11-27 21:17:38
回调函数的资料,始终编译通不过
exports
SetCallback;
type
TCallback=procedure(s:string);
TABC=class(TComponent)
procedure MSCommOnComm(Sender:TObject);
end;
var
FCallback:TCallback;
ABC:TABC;
procedure SetCallback(ACallback:TCallback);
begin
FCallback:=@ACallback;
end;
procedure TABC.MSCommComm(Sender:TObject);
var
s:string;
begin
while MSComm1.InBufferCount>0 do
begin
s:=MSComm1.Input;
if Assigned(FCallback) then
FCallback(PChar(s));
end;
end;
initialization
...
ABC:=TABC.Create(nil);
MSComm1.OnComm:=ABC.MSCommOnComm
finalization
...
ABC.Free;
end.
大家帮帮忙,用CPort或者spcomm都好
如果有pcomm的delphi资料给咱一份
我没有这样做过,不过很感兴趣。在台湾大富翁查了一份封装SPCOMM的资料,不知道对你有没有帮助。
感谢楼上的
不客气,因为我对工业控制一直很感兴趣,也做了好几个项目。但一直没有用串口通讯组件,都是用的自己写的WIN32底层封装。
楼上能否给一份自己封装好的api
源码都可以给。你可以根据你的需要来封装
10分感谢。先给你记分
睡觉了,明天给你揭帖
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function OPEN_PORT(PORT: SHORTSTRING; BTL: INTEGER): INTEGER; StdCall External 'DRYPRT5.dll';
function CLOSE_PORT: INTEGER; StdCall External 'DRYPRT5.dll';
function SEND_COMMAND(SD: string; var RD: PChar): INTEGER; StdCall External 'DRYPRT5.dll';
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if OPEN_PORT('1', 9600) = 1 then ShowMessage('正常打开');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if CLOSE_PORT = 1 then ShowMessage('正常关闭');
end;
end.
-----------------------------------------------------------
library DRYPRT5;
uses
SysUtils,
Classes,
PRTTING in 'PRTTING.pas';
{$R *.RES}
exports
OPEN_PORT,
CLOSE_PORT,
SEND_COMMAND;
begin
end.
unit PRTTING;
interface
uses
Windows, Forms, ExtCtrls, SysUtils, SPComm;
type
TMYOBJ = class
procedure MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
end;
var
WAIT_TIMES, N_NUMBER: INTEGER;
START_TIMES: REAL;
READ_BUSY, OPEN_BUSY, PORT_ACTIVE, RECEIVE_FINISH: BOOLEAN;
S_DATA: string;
MYCOM: TCOMM;
MYOBJ: TMYOBJ;
function OPEN_PORT(PORT: SHORTSTRING; BTL: INTEGER): INTEGER; STDCALL;
function CLOSE_PORT: INTEGER; STDCALL;
function SEND_COMMAND(SD: string; var RD: PChar): INTEGER; STDCALL;
implementation
procedure INI_OBJ;
begin
MYOBJ := TMYOBJ.Create;
MYCOM := TCOMM.Create(nil);
MYCOM.OnReceiveData := MYOBJ.MYComReceiveData;
end;
procedure FREE_OBJ;
begin
try
if MYOBJ <> nil then
begin
MYOBJ.FREE;
MYOBJ := nil;
end;
if MYCOM <> nil then
begin
MYCOM.FREE;
MYCOM := nil;
end;
except
end;
end;
procedure TMYOBJ.MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
var
S1: string;
begin
START_TIMES := Now;
SetLength(S1, BufferLength);
Move(Buffer^, PChar(S1)^, BufferLength);
S_DATA := S_DATA + S1;
if Pos(#13, S_DATA) > 0 then RECEIVE_FINISH := TRUE;
end;
//function SEND_COMMAND(var SD, RD: PChar): INTEGER; stdcall;
function SEND_COMMAND(SD: string; var RD: PChar): INTEGER; stdcall;
var
N2: REAL;
B: BOOLEAN;
begin
if READ_BUSY then
begin
RESULT := 0;
Exit;
end;
if not PORT_ACTIVE then
begin
RESULT := -1;
Exit;
end;
READ_BUSY := TRUE;
RECEIVE_FINISH := FALSE;
START_TIMES := Now;
S_DATA := '';
MYCOM.WriteCommData(PChar(SD), Length(SD));
B := FALSE;
while not RECEIVE_FINISH do
begin
APPLICATION.ProcessMessages;
N2 := Now - START_TIMES;
N2 := N2 * 100000000;
B := N2 > 2000;
if B then Break;
end;
if B then RESULT := -2 // 超时没有返回值
else RESULT := 1;
//RD := PChar(S_DATA);
//Move(S_DATA[1], RD^, length(S_DATA));
RD := StrNew(PChar(S_DATA));
S_DATA := '';
READ_BUSY := FALSE;
end;
function OPEN_PORT(PORT: SHORTSTRING; BTL: INTEGER): INTEGER; stdcall;
begin
if OPEN_BUSY or READ_BUSY then
begin
RESULT := 0;
Exit;
end;
if PORT_ACTIVE then
begin
RESULT := -1;
Exit;
end;
OPEN_BUSY := TRUE;
INI_OBJ;
MYCOM.BaudRate := BTL;
MYCOM.CommName := 'com' + PORT;
try
MYCOM.StartComm;
PORT_ACTIVE := TRUE;
RESULT := 1;
except
PORT_ACTIVE := FALSE;
RESULT := -2;
end;
OPEN_BUSY := FALSE;
end;
function CLOSE_PORT: INTEGER; stdcall;
begin
try
if MYCOM <> nil then MYCOM.StopComm;
PORT_ACTIVE := FALSE;
RESULT := 1;
except
RESULT := -1;
end;
FREE_OBJ;
end;
end.
上面代码还有返回没有解决,这样返回不好。回调怎么实现?
while not RECEIVE_FINISH do会占用100% CPU时间的哦
SPCOMM是异步线程控制的,所以最好你也采用异步管理方法
同意楼上的,就是这个返回方式还没有解决
spcomm的ReceiveData触发后用什么方法把数据给exe合适呢
下面代码,exe如何调用SetCallback?
library DRYPRT5;
uses
SysUtils,
Classes,
PRTTING in 'PRTTING.pas';
{$R *.RES}
exports
SetCallback,
OPEN_PORT,
CLOSE_PORT,
SEND_COMMAND;
begin
end.
unit PRTTING;
interface
uses
Windows, Forms, ExtCtrls, SysUtils, SPComm;
type
TCallback = procedure(s: string);
TMYOBJ = class
procedure MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
end;
var
WAIT_TIMES, N_NUMBER: INTEGER;
START_TIMES: REAL;
READ_BUSY, OPEN_BUSY, PORT_ACTIVE, RECEIVE_FINISH: BOOLEAN;
S_DATA: string;
MYCOM: TCOMM;
MYOBJ: TMYOBJ;
FCallback: TCallback;
function OPEN_PORT(PORT: SHORTSTRING; BTL: INTEGER): INTEGER; STDCALL;
function CLOSE_PORT: INTEGER; STDCALL;
function SEND_COMMAND(SD: string; var RD: PChar): INTEGER; STDCALL;
procedure SetCallback(ACallback: TCallback); STDCALL;
implementation
function SEND_COMMAND(SD: string; var RD: PChar): INTEGER; stdcall;
var
N2: REAL;
B: BOOLEAN;
begin
if READ_BUSY then
begin
RESULT := 0;
Exit;
end;
if not PORT_ACTIVE then
begin
RESULT := -1;
Exit;
end;
READ_BUSY := TRUE;
RECEIVE_FINISH := FALSE;
START_TIMES := Now;
S_DATA := '';
MYCOM.WriteCommData(PChar(SD), Length(SD));
{B := FALSE;
while not RECEIVE_FINISH do
begin
APPLICATION.ProcessMessages;
N2 := Now - START_TIMES;
N2 := N2 * 100000000;
B := N2 > 2000;
if B then Break;
end;
if B then RESULT := -2 // 超时没有返回值
else RESULT := 1;
//RD := PChar(S_DATA);
//Move(S_DATA[1], RD^, length(S_DATA));
RD := StrNew(PChar(S_DATA));
S_DATA := ''; }
READ_BUSY := FALSE;
end;
function OPEN_PORT(PORT: SHORTSTRING; BTL: INTEGER): INTEGER; stdcall;
begin
if OPEN_BUSY or READ_BUSY then
begin
RESULT := 0;
Exit;
end;
if PORT_ACTIVE then
begin
RESULT := -1;
Exit;
end;
OPEN_BUSY := TRUE;
MYCOM.BaudRate := BTL;
MYCOM.CommName := 'com' + PORT;
try
MYCOM.StartComm;
PORT_ACTIVE := TRUE;
RESULT := 1;
except
PORT_ACTIVE := FALSE;
RESULT := -2;
end;
OPEN_BUSY := FALSE;
end;
function CLOSE_PORT: INTEGER; stdcall;
begin
try
if MYCOM <> nil then MYCOM.StopComm;
PORT_ACTIVE := FALSE;
RESULT := 1;
except
RESULT := -1;
end;
end;
procedure TMYOBJ.MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
var
S1: string;
begin
START_TIMES := Now;
SetLength(S1, BufferLength);
Move(Buffer^, PChar(S1)^, BufferLength);
S_DATA := S_DATA + S1;
if Assigned(FCallback) then
FCallback(PChar(S_DATA));
end;
procedure SetCallback(ACallback: TCallback);
begin
FCallback := @ACallback;
end;
initialization
MYOBJ := TMYOBJ.Create;
MYCOM := TCOMM.Create(nil);
MYCOM.OnReceiveData := MYOBJ.MYComReceiveData;
finalization
try
if MYOBJ <> nil then
begin
MYOBJ.FREE;
MYOBJ := nil;
end;
if MYCOM <> nil then
begin
MYCOM.FREE;
MYCOM := nil;
end;
except
end;
end.
想通过DLL给EXE,自然是要通过函数的返回值了!返回ARRAY OF CHAR
偶还用过一种方法,那就是向EXE的MAINFORM发消息,把一个字符串的地址放在消息参数里面!
jf