API串口通讯函数如何改为DLL
这是一个完整的用API通讯的函数，但是我不知道如何改编成DLL请大虾们指点一下，谢谢
unit dd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TcommCLS = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure CommInitialize;
function WriteStr(const Str : string) : boolean;
public}
end;
TComm = class(TThread)
protected
procedure Execute; override;
procedure MsgComm();
end;
var
commCLS: TcommCLS;
HCom, Post_Event : Thandle;
LpolW, LpolR : PoverLapped;
RXComm : TComm;
dataRx : string;
implementation
{$R *.dfm}
{ TComm }
procedure TComm.Execute;
var
dwEvtmask, dwOvres,bb : Dword;
RXFinish : bool;
begin
while true do
begin
DwEvtMask := 0;
RXFinish := WaitCommEvent(Hcom,dwEvtMask,LpolR); //等待串口事件EV_RXCHAR
if not RXFinish then //如果返回true，已立即完成，否则继续判断
if GetLastError() = ERROR_IO_PENDING then //正在接收数据
begin
bb := WaitForSingleObject(LpolR^.hEvent,500); //等待500ms
Case bb of
Wait_Object_0 : RXFinish := GetOverLappedResult(hcom,LpolR^,dwOvRes,false);
Wait_TimeOut : RXFinish := false ; ////返回false，出错，定时溢出
else RXFinish := false; //出错
end;
end
else RXFinish := false;
if RXFinish then
begin
if WaitForSingleObject(Post_Event,infinite) = Wait_object_0 then //等待同步事件置位
begin
ResetEvent(Post_Event); //同步事件复位
MsgComm;
//在这里可以触发串口接受事件
commCLS.Memo1.Text := commCLS.Memo1.Text + dataRx;
end;
end;
sleep(20);
end;
end;
{ TcommCLS }
procedure TcommCLS.CommInitialize;
var
Lpdcb : TDCB;
begin
hcom := CreateFile('com1', //串口名，可为com1-com4
Generic_Read or Generic_write, //访问模式
0, //共享模式，必须为0
nil, //安全属性指针
open_existing, //打开方式必须为 open_existing
File_Flag_OverLapped, //文件属性，本文设为交迭标志
0); //临时文件句柄，必须为0
if hcom <> invalid_Handle_Value then
begin
SetupComm(hcom,4096,4096); //设置缓冲区长度
GetCommState(hcom,lpdcb); //获取串口设置
lpdcb.BaudRate := 9600;
lpdcb.StopBits := 1;
lpdcb.ByteSize := 8;
lpdcb.Parity := 0;
SetCommState(hcom,lpdcb); //设置串口
SetCommMask(hcom,ev_Rxchar); //设置串口事件屏蔽
end else ShowMessage('无法打开串口');
end;
procedure TComm.MsgComm();
var
clear : boolean;
coms : TComStat;
cbNum,cbRead,lpErrors : Dword;
s : string;
begin
clear := ClearCommError(hcom,lpErrors,@coms);
if clear then
begin
cbNum := Coms.cbInQue; //获取接收缓冲区待接收字节数
SetLength(s,cbNum + 1); //分配内存
ReadFile(hcom,pchar(s)^,cbNum,cbRead,LpolR); //读串口
setLength(s,cbRead); //分配内存
SetEvent(Post_Event); //同步事件置位
dataRx := s;
end;
end;
function TcommCLS.WriteStr(const Str: string): boolean;
var
DwCharsWritten, DwRes : Dword;
s_DATA : String;
BRes : Boolean;
begin
BRes := false;
S_DATA := Str;
if hcom <> invalid_Handle_Value then //如果指针有效
begin
DwCharsWritten := 0;
BRes := WriteFile(hcom,Pchar(S_Data)^,Length(S_DATA),DwCharsWritten,LpolW); //返回True，数据立即发送完成
if not Bres then
begin
if GetLastError() = Error_IO_Pending then
begin //正在发送数据
DwRes := WaitForSingleObject(LpolW^.hEvent,Infinite); //等待同步事件
if DwRes = Wait_object_0 then //如果不相等，出错
BRes := GetOverLappedResult(hcom,LpolW^,DwCharsWritten,false) //返回false，出错
else BRes := true; //数据发送完成
end;
end;
end;
Result := Bres;
end;
procedure TcommCLS.FormCreate(Sender: TObject);
begin
CommInitialize;
new(lpolW);
new(lpolR);
LpolW^.Internal := 0;
LpolW^.InternalHigh := 0;
LpolW^.Offset := 0;
LpolW^.OffsetHigh := 0;
LpolW^.hEvent := CreateEvent(nil,true,false,nil);
LpolR^.Internal := 0;
LpolR^.InternalHigh :=0;
LpolR^.Offset :=0;
LpolR^.OffsetHigh := 0;
LpolR^.hEvent := CreateEvent(nil,true,false,nil);
//消除串口读写缓冲区的所有字符，用以终止悬而未决的读写操作
PurgeComm(Hcom,Purge_TxAbort or Purge_RxAbort or Purge_TxClear or Purge_RxClear);
Post_Event := CreateEvent(nil,true,true,nil);
RXComm := Tcomm.Create(false);
end;
procedure TcommCLS.FormDestroy(Sender: TObject);
begin
CloseHandle(LpolW^.hEvent);
CloseHandle(LpolR^.hEvent);
dispose(LpolW);
dispose(LpolR);
LpolW := nil;
LpolW := nil;
RXComm.Terminate;
SetEvent(Post_Event);
CloseHandle(Post_Event);
CloseHandle(hcom);
end;
procedure TcommCLS.Button1Click(Sender: TObject);
var
s : string;
begin
s := 'Hello,this is test data!';
if not WriteStr(s) then
showMessage('Send Fail！');
end;
end.
[解决办法]
啊哦，错了。是
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,
dd in "dd.pas ";
{$R *.res}
exports
WriteStr;
begin
end.
//不过你dd单元里面的WriteStr要把参数改一下。。。。
不要用string;
