用回调函数总是不能正确返回,我发送消息SendMessage是可以的。
unit Unit1;
.........type
  TCallback = procedure(s: pchar); stdcall;var
  Form1: TForm1;
function OpenPort(PORT: shortstring; BTL: integer): integer; stdcall External 'DRYPRT5.dll';
function ClosePort: integer; stdcall External 'DRYPRT5.dll';
function OutDate(SD: string): integer; stdcall External 'DRYPRT5.dll';
procedure SetCallback(ACallback: TCallback); stdcall External 'DRYPRT5.dll';
procedure CallbackExample(s: pchar); stdcall;implementation{$R *.dfm}procedure CallbackExample(s: pchar); stdcall;
begin
  Form1.Label1.Caption := (s);
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPort('1', 9600) = 1 then Shape1.Brush.Color := clred;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if ClosePort = 1 then Shape1.Brush.Color := clblack;
end;procedure TForm1.Button4Click(Sender: TObject);
begin
  SetCallback(@CallbackExample);//此处传给DLL地址
end;end./////////////////////////////////////////////////////////////////////////////////library DRYPRT5;uses
  SysUtils,
  Classes,
  PRTTING in 'PRTTING.pas';{$R *.RES}
exports
  SetCallback,
  OpenPort,
  ClosePort,
  OutDate,
  IniComm;
begin
end./////////////
unit PRTTING;
.......
type
  TMYOBJ = class
    procedure MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
  end;
type
  TCallback = procedure(s: pchar);var
  Read_busy, Open_busy, Port_active, Receive_finish: BOOLEAN;  S_DATA: string;  MYCOM: TCOMM;
  MYOBJ: TMYOBJ;
  FCallback: TCallback;  hd: THandle;function OpenPort(Port: shortstring; BTL: INTEGER): INTEGER; STDCALL;
function ClosePort: INTEGER; STDCALL;
function OutDate(SD: string): INTEGER; STDCALL;
procedure SetCallback(ACallback: TCallback); STDCALL;
procedure SendData(SData: string); STDCALL;
procedure IniComm(formhd: THandle); STDCALL;implementationprocedure TMYOBJ.MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
var
  S1: string;
  RD: pchar;
begin
  SetLength(S1, BufferLength);
  Move(Buffer^, pchar(S1)^, BufferLength);
  S_DATA := S1;
  if Assigned(FCallback) then
    FCallback(pchar(S_DATA ));//回调
end;procedure SetCallback(ACallback: TCallback); stdcall;
begin
  FCallback := ACallback;//得到
end;
下面是另外的函数有这个问题没有关系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;function OutDate(SD: string): INTEGER; stdcall;
begin
  if Read_busy then //正在发送
  begin
    RESULT := 0;
    Exit;
  end;
  if not Port_active then //没有打开串口
  begin
    RESULT := -1;
    Exit;
  end;
  Read_busy := TRUE; //发送开始
  MYCOM.WriteCommData(pchar(SD), Length(SD));
  Read_busy := FALSE; //发送结束
  RESULT := 1;
end;function OpenPort(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 ClosePort: INTEGER; stdcall;
begin
  try
    if MYCOM <> nil then MYCOM.StopComm;
    Port_active := FALSE;
    RESULT := 1;
  except
    RESULT := -1;
  end;
  FREE_OBJ;
end;end.