返回
{***************************************************************}
{*** FVision Unit Version1.0 ***}
{*** 蓝蚂蚁工作室 ***}
{***************************************************************}
{*** 串行通信单元 ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit CommDlg;
Interface
Uses
Memory,Dos,FTool,FMouse,FGraph,FView,FEvent,FExtDrv,
FDialog,FControl,FCommu,FMenu,FList,FEdit,fwrite;
Const
cm_ReceiveFile = 31;
dfWaitEcho :Boolean = False;
dfUseCrc :Boolean = False;
dfSendCLCode :Boolean = False;
dfLocalEcho :Boolean = False;
dfReceCLCode :Boolean = False;
df7BitAscii :Boolean = False;
dfAutoCL :Boolean = False;
Type
WordRec=record
case Word of
0:(Lo,Hi:Byte);
1:(Wor:Word);
end;
LongRec=record
case LongInt of
0:(A0,A1,A2,A3:Byte);
1:(Lon:LongInt);
end;
CommuDataType=Record
Baud:Longint;
ComPort:Byte;
DataBits:Byte;
Parity:Byte;
StopBits:Byte;
ReceBufferSize:Longint;
SendBufferSize:Longint;
end;
PSetupComPort=^TSetupComPort;
TSetupComPort=object(TWindow)
constructor Init;
procedure SetData;virtual;
end;
PSendWin=^TSendWin;
TSendWin=object(TInstallWin)
FileError,Connect:Boolean;
Fp:File;
Name,NameS:string;
FSize,FTime:LongRec;
Count:LongInt;
FAttr:Word;
Timer:PTimer;
constructor Init(N:string);
destructor Done;virtual;
procedure HandleEvent(var Event:TEvent);virtual;
procedure SendFileHead;
end;
PReceiveWin=^TReceiveWin;
TReceiveWin=object(TInstallWin)
FileError,FileStart:Boolean;
Fp:File;
FTime,FSize:LongRec;
Count:LongInt;
FAttr:WordRec;
NameLen:Integer;
NameS:string;
constructor Init;
destructor Done;virtual;
procedure HandleEvent(var Event:TEvent);virtual;
end;
PComWin=^TComWin;
TComWin=object(TWindow)
Send,Rece:PEditor;
Statu:PStatusLine;
Constructor Init(R:TRect);
Destructor Done;virtual;
Procedure ClearSendBuf;
Procedure ClearReceBuf;
Procedure ResetCom;
Procedure ModifyStatu;
Procedure HandleEvent(var Event:TEvent);virtual;
end;
function SetupComm:PWindow;
function SetupAsciiCode:PWindow;
Implementation
Const
MSChar:array[False..True] of string[3]=('@','~@~');
var
CommuData:CommuDataType;
constructor TSetupComPort.Init;
var
Q: PRadioButton;
R: PCheckBox;
Inp:PInput;
List:PLister;
T: TRect;
begin
AssignRect(T, 0, 0, 370, 230);
Inherited Init(T,'设置串行口',True);
Option:=Option or opAligen8;
Q:=New(PRadioButton,Init(20,45,150,98,'串行口:',CommuData.ComPort));
Q^.Insert('COM1');
Q^.Insert('COM2');
Q^.Insert('COM3');
Q^.Insert('COM4');
Insert(Q);
Q:=New(PRadioButton,Init(155,45,270,98,'数据位:',CommuData.DataBits));
Q^.Insert('5位');
Q^.Insert('6位');
Q^.Insert('7位');
Q^.Insert('8位');
Insert(Q);
Q:=New(PRadioButton,Init(275,45,350,98,'停止位:',CommuData.StopBits));
Q^.Insert('1位');
Q^.Insert('2位');
Insert(Q);
Insert(New(PStaticText,Init(stNormal,20,115,'波特率:',0)));
Inp:=New(PDigInput,Init(80,115,@CommuData.Baud,12,ipBroad+ipSelect+ipDigital,dtLongint));
List:=New(PLister,Init(80,133,10,4,15,stVScroll+stSaveBack));
List^.Insert('600');
List^.Insert('1200');
List^.Insert('2400');
List^.Insert('4800');
List^.Insert('7200');
List^.Insert('9600');
List^.Insert('14400');
List^.Insert('19200');
List^.Insert('28800');
List^.Insert('38400');
List^.Insert('57600');
List^.Insert('115200');
Inp^.SetLister(List);
Inp^.SetRange('波特率',100,115200);
Insert(Inp);
Insert(List);
Insert(New(PStaticText,Init(stNormal,20,143,'接收缓冲区:',0)));
Inp:=New(PDigInput,init(113,143,@CommuData.ReceBufferSize,8,ipBroad+ipDigital,dtLongint));
Inp^.SetRange('接收缓冲区',100,60000);
Insert(Inp);
Insert(New(PStaticText,Init(stNormal,20,171,'发送缓冲区:',0)));
Inp:=New(PDigInput,init(113,171,@CommuData.SendBufferSize,8,ipBroad+ipDigital,dtLongint));
Inp^.SetRange('发送缓冲区',100,20000);
Insert(Inp);
Q:=New(PRadioButton,Init(200,115,350,190,'奇偶校验:',CommuData.Parity));
Q^.Insert('无奇偶校验');
Q^.Insert('奇校验');
Q^.Insert('偶校验');
Insert(Q);
Insert(New(PButton,Init(160,200,220,220,'确定',0,cmOk)));
Insert(New(PButton,Init(225,200,285,220,'放弃',0,cmCancel)));
Insert(New(PButton,Init(290,200,350,220,'帮助',kbF1,cmHelp)));
Next;
Center;
end;
procedure TSetupComPort.SetData;
begin
Inherited SetData;
with CommuData do
begin
dfBaud:=Baud;
dfBufLen:=ReceBufferSize;
dfSendBufLen:=SendBufferSize;
dfDataBits:=DataBits+4;
dfStopBits:=StopBits;
dfComPort:=ComPort;
case Parity of
1: dfParity:='N';
2: dfParity:='O';
3: dfParity:='E';
end;
end;
end;
function SetupComm:PWindow;
var
P: PWindow;
R: PCheckBox;
T: TRect;
begin
AssignRect(T, 0, 0, 350, 200);
P:=New(PWindow,Init(T,'设置通信参数',True));
R:=New(pCheckBox,Init(20,40,320,100,'文件传送协议:'));
R^.Insert('发送时等待对方应答.',dfWaitEcho);
R^.Insert('使用循环冗余校验码(CRC).',dfUseCrc);
P^.Insert(R);
P^.Insert(New(PButton,Init(100,170,160,190,'确定',0,cmOk)));
P^.Insert(New(PButton,Init(180,170,240,190,'放弃',0,cmCancel)));
P^.Insert(New(PButton,Init(260,170,320,190,'帮助',kbF1,cmHelp)));
P^.Next;
P^.Center;
SetupComm:=P;
end;
function SetupAsciiCode:PWindow;
var
P: PWindow;
R: PCheckBox;
T: TRect;
begin
AssignRect(T, 0, 0, 350, 230);
P:=New(PWindow,Init(T,'ASCII码设置',True));
R:=New(pCheckBox,Init(20,40,320,100,'发送ASCII码:'));
R^.Insert('发送以换行符结尾的行.',dfSendCLCode);
R^.Insert('本地响应键入的字符.',dfLocalEcho);
P^.Insert(R);
R:=New(pCheckBox,Init(20,115,320,190,'接收ASCII码:'));
R^.Insert('收到的字符行尾添加换行符.',dfReceCLCode);
R^.Insert('强制7位ASCII码.',df7BitAscii);
R^.Insert('超过终端宽度则自动换行.',dfAutoCL);
P^.Insert(R);
P^.Insert(New(PButton,Init(100,200,160,220,'确定',0,cmOk)));
P^.Insert(New(PButton,Init(180,200,240,220,'放弃',0,cmCancel)));
P^.Insert(New(PButton,Init(260,200,320,220,'帮助',kbF1,cmHelp)));
P^.Next;
P^.Center;
SetupAsciiCode:=P;
end;
constructor TSendWin.Init;
begin
Inherited Init('Send File','File:'+N,0);
Connect:=False;
Name:=N;
FileError:=False;
Assign(Fp,Name);
{$i-}System.Reset(Fp,1);{$i+}
FileError:=IoResult<>0;
if FileError Then Exit;
FSize.Lon:=FileSize(Fp);
{$i-}GetFAttr(Fp,FAttr);{$i+}
FileError:=IoResult<>0;
if FileError Then Exit;
{$i-}GetFTime(Fp,FTime.Lon);{$i+}
FileError:=IoResult<>0;
if FileError Then Exit;
NameS:=FName(Name);
StatusLine^.Modify('Send File:'+Names+#0'COM'+IntStr(dfComPort)+#0+
IntStr(dfBaud)+#0+IntStr(dfDataBits)+#0+
IntStr(dfStopBits)+#0+dfParity+#0+'Waiting to connect');
Count:=0;
ClearReceiveBuffer;
ClearSendBuffer;
InitSerialPort(dfBaud,dfStopBits,dfDataBits,dfParity);
EnableSerialInt;
if dfWaitEcho then
begin
Timer:=New(PTimer,Init(10));
Insert(Timer);
end;
SendChar(cm_ReceiveFile);
end;
destructor TSendWin.Done;
begin
{$i-}Close(Fp);{$i+}
if not FileError then
begin
DisableSerialInt;
DoneSerialPort;
end;
StatusLine^.Modify('');
Inherited Done;
end;
procedure TSendWin.HandleEvent;
var
Ch:array[1..100] of Byte;
Result:Word;
i:Integer;
begin
Inherited HandleEvent(Event);
if FileError then Exit;
if Event.What=evNothing then
begin
if not Connect then
begin
if not dfWaitEcho then
begin
Connect:=True;
SendFileHead;
end else
if CharsInBuf>0 then
begin
if GetCharInBuf=Byte(not cm_ReceiveFile) then
begin
Connect:=True;
Timer^.StopTimer;
SendFileHead;
end;
end;
end else
if not Eof(Fp) then
begin
BlockRead(Fp,Ch,100,Result);
for i:=1 to Result do
SendChar(Ch[i]);
Inc(Count,Result);
SetBlock(Count/FSize.Lon);
end else
begin
Event.What:=evCommand;
Event.Command:=cmOk;
Event.InfoPtr:=@Self;
end;
end else
if (Event.What=evCommand) and (Event.Command=cmTimer)
and (Event.InfoPtr=Timer) and (not Connect) then
begin
SendChar(cm_ReceiveFile);
Timer^.Reset;
ClearEvent(Event);
end;
end;
procedure TSendWin.SendFileHead;
var
i:Integer;
begin
if FileError Then Exit;
StatusLine^.Modify('Send File:'+Names+#0'COM'+IntStr(dfComPort)+#0+
IntStr(dfBaud)+#0+IntStr(dfDataBits)+#0+
IntStr(dfStopBits)+#0+dfParity+#0+'Now Sending...');
Count:=0;
SendChar(Byte(not cm_ReceiveFile));
SendChar(Lo(FAttr));
SendChar(Hi(FAttr));
SendChar(FSize.A0);
SendChar(FSize.A1);
SendChar(FSize.A2);
SendChar(FSize.A3);
SendChar(FTime.A0);
SendChar(FTime.A1);
SendChar(FTime.A2);
SendChar(FTime.A3);
SendChar(cm_ReceiveFile);
SendChar(Length(NameS));
for i:=1 to Length(NameS) do
SendChar(Byte(NameS[i]));
end;
constructor TReceiveWin.Init;
begin
Inherited Init('Receive File','File:',0);
FileError:=False;
FileStart:=False;
Count:=0;
StatusLine^.Modify('Receive File: '#0'COM'+IntStr(dfComPort)+#0+
IntStr(dfBaud)+#0+IntStr(dfDataBits)+#0+
IntStr(dfStopBits)+#0+dfParity);
ClearReceiveBuffer;
ClearSendBuffer;
InitSerialPort(dfBaud,dfStopBits,dfDataBits,dfParity);
EnableSerialInt;
end;
destructor TReceiveWin.Done;
begin
{$i-}Close(Fp);{$i+}
DisableSerialInt;
DoneSerialPort;
StatusLine^.Modify('');
Inherited Done;
end;
procedure TReceiveWin.HandleEvent;
var
Temp:Byte;
Result:Word;
DataValid:Boolean;
begin
Inherited HandleEvent(Event);
if Event.What=evNothing then
begin
if (CharsInBuf>0) then
begin
Temp:=GetCharInBuf;
if not FileStart then
begin
case Count of
0:if Temp=cm_ReceiveFile then
begin
Inc(Count);
if dfWaitEcho then
SendChar(Byte(not cm_ReceiveFile));
end;
1:if Temp=Byte(not cm_ReceiveFile) then Inc(Count) else Count:=0;
2:begin FAttr.Lo:=Temp;Inc(Count); end;
3:begin FAttr.Hi:=Temp;Inc(Count); end;
4:begin FSize.A0:=Temp;Inc(Count); end;
5:begin FSize.A1:=Temp;Inc(Count); end;
6:begin FSize.A2:=Temp;Inc(Count); end;
7:begin FSize.A3:=Temp;Inc(Count); end;
8:begin FTime.A0:=Temp;Inc(Count); end;
9:begin FTime.A1:=Temp;Inc(Count); end;
10:begin FTime.A2:=Temp;Inc(Count); end;
11:begin FTime.A3:=Temp;Inc(Count); end;
12:if Temp=cm_ReceiveFile then Inc(Count) else Count:=0;
13:begin NameLen:=Temp;
NameS:='';
Inc(Count);
end;
else if (Count>13)and(Count<=13+NameLen) then
begin NameS:=NameS+Char(Temp);
Inc(Count);
if Count>13+NameLen then
begin
StatusLine^.Modify('Receive File:'+Names+#0'COM'+IntStr(dfComPort)+#0+
IntStr(dfBaud)+#0+IntStr(dfDataBits)+#0+
IntStr(dfStopBits)+#0+dfParity);
Count:=0;
{if Exist_Fi(NameS) then
}
Assign(Fp,Names);
{$i-}ReWrite(Fp,1);{$i+}
FileError:=IoResult<>0;
{$i-}SetFAttr(Fp,FAttr.Wor);{$i+}
FileError:=IoResult<>0;
{$i-}SetFTime(Fp,FTime.Lon);{$i+}
FileError:=IoResult<>0;
if not FileError then
begin
FileStart:=True;
ShowStr^.Modify('File:'+NameS);
Reset;
Count:=0;
end;
end;
end else Count:=0;
end;
end else
begin
DataValid:=True;
while (Count<FSize.Lon) and DataValid do
begin
BlockWrite(Fp,Temp,1,Result);
Inc(Count);
if CharsInBuf>0 then
begin
DataValid:=True;
Temp:=GetCharInBuf;
end else DataValid:=False;
end;
SetBlock(Count/FSize.Lon);
if Count>=FSize.Lon then
begin
FileStart:=False;
ShowStr^.Modify('File:'+NameS+' Completed');
{$i-}Close(Fp);{$i+}
Count:=0;
end;
end;
end;
end;
end;
{-------------object TComWin------------}
Constructor TComWin.Init;
var
T:TRect;
begin
R.A.X:=R.A.X div 8 * 8;
T.A:=R.A;
T.B.X:=T.A.X+R.B.X*8+31;
T.B.Y:=T.A.Y+R.B.Y*16+53;
Inherited Init(T,'终端通信',True);
Option:=Option or opAligen8 or opResize or opCantClose;
GrowDlt.X:=8;
GrowDlt.Y:=16;
Inc(R.A.X,8);
Inc(R.A.Y,29);
R.B.Y:=R.B.Y div 2 -1;
Send:=New(PEditor,Init(R,edHScroll+edVScroll+edBroad+edViewerPos));
Insert(Send);
Inc(R.A.Y,R.B.Y*16+25);
Rece:=New(PEditor,Init(R,edHScroll+edVScroll+edBroad+edViewerPos));
Rece^.GrowMode:=gfGrowHiX+gfGrowLoY+gfGrowHiY;
Rece^.CanEdit:=False;
Insert(Rece);
AssignRect(R,Broad.A.X+5,Broad.B.Y-25,Broad.B.X-20,Broad.B.Y-3);
Statu:=New(PStatusLine,Init(R,0,#0));
Insert(Statu);
Next;
ResetCom;
end;
Destructor TComWin.Done;
begin
DisableSerialInt;
DoneSerialPort;
Inherited Done;
end;
Procedure TComWin.ClearSendBuf;
begin
ClearSendBuffer;
Send^.FreeBuf;
Send^.Draw;
end;
Procedure TComWin.ClearReceBuf;
begin
ClearReceiveBuffer;
Rece^.FreeBuf;
Rece^.Draw;
end;
Procedure TComWin.ResetCom;
begin
ClearSendBuf;
ClearReceBuf;
DisableSerialInt;
DoneSerialPort;
InitSerialPort(dfBaud,dfStopBits,dfDataBits,dfParity);
EnableSerialInt;
ModifyStatu;
end;
Procedure TComWin.ModifyStatu;
var
Temp:Byte;
begin
Temp:=GetModemStatus;
Statu^.Modify('COM'+IntStr(ComIndex)+#0+IntStr(dfBaud)+','+dfParity+','+
IntStr(dfDataBits)+','+IntStr(dfStopBits)+#0+
'DSR:'+MSChar[(Temp and sioDSR)<>0]+
' CTS:'+MSChar[(Temp and sioCTS)<>0]+
' RI:'+MSChar[(Temp and sioRI)<>0]+
' CD:'+MSChar[(Temp and sioDCD)<>0]+#0+
HexStr(GetComAddr(ComIndex))+#0);
end;
Procedure TComWin.HandleEvent;
var
Temp:Byte;
begin
Inherited HandleEvent(Event);
if (CharsInBuf>0) then
begin
Temp:=GetCharInBuf;
case Temp of
$0D:Rece^.ProEnter;
$0A:;
else Rece^.ProChar(Char(Temp));
end;
end;
case Event.What of
evCommand:case Event.Command of
cmEnterPress:SendString(Send^.GetLine(Send^.Pos.Y+Send^.Mark.Y-1));
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
Rece^.ModifyFlag:=False;
Send^.ModifyFlag:=False;
ModifyStatu;
end;
{----------------------------------------}
begin
with CommuData do
begin
Baud:=9600;
ComPort:=3;
DataBits:=4;
Parity:=1;
StopBits:=1;
ReceBufferSize:=40000;
SendBufferSize:=1000;
end;
with CommuData do
begin
dfBaud:=Baud;
dfBufLen:=ReceBufferSize;
dfSendBufLen:=SendBufferSize;
dfDataBits:=DataBits+4;
dfStopBits:=StopBits;
dfComPort:=ComPort;
case Parity of
1: dfParity:='N';
2: dfParity:='O';
3: dfParity:='E';
end;
end;
end.