SPComm编写的DLL，我不知道错什么地方了(85分)

  • 主题发起人 主题发起人 风零落
  • 开始时间 开始时间
风

风零落

Unregistered / Unconfirmed
GUEST, unregistred user!
小弟我刚刚出道，有很多问题不会，SPComm编写的DLL，我不知道错什么地方了，谁愿意帮助我，我发源文件给他，帮我改改就好了。。。改写的时候帮助说明一下。。
应为有很多类似的地方，帮我改动一两个地方，指明。。谢谢
献上小弟唯一的85分给帮助我的人

 
帮帮忙啊
 
靠，那到是把代码贴上来啊
 
我编译的时候通过了，我发源程序给你好不，？？？？？
 
unit ComFuc;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, SPComm;

type
TForm1 = class(TForm)
Comm1: TCommm;
private
{ Private declarations }
public
{ Public declarations }
end;

const
start=chr($7E);
var
Form1: TForm1;
Comm1: TCommm;
DayTime,PassTime:TDatetime;
PerCode,Address,DoorKey,apply,nPerson,nOpenCount,TT:integer;
bagsize:char;
BoardID,Name,MDelay,SupOrder,Edition,Dactylogram:shortstring;
s0,s1,s2,s3,s4,s5,bagnumber:shortstring;
r0,r1,r2,Raddress,r3,r4:shortstring;
Send,Receive:string;
{ Declare the export function 宣布Form函数出口}
function OpenCom(Comname:shortstring):BOOL;StdCall; //打开串口
function CloseCom:BOOL;StdCall;//关闭串口
function SetNetID(BoardID:integer;Address:integer):BOOL;StdCall;//设置门禁机网络地址号
function SetMDelay(Address:integer;MDelay:shortstring):BOOL;StdCall;//设置门禁机延时
function SetSysTime(Address:integer):BOOL;StdCall;//设置门禁机系统时间
function SetDoorKey(Address:integer;DoorKey:integer):BOOL;StdCall;//设置门禁机门磁状态
function SetSupOrder(Address:integer;SupOrder:shortstring):BOOL;StdCall;//设置超级密码
function SendDactylogram(Address:integer;Percode:integer;Dactylogram:shortstring):Bool;StdCall;//传送人员指纹信息
function ModifyRouteInf(Address:integer;Percode:integer;name:shortstring;Apply:Integer;UseTime:shortstring):BOOl;StdCall;//修改门禁机中信息
function ClearOpenInf(Address:integer):BOOL;StdCall;//清空门禁机存储的指纹开门纪录
function ClearDownLoad(Address:integer):BOOL;StdCall;//清空门禁机下载过的人员信息
function GetDoorInf(Address:integer):shortstring;StdCall;//提取门禁机信息
function GetCurrentEnterInf(Address:integer):shortstring;StdCall;//实时人员开门信息采集
function GetEnterRecord(Address:integer):shortstring;StdCall;//提取门禁机存储的开门纪录
function GetSysEdition(Address:integer):shortstring;StdCall;//得到系统版本号
function GetDactylogram(Address:integer;Percode:integer):shortstring;Stdcall;//获取人员指纹信息

implementation

{$R *.dfm}

procedure Transmit;
var
i,count:integer;
commflg:boolean;
USend:pchar;
sbuf:array of byte;
begin
commflg:=true;
GetMem(USend,255);
USend:=pchar(Send);
count:=Length(Send);
setLength(sbuf,count);
for i:=1 to count do
begin
sbuf:=byte(USend[i-1]);
if not Form1.Comm1.WriteCommData(@sbuf,1) then
begin
commflg:=false;
break;
end;
sleep(2);
end;
if not commflg then
MessageDlg('发送失败!',mterror,[mbyes],0);
end;

procedure ReadData;
var
buffer:Pointer;
BufferLength:Word;
UReceive:pchar;
begin
GetMem(UReceive,255);
Move(Buffer^,UReceive,BufferLength);
SetLength(Receive,BufferLength);
Receive:=UReceive;
end;

Function OpenCom(Comname:shortstring):BOOL;//打开串口
begin
Comm1.StartComm;
Comm1.CommName:=Comname;
end;

Function CloseCom:BOOL;//关闭串口
begin
Comm1.StopComm;
end;

Function SetNetID(BoardID:integer;Address:integer):BOOL;//设置门禁机网络逻辑地址号
begin
bagsize:=chr($04);
s0:=start;
s1:=start;
s2:=chr($4f);
s3:=chr(Address);
s4:=bagsize;
s5:=chr(BoardID);
Send:=s0+s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($5f) then
Result:=true
else if r2=chr($7f) then
Result:=false
end;

Function SetMDelay(Address:integer;MDelay:shortstring):BOOL;//设置门禁机延时
var a,b:shortstring;
begin
bagsize:=chr($07);
s0:=start;
s1:=start;
s2:=chr($41);
s3:=chr(Address);
s4:=bagsize;
a:=MDelay[1]+MDelay[2];
b:=MDelay[3]+MDelay[4];
s5:=chr(strtoint(a))+chr(strtoint(b));
Send:=s0+s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($51) then
Result:=true
else if r2=chr($71) then
Result:=false
else exit;
end;

Function SetSysTime(Address:integer):BOOL;
var
a,b,c,d,e,f,j:shortstring;
begin
j:=FormatDateTime('YYMMDDhhmmss',now);
a:=j[1]+j[2];
b:=j[3]+j[4];
c:=j[5]+j[6];
d:=j[7]+j[8];
e:=j[9]+j[10];
f:=j[11]+j[12];
bagsize:=chr($16);
s0:=start;
s1:=start;
s2:=chr($42);
s3:=chr(Address);
s4:=bagsize;
s5:=chr(strtoint(a))+chr(strtoint(b))+chr(strtoint(c))+chr(strtoint(d))+chr(strtoint(e))+chr(strtoint(f));
send:=s0+s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($52) then
Result:=true
else if r2=chr($72) then
Result:=false
else exit;

end;

Function SetDoorKey(Address:integer;DoorKey:integer):BOOL;
begin
bagsize:=chr($04);
s0:=start;
s1:=start;
s2:=chr($43);
s3:=chr(Address);
s4:=bagsize;
s5:=IntToStr(DoorKey);
send:=s0+s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($53) then
Result:=true
else if r2=chr($73) then
Result:=false
else exit;
end;

Function SetSupOrder(Address:integer;SupOrder:shortstring):BOOL;//设置超级密码
var a,b,c,j:shortstring;
begin
j:=suporder;
bagsize:=chr($09);
a:=j[1]+j[2];
b:=j[3]+j[4];
c:=j[5]+j[6];
s0:=start;
s1:=start;
s2:=chr($44);
s3:=chr(Address);
s4:=bagsize;
s5:=chr(strtoint(a))+chr(strtoint(b))+chr(strtoint(c));
send:=s0+s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($54) then
Result:=true
else if r2=chr($74) then
Result:=false
else exit;
end;

Function SendDactylogram(Address:integer;PerCode:Integer;Dactylogram:shortstring):Bool;//传送人员指纹信息
var
a,b,c,h,j:shortstring;
begin
j:=inttostr(Percode);
a:=j[1]+j[2];
b:=j[3]+j[4];
c:=j[5]+j[6];
h:=chr(strtoint(a))+chr(strtoint(b))+chr(strtoint(c));
s0:=start;
s1:=start;
s2:=chr($45);
s3:=chr(Address);
s4:=bagsize;
s5:=h+Dactylogram;
Send:=s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=Receive[1];
r1:=Receive[2];
r2:=Receive[3];
r3:=Receive[4];
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($55)then
Result:=true
else if r3=chr($75)then
Result:=false
else exit;
end;

Function ModifyRouteInf(Address:integer;Percode:integer;Name:shortstring;Apply:Integer;UseTime:shortstring):BOOl;//修改门禁机中信息
var
i,m,n:integer;
a,b,c,h,j,x:shortstring;
begin
i:=4;
while i<4 do
begin
m:=Length(UseTime) div 2;
for n:=1 to m do
begin
x:=x+chr(strtoint(UseTime[2*n-1]+UseTime[2*n]));
end;
while Length(x)<23 do
begin
x:=x+chr($FE);
end;
while Length(Name)<8 do
begin
Name:=Name+'0';
end;
j:=inttostr(percode);
a:=j[1]+j[2];
b:=j[3]+j[4];
c:=j[5]+j[6];
h:=chr(strtoint(a))+chr(strtoint(b))+chr(strtoint(c));
bagsize:=chr($64);
s0:=start;
s1:=start;
s2:=chr($46);
s3:=chr(Address);
s4:=bagsize;
s5:=h+Name+IntToStr(Apply)+x;
send:=s0+s1+s2+s3+s4+s5;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($56) then
Result:=true
else if r2=chr($76) then
Result:=false
else exit
else i:=i-1
end
end;

Function ClearOpenInf(Address:integer):BOOL;//清空门禁机存储的指纹开门记录
begin
bagsize:=chr($03);
s0:=start;
s1:=start;
s2:=chr($01);
s3:=chr(Address);
s4:=bagsize;
send:=s0+s1+s2+s3+s4;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($11) then
Result:=true
else if r2=chr($31) then
Result:=false
else exit;
end;

Function ClearDownLoad(Address:integer):BOOL;//清空门禁机下载过的人员信息
begin
bagsize:=chr($03);
s0:=start;
s1:=start;
s2:=chr($02);
s3:=chr(Address);
s4:=bagsize;
send:=s0+s1+s2+s3+s4;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
if r0+r1=start+start then
if r2=chr($12) then
Result:=true
else if r2=chr($32) then
Result:=false
else exit;
end;

Function GetDoorInf(Address:integer):shortstring;//提取门禁机的信息
var
i:integer;
a,b,c,d:shortstring;
begin
i:=4;
while i>0 do
begin
bagsize:=chr($03);
s0:=start;
s1:=start;
s2:=chr($81);
s3:=chr(Address);
s4:=bagsize;
send:=s0+s1+s2+s3+s4;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
r4:=copy(Receive,7,9);
if r2=chr($91) then
BoardID:=copy(r4,1,1);
a:=copy(r4,2,1);
nperson:=ord(a[1]);
b:=copy(r4,3,2);
nOpenCount:=ord(b[1])*ord(b[2]);
c:=copy(r4,5,2);
MDelay:=inttostr(ord(c[1]))+inttostr(ord(c[2]));
d:=copy(r4,7,3);
SupOrder:=inttostr(ord(d[1]))+inttostr(ord(d[2]))+inttostr(ord(d[3]));
if r2=chr($C1) then
i:=i-1;
end
end;

Function GetCurrentEnterInf(Address:integer):shortstring;//实时采集人员开门信息
var a,b,c:shortstring;
begin
bagsize:=chr($03);
s0:=start;
s1:=start;
s2:=chr($82);
s3:=chr(Address);
s4:=bagsize;
send:=s0+s1+s2+s3+s4;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
r4:=copy(Receive,7,18);
if r2=chr($92) then
a:=copy(r4,1,3);
Percode:=strtoint(inttostr(ord(a[1]))+inttostr(ord(a[2]))+inttostr(ord(a[3])));
Name:=copy(r4,4,8);
b:=copy(r4,12,6);
c:=inttostr(ord(b[1]))+inttostr(ord(b[2]))+inttostr(ord(b[3]))+inttostr(ord(b[4]))+inttostr(ord(b[5]))+inttostr(ord(b[6]));
DayTime:=strtodatetime(c);
DoorKey:=StrToInt(copy(r4,18,1));
if r2=chr($C2) then
exit;
end;

Function GetEnterRecord(Address:integer):shortstring;//提取门禁机存储的开门纪录
var
i:integer;
a,b,c:shortstring;
begin
i:=4;
while i>0 do
begin
bagsize:=chr($03);
s0:=start;
s1:=start;
s2:=chr($83);
s3:=chr(Address);
s4:=bagsize;
send:=s0+s1+s2+s3+s4;
Transmit;

ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
r4:=copy(Receive,7,10);
if r2=chr($93) then
a:=copy(r4,1,3);
Percode:=ord(a[1])+ord(a[2])+ord(a[3]);
TT:=StrToInt(copy(r4,4,1));
b:=copy(r4,5,6);
c:=inttostr(ord(b[1]))+inttostr(ord(b[2]))+inttostr(ord(b[3]))+inttostr(ord(b[4]))+inttostr(ord(b[5]))+inttostr(ord(b[6]));
PassTime:=strtodatetime(c);
if r2=chr($C3) then
i:=i-1;
end
end;

Function GetSysEdition(Address:integer):shortstring;
var i:integer;
begin
i:=4;
while i>0 do
begin
bagsize:=chr($03);
s0:=start;
s1:=start;
s2:=chr($84);
s3:=chr(Address);
s4:=bagsize;
send:=s0+s1+s2+s3+s4;
Transmit;
ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
r4:=copy(Receive,7,2);
if r0+r1=start+start then
if r2=chr($94) then
Edition:=r4
else if r2=chr($B4) then
i:=i-1
else exit;
end;
end;

Function GetDactylogram(Address:integer;Percode:integer):shortString;//获取人员指纹信息
var i,m:integer;
a,b,c,h,j:shortstring;
begin
i:=4;
while i>0 do
begin
j:=inttostr(percode);
a:=j[1]+j[2];
b:=j[3]+j[4];
c:=j[5]+j[6];
h:=chr(strtoint(a))+chr(strtoint(b))+chr(strtoint(c));
bagsize:=chr($06);
s0:=start;
s1:=start;
s2:=chr($85);
s3:=chr(Address);
s4:=bagsize;
s5:=h;
send:=s0+s1+s2+s3+s4;
Transmit;
ReadData;
Raddress:=r3;
r0:=copy(Receive,1,1);
r1:=copy(Receive,2,1);
r2:=copy(Receive,3,1);
r3:=copy(Receive,4,1);
bagnumber:=copy(Receive,5,2);
m:=Length(Receive);
r4:=copy(Receive,7,m-6);
if r0+r1=start+start then
if r2=chr($95) then
begin
Percode:=Percode;
Dactylogram:=copy(Receive,10,m-9);
end
else if r2=chr($B5) then
i:=i-1
else exit;
end;
end;
end.
 
回答我啊。。。。
 
呵呵，没收到邮件通知：）
发过来吧 lclpipi@163.com
为什么用dll？直接用不就行？
 
hy-zgm@163.com
我给你瞧瞧。
 
也不知道你出什么错误？
你试试在你的DLL和应用程序的工程中加入 ShareMem单元试试
 
首先谢谢各位大哥的回答，。。
我用过shareMem了，是不是只要写一次啊。。。
我给你们发源文件，帮忙看看，。。主要是调用时候出错，可我刚刚出道，希望师兄们帮帮我
 
写出你的出错信息呀！
 
写你的操作， 以及什么时间出错，还有出错误信息，
你应该看看网站第一页的发何提问！
 
是这样的，我在正常的时候用没有问题，当变成DLL后进行调用就出现了下面的错误

Access violation at address 003c2841 in module 'DLLCON.DLL',Read of address 00000038
 
您必须登录或注册才可回复。

Similar threads

不
B编码以及BT种子文件分析 - 不得闲
回复
0
查看
1K
不得闲
不
老
学习中的一些牢骚。栈/堆地址标准写法。
回复
0
查看
983
老衲
老
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
[原]OrangeUI－Delphi移动开发利器
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部