SOS:求助(50分)

  • 主题发起人 主题发起人 abc516
  • 开始时间 开始时间
A

abc516

Unregistered / Unconfirmed
GUEST, unregistred user!
通讯协议:
系统发一个负脉冲给COM口,然后延时500-1000MS然后发55H(十六进制)给COM,
接收八个BCD码,其中前二个,是该设备的
号-------最后要求提供该设备号
然后发04H给COM。再接收八个BCD码。
这八个BCD码,前四个分别是分,时,日,月
其中每个码的高四位表示十位,每个码的低四位表示个位,
后四个分别是8个卡号。
如果发现“分”是0FFH那么,表示该设备中已经无数据。
否则,发一个负脉冲给COM。再接收第二个卡号及时间。
直到发现“分”是0FFH。
然后发送分时日月的十六进制的BCD。

我做如下的代码
procedure TForm1.Button1Click(Sender: TObject);
var
numb:string;
sss: String;
sss1: String;
sss2:string;
begin
mscomm1.PortOpen:=true;
sss:=#$30;
sss1:=#$55;
sss2:=#$04;
MsComm1.Output:=sss;
sleep(600);
mscomm1.Output:=sss1;
numb:=trim(mscomm1.input);
memo1.Text:=memo1.Text+'这是该设备的号码'+trim(numb)+#10#13;
//这里出现的不是设备真正号2039。为什么?
mscomm1.Output:=sss2;
memo1.Text:=memo1.Text +'这是卡号'+TRIM(mscomm1.input)+#10#13;
//这里也不是第一个卡号???
mscomm1.PortOpen:=false;
 
太高深了!Faint!
 
有人用VB做出来了,
哪位大侠能改成DELPHI的?
Option Explicit


Dim receive(9) As Byte
Dim inTinputlen As Integer
Private Sub Command1_Click()
On Error GoTo err_write
Dim strtxt As String
Dim i As Integer
strtxt = "0"
MSComm1.Output = strtxt
TimeDelay 550
MSComm1.InBufferCount = 0
liqin ("55")
TimeDelay 60
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 9
inTinputlen = 9
ReDim byTinput(9) As Byte

byTinput = MSComm1.Input
For i = 2 To 9
receive(i - 2) = byTinput(i - 1)
Next
Call GetDisplayText


MSComm1.InBufferCount = 0
liqin ("04")
TimeDelay 100
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 9
ReDim byTinput(9) As Byte
byTinput = MSComm1.Input
For i = 2 To 9
receive(i - 2) = byTinput(i - 1)
Next
Call Display



Exit Sub


err_write:
Command1_Click




End Sub
Private Sub Form_Load()

intport = 1

strset = "9600,n,8,1"
MSComm1.InBufferSize = 1024
MSComm1.OutBufferSize = 512
MSComm1.PortOpen = True


End Sub



Public Sub GetDisplayText()

Dim n As Integer
Dim intValue As Integer
Dim intHighHex As Integer
Dim intLowHex As Integer
Dim strSingleChr As String * 1

Dim intAddress As Integer
Dim intAddressArray(8) As Integer
Dim intHighAddress As Integer

Dim strhex, strAscii As String
Dim result(16) As String
Dim i As Integer
Dim time1 As String
i = 0


'设置初值
strhex = ""






For n = 1 To 8

intValue = receive(n - 1)



intHighHex = intValue / 16
intLowHex = intValue - intHighHex * 16

If intHighHex < 10 Then
intHighHex = intHighHex + 48
Else
intHighHex = intHighHex + 55
End If
If intLowHex < 10 Then
intLowHex = intLowHex + 48
Else
intLowHex = intLowHex + 55
End If

strhex = strhex + Chr$(intHighHex) + Chr$(intLowHex)
If i < 16 Then
result(i) = Chr$(intHighHex)

i = i + 1
result(i) = Chr$(intLowHex)
i = i + 1
End If

Next n
Text1.Text = ""





Text1.Text = strhex
MsgBox "棒号" &amp; result(0) &amp; result(1) &amp; result(2) &amp; result(3)
i = ((Asc(result(4)) - 48) * 16 ^ 3 + (Asc(result(5)) - 48) * 16 ^ 2 + (Asc(result(6)) - 48) * 16 ^ 1 + (Asc(result(7)) - 48) * 1) / 8
MsgBox "记录数" &amp; i
time1 = result(14) &amp; result(15) &amp; "月" &amp; result(12) &amp; result(13) &amp; "号" &amp; result(10) &amp; result(11) &amp; ":" &amp; result(8) &amp; result(9)
MsgBox "时间为" &amp; time1









End Sub

'**********************************
'字符表示的十六进制数转化为相应的整数
'错误则返回 -1
'**********************************

Function ConvertHexChr(str As String) As Integer

Dim test As Integer

test = Asc(str)
If test >= Asc("0") And test <= Asc("9") Then
test = test - Asc("0")
ElseIf test >= Asc("a") And test <= Asc("f") Then
test = test - Asc("a") + 10
ElseIf test >= Asc("A") And test <= Asc("F") Then
test = test - Asc("A") + 10
Else
test = -1 '出错信息
End If
ConvertHexChr = test

End Function

'**********************************
'字符串表示的十六进制数据转化为相应的字节串
'返回转化后的字节数
'**********************************



Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer

Dim HexData As Integer '十六进制(二进制)数据字节对应值
Dim hstr As String * 1 '高位字符
Dim lstr As String * 1 '低位字符
Dim HighHexData As Integer '高位数值
Dim LowHexData As Integer '低位数值
Dim HexDataLen As Integer '字节数
Dim StringLen As Integer '字符串长度
Dim Account As Integer '计数
Dim n As Integer
'strTestn = "" '设初值
HexDataLen = 0
strHexToByteArray = 0

StringLen = Len(strText)
Account = StringLen / 2
ReDim bytByte(Account)

For n = 1 To StringLen

Do '清除空格
hstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1

Exit For
End If
Loop While hstr = " "

Do
lstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1

Exit For
End If
Loop While lstr = " "
n = n - 1
If n > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If

HighHexData = ConvertHexChr(hstr)
LowHexData = ConvertHexChr(lstr)

If HighHexData = -1 Or LowHexData = -1 Then '遇到非法字符中断转化
HexDataLen = HexDataLen - 1

Exit For
Else

HexData = HighHexData * 16 + LowHexData
bytByte(HexDataLen) = HexData
HexDataLen = HexDataLen + 1


End If

Next n

If HexDataLen > 0 Then '修正最后一次循环改变的数值
HexDataLen = HexDataLen - 1
ReDim Preserve bytByte(HexDataLen)
Else
ReDim Preserve bytByte(0)
End If


If StringLen = 0 Then '如果是空串,则不会进入循环体
strHexToByteArray = 0
Else
strHexToByteArray = HexDataLen + 1
End If


End Function
Public Sub liqin(strtxt As String)
Dim length As Integer
Dim strsendtext As String
Dim bytsendbyte() As Byte


strsendtext = strtxt

length = strHexToByteArray(strsendtext, bytsendbyte())

If length > 0 Then
MSComm1.Output = bytsendbyte
End If
End Sub

Public Sub Display()
Dim n As Integer
Dim intValue As Integer
Dim intHighHex As Integer
Dim intLowHex As Integer
Dim strSingleChr As String * 1

Dim intAddress As Integer
Dim intAddressArray(8) As Integer
Dim intHighAddress As Integer

Dim strhex, strAscii As String
Dim result(16) As String
Dim i As Integer
Dim time1 As String
Dim number_str As String
i = 0


'设置初值
strhex = ""


'*****************************************
'获得16进制码
'*****************************************



For n = 1 To 8

intValue = receive(n - 1)



intHighHex = intValue / 16
intLowHex = intValue - intHighHex * 16

If intHighHex < 10 Then
intHighHex = intHighHex + 48
Else
intHighHex = intHighHex + 55
End If
If intLowHex < 10 Then
intLowHex = intLowHex + 48
Else
intLowHex = intLowHex + 55
End If

strhex = strhex + " " + Chr$(intHighHex) + Chr$(intLowHex) + " "
If i < 16 Then
result(i) = Chr$(intHighHex)

i = i + 1
result(i) = Chr$(intLowHex)
i = i + 1
End If

Next n
If result(0) = "F" And result(1) = "F" Then
OutDate
End If


Text1.Text = ""
Text1.Text = strhex
number_str = result(14) &amp; result(15) &amp; result(12) &amp; result(13) &amp; result(10) &amp; result(11) &amp; result(8) &amp; result(9)

MsgBox "钮号为" &amp; number_str
Call Niu_Hao


End Sub

Public Sub OutDate()
Dim YM As String
Dim hm As String
Dim strtxt As String
Dim str1 As String

YM = Date
hm = Time


'读分
If Mid(hm, 3, 1) = ":" Then
strtxt = Mid(hm, 4, 2)
strtxt = strtxt + Mid(hm, 1, 2)
Else
strtxt = Mid(hm, 3, 2)
strtxt = strtxt + "0" + Mid(hm, 1, 1)
End If
'读小时
If Mid(YM, 6, 1) = "1" And Mid(YM, 7, 1) <> "-" Then

If Len(YM) = 9 Then
strtxt = strtxt + "0" + Mid(YM, 9, 1)
Else
strtxt = strtxt + Mid(YM, 9, 2)
End If
strtxt = strtxt + Mid(YM, 6, 2)


Else
If Len(YM) = 8 Then
strtxt = strtxt + "0" + Mid(YM, 8, 1)
Else
strtxt = strtxt + Mid(YM, 8, 2)
End If

strtxt = strtxt + "0" + Mid(YM, 6, 1)

End If


liqin (strtxt)
MsgBox "succeed"
End


End Sub

Public Sub Niu_Hao()



Dim i As Integer
Dim byTinput1() As Byte


MSComm1.InBufferCount = 0
MSComm1.Output = "0"
TimeDelay 30

MSComm1.InputMode = comInputModeBinary


MSComm1.InputLen = 9
inTinputlen = 9
ReDim byTinput1(9) As Byte
byTinput1 = MSComm1.Input
For i = 2 To 9
receive(i - 2) = byTinput1(i - 1)
Next
DoEvents

Call Display



Exit Sub





End Sub


Public Function TimeDelay_1(t As Integer)
Dim tt As Long

tt = GetTickCount()

Do
DoEvents
MSComm1.Output = "0"
Loop Until GetTickCount - tt > t


End Function


 
用delphi有好些办法,一个你可以用spcomm来做,另一个的话下面这个网友的代码你也可以参考一下:
///////////////////////////////////////////////////////////////////////////////
我自己开发过一个 串口通讯控件如下:
基本解决了延时的问题;
我是这样处理的,通过 ClearCommError(hCommHandle,dwError,@CS); 取得状态
然后看看缓冲区数据长度 :cs.cbInQue
然后在用ClearCommError(hCommHandle,dwError,@CS); 取得状态
比较这次和上次缓冲取数据的长度,看看是否一样长。如果一样长,说明已经收完了。
如果不一样长,重复上边的操作。
-------------------------------------------------------
下面是控件代码:

unit CommDai;

interface

uses
Windows, Messages, SysUtils, Classes,Forms ;

type
TParity = ( None, Odd, Even );
TStopBits = ( _1, _1_5, _2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
TCommDai = class(TComponent)
private
FBaudRate: DWORD;
FreadComCount:integer;
FCommName: String;
FParity: TParity;
FStopBits: TStopBits;
FRecieveDelay: Word;
hCommHandle:Thandle;
FFtuAddress:word;
FDataBits: TDataBits;
procedure SetBaudRate(const Value: DWORD);
procedure SetParity(const Value: TParity);
procedure SetStopBits(const Value: TStopBits);
procedure SetRecieveDelay(const Value: Word);
procedure SetDataBits(const Value: TDataBits);


{ Private declarations }
protected
{ Protected declarations }
public
property Handle: THandle read hCommHandle write hCommHandle;
property readComCount:integer read FreadComCount;
function SendString(str:string): string;
// constructor Create( AOwner: TComponent ); override;
// destructor Destroy; override;
function stringtohex(str:string): string;
Procedure TimeDelay(DT:DWORD);
function StartComm:boolean;
procedure StopComm;
procedure SendByteArray(SendStr:String) ; overload;
procedure SendByteArray(ByteArray:Array of Byte; SendCount:word);overload;
procedure RecieveByteArray(var ByteArray:Array of Byte;var RecieveCount:word);overload;
function BytesToString(Bytes:Array of Byte;Count:word):String;
function RecieveByteArray:string; overload;

{ Public declarations }
published
property CommName: string read FCommName write FCommName; // String read FCommName write
property BaudRate: DWORD read FBaudRate write SetBaudRate; //read FBaudRate write
property Parity: TParity read FParity write SetParity; //read FParity write FParity
property StopBits: TStopBits read FStopBits write SetStopBits; //read FStopBits write SetStopBits
property RecieveDelay :Word read FRecieveDelay write SetRecieveDelay;
property FtuAddress: word read FFtuAddress write FFtuAddress;
property DataBits: TDataBits read FDataBits write SetDataBits;
{ Published declarations }
end;

procedure Register;
{$R CommDai.dcr}
implementation

procedure Register;
begin
RegisterComponents('dai', [TCommDai]);
end;

{ TCommDai }

procedure TCommDai.SetBaudRate(const Value: DWORD);
begin
FBaudRate := Value;
end;


procedure TCommDai.SetParity(const Value: TParity);
begin
FParity := Value;
end;

procedure TCommDai.SetRecieveDelay(const Value: Word);
begin
FRecieveDelay := Value;
end;


procedure TCommDai.SetStopBits(const Value: TStopBits);
begin
FStopBits := Value;
end;
function TCommDai.stringtohex(str:string): string;
var temp:string;
begin
str:=trim(str);
while length(str)>1 do
begin
temp:=temp+'$'+copy(str,1,2);
str:=copy(str,3,length(str)-2);
str:=trim(str);
end;
result:=temp;
end;
function TCommDai.SendString(str:string): string;
var temp:string;
begin
str:=trim(str);
while length(str)>1 do
begin
temp:=temp+' '+copy(str,1,2);
str:=copy(str,3,length(str)-2);
str:=trim(str);
end;
result:=temp;
end;
{ public function or procedure}
// constructor Create( AOwner: TComponent ); override;
// destructor Destroy; override;
Procedure TCommDai.TimeDelay(DT:DWORD);
var
TT:DWORD;
begin
//取得现在的Tick值
//TT:=GetTickCount();
//计算Tick差值是否超过设置值

// while GetTickCount()-TT<DT do
// begin
sleep(DT);
// Application.ProcessMessages; //释放控制权
// end;
end;

//以下是打开通信端口的程序
function TCommDai.StartComm:boolean;
var
cc:TCOMMCONFIG;
Temp:string;
begin
hCommHandle:=CreateFile(PChar(FCommName),//文件名指针,如com1,com2
GENERIC_READ or GENERIC_WRITE, //存取属性

2, //共享模式 0-不共享, 1-共相书
nil, OPEN_EXISTING, 0, 0); // 打开COM
if (hCommHandle = INVALID_HANDLE_VALUE) then begin // 如果COM 未打开
result:=false;
exit;
end;

GetCommState(hCommHandle,cc.dcb); // 得知目前COM 的状态

cc.dcb.BaudRate:= BaudRate;//CBR_9600; // 设置波特率为9600
cc.dcb.ByteSize:=ord(FDataBits)+5; // 字节为 8 bit
cc.dcb.Parity:=ord(FParity); //NOPARITY; // Parity 为 None
cc.dcb.StopBits:=ord(StopBits); //ONESTOPBIT; // 1 个Stop bit
if not SetCommState(hCommHandle, cc.dcb) then
begin// 设置COM 的状态
MessageBox (0, '通信端口设置错误!!!','',MB_OK);
CloseHandle(hCommHandle);
result:=false;
exit;
end;
result:=true;
end;

procedure TcommDai.StopComm;
begin
SetCommMask( hCommHandle,$0);
CloseHandle(hCommHandle);
end;
procedure TcommDai.SendByteArray(SendStr:string) ;
var StrTemp :string;
SendByteCount :integer;
SendBuff :Array[0..2047] of Byte;
nBytesRead, dwEvent, dwError:LongWORD ;
cs:TCOMSTAT;
pt:pbyte;
lrc:dword;
i:integer;
begin

StrTemp:=self.stringtohex(SendStr);
SendByteCount:=Length(StrTemp) div 3;
//SetLength(SendBuff,SendByteCount);
for i:=0 to SendByteCount-1 do
SendBuff:=StrToInt(copy(StrTemp,i*3+1,3));
//实际的传送动作
try
WriteFile(hCommHandle,SendBuff, SendByteCount ,lrc, nil); // 送出
except
application.MessageBox('发送失败!','系统提示!',mb_ok+mb_iconinformation);
end;
end;

PROCEDURE TcommDai.SendByteArray(ByteArray:Array of Byte; SendCount:word);
var
lrc:dword;
begin
try
WriteFile(hCommHandle,ByteArray, SendCount ,lrc, nil); // 送出
except
application.MessageBox('发送失败!','系统提示!',mb_ok+mb_iconinformation);
end;
end;

procedure TcommDai.RecieveByteArray(var ByteArray:Array of Byte;var RecieveCount:word);

var
StrTemp :String;
RecieveBuff :Array[0..2047] of Byte;
cs:TCOMSTAT;
pt:pbyte;
lrc:dword;
nBytesRead, dwEvent, dwError:LongWORD ;
i:integer;
comp:integer;
begin
timedelay(20);
ClearCommError(hCommHandle,dwError,@CS); //取得状态
comp:=cs.cbInQue;
// timedelay(1);
for i:=1 to 50 do
begin
timedelay(20);
ClearCommError(hCommHandle,dwError,@CS); //取得状态
if (comp=cs.cbInQue) and (cs.cbInQue>1) then break;
if (i>15) and (cs.cbInQue=0) then break;
comp:=cs.cbInQue;
end;
FreadComCount:=i;
// application.MessageBox(pchar(inttostr(i)),'系统提示!',mb_ok+mb_iconinformation);
RecieveCount:=cs.cbInQue;
if cs.cbInQue >2048 then
begin
PurgeComm(hCommHandle, PURGE_RXCLEAR);
RecieveCount:=0;
// 清除COM 数据
exit;
end;
try
ReadFile(hCommHandle, ByteArray,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
except

end;

end;




function TcommDai.RecieveByteArray:string; //用不到了
var
StrTemp :String;
RecieveBuff :Array[0..2047] of Byte;
cs:TCOMSTAT;
pt:pbyte;
lrc:dword;
nBytesRead, dwEvent, dwError:LongWORD ;
i:integer;
comp:integer;
begin

timedelay(10 );
ClearCommError(hCommHandle,dwError,@CS); //取得状态
comp:=cs.cbInQue;
timedelay(0);
i:=1;
while i<100 do
begin
timedelay(10 );
ClearCommError(hCommHandle,dwError,@CS); //取得状态
if (comp=cs.cbInQue) and (cs.cbInQue>1) then break;
comp:=cs.cbInQue;
inc(i);
end;


// 数据是否大于我们所准备的Buffer
if cs.cbInQue=0 then
begin
result:='';

exit;
end;
if cs.cbInQue >2048 then
begin
PurgeComm(hCommHandle, PURGE_RXCLEAR);
result:='';
application.MessageBox('接受溢出,可能是未打开端口!','系统提示!',mb_ok+mb_iconinformation);
// 清除COM 数据
exit;
end;
try
ReadFile(hCommHandle, RecieveBuff,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
except
application.MessageBox('接受失败!','系统提示!',mb_ok+mb_iconinformation);
end;
StrTemp:='';
for i:=0 to cs.cbInQue -1 do
StrTemp:=StrTemp+inttohex(RecieveBuff,2)+' ';
Result:=StrTemp;
end;

function TcommDai.BytesToString(Bytes:Array of Byte;Count:word):String;
var i :integer;
StrTemp :String;
begin
strTemp:='';
for i:=0 to Count-1 do
strTemp:=strTemp+ inttohex(Bytes,2)+' ';
Result:=strTemp;
end;


procedure TCommDai.SetDataBits(const Value: TDataBits);
begin
FDataBits := Value;
end;
///////////////////////////////////////////////////////////////////////////
如果用mscomm32的控件的话,你用sleep(600);是不是延时不够呀?我用的时候,有时用
这样方法的延时
var
time_1:real;
begin
time_1:=time;
while time()>time_1+StrToTime('00:00:01')*3 do //等待3秒
begin
APPLICATION.PROCESSMESSAGES;
if (MSComm1.InBufferCount>0) then
break;
end;.
end;
你看看,对你有没有用吧
 
后退
顶部