动态库中使用SpComm 读写串口问题

Question

为了将串口的读写独立到软件系统的外部，我想把串口的读写放到动态库中，只要串口有数据到来时就发送消息到宿主程序，并在LParam 中带上数据，但是在动态库中，SPCOMM好像不能用，我一直找不到错误原因。
library Weight;{ 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,
  Windows,
  Classes,
  Forms,
  SPComm in '..\..\Common\SPComm.pas',  
var
  FCom :TComm ;exports{$R *.res}
 
procedure LibExit(Reason: Integer); stdcall ;
begin
  if (Reason = DLL_PROCESS_DETACH) or (Reason = DLL_PROCESS_DETACH) then
  begin
    if Assigned( goWeight ) then
    begin
      FCom.Free ;
    end ;
  end ;
end ;begin
 // 我在下面的初始化代码中创建TCOMM对象，然后反复调用开关串口函数，试验显示，串口在第二次关闭或者打开时总是会长时间没反应，宿主程序处于死机状态。
  if not Assigned( FCOM ) then FCOm := TComm.Create( nil );
  FCom.CommName := 'COM1' ;
  FCom.StopComm ;
  FCom.StartComm ;
  FCom.StopComm ; // 在此就出错了，有谁知道，这是为什么啊！
  FCom.StartComm ;
  FCom.StopComm ;
  FCom.StartComm ;
  FCom.StopComm ;
  FCom.StartComm ;  SaveDllProc := DllProc ;  // save exit procedure chain
  DllProc := @LibExit ;  // install LibExit exit procedure
end.

Answer 1

DLL 中没有消息循环，不能触发事件

Answer 2

先给你一个看看，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); stdcall;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.

Answer 3

library ComPort;uses
  SysUtils,
  Classes,
  Spcom in 'Spcom.pas';{$R *.RES}
exports
  SetCallback,
  OpenPort,
  ClosePort,
  OutDate;
  //IniComm;
begin
end.
//**********************************************unit Spcom;interfaceuses
  Windows, SysUtils, spcomm;type
  TMYOBJ = class
    procedure MYComReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
  end;
type
  TCallback = procedure(s: pchar); stdcall;var  Read_busy, Open_busy, Port_active, Receive_finish: BOOLEAN;
  S_DATA: string;
  MYCOM: TCOMM;
  MYOBJ: TMYOBJ;
  FCallback: TCallback;function OpenPort(Port: shortstring; BTL: INTEGER): INTEGER; stdcall;
function ClosePort: INTEGER; stdcall;
function OutDate(SD: string): INTEGER; stdcall;
procedure SetCallback(ACallback: TCallback); stdcall;implementation
procedure INI_OBJ;
begin
  MYCOM := TCOMM.Create(nil);
  MYCOM.OnDataReceived  := 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.ByteSize := _8;
  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;
procedure 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 Pos(#13, S_DATA) > 0 then RECEIVE_FINISH := TRUE;
  RECEIVE_FINISH := TRUE;
  if Assigned(FCallback) then
    FCallback(pchar(S_DATA));
end;procedure SetCallback(ACallback: TCallback); stdcall;
begin
  FCallback := ACallback;
end;initialization
  //CoInitialize(nil);
finalization
  //CoUninitialize;
end.

Answer 4

上面是spcomm封装进dll的代码，返回使用回调函数。mscomm要加上
initialization
  CoInitialize(nil);
finalization
  CoUninitialize; 
因为是Activies控件。lz不明白可以联系我

Answer 5

if not Assigned( FCOM ) then FCOm := TComm.Create( nil );
  FCom.CommName := 'COM1' ;
  FCom.StopComm ;
  FCom.StartComm ;
  sleep(5);//---------------SPCOMM 是多线程工作模式，STARTCOMM实际上是创建一个线程（发送线程）后挂起。延时作用：让OS处理创建THREAD的操作
  FCom.StopComm ; // 在此就出错了，有谁知道，这是为什么啊！
  FCom.StartComm ;
sleep(5);//---------------
  FCom.StopComm ;
  FCom.StartComm ;
sleep(5);//---------------
  FCom.StopComm ;
  FCom.StartComm ;
sleep(5);//---------------

Answer 6

严重关注，楼主这个问题搞定了吗？
本人也正要搞个这样的dll.
楼主搞好了可以将这发一份到
谢谢。

Answer 7

我发现用 Sleep(5) 的方式没能解决问题，不知道为什么；
to oosmile:
   我看了代码有点晕，这样能实现DLL封装类的目的吗？能不能多一点分析，本人是菜鸟级的，
别见怪!

Answer 8

to fox1999：
    DLL中没有消息循环，意思是不是说DLL中不能使用SPCOMM来读取串口了？

Answer 9

顶，楼主加油，我也在搞这个dll

Answer 10

To sadprince2008(沼泽)
dll封装类？封装spcomm？没有问题的啊我上面的
function OpenPort(Port: shortstring; BTL: INTEGER): INTEGER; STDCALL;
function ClosePort: INTEGER; STDCALL;
是打开关闭串口的，测试过的。具体你看看代码，很简单的，上面是全部代码。串口事件是用回调函数实现的。type
  TCallback = procedure(s: pchar); stdcall;var
  FCallback: TCallback;procedure SetCallback(ACallback: TCallback); stdcall;
begin
  FCallback := ACallback;
end;就等于主程序给dll一个内存入口，当dll收到串口数据后就通知主程序。，可以用邮箱联系