求将async32控件放入DLL的示例(我可是倾囊而出了)(90分)

可能是控件不能放到DLL中吧.哪位高手能够给我一个确切的答案?我好另寻其他办法.
否则只好删除这个问题了.

信已发出, 请查收, 如不明白可以详细讨论

信已收到,还没有来得及看.
我已做了一个DLL,但是没法用,不知何故.

to another_eyes:
我编的程序肯定是有毛病,不知你是否愿意帮我找出毛病.

贴出来看看

主要程序如下,请指教.

commint.pas和commObjs.pas 为async32控件中源代码.

library IC_DLL;
uses
SysUtils,
Classes,
ic in 'ic.pas' {Form1},
CommInt in '../async32/CommInt.pas',
CommObjs in '../async32/CommObjs.pas';
exports
RW_OPEN,RW_CLOSE,W_MIM,R_MIM,RW_REQUEST,RW_RESET;
begin
end.

unit ic;

interface

uses
Windows,Messages,SysUtils, Classes,Controls,Forms,CommInt;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure HandleException(Sender: TObject; E: Exception);
public
{ Public declarations }
end;

var
Form1: TForm1;
comm1:TComm;
function RW_OPEN(ID:Integer):Integer;export;stdcall;
function RW_CLOSE(ID:Integer):Integer;export;stdcall;
function W_MIM(ID:integer;address:Integer;number:Integer;m_string:string):integer;export;stdcall;
function R_MIM(ID:integer;address:Integer;number:Integer;var text:string):integer;export;stdcall;
function RW_REQUEST(ID:integer;var Chipn:string):integer;export;stdcall;
function RW_RESET(ID:Integer):integer;export;stdcall;
function BYTE_CONVERT(S_INPUT:string;number:integer):string;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := HandleException;
end;

procedure Tform1.HandleException(Sender: TObject; E: Exception);
begin
// if E is ECommError then
// with E as ECommError do
// ShowMessage('serial communication ' + Message);
end;

function RW_OPEN(ID:Integer):Integer;
begin
Comm1.Open;
RW_OPEN:=0;
end;

function RW_CLOSE(ID:Integer):Integer;
begin
comm1.close;
RW_CLOSE:=0;
end;

function RW_REQUEST(ID:integer;var Chipn:string):integer;
type
CharBuf = array[0..9999] of Char;
var
Buffer: ^CharBuf;
Bytes,p,p1: Integer;
text:string;
s:string;
count:Integer;
linedata:string;
begin
RW_REquest:=1;
s:=chr($06);
s:=s+chr($10);
s:=s+chr($00);
s:=s+chr($01);
s:=s+chr($04);
s:=s+chr($09);
s:=s+chr($1A);
count:=length(s);
Count := Comm1.Write(S[1], Count);{0x06, 0x10, 0x00, 0x01, 0x04, 0x09, 0x1A}
if Count <> -1 then
begin
Bytes:=0;
P1:=0;
while Bytes<14 do
begin
try
GetMem(Buffer, Comm1.ReadBufSize);
Fillchar(Buffer^, Comm1.ReadBufSize, 0);
Bytes :=Bytes+ Comm1.Read(Buffer^, 15);
if Bytes<>P1 then
begin
for P := P1 to Bytes - 1 do
begin
LineData := LineData + CharBuf(Buffer^)[P-P1];
end;
end;
P1:=Bytes;
finally
end;
end;
text:='';
text:=byte_convert(linedata,15);
if copy(text,3,4)='1005' then
begin
chipn:=text;
RW_REQUEST:=0;
end
else
begin
chipn:='';
RW_REQUEST:=1;
end
end;
end;

function W_MIM(ID:integer;address:Integer;number:Integer;m_string:string):integer;
type
CharBuf = array[0..9999] of Char;
var
Buffer: ^CharBuf;
Bytes,p,P1,i,sum: Integer;
text:string;
s,s1:string;
CurrChr:char;
count,s2:integer;
linedata:string;
begin
W_MIM:=1;
s:=chr(($05)+number);
s:=s+chr($40);
s:=s+chr($00);
s:=s+chr(address);
s:=s+chr(number);
s2:=($40)xor(address)xor(number)xor(($05)+number);
i:=1;
sum:=0;
while i<(2*number) do
begin
s1:=copy(M_string,i,2);
CurrChr:=s1[1];
case CurrChr of
'0'..'9':sum:=TRUNC(StrToInt(CurrChr)*16);
{'a'..'z':sum:=TRUNC((ord(CurrChr)-87)*16); }
'A'..'F':sum:=TRUNC((ord(CurrChr)-55)*16);
end;
CurrChr:=s1[2];
case CurrChr of
'0'..'9':sum:=sum+TRUNC(StrToInt(CurrChr));
{'a'..'z':sum:=sum+TRUNC((ord(CurrChr)-87)); }
'A'..'F':sum:=sum+TRUNC((ord(CurrChr)-55));
end;
s:=s+chr(sum);
s2:=(sum)xor(s2);
i:=i+2;
end;
s:=s+chr(s2);
count:=length(s);
Count := Comm1.Write(S[1], Count);{0x06, 0x10, 0x00, 0x01, 0x04, 0x09, 0x1A}
if Count <> -1 then
begin
Bytes:=0;
P1:=0;
while Bytes<10 do
begin
try
GetMem(Buffer, Comm1.ReadBufSize);
Fillchar(Buffer^, Comm1.ReadBufSize, 0);
Bytes := Bytes+Comm1.Read(Buffer^, 10);
if Bytes<>P1 then
begin
for P := P1 to Bytes - 1 do
begin
LineData := LineData + CharBuf(Buffer^)[P-P1];
end;
end;
P1:=Bytes;
finally
end;
end;
text:='';
text:=byte_convert(linedata,10);
if copy(text,3,4)='3000' then
begin
W_MIM:=0;
end
else
begin
W_MIM:=1;
end
end;
end;

function R_MIM(ID:integer;address:Integer;number:Integer;var text:string):integer;
type
CharBuf = array[0..9999] of Char;
var
Buffer: ^CharBuf;
Bytes,p,P1: Integer;
s:string;
count:integer;
linedata:string;
begin
R_MIM:=1;
s:=chr($05);
s:=s+chr($20);
s:=s+chr($00);
s:=s+chr(address);
s:=s+chr(number);
s:=s+chr(($25)xor(address)xor(number));
count:=length(s);
Count := Comm1.Write(S[1], Count);{0x06, 0x10, 0x00, 0x01, 0x04, 0x09, 0x1A}
if Count <> -1 then
begin
count:=count+number;
Bytes:=0;
p1:=0;
while Bytes<count do
begin
try
GetMem(Buffer, Comm1.ReadBufSize);
Fillchar(Buffer^, Comm1.ReadBufSize, 0);
Bytes :=Bytes+Comm1.Read(Buffer^, Count);
if Bytes<>P1 then
begin
for P := P1 to Bytes - 1 do
begin
LineData := LineData + CharBuf(Buffer^)[P-P1];
end;
end;
P1:=Bytes;
finally
end;
end;
text:=byte_convert(linedata,6+number);
if copy(text,3,4)='2000' then
begin
R_MIM:=0;
end
else
begin
text:='';
R_MIM:=1;
end
end;
end;

function RW_RESET(ID:Integer):integer;
type
CharBuf = array[0..9999] of Char;
var
Buffer: ^CharBuf;
Bytes,p,P1: Integer;
text:string;
s:string;
count:integer;
linedata:string;
begin
RW_RESET:=1;
s:=chr($03);
s:=s+chr($14);
s:=s+chr($01);
s:=s+chr($16);
count:=length(s);
Count:= Comm1.Write(S[1], Count);
if Count <> -1 then
begin
Bytes:=0;
P1:=0;
while Bytes<count do
begin
try
GetMem(Buffer, Comm1.ReadBufSize);
Fillchar(Buffer^, Comm1.ReadBufSize, 0);
Bytes :=Bytes+ Comm1.Read(Buffer^, Count);
if Bytes<>P1 then
begin
for P := P1 to Bytes - 1 do
begin
LineData := LineData + CharBuf(Buffer^)[P-P1];
end;
end;
P1:=Bytes;
finally
end;
end;
text:='';
text:=Byte_convert(linedata,4);
if copy(text,3,4)='1401' then
begin
RW_RESET:=0;
end
else
begin
RW_RESET:=1;
end
end;
end;

function BYTE_CONVERT(S_INPUT:string;number:integer):string;
var
P,i,j:Integer;
datachar:char;
text:string;
begin
for p:=1 to number do
begin
datachar:=S_INput[p];
i:=ord(datachar);
j:=i;
i:=(i and $F0);
i:=i div $10;
if i<=9 then
i:=i+$30
else
i:=i+$37;
text:=text+chr(i);
j:=(j and $0F);
if (j<=9) then
j:=j+$30
else
j:=j+$37;
text:=text+chr(j);
end;
BYTE_CONVERT:=text;
end;
end.

忘了加注解.
RW_OPEN--打开串口
RW_CLOSE--关闭串口
RW_REQUEST--启动读卡机并读取卡号
RW_RESET--关闭读卡机
W_MIM--写卡
R_MIM--读卡

控件放入DLL中肯定是可以的.
你的代码中好象没看见export函数呀!
加入 export 试试!

另外:
要Form干吗?
可以把Form从程序中去掉,如果想dll在加载前运行一段初始化代码,
可在最后的end. 前加入initiation,再加入你的代码就行了.
就象:
....
initiation
Application.OnException := HandleException;
end.

to amo:
export 有啊,在IC_DLL中和IC.pas中都有.
你说的偶也明白,可是不知道怎么加才对.

先把我的读写磁卡机的主要代码贴出来你看看, 至于你的毛病我看完再说.
主要是pas文件, dpr文件中只是export声明而已(initialization和finalization都没有).
unit comdevice;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls,async32, forms;


type
TComDevice = class(TWinControl)
public
fparenthandle: Integer;
fCom : TComm32; // 这个是async32, 最早的一个(96年的?)
FFinished: boolean;
buff: tstringlist;
constructor create(AOwner: TComponent); override;
destructor Destroy; override;
procedure OnGetData(Sender: TObject; Count: Integer); // 主要com读写在此
end;

function InitPort(APort: Word): boolean; stdcall; export; // 初始化
function ClosePort: boolean; stdcall; export; // 结束
function WriteString(Str: Pchar): boolean; stdcall; export; // 写磁卡

var
Com_dev: TComdevice; // 保存TComDev的实例

implementation

function InitPort(APort: word): boolean; // 返回是否成功打开磁卡机
var
initstr : string
begin
result := true;
try
if not assigned(Com_Dev) then
Com_Dev := TComDevice.create(Application); // 防止多次调用
With Com_Dev do
begin
fcom.Close;
fcom.DeviceName := 'COM'+inttostr(Aport); // COM1..COM4
fcom.BaudRate := cbr9600;
ffinished := false;
fcom.Open; // 开始监听com口
initstr := #27'0';
fcom.Write(initstr[1], 2); // 初始化磁卡机
initstr := #27']';
fcom.write(initstr[1],2); // 磁卡机等待划卡
end;
except
raise Exception.Create('COM port error!');
result := false;
end;
end;

function ClosePort: boolean; // 关闭端口, 释放对象实例
var
s: string;
begin
result := true;
if assigned(com_dev) then
begin
s := #27'0'; // 关闭磁卡机
com_dev.fcom.write(s[1],2);
com_dev.free;
com_dev := nil;
end;
end;

function WriteString(Str: Pchar): boolean; // 写磁卡
var
s: string;
begin
result := false;
if not assigned(com_dev) then
begin
exit;
end;
s := #27'0';
com_dev.fcom.write(s[1], 2); // 初始化磁卡机
s := #27']';
com_dev.fcom.write(s[1], 2); // 等待写入
s := #27't'+stringofchar(' ', strlen(str))+#29#27'/';
move(str^, s[3], strlen(str));
com_dev.fcom.write(s[1], length(s)); // 写字串
result := true;
end;

constructor Tcomdevice.create(AOwner: TComponent);
begin
inherited create(AOwner);
fcom := TComm32.Create(self);
fcom.OnRxCharSignal := OnGetData; // com口接受到数据的事件
end;

destructor Tcomdevice.Destroy;
var
s: string;
begin
fcom.close;
fcom.free;
inherited;
end;

procedure Tcomdevice.OnGetData(Sender: TObject; Count: Integer);
var
i : Integer;
buff: string;
s: string;
begin
fparenthandle := getfocus; // 取得当前输入焦点的control的hwnd
buff := stringofchar(#0, count);
fcom.read(buff[1], count);
i := 1;
while i <= length(buff) do
begin
if buff=#$1b then // 跳过读入字串头标记
inc(i)
else if (i<length(buff)) and (buff = #$3f) and (buff[i+1]=#$1c) then
begin // 读入字串尾标记
inc(i);
s := #27'0';
fcom.write(s[1], 2);
s := #27']';
fcom.write(s[1], 2);
exit;
end
else
postmessage(fparenthandle, WM_CHAR, ord(buff), 1); // 模拟成键盘输入
inc(i);
end;
end;

end.

to Another_eYes:
多谢多谢,真不愧是专家,同样的功能,代码却少多了.
顺便问一句,能不能mail给我一份?贴出来的好象缺一些代码.

; else if (i<length(buff)) and (buff = #$3f) and (buff[i+1]=#$1c) then
begin // 字符串尾标记
inc(i);
s := #27'0';
fcom.write(s[1], 2);
s := #27']';
fcom.write(s[1], 2);
exit;
end
else
postmessage(fparenthandle, WM_CHAR, ord(buff), 1); // 模拟键盘输入
inc(i);
end;
end;

end.

hhe,eyes有趣

咦?
难道有什么让server认为是html了?
again....

else if (i ＜ length(buff)) and (buff = #$3f) and (buff[i+1]=#$1c) then
begin
inc(i);
s := #27'0';
fcom.write(s[1], 2);
s := #27']';
fcom.write(s[1], 2);
exit;
end
else
postmessage(fparenthandle, WM_CHAR, ord(buff), 1);
inc(i);
end;
end;

end.

当有人出贴时,能收到mail,今天也特别怪,就是没有收到mail.不知你们感觉到没有.
要断电了,明天见.

到此为止吧.