用pcomm的高手请帮帮忙。(100分)

tonyliu · 2006-02-09

最近在写一个门禁系统，没什么经验，用的是RS485做通信，打算用pcomm操作串口传接下位机数据，不知哪位大哥有这方面的经验，给在下指点一二，或者给各源代码做参考。
我还打算系统可以支持udp和RS485两种方式。欢迎有经验的朋友给与帮助，谢谢！

tonyliu · 2006-02-09

自己顶一下
如果有代码请帮忙发送到sirusoft@hotmail.com,谢谢！

Mike1234567890 · 2006-02-09

呵呵，这个应该不难
你把485当作是232好了

tonyliu · 2006-02-09

我也知道是这样,但没有用过pcomm，听说这个动态库比较好。

41426277 · 2006-02-09

我都做过
下啦机
/
1.电脑232->485->下啦机
/
下啦机

2.电脑UDP(或TCP)->422设备->232(或再到->485)->下啦机

tonyliu · 2006-02-09

To:41426277兄，你用的是什么控件操作串口
能否给我发一份源码供我参考？sirusoft@hotmail.com
不胜感激！

tonyliu · 2006-02-09

欢迎讨论。分不够再加！

网中戏 · 2006-02-09

同行啊！我们也是做门禁的。

tonyliu · 2006-02-10

To:网中戏，能否交流一下？QQ:39913823

tonyliu · 2006-02-10

自己再顶!

kaoleoloi · 2006-02-10

帮顶！

╭=========================================╮

80G海量源代码,控件，书籍全免费狂下不停！

http://www.source520.com

个人网站站长开发推广同盟，让所有人知道你的世界！

http://www.source520.com/search/search.asp

╰=========================================╯

tonyliu · 2006-02-14

怎么没人来拿分呢？大富翁们都哪去了?

阿九 · 2006-02-21

spComm也不错

天道酬勤 · 2006-02-21

直接引用pcomm.pas就可以了。

lxw5214 · 2006-02-25

我使用spcomm操作串口，网上有很多例子

tonyliu · 2006-02-27

TO：lxw5214哪里有好的例子，我找了好久没找到

天使屁屁猪 · 2006-03-01

几年以前写的程序，你可以参考看看。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, SPComm, Buttons, Registry, DB, DBTables,
ADODB, ScktComp, Winsock, NB30, ComCtrls, XPMenu;

type
TForm1 = class(TForm)
Panel1: TPanel;
GroupBox1: TGroupBox;
Panel2: TPanel;
BitBtn31: TBitBtn;
BitBtn32: TBitBtn;
BitBtn33: TBitBtn;
SFCB3: TCheckBox;
Panel3: TPanel;
Panel4: TPanel;
Splitter1: TSplitter;
Memo1: TMemo;
Memo2: TMemo;
Label11: TLabel;
Label12: TLabel;
Panel9: TPanel;
Label13: TLabel;
Timer1: TTimer;
BitBtn7: TBitBtn;
Bevel2: TBevel;
RXP3: TPanel;
TXP3: TPanel;
Comm1: TComm;
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
ServerSocket1: TServerSocket;
GroupBox2: TGroupBox;
Edit1: TEdit;
StaticText1: TStaticText;
StaticText2: TStaticText;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Panel6: TPanel;
Label7: TLabel;
SFCB2: TCheckBox;
Bevel3: TBevel;
BitBtn9: TBitBtn;
RXP2: TPanel;
TXP2: TPanel;
Bevel4: TBevel;
ComboBox1: TComboBox;
Label6: TLabel;
Label8: TLabel;
ADOQuery3: TADOQuery;
Label9: TLabel;
ADOTCP: TADOQuery;
COM_T: TTimer;
TCP_T: TTimer;
ADOCOM: TADOQuery;
ADOQuery6: TADOQuery;
ADOQuery7: TADOQuery;
DEL_TCPMSG: TADOQuery;
Panel7: TPanel;
Label15: TLabel;
Memo3: TMemo;
Splitter2: TSplitter;
ListBox3: TListBox;
GroupBox4: TGroupBox;
Label21: TLabel;
Bevel6: TBevel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
SFCB1: TCheckBox;
Panel5: TPanel;
BitBtn15: TBitBtn;
RXP1: TPanel;
TXP1: TPanel;
ListBox1: TListBox;
GroupBox3: TGroupBox;
Label10: TLabel;
Label14: TLabel;
CheckBox2: TCheckBox;
BitBtn12: TBitBtn;
BitBtn8: TBitBtn;
Edit2: TEdit;
CheckBox1: TCheckBox;
BitBtn10: TBitBtn;
CheckBox3: TCheckBox;
Edit3: TEdit;
ListBox2: TListBox;
DSL_T: TTimer;
Comm2: TComm;
DSL_Query: TADOQuery;
DslCom: TADOQuery;
ADOQuery4: TADOQuery;
Label1: TLabel;
Label2: TLabel;
Timer2: TTimer;
ADODSLFee: TADOQuery;
ADOTP: TADOQuery;
DSLTP: TADOQuery;
ADOQuery5: TADOQuery;
procedure BitBtn31Click(Sender: TObject);
procedure BitBtn32Click(Sender: TObject);
procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure BitBtn9Click(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure BitBtn12Click(Sender: TObject);
procedure TCP_TTimer(Sender: TObject);
procedure COM_TTimer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn33Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn15Click(Sender: TObject);
procedure DSL_TTimer(Sender: TObject);
procedure Comm2ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure Timer2Timer(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure BitBtn6Click(Sender: TObject);
private
// function GetFieldName(var fieldname:array of string;str:string):integer;
function GetFieldValue(MSG,CMD:string):string;
function WinsockEnabled: Bool;
function SendData1(Len:Integer):Bool;
function SendData3(Len:Integer):Bool;
{ Private declarations }
public
{ Public declarations }
end;

const
STX=#02; //开始标志
ETX=#03; //结束标记
ACK=#06; //应答标记
NAK=#21; //错误标记
EQU=#05; //请求应答

const
C1 = 52845;
C2 = 22719;

var
Form1: TForm1;
DEPTCODE: String; //宽带上网费用特征代码
Len1,Len3: Integer;
RBuf1,SBuf1,RBuf3,SBuf3: array [1..1000] of byte;
RBuf2:array [1..1000] of String;
RX1,TX1,RX2,TX2,RX3,TX3:LongWord;
LogFile1,LogFile2,LogFile3: TextFile;
OldDate,OldTime,LD1,LD2,LD3,LT1,LT2,LT3,NoDay,NoWeek:String;
TCP_MSG_ON,COM_MSG_ON,DSL_MSG_ON,TCP_MSG_OFF,COM_MSG_OFF,DSL_MSG_OFF:Bool;

implementation

uses Unit2, Unit4, Unit5, Unit3, Unit6;

type
TNBLanaResources = (lrAlloc, lrFree);

type
PMACAddress = ^TMACAddress;
TMACAddress = array[0..5] of Byte;

{$R *.dfm}

//获取第一个IDE硬盘的序列号
// 更多关于 S.M.A.R.T. ioctl 的信息可查看:
// http://www.microsoft.com/hwdev/download/respec/iocltapi.rtf

// MSDN库中也有一些简单的例子
// Windows Development -> Win32 Device Driver Kit ->
// SAMPLE: SmartApp.exe Accesses SMART stats in IDE drives

// 还可以查看 http://www.mtgroup.ru/~alexk
// IdeInfo.zip - 一个简单的使用了S.M.A.R.T. Ioctl API的Delphi应用程序

// 注意:

// WinNT/Win2000 - 你必须拥有对硬盘的读/写访问权限

// Win98
// SMARTVSD.VXD 必须安装到 /windows/system/iosubsys
// (不要忘记在复制后重新启动系统)

function GetIdeSerialNumber : pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
TIDERegs = packed record
bFeaturesReg : BYTE; // Used for specifying SMART "commands".
bSectorCountReg : BYTE; // IDE sector count register
bSectorNumberReg : BYTE; // IDE sector number register
bCylLowReg : BYTE; // IDE low order cylinder value
bCylHighReg : BYTE; // IDE high order cylinder value
bDriveHeadReg : BYTE; // IDE drive/head register
bCommandReg : BYTE; // Actual IDE command.
bReserved : BYTE; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
// Buffer size in bytes
cBufferSize : DWORD;
// Structure with drive register values.
irDriveRegs : TIDERegs;
// Physical drive number to send command to (0,1,2,3).
bDriveNumber : BYTE;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte; // Input buffer.
end;
TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of CHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
// 驱动器返回的错误代码，无错则返回0
bDriverError : Byte;
// IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
bIDEStatus : Byte;
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
// bBuffer的大小
cBufferSize : DWORD;
// 驱动器状态
DriverStatus : TDriverStatus;
// 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
bBuffer : Array[0..0] of BYTE;
end;
var hDevice : THandle;
cbBytesReturned : DWORD;
SCIP : TSendCmdInParams;
aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;
begin
Result := ''; // 如果出错则返回空串
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '//./PhysicalDrive1/'
hDevice := CreateFile( '//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile( '//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do begin
ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
(PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
Result := PChar(@sSerialNumber);
end;
end;

// Get the list of adapters --------------------------
function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
var
LanaEnumNCB: PNCB;
begin
New(LanaEnumNCB);
ZeroMemory(LanaEnumNCB, SizeOf(TNCB));
try
with LanaEnumNCB^ do
begin
ncb_buffer := PChar(LanaEnum);
ncb_length := SizeOf(TLanaEnum);
ncb_command := Char(NCBENUM);
NetBios(LanaEnumNCB);
Result := Byte(ncb_cmd_cplt);
end;
finally
Dispose(LanaEnumNCB);
end;
end;

//Mac address function ResetLana --------------------
function ResetLana(LanaNum, ReqSessions, ReqNames: Byte; LanaRes: TNBLanaResources): Byte;
var
ResetNCB: PNCB;
begin
New(ResetNCB);
ZeroMemory(ResetNCB, SizeOf(TNCB));
try
with ResetNCB^ do
begin
ncb_lana_num := Char(LanaNum); // Set Lana_Num
ncb_lsn := Char(LanaRes); // Allocation of new resources
ncb_callname[0] := Char(ReqSessions); // Query of max sessions
ncb_callname[1] := #0; // Query of max NCBs (default)
ncb_callname[2] := Char(ReqNames); // Query of max names
ncb_callname[3] := #0; // Query of use NAME_NUMBER_1
ncb_command := Char(NCBRESET);
NetBios(ResetNCB);
Result := Byte(ncb_cmd_cplt);
end;
finally
Dispose(ResetNCB);
end;
end;

//Mac address function GetMacAddress ----------------
function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
var
AdapterStatus: PAdapterStatus;
StatNCB: PNCB;
begin
New(StatNCB);
ZeroMemory(StatNCB, SizeOf(TNCB));
StatNCB.ncb_length := SizeOf(TAdapterStatus) + 255 * SizeOf(TNameBuffer);
GetMem(AdapterStatus, StatNCB.ncb_length);
try
with StatNCB^ do
begin
ZeroMemory(MACAddress, SizeOf(TMACAddress));
ncb_buffer := PChar(AdapterStatus);
ncb_callname := '* ' + #0;
ncb_lana_num := Char(LanaNum);
ncb_command := Char(NCBASTAT);
NetBios(StatNCB);
Result := Byte(ncb_cmd_cplt);
if Result = NRC_GOODRET then
MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));
end;
finally
FreeMem(AdapterStatus);
Dispose(StatNCB);
end;
end;

// Returns ISP assigned IP --------------------------
Function LocalIP : string;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;

begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^ <> nil do begin
result:=StrPas(inet_ntoa(pptr^^));
Inc(I);
end;
WSACleanup;
end;

Procedure ShowIP();
var LanaNum: Byte;
MACAddress: PMACAddress;
RetCode: Byte;
LanaEnum: PLanaEnum;
I: Integer;
begin
//Display Mac address and Local IP address ------------------------------
New(LanaEnum);
ZeroMemory(LanaEnum, SizeOf(TLanaEnum));
try
if GetLanaEnum(LanaEnum) = NRC_GOODRET then
begin
with Form1.ComboBox1.Items do
begin
Form1.ComboBox1.Sorted := True;
BeginUpdate;
Clear;
for I := 0 to Byte(LanaEnum.length) - 1 do
Add(IntToStr(Byte(LanaEnum.lana)));
Form1.ComboBox1.ItemIndex := 0;
EndUpdate;
end;
end;
finally
Dispose(LanaEnum);
end;

Try
LanaNum := StrToInt(Form1.ComboBox1.Text);
RetCode := ResetLana(LanaNum, 0, 0, lrAlloc);
if RetCode <> NRC_GOODRET then
begin
Beep;
ShowMessage('Reset Error! RetCode = $' + IntToHex(RetCode, 2));
end;
New(MACAddress);
try
RetCode := GetMACAddress(LanaNum, MACAddress);
if RetCode = NRC_GOODRET then
begin
Form1.Label8.Caption := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
[MACAddress[0], MACAddress[1], MACAddress[2],
MACAddress[3], MACAddress[4], MACAddress[5]]);
end else
begin
Beep;
Form1.Label8.Caption := 'Error Or NetCard Not Install!';
Form1.Label9.Caption:=LocalIP;
Form1.BitBtn4.Enabled:=False;
end;
finally
Dispose(MACAddress);
end;
Except
Form1.Label8.Caption := '未知错误或网卡未接入!';
Form1.Label9.Caption:='0.0.0.0';
Form1.BitBtn4.Enabled:=False;
Exit;
end;

Form1.Label9.Caption:=LocalIP;
Form1.BitBtn4.Enabled:=True;
Application.ProcessMessages;
end;

function TForm1.WinsockEnabled: Bool; //监测TCP IP协议是否安装了
var
wsaData: TWSAData;
begin
result := true;
case Winsock.WSAStartup($0101,wsaData) of
WSAEINVAL, WSASYSNOTREADY, WSAVERNOTSUPPORTED: result := false;
else Winsock.WSACleanup;
end;
end;

{
function TForm1.GetFieldName(var fieldname:array of string;str:string):integer;
//返回特定字段的头标识字
var
word,Data:string;
p,qchar;
i:integer;
begin
Data:=str;
p:=pchar(Data);
q:=strpos(p,'|');
i:=0;
while (q<>nil) do
begin
word:=copy(p,0,q-p);
p:=q+1;
q:=strpos(p,'|');
fieldname:=word;
inc(i);
end;
fieldname:=p;
result:=i+1;
end;
}

function TForm1.GetFieldValue(MSG,CMD:string):string;
//功能：返回指定代码字段的内容传入值：Msg为特定的消息串，Cmd为特定的消息字头, 返回值为消息内容
//例子：<STX>AC|DN1001|CT2|DG0|MO10000|BD1|CN1|<ETX>
//GetFieldValue('AC|DN1001|CT2|DG0|MO10000|BD1|CN1|','|DN')
//返回值为1001

var
P1,P2:integer;
SubStr:string;
begin
SubStr:='';
P1:=pos(CMD,Msg);
SubStr:=copy(Msg,P1+3,strlen(pchar(Msg))-1);
P2:=pos('|',SubStr);
result:=copy(SubStr,1,P2-1);
end;

function Encrypt(const S: String; Key: Word): String;
var
I: byte;
begin
for I := 1 to Length(S) do begin
S := char(byte(S) xor (Key shr 8));
Key := (byte(S) + Key) * C1 + C2;
end;
Result:=S;
end;

function Decrypt(const S: String; Key: Word): String;
var
I: byte;
begin
Result:= S;
for I := 1 to Length(S) do begin
Result := char(byte(S) xor (Key shr 8));
Key := (byte(S) + Key) * C1 + C2;
end;
end;

procedure TForm1.BitBtn31Click(Sender: TObject);
begin
Comm2.StopComm;

Comm2.CommName:=Form4.CN2.Text;
Comm2.BaudRate:=StrToInt(Form4.BR2.Text);

Case StrToInt(Form4.SB2.Text) of
1: Comm2.StopBits:=_1;
2: Comm2.StopBits:=_2;
end;

Case StrToInt(Form4.BS2.Text) of
8: Comm2.ByteSize:=_8;
7: Comm2.ByteSize:=_7;
6: Comm2.ByteSize:=_6;
5: Comm2.ByteSize:=_5;
end;

if Form4.PA2.Text='NONE' then Comm2.Parity:=NONE;
if Form4.PA2.Text='ODD' then Comm2.Parity:=ODD;
if Form4.PA2.Text='EVWN' then Comm2.Parity:=EVEN;
if Form4.PA2.Text='MARK' then Comm2.Parity:=MARK;
if Form4.PA2.Text='SPACE' then Comm2.Parity:=SPACE;
if Comm2.Parity<>NONE then Comm2.ParityCheck:=True;

Comm2.StartComm;
Panel9.Font.Color:=CLLIME;
Panel9.Caption:='端口状态：开启';
BitBtn31.Enabled:=False;
BitBtn32.Enabled:=True;

DSL_T.Enabled:=True;
end;

procedure TForm1.BitBtn32Click(Sender: TObject);
begin
//DSL_T.Enabled:=False;
DSL_MSG_OFF:=True;

Comm2.StopComm;
Panel9.Font.Color:=CLRED;
Panel9.Caption:='端口状态：关闭';

BitBtn31.Enabled:=True;
BitBtn32.Enabled:=False;
end;

function TForm1.SendData1(Len:Integer):Bool;
var
i:Integer;
CommFLG:Boolean;
begin
CommFLG:=True;

Form1.TXP1.Color:=CLRED;
Application.ProcessMessages;

for i:=1 to Len do //Len为发送数据的长度
begin
if not Form1.Comm1.WriteCommData(@SBuf1,1) then
begin
CommFLG:=false;
Break;
end;
Sleep(1); //发送时字节间的延时
end;

TX1:=TX1+Int64(i-1);
Form1.TXP1.Caption:=' TX1: '+IntToStr(TX1);
Form1.TXP1.Color:=CLWhite;
Application.ProcessMessages;

if not CommFLG then
SendData1:=False
else
SendData1:=True;
end;

function TForm1.SendData3(Len:Integer):Bool;
var
i:Integer;
CommFLG:Boolean;
begin
CommFLG:=True;

Form1.TXP3.Color:=CLRED;
Application.ProcessMessages;

for i:=1 to Len do //Len为发送数据的长度
begin
if not Form1.Comm2.WriteCommData(@SBuf3,1) then
begin
CommFLG:=false;
Break;
end;
Sleep(1); //发送时字节间的延时
end;

TX3:=TX3+Int64(i-1);
Form1.TXP3.Caption:=' TX3: '+IntToStr(TX3);
Form1.TXP3.Color:=CLWhite;
Application.ProcessMessages;

if not CommFLG then
SendData3:=False
else
SendData3:=True;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
DECS,HEXS: String;
Msg,Send_Msg:String;
FN:String; //命令参数
i,p: Integer;
RN,GN,RS,DA,TI,GNO,GG,VIP,Free,GUName: String;
TP_MSG,TP:String;
CT,BD,DT:String;
begin
Send_Msg:='';
DECS:='';
HEXS:='';
//接收RS232的数据并显示Memo1上。
Move(Buffer^,RBuf1,BufferLength);

COM_MSG_ON:=True;

RX1:=RX1+BufferLength;
RXP1.Caption:=' RX1: '+IntToStr(RX1);
RXP1.Color:=CLLIME;
Application.ProcessMessages;

For i:=1 to BufferLength do //数据接收过程按照每个字节进行处理
begin
//Sleep(1) //接收延迟
HEXS:=HEXS+inttohex(RBuf1,2)+''; //HEX Disp
DECS:=DECS+Char(RBuf1); //DEC Disp
end;

Memo1.Lines.Add('ComPort Recv '+DateTimeToStr(NOW)+' TXT ---> '+DECS);
Memo1.Lines.Add('ComPort Recv '+DateTimeToStr(NOW)+' HEX ---> '+HEXS);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Recv '+DateTimeToStr(NOW)+' TXT ---> '+DECS+#10); //写入Log文件
Write(LogFile1,'ComPort Recv '+DateTimeToStr(NOW)+' HEX ---> '+HEXS+#10);
Write(LogFile1,'...'+#10);
end;

Application.ProcessMessages;
RXP1.Color:=CLWhite;
Application.ProcessMessages;

//接收数据处理过程
if DECS=NAK then //酒店PABX未接收到正确的消息数据，原消息重新发送
begin
//先对错误的消息回应 ACK 信号
Len1:=1;
SBuf1[1]:=Byte(ACK);
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK But Send ACK Error !!! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK But Send ACK Error !!! '+#10);
Write(LogFile1,'...'+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK Send ACK OK!');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK Send ACK OK!'+#10);
Write(LogFile1,'...'+#10);
end;
end;
//原消息开始重发
//处理COM消息队列数据库
Try
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Text:='Select * from ComPort_Msg where Send_Tag=''T''';
ADOQuery1.Open;
Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到PABX的NAK消息后，无法重新发送原命令消息。');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到PABX的NAK消息后，无法重新发送原命令消息。'+#10);
Write(LogFile1,'...'+#10);
end;
end;

ADOQuery1.First;
While Not ADOQuery1.Eof do
begin
Send_Msg:='';
Send_Msg:=ADOQuery1.FieldByName('MSG').Text;
Len1:=Length(Send_Msg);
Move(Pchar(Send_Msg)^,SBuf1,Len1);
if COM_MSG_OFF=False then
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG Error! '+Send_Msg);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG Error! '+Send_Msg+#10);
Write(LogFile1,'...'+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG OK! '+Send_Msg);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG OK! '+Send_Msg+#10);
Write(LogFile1,'...'+#10);
end;
end;

Application.ProcessMessages;
Sleep(Form3.FlatSpinEditInteger1.Value); //暂停100毫秒
Application.ProcessMessages;

ADOQuery1.Next;
end;
//重发消息结束
ADOQuery1.Close;
//跳出接收函数
exit;
end;

if DECS=EQU then //表明请求发送应答信号
begin
Len1:=1;
SBuf1[1]:=Byte(ACK);
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU But Send ACK Error !!! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU But Send ACK Error !!! '+#10);
Write(LogFile1,'...'+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU Send ACK OK! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU Send ACK OK! '+#10);
Write(LogFile1,'...'+#10);
end;
end;
//跳出接收函数
exit;
end;

if DECS=ACK then //表明数据发送成功，消息列表中消除已经发送成功的一条记录
begin
Len1:=1;
SBuf1[1]:=Byte(ACK);
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK But Send ACK Error !!! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK But Send ACK Error !!! '+#10);
Write(LogFile1,'...'+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK Send ACK Ok! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK Send ACK OK! '+#10);
Write(LogFile1,'...'+#10);
end;
end;
//清除已经正确发送的接口消息
//处理COM消息队列数据库
Try
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Text:='Delete from ComPort_Msg where Send_Tag=''T''';
ADOQuery1.ExecSQL;
Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到PABX的ACK消息后，无法清除原消息队列记录。');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到PABX的ACK消息后，无法清除原消息队列记录。'+#10);
Write(LogFile1,'...'+#10);
end;

end;
//清除已发接口数据结束
//跳出接收函数
exit;
end;

if (Copy(DECS,1,1)=STX)and(Copy(DECS,Length(DECS),1)=ETX) then //酒店PABX消息正确数据封装方式已经被接收
begin
//正确接收到酒店PABX的消息
TP:=DECS;
//可能有重复消息队列要分段处理
repeat
TP:=Copy(DECS,1,POS(ETX,DECS));

Msg:=Pchar(TP);
FN:=copy(Msg,2,2);

RN:='';
GN:='';
RS:='';
DA:='';
TI:='';
GNO:='';
GG:='';
VIP:='';
FREE:='F';

oldDate:=DateToStr(NOW);
oldTime:=TimeToStr(NOW);

LD1 := FormatDateTime('yy', strtoDate(oldDate));
LD2 := FormatDateTime('mm', strtoDate(oldDate));
LD3 := FormatDateTime('dd', strtoDate(oldDate));

LT1 := FormatDateTime('hh', strtoTime(oldTime));
LT2 := FormatDateTime('nn', strtoTime(oldTime));
LT3 := FormatDateTime('ss', strtoTime(oldTime));

DA:=LD1+LD2+LD3;
TI:=LT1+LT2+LT3;

if FN='GI' then //接收到ChickIn信号
begin
P:=pos('|RN',Msg);
if P>0 then
begin
RN:=GetFieldValue(Msg,'|RN');
GN:=GetFieldValue(Msg,'|GN');
GN:=Trim(GN);
GNO:=GetFieldValue(Msg,'|G#');
GG:=GetFieldValue(Msg,'|GG');
VIP:=GetFieldValue(Msg,'|GV');

TP_MSG:='GI|G#'+GNO+'|RN'+RN+'|GN'+GN+'|DA'+DA+'|TI'+TI+'|GG'+GG+'|GD'+DA+'|';

Len1:=1;
SBuf1[1]:=Byte(ACK);
if COM_MSG_OFF=False then
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckIn But Send ACK Error !!! ');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckIn But Send ACK Error !!! '+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckIn Send ACK Ok! ');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckIn Send ACK OK! '+#10);
end;
end;

//HIBS ChinkIn Information <STX>GI|G#|RN|GN|DA|TI|GG|GD|<ETX>
Try
AdoQuery6.SQL.Clear;
AdoQuery6.SQL.Text:='Insert into TcpPort_Msg (Msg,Send_Tag,DT) Values ('+''''+TP_MSG+''''+',''F'','+''''+DateTimeToStr(NOW)+''''+')';
AdoQuery6.ExecSQL;
TCP_MSG_ON:=True;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Save CI To HIBS DataBase RoomNo: '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Save CI To HIBS DataBase RoomNo: '+RN+#10);
end;

Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CI To HIBS DataBase '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CI To HIBS DataBase '+RN+#10);
end;
End;

CT:='1';

if Form4.FlatComboBox1.Text='非预付费卡' then CT:='1';
if Form4.FlatComboBox1.Text='预付费卡，可充值' then CT:='2';
if Form4.FlatComboBox1.Text='预付费卡，不可充值' then CT:='3';

if Form4.FlatComboBox2.Text='绑定' then BD:='1|CN1' else BD:='0|CN'+IntToStr(Form4.FlatSpinEditInteger2.Value);

//ADSL ChickIn Information <STX>AC|DN|CT|DG|MO|BD|CN|<ETX>
TP_MSG:=Form4.FlatEdit1.Text+'|DN'+RN+'|CT'+CT+'|DG'+IntToStr(Form4.FlatSpinEditInteger1.value)+'|M0'+Form4.FlatEdit7.Text+'|BD'+BD+'|';

Try
DSL_Query.SQL.Clear;
DSL_Query.SQL.Text:='Insert into DslPort_Msg (Msg,Send_Tag,DT,FN,RN) Values ('+''''+TP_MSG+''''+',''F'','+''''+DateTimeToStr(NOW)+''''+','+''''+FN+''''+','+''''+RN+''''+')';
DSL_Query.ExecSQL;
DSL_MSG_ON:=True;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Save CI To ADSL DataBase RoomNo: '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Save CI To ADSL DataBase '+RN+#10);
end;

Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CI To ADSL DataBase '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CI To ADSL DataBase '+RN+#10);
end;
End;

Try
if CheckBox1.Checked=True then
if VIP<>'0' then
FREE:='T'
else
FREE:='F'
else
FREE:='F';

GUName:='';
AdoQuery6.SQL.Clear;
AdoQuery6.SQL.Text:='Update RoomInfo set GuestNo='+''''+GNO+''''+',GuestName=:GuName'+',GG='+''''+GG+''''+',State=''I'',Free='+''''+FREE+''''+' where RmNo='+''''+RN+'''';
AdoQuery6.Parameters.ParamByName('GuName').Value:=Copy(GN,1,Length(GN));
AdoQuery6.ExecSQL;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Update RoomInfo DateBase Succeed CI RoomNo: '+RN);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Update RoomInfo DateBase Succeed CI RoomNo: '+RN+#10);
Write(LogFile1,'...'+#10);
end;
Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Update RoomInfo DateBase CI RoomNo: '+RN);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Update RoomInfo DateBase CI RoomNo: '+RN+#10);
Write(LogFile1,'...'+#10);
end;
End;
end;
end;

if FN='GO' then //接收到ChickOut信号
begin
P:=pos('|RN',Msg);
if P>0 then
begin
RN:=GetFieldValue(Msg,'|RN');

TP_MSG:='GO|RN'+RN+'|DA'+DA+'|TI'+TI+'|';

Len1:=1;
SBuf1[1]:=Byte(ACK);
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckOut But Send ACK Error !!! ');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckOut But Send ACK Error !!! '+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckOut Send ACK Ok! ');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv CheckOut Send ACK OK! '+#10);
end;
end;

Try
AdoQuery6.SQL.Clear;
AdoQuery6.SQL.Text:='Insert into TcpPort_Msg (Msg,Send_Tag,DT) Values ('+''''+TP_MSG+''''+',''F'','+''''+DateTimeToStr(NOW)+''''+')';
AdoQuery6.ExecSQL;
TCP_MSG_ON:=True;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Save CO To HIBS DataBase RoomNo: '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Save CO To HIBS DataBase RoomNo: '+RN+#10);
end;
Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CO To HIBS DataBase RoomNo: '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CO To HIBS DataBase RoomNo: '+RN+#10);
end;
End;

DT:='0';
//ADSL ChickOut Information <STX>DC|DT|DN|CN|<ETX>
if Form4.FlatComboBox3.Text='去激活房间所有卡' then
begin
TP_MSG:=Form4.FlatEdit2.Text+'|DT0|DN'+RN+'|';
end
else
begin
//去除原来分配的用户卡号,该功能暂时不用 .
TP_MSG:=Form4.FlatEdit2.Text+'|DT0|DN'+RN+'|';
end;

Try
DSL_Query.SQL.Clear;
DSL_Query.SQL.Text:='Insert into DslPort_Msg (Msg,Send_Tag,DT,FN,RN) Values ('+''''+TP_MSG+''''+',''F'','+''''+DateTimeToStr(NOW)+''''+','+''''+FN+''''+','+''''+RN+''''+')';
DSL_Query.ExecSQL;
DSL_MSG_ON:=True;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Save CO To ADSL DataBase RoomNo: '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Save CO To ADSL DataBase RoomNo: '+RN+#10);
end;
Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CO To ADSL DataBase RoomNo: '+RN);

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Save CO To ADSL DataBase RoomNo: '+RN+#10);
end;
End;

Try
AdoQuery6.SQL.Clear;
AdoQuery6.SQL.Text:='Update RoomInfo set GuestNo='''',GuestName='''',GG='''',State=''O'',Free=''F'' where RmNo='+''''+RN+'''';
AdoQuery6.ExecSQL;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Update RoomInfo DateBase Succeed CO RoomNo: '+RN);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Update RoomInfo DateBase Succeed CO RoomNo: '+RN+#10);
Write(LogFile1,'...'+#10);
end;
Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Update RoomInfo DateBase CO RoomNo: '+RN);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Update RoomInfo DateBase CO RoomNo: '+RN+#10);
Write(LogFile1,'...'+#10);
end;
End;

Try
ADOQuery6.SQL.Clear;
ADOQuery6.SQL.Text:='Delete from DslFee where DN=:TP1';
ADOQuery6.Parameters.ParamByName('TP1').Value:=RN;
ADOQuery6.ExecSQL;

Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Update DslFee DateBase Succeed CO RoomNo: '+RN);
Memo1.Lines.Add('...');
if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Update DslFee DateBase Succeed CO RoomNo: '+RN+#10);
Write(LogFile1,'...'+#10);
end;

Except
Memo1.Lines.Add('ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Update DslFee DateBase CO RoomNo: '+RN);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Info '+DateTimeToStr(NOW)+' *** Can''t Update DslFee DateBase CO RoomNo: '+RN+#10);
Write(LogFile1,'...'+#10);
end;
end;

end;
end;

if FN='LW' then //接收到留言信息
begin
end;

if FN='FO' then //接收到免单信息
begin
end;

if FN='CS' then //接收到客人消费信息
begin
end;

DECS:=Copy(DECS,POS(ETX,DECS)+1,Length(DECS)-POS(ETX,DECS));
until ((POS(ETX,DECS)=Length(DECS)) and (DECS=TP)) or (DECS='');

//消息处理结束
exit;
end;

//如果没有接收到正确的消息，就发送接收错误消息给酒店的PABX
Len1:=1;
SBuf1[1]:=Byte(NAK);
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error But Send NAK Error !!! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error But Send NAK Error !!! '+#10);
Write(LogFile1,'...'+#10);
end;
end
else
begin
Memo1.Lines.Add('ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error Send NAK OK! ');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error Send NAK OK! '+#10);
Write(LogFile1,'...'+#10);
end;
end;
end;

procedure TForm1.BitBtn8Click(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
end;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
RXP3.Caption:=' RX3: 0';
TXP3.Caption:=' TX3: 0';

RX3:=0;
TX3:=0;
end;

procedure TForm1.FormShow(Sender: TObject);
var LockDate,LiceCode,SetDay:String;
LockSystem:Bool;
TTP:String;
begin
LockSystem:=False;
Form5.Edit4.Text:=Trim(StrPas(GetIdeSerialNumber));
Panel3.Height:=(Form1.Height div 3)-10;
Panel4.Height:=(Form1.Height div 3)-10;
Panel7.Height:=(Form1.Height div 3)-10;

//Create File 建立Log文件 ***************
//ListBox1.Items.SaveToFile(ExtractFilePath(Application.EXEName)+'ComPort.LOG');
if FileExists('C:/ComPort.LOG')<>True then
ListBox1.Items.SaveToFile('C:/ComPort.LOG');

if FileExists('C:/TcpPort.LOG')<>True then
ListBox2.Items.SaveToFile('C:/TcpPort.LOG');

if FileExists('C:/DslPort.LOG')<>True then
ListBox3.Items.SaveToFile('C:/DslPort.LOG');
//***************************************
RX1:=0;
TX1:=0;

RX2:=0;
TX2:=0;

RX3:=0;
TX3:=0;

if WinsockEnabled=False then
begin
Application.MessageBox('您的系统没有安装 TCP/IP 通讯协议，程序无法运行！','System Error',MB_OK+MB_ICONWARNING);
Form1.Close;
end;

ShowIP();

AssignFile(LogFile1, 'C:/ComPort.Log');
Append(LogFile1);
AssignFile(LogFile2, 'C:/TcpPort.Log');
Append(LogFile2);
AssignFile(LogFile3, 'C:/DslPort.Log');
Append(LogFile3);

Try
ADOQuery5.SQL.Text:='Select * from Sysinfo';
ADOQuery5.Open;
Except
Application.MessageBox('无法打开系统信息数据库文件。','系统错误',MB_OK+MB_ICONERROR+MB_SYSTEMMODAL );
Application.Terminate;
End;

LockDate:=Trim(ADOQuery5.FieldByName('使用期限').AsString);
LiceCode:=Trim(ADOQuery5.FieldByName('注册码').AsString);
TTP:=Trim(ADOQuery5.FieldByName('当前日期').AsString);
SetDay:=Decrypt(TTP,1234);

Try
if (Now < StrToDate(SetDay)) then
begin
LockSystem:=True;
Application.MessageBox('非法修改系统日期！','系统错误',MB_OK+MB_ICONERROR+MB_SYSTEMMODAL );
end;

if (Now > StrToDate(LockDate)) then
begin
LockSystem:=True;
Application.MessageBox('已经超过使用期限！','系统错误',MB_OK+MB_ICONERROR+MB_SYSTEMMODAL );
end;

if LockSystem=True then
begin
BitBtn2.Click;
BitBtn32.Click;
BitBtn5.Click;
BitBtn1.Enabled:=False;
BitBtn31.Enabled:=False;
BitBtn4.Enabled:=False;
end;
Except
BitBtn2.Click;
BitBtn32.Click;
BitBtn5.Click;
BitBtn1.Enabled:=False;
BitBtn31.Enabled:=False;
BitBtn4.Enabled:=False;
end;

Try
if LockSystem=False then
begin
ADOQuery5.Edit;

oldDate:=DateToStr(NOW);
LD1 := FormatDateTime('yyyy', strtoDate(oldDate));
LD2 := FormatDateTime('mm', strtoDate(oldDate));
LD3 := FormatDateTime('dd', strtoDate(oldDate));
TTP:=(LD1+'-'+LD2+'-'+LD3);
TTP:=Encrypt(TTP,1234);

ADOQuery5.FieldByName('当前日期').AsString:=TTP;
ADOQuery5.Edit;
ADOQuery5.Post;
ADOQuery5.Close;
end;
Except
Application.MessageBox('系统信息数据库文件写入错误！','系统错误',MB_OK+MB_ICONERROR+MB_SYSTEMMODAL );
end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
RXP1.Caption:=' RX1: 0';
TXP1.Caption:=' TX1: 0';

RX1:=0;
TX1:=0;

RXP2.Caption:=' RX2: 0';
TXP2.Caption:=' TX2: 0';

RX2:=0;
TX2:=0;

RXP3.Caption:=' RX3: 0';
TXP3.Caption:=' TX3: 0';

RX3:=0;
TX3:=0;

if SFCB1.Checked=True and BitBtn1.Enabled=False then
begin
Try
Flush(LogFile1);
Except
end;
end;

if SFCB2.Checked=True and BitBtn4.Enabled=False then
begin
Try
Flush(LogFile2);
Except
end;
end;

if SFCB3.Checked=True and BitBtn31.Enabled=False then
begin
Try
Flush(LogFile3);
Except
end;
end;

ListBox1.Clear;
ListBox2.Clear;
ListBox3.Clear;

ListBox1.Items.Add('－－－串口通讯调试程序－－－');
ListBox1.Items.Add(' 以下为数据流水记录 ');
ListBox1.Items.Add('－－－－－－－－－－－－－－－');
ListBox1.Items.Add(' ');

ListBox2.Items.Add('－－－ TCP通讯调试程序－－－');
ListBox2.Items.Add(' 以下为数据流水记录 ');
ListBox2.Items.Add('－－－－－－－－－－－－－－－');
ListBox2.Items.Add(' ');

ListBox3.Items.Add('－－－ ADSL通讯调试程序－－－');
ListBox3.Items.Add(' 以下为数据流水记录 ');
ListBox3.Items.Add('－－－－－－－－－－－－－－－');
ListBox3.Items.Add(' ');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Panel5.Caption<>'端口状态：关闭' then
begin
Action := caNone;
Application.MessageBox('请先关闭PABX COM数据通讯端口!','System Error',MB_OK+MB_ICONWARNING);
exit;
end;

if Panel6.Caption<>'端口状态：关闭' then
begin
Action := caNone;
Application.MessageBox('请先关闭HIBS TCP数据通讯端口!','System Error',MB_OK+MB_ICONWARNING);
exit;
end;

if Panel9.Caption<>'端口状态：关闭' then
begin
Action := caNone;
Application.MessageBox('请先关闭ADSL COM数据通讯端口!','System Error',MB_OK+MB_ICONWARNING);
exit;
end;

if SFCB2.Checked=True then
begin
Try
Flush(LogFile2);
CloseFile(LogFile2);
Except
end;
end;

if SFCB1.Checked=True then
begin
Try
Flush(LogFile1);
CloseFile(LogFile1);
Except
end;
end;

if SFCB3.Checked=True then
begin
Try
Flush(LogFile3);
CloseFile(LogFile3);
Except
end;
end;

end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
Panel6.Font.Color:=CLLIME;
Panel6.Caption:='端口状态：开启';
BitBtn4.Enabled:=False;
BitBtn5.Enabled:=True;

ServerSocket1.Port:=StrToInt(Edit1.Text);
ServerSocket1.Active:=True;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
//关闭通讯前需要发送 LE 通讯结束代码
oldDate:=DateToStr(NOW);
oldTime:=TimeToStr(NOW);

LD1 := FormatDateTime('yy', strtoDate(oldDate));
LD2 := FormatDateTime('mm', strtoDate(oldDate));
LD3 := FormatDateTime('dd', strtoDate(oldDate));

LT1 := FormatDateTime('hh', strtoTime(oldTime));
LT2 := FormatDateTime('nn', strtoTime(oldTime));
LT3 := FormatDateTime('ss', strtoTime(oldTime));

Try
if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+'LE|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|'+ETX);
Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Send LinkEnd');
if SFCB2.Checked=True then
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Send LinkEnd'+#10);

TX2:=TX2+Length(STX+'LE|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|'+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);
Except
TCP_T.Enabled:=False;
ServerSocket1.Close;
end;

Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** Server is ShutDown');
Memo2.Lines.Add(' ... ');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** Server is ShutDown'+#10);
Write(LogFile2,'...'+#10);
end;

TCP_T.Enabled:=False;
ServerSocket1.Active:=False;

Panel6.Font.Color:=CLRED;
Panel6.Caption:='端口状态：关闭';

BitBtn4.Enabled:=True;
BitBtn5.Enabled:=False;

Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
TCP_MSG_OFF:=True;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var TCP_Msg,Send_Msg,TP_MSG:String;
LN:integer;
FN,TP,BT,ET:String;
ChickIn_Out:String;
GN,RN,DA,TI,TA,CT,GName,DT:String;

ED1,ED2,ED3,ET1,ET2,ET3:String;
begin
//处理TCP端口消息
FN:='';
Send_Msg:='';
TP_MSG:='';
ED1:='';
ED2:='';
ED3:='';
ET1:='';
ET2:='';
ET3:='';
//接收到TCP接口消息并显示Memo1上。
TCP_Msg:='';
TCP_Msg:=Socket.ReceiveText;
LN:=Length(TCP_Msg);

RX2:=RX2+Int64(LN);
RXP2.Caption:=' RX2: '+IntToStr(RX2);
RXP2.Color:=CLLIME;
Application.ProcessMessages;

Memo2.Lines.Add('TcpPort Recv '+DateTimeToStr(NOW)+' ---> '+TCP_MSG);
if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Recv '+DateTimeToStr(NOW)+' ---> '+TCP_MSG+#10); //写入Log文件
end;

if (Copy(TCP_MSG,1,1)=STX)and(Copy(TCP_MSG,Length(TCP_MSG),1)=ETX) then //酒店PABX消息正确数据封装方式已经被接收
begin
//正确接收到酒店PABX的消息
TP:=TCP_MSG;
//可能有重复消息队列要分段处理
repeat
TP:=Copy(TCP_MSG,1,POS(ETX,TCP_MSG));
FN:=copy(TP,2,2);

oldDate:=DateToStr(NOW);
oldTime:=TimeToStr(NOW);

LD1 := FormatDateTime('yy', strtoDate(oldDate));
LD2 := FormatDateTime('mm', strtoDate(oldDate));
LD3 := FormatDateTime('dd', strtoDate(oldDate));

LT1 := FormatDateTime('hh', strtoTime(oldTime));
LT2 := FormatDateTime('nn', strtoTime(oldTime));
LT3 := FormatDateTime('ss', strtoTime(oldTime));

if FN='LS' then //接收到LinkStart开始连接信号
begin
TP_MSG:='LA|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|';

Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;
TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+TP_MSG+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv LS Send LA : HIBS Link State Request ... ');
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** HIBS Link State Is Connect... ');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv LS Send LA : HIBS Link State Request ... '+#10);
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** HIBS Link State Is Connect... '+#10);
Write(LogFile2,'...'+#10);
end;
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
end;

if FN='LA' then //接收到LinkAck信号
begin
TP_MSG:='LA|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|';

Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;
TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+TP_MSG+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv LA Send LA');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv LA Send LA'+#10);
Write(LogFile2,'...'+#10);
end;

TCP_T.Enabled:=True; //开始发送消息队列
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
end;

if FN='DR' then //接收到Swap信息
begin
TP_MSG:='DS|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|';
Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' ---> Recv DataBase Sync Request ...');
Memo2.Lines.Add(' ...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' ---> Recv DataBase Sync Request ...'+#10);
Write(LogFile2,' ...'+#10);
end;

TCP_T.Enabled:=False; //停止队列数据库的消息发送

Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;
TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+TP_MSG+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- '+TP_MSG);
Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' **** Starting DataBase Sync ...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- '+TP_MSG+#10);
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' **** Starting DataBase Sync ...'+#10);
end;
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
//================================================================
//开始发送所有房间的状态表
AdoQuery3.SQL.Clear;
AdoQuery3.SQL.Text:='Select * From RoomInfo';
Try
AdoQuery3.Open;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 RoomInfo 数据库 Swap 命令无法执行！');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 RoomInfo 数据库 Swap 命令无法执行！'+#10);
Write(LogFile2,'...'+#10);
end;
end;

ADOQuery3.First;
While Not ADOQuery3.Eof do
begin

oldDate:=DateToStr(NOW);
oldTime:=TimeToStr(NOW);

LD1 := FormatDateTime('yy', strtoDate(oldDate));
LD2 := FormatDateTime('mm', strtoDate(oldDate));
LD3 := FormatDateTime('dd', strtoDate(oldDate));

LT1 := FormatDateTime('hh', strtoTime(oldTime));
LT2 := FormatDateTime('nn', strtoTime(oldTime));
LT3 := FormatDateTime('ss', strtoTime(oldTime));

Send_Msg:='';
ChickIn_Out:='';

if AdoQuery3.FieldByName('State').Text='I' then
begin
ChickIn_Out:='GI';
Send_Msg:=ChickIn_Out+'|G#'+Trim(ADOQuery3.FieldByName('GuestNo').Text)+'|RN'+Trim(ADOQuery3.FieldByName('RmNo').Text)+'|GN'+Trim(ADOQuery3.FieldByName('GuestName').Text)+'|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|GG|GD'+LD1+LD2+LD3+'|';
end
else
begin
ChickIn_Out:='GO';
Send_Msg:=ChickIn_Out+'|RN'+ADOQuery3.FieldByName('RmNo').Text+'|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|';
end;

TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);
Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;

if TCP_MSG_OFF=False then
if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+Send_Msg+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- '+Send_Msg);

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- '+Send_Msg+#10);
end;

Application.ProcessMessages;
Sleep(100); //每条数据在发送时，暂停一秒钟。
Application.ProcessMessages;

ADOQuery3.Next;
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
end;
//消息发送结束
ADOQuery3.Close;
//================================================================
TP_MSG:='DE|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|';

Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;
TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+TP_MSG+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- '+TP_MSG);
Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' **** DataBase Sync End ... ');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' ---> '+TP_MSG+#10);
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' **** DataBase Sync End ... '+#10);
end;

TCP_T.Enabled:=True; //重新启动队列数据库的消息发送
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
end;

if FN='PS' then //接收到Posting费用信息
begin
//写入费用明细数据库
//TCP_MSG消息
if pos('|G#',TCP_MSG)>0 then
begin
GN:='';
GN:=GetFieldValue(TCP_MSG,'|G#');
end;
if pos('|RN',TCP_MSG)>0 then
begin
RN:='';
RN:=GetFieldValue(TCP_MSG,'|RN');
end;
if pos('|DA',TCP_MSG)>0 then
begin
DA:='';
DA:=GetFieldValue(TCP_MSG,'|DA');
end;
if pos('|TI',TCP_MSG)>0 then
begin
TI:='';
TI:=GetFieldValue(TCP_MSG,'|TI');
end;
if pos('|TA',TCP_MSG)>0 then
begin
TA:='';
TA:=Trim(GetFieldValue(TCP_MSG,'|TA'));
end;
if pos('|CT',TCP_MSG)>0 then
begin
CT:='';
CT:=GetFieldValue(TCP_MSG,'|CT');
end;
if pos('|BT',TCP_MSG)>0 then
begin
BT:='';
BT:=GetFieldValue(TCP_MSG,'|BT');
end;
if pos('|ET',TCP_MSG)>0 then
begin
ET:='';
ET:=GetFieldValue(TCP_MSG,'|ET');
end;

//读入设置窗口的数据
if Form6.Edit1.Text<>'' then
begin
// BT:=DateTimeToStr(StrToDateTime(BT)+(StrTofloat(Form6.Edit1.Text)/86400));
TA:=FloatToStr(StrtoFloat(TA)-StrToFloat(Form6.Edit2.text));
end;

TP_MSG:='';
TP_MSG:='PA|G#'+GN+'|RN'+RN+'|ASOK|DA'+DA+'|TI'+TI+'|';

Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;
TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+TP_MSG+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- '+TP_MSG);
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- '+TP_MSG+#10);
Write(LogFile2,'...'+#10);
end;

GName:='';

Try
AdoQuery3.SQL.Clear;
AdoQuery3.SQL.Text:='Select * from RoomInfo where RmNo='+''+RN+'';
AdoQuery3.Open;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 RoomInfo 数据库。');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 RoomInfo 数据库。'+#10);
Write(LogFile2,'...'+#10);
end;
end;

if AdoQuery3.RecordCount =1 then
begin
if ((AdoQuery3.FieldByName('State').AsString='I') and (AdoQuery3.FieldByName('Free').AsString='F')) then //在住客，不免费
begin
GName:=AdoQuery3.FieldByName('GuestName').AsString;

DT:='';
DT:='Insert into RmCharge (System,RmNo,GuestNo,TotalAmount,StartTime,EndTime,MiscInfo,Free,Lost,DT) Values ('+''''+'HIBS'+''''+','+''''+RN+''''+','+''''+GN+''''+','+''''+TA+''''+','+''''+BT+''''+','+''''+ET+''''+','+''''+CT+''''+','+'''F'',''F'','+''''+DateTimeToStr(Now)+''''+')';

Try
AdoQuery7.SQL.Clear;
AdoQuery7.SQL.Text:=DT;
AdoQuery7.ExecSQL;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 RmCharge 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA));
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 RmCharge 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA)+#10);
Write(LogFile2,'...'+#10);
end;

end;

if CheckBox3.Checked=False then //是否发送计费消息
begin
TP_MSG:='';
DEPTCODE:=EDIT2.Text;
// 入帐特定代码字符串 = 'DEPTCODE|RoomNo| Internet Fee |2003-02-01 13:00:00|2003-02-02 13:01:01|140.50';
TP_MSG:=DEPTCODE+'|'+RN+'| Internet Fee |'+BT+'|'+ET+'|'+TA+'|';

Try
AdoQuery7.SQL.Clear;
AdoQuery7.SQL.Text:='Insert into ComPort_Msg (MSG,Send_TAG,DT) Values ('+''''+TP_MSG+''''+',''F'','+''''+DateTimeToStr(Now)+''''+')';
AdoQuery7.ExecSQL;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA));
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA)+#10);
Write(LogFile2,'...'+#10);
end;
end;
COM_MSG_ON:=True;
end;
end;

if ((AdoQuery3.FieldByName('State').AsString='I') and (AdoQuery3.FieldByName('Free').AsString='T')) then //在住免费客人
begin
GName:=AdoQuery3.FieldByName('GuestName').AsString;

Try
AdoQuery7.SQL.Clear;
AdoQuery7.SQL.Text:='Insert into RmCharge (System,RmNo,GuestNo,TotalAmount,StartTime,EndTime,MiscInfo,Free,Lost,DT) Values ('+''''+'HIBS'+''''+','+''''+RN+''''+','+''''+GN+''''+','+''''+TA+''''+','+''''+BT+''''+','+''''+ET+''''+','+''''+CT+''''+','+'''T'',''F'','+''''+DateTimeToStr(Now)+''''+')';
AdoQuery7.ExecSQL;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 RmCharge 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA));
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 RmCharge 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA)+#10);
Write(LogFile2,'...'+#10);
end;
end;

end;

if (AdoQuery3.FieldByName('State').AsString='O') then //非在住客人
begin
GName:=AdoQuery3.FieldByName('GuestName').AsString;
Try
AdoQuery7.SQL.Clear;
AdoQuery7.SQL.Text:='Insert into RmCharge (System,RmNo,GuestNo,TotalAmount,StartTime,EndTime,MiscInfo,Free,Lost,DT) Values ('+''''+'HIBS'+''''+','+''''+RN+''''+','+''''+GN+''''+','+''''+TA+''''+','+''''+BT+''''+','+''''+ET+''''+','+''''+CT+''''+','+'''F'',''T'','+''''+DateTimeToStr(Now)+''''+')';
AdoQuery7.ExecSQL;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 RmCharge 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA));
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，计费信息无法写入 RmCharge 数据库房号为 '+Pchar(RN)+' 金额为 '+Pchar(TA)+#10);
Write(LogFile2,'...'+#10);
end;
end;
end;
end;

if AdoQuery3.RecordCount < 1 then
begin
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，RoomInfo 数据库中不存在房号为 '+Pchar(RN)+' 的房间！');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，RoomInfo 数据库中不存在房号为 '+Pchar(RN)+' 的房间！'+#10);
Write(LogFile2,'...'+#10);
end;
end;

if AdoQuery3.RecordCount > 1 then
begin
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，RoomInfo 数据库中已经存在房号为 '+Pchar(RN)+' 的房间！');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误！，RoomInfo 数据库中已经存在房号为 '+Pchar(RN)+' 的房间！'+#10);
Write(LogFile2,'...'+#10);
end;
end;

AdoQuery3.Close;
end;

if FN='LE' then //接收到LinkEnd结束连接信号
begin
TCP_T.Enabled:=False;
TP_MSG:='LE|DA'+LD1+LD2+LD3+'|TI'+LT1+LT2+LT3+'|';

Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;
TX2:=TX2+Length(STX+TP_MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

if TCP_MSG_OFF=False then
if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+TP_MSG+ETX);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv LE Send LE');
Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' **** HIBS connent is Link End ');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv LE Send LE'+#10);
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' **** HIBS connent is Link End '+#10);
Write(LogFile2,'...'+#10);
end;
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
end;

TCP_MSG:=Copy(TCP_MSG,POS(ETX,TCP_MSG)+1,Length(TCP_MSG)-POS(ETX,TCP_MSG));
until ((POS(ETX,TCP_MSG)=Length(TCP_MSG)) and (TCP_MSG=TP)) or (TCP_MSG='');

//消息处理结束
Application.ProcessMessages;
TXP2.Color:=CLWHITE;
Application.ProcessMessages;
RXP2.Color:=CLWhite;
Application.ProcessMessages;
exit;
end;

//如果没有接收到正确的消息，就发送接收错误消息给酒店的PABX
if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+NAK+ETX);
TX2:=TX2+Length(STX+NAK+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);
Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv Error Send NAK');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Recv Error Send NAK'+#10);
end;
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;
end;

procedure TForm1.ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Server is Accept HIBS Request.');
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'HIBS IP Addr :'+Socket.RemoteAddress);
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'HIBS IP Port :'+IntToStr(Socket.RemotePort));

Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Server is Accept HIBS Request.'+#10); //写入Log文件
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'HIBS IP Addr :'+Socket.RemoteAddress+#10);
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'HIBS IP Port :'+IntToStr(Socket.RemotePort)+#10);
Write(LogFile2,'...'+#10); //写入Log文件
end;

end;

procedure TForm1.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Start Interface to HIBS.');
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Client is Listenning.');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Start Interface to HIBS.'+#10); //写入Log文件
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Client is Listenning.'+#10);
Write(LogFile2,'...'+#10);
end;
end;

procedure TForm1.BitBtn9Click(Sender: TObject);
begin
RXP2.Caption:=' RX2: 0';
TXP2.Caption:=' TX2: 0';

RX2:=0;
TX2:=0;
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Connect Success to HIBS.');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Connect Success to HIBS.'+#10); //写入Log文件
end;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
TCP_T.Enabled:=False;
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Client is Disconnent.');
Memo2.Lines.Add('');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** '+'Client is Disconnent.'+#10); //写入Log文件
Write(LogFile2,''+#10); //写入Log文件
end;
end;

procedure TForm1.BitBtn12Click(Sender: TObject);
begin
Form2.ShowModal;
end;

procedure TForm1.TCP_TTimer(Sender: TObject);
var MSG:String;
begin
if TCP_MSG_ON=True then
begin
TCP_T.Enabled:=False;
Try
ADOTCP.SQL.Clear;
ADOTCP.SQL.Text:='Select * from TcpPort_Msg where Send_Tag=''F''';
ADOTCP.Open;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 TcpPort_Msg 数据库。');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 TcpPort_Msg 数据库。'+#10);
Write(LogFile2,'...'+#10);
end;
end;

ADOTCP.First;

While Not ADOTCP.Eof do
begin
MSG:='';
MSG:=trim(ADOTCP.FieldByName('MSG').AsString);

Try
if TCP_MSG_OFF=False then
if ServerSocket1.Socket.ActiveConnections>0 then
ServerSocket1.Socket.Connections[0].SendText(STX+MSG+ETX);
Form1.TXP2.Color:=CLRED;
Application.ProcessMessages;

TX2:=TX2+Length(STX+MSG+ETX);
TXP2.Caption:=' TX2: '+IntToStr(TX2);

Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Send '+MSG);
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Send '+MSG+#10); //写入Log文件
Write(LogFile2,'...'+#10);
end;
Except
Memo2.Lines.Add('TcpPort Send '+DateTimeToStr(NOW)+' <--- Can''t Send '+MSG);
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Send '+DateTimeToStr(NOW)+' <--- Can''t Send '+MSG+#10); //写入Log文件
Write(LogFile2,'...'+#10);
end;
End;

Application.ProcessMessages;
Sleep(100); //每条数据在发送时，暂停一秒钟。
Application.ProcessMessages;

ADOTCP.Next;
end;

Try
DEL_TCPMSG.SQL.Clear;
DEL_TCPMSG.SQL.Text:='Delete from TcpPort_Msg';
DEL_TCPMSG.ExecSQL;
Except
Memo2.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，不能更新 TcpPort_Msg 数据库的 Send_Tag 标记。');
Memo2.Lines.Add('...');

if SFCB2.Checked=True then
begin
Write(LogFile2, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，不能更新 TcpPort_Msg 数据库的 Send_Tag 标记。'+#10);
Write(LogFile2,'...'+#10);
end;
End;
TCP_T.Enabled:=True;
TCP_MSG_ON:=False;
end;
Form1.TXP2.Color:=CLWHITE;
Application.ProcessMessages;

end;

procedure TForm1.COM_TTimer(Sender: TObject);
var MSG:String;
begin
if COM_MSG_ON=True then
begin
COM_T.Enabled:=False;
Try
ADOCOM.SQL.Clear;
ADOCOM.SQL.Text:='Select * from ComPort_Msg where Send_Tag=''F''';
ADOCOM.Open;
Except
Memo1.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 ComPort_Msg 数据库。');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 ComPort_Msg 数据库。'+#10);
Write(LogFile1,'...'+#10);
end;
end;

ADOCOM.First;

While Not ADOCOM.Eof do
begin
MSG:='';
MSG:=Trim(ADOCOM.FieldByName('MSG').AsString);

Len1:=Length(STX+MSG+ETX);
Move(Pchar(STX+MSG+ETX)^,SBuf1,Len1);

if COM_MSG_OFF=False then
if SendData1(Len1)=False then //调用发送函数
begin
Memo1.Lines.Add('ComPort POST '+DateTimeToStr(NOW)+' TXT **** Can''t POST '+MSG);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort POST '+DateTimeToStr(NOW)+' TXT **** Can''t POST '+MSG+#10);
Write(LogFile1,'...'+#10);
end;
end
else
begin

TX1:=TX1+Len1;
TXP1.Caption:=' TX1: '+IntToStr(TX1);

Memo1.Lines.Add('ComPort POST '+DateTimeToStr(NOW)+' TXT **** POST '+MSG);
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1,'ComPort POST '+DateTimeToStr(NOW)+' TXT **** POST '+MSG+#10);
Write(LogFile1,'...'+#10);
end;
end;

Application.ProcessMessages;
Sleep(Form3.FlatSpinEditInteger1.Value); //每条数据在发送时，暂停一秒钟。
Application.ProcessMessages;

ADOCOM.Next;
end;

Try
ADOCOM.SQL.Clear;
ADOCOM.SQL.Text:='Update ComPort_Msg set Send_Tag=''T''';
ADOCOM.ExecSQL;
Except
Memo1.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，不能更新 ComPort_Msg 数据库的 Send_Tag 标记。');
Memo1.Lines.Add('...');

if SFCB1.Checked=True then
begin
Write(LogFile1, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，不能更新 ComPort_Msg 数据库的 Send_Tag 标记。'+#10);
Write(LogFile1,'...'+#10);
end;
end;
COM_T.Enabled:=True;
COM_MSG_ON:=False;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Panel3.Height:=Form1.Height div 3;
Panel4.Height:=Form1.Height div 3;
Panel7.Height:=Form1.Height div 3;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Comm1.StopComm;

Comm1.CommName:=Form3.CN1.Text;
Comm1.BaudRate:=StrToInt(Form3.BR1.Text);

Case StrToInt(Form3.SB1.Text) of
1: Comm1.StopBits:=_1;
2: Comm1.StopBits:=_2;
end;

Case StrToInt(Form3.BS1.Text) of
8: Comm1.ByteSize:=_8;
7: Comm1.ByteSize:=_7;
6: Comm1.ByteSize:=_6;
5: Comm1.ByteSize:=_5;
end;

if Form3.PA1.Text='NONE' then Comm1.Parity:=NONE;
if Form3.PA1.Text='ODD' then Comm1.Parity:=ODD;
if Form3.PA1.Text='EVWN' then Comm1.Parity:=EVEN;
if Form3.PA1.Text='MARK' then Comm1.Parity:=MARK;
if Form3.PA1.Text='SPACE' then Comm1.Parity:=SPACE;
if Comm1.Parity<>NONE then Comm1.ParityCheck:=True;

Comm1.StartComm;
Panel5.Font.Color:=CLLIME;
Panel5.Caption:='端口状态：开启';
BitBtn1.Enabled:=False;
BitBtn2.Enabled:=True;
COM_T.Enabled:=TRUE;

end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
COM_T.Enabled:=False;
COM_MSG_OFF:=True;

Comm1.StopComm;
Panel5.Font.Color:=CLRED;
Panel5.Caption:='端口状态：关闭';

BitBtn1.Enabled:=True;
BitBtn2.Enabled:=False;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
Form3.ShowModal;
end;

procedure TForm1.BitBtn33Click(Sender: TObject);
begin
Form4.ShowModal;
end;

procedure TForm1.BitBtn10Click(Sender: TObject);
begin
Form5.ShowModal;
end;

procedure TForm1.BitBtn15Click(Sender: TObject);
begin
RXP1.Caption:=' RX1: 0';
TXP1.Caption:=' TX1: 0';

RX1:=0;
TX1:=0;
end;

procedure TForm1.DSL_TTimer(Sender: TObject);
var MSG:String;
begin
if DSL_MSG_ON=True then
begin
DSL_T.Enabled:=False;
Try
DSLCOM.SQL.Clear;
DSLCOM.SQL.Text:='Select * from DSLPort_Msg where Send_Tag=''F''';
DSLCOM.Open;
Except
Memo3.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 DSLPort_Msg 数据库。');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，无法打开 DSLPort_Msg 数据库。'+#10);
Write(LogFile3,'...'+#10);
end;
end;

DSLCOM.First;

While Not DSLCOM.Eof do
begin
MSG:='';
MSG:=Trim(DSLCOM.FieldByName('MSG').AsString);

Len3:=Length(STX+MSG+ETX);
Move(Pchar(STX+MSG+ETX)^,SBuf3,Len3);

if DSL_MSG_OFF=False then
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Can''t Send '+MSG);
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Can''t Send '+MSG+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin

TX3:=TX3+Len3;
TXP3.Caption:=' TX3: '+IntToStr(TX3);

Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Send '+MSG);
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Send '+MSG+#10);
Write(LogFile3,'...'+#10);
end;
end;

Application.ProcessMessages;
Sleep(Form4.FlatSpinEditInteger4.Value); //每条数据在发送时，暂停一秒钟。
Application.ProcessMessages;

DSLCOM.Next;
end;

Try
DSLCOM.SQL.Clear;
DSLCOM.SQL.Text:='Update DslPort_Msg set Send_Tag=''T''';
DSLCOM.ExecSQL;
Except
Memo3.Lines.Add('System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，不能更新 DslPort_Msg 数据库的 Send_Tag 标记。');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3, 'System Info '+DateTimeToStr(NOW)+' TXT **** 操作接口数据库错误，不能更新 DslPort_Msg 数据库的 Send_Tag 标记。'+#10);
Write(LogFile3,'...'+#10);
end;
end;
DSL_T.Enabled:=True;
DSL_MSG_ON:=False;
end;
end;

procedure TForm1.Comm2ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
DECS,HEXS: String;
Msg,Send_Msg:String;
FN:String; //命令参数
i,p: Integer;
RN,RT: String;
TP,CPT,CN:String;
DN,BT,ET,LS,TNP,ET1,ET2,BT1,BT2:String;
TotalFee:real;
TP_MSG:String;
begin
Send_Msg:='';
DECS:='';
HEXS:='';

//接收RS232的数据并显示Memo1上。
Move(Buffer^,RBuf3,BufferLength);

RX3:=RX3+BufferLength;
RXP3.Caption:=' RX3: '+IntToStr(RX3);
RXP3.Color:=CLLIME;
Application.ProcessMessages;

For i:=1 to BufferLength do //数据接收过程按照每个字节进行处理
begin
//Sleep(1) //接收延迟
HEXS:=HEXS+inttohex(RBuf3,2)+''; //HEX Disp
DECS:=DECS+Char(RBuf3); //DEC Disp
end;

Memo3.Lines.Add('DslPort Recv '+DateTimeToStr(NOW)+' TXT ---> '+DECS);
Memo3.Lines.Add('DslPort Recv '+DateTimeToStr(NOW)+' HEX ---> '+HEXS);
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Recv '+DateTimeToStr(NOW)+' TXT ---> '+DECS+#10); //写入Log文件
Write(LogFile3,'DslPort Recv '+DateTimeToStr(NOW)+' HEX ---> '+HEXS+#10);
Write(LogFile3,'...'+#10);
end;

Application.ProcessMessages;
RXP3.Color:=CLWhite;
Application.ProcessMessages;

//接收数据处理过程
if DECS=NAK then //酒店PABX未接收到正确的消息数据，原消息重新发送
begin
//先对错误的消息回应 ACK 信号
Len3:=1;
SBuf3[1]:=Byte(ACK);
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK But Send ACK Error !!! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK But Send ACK Error !!! '+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK Send ACK OK!');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv NAK Send ACK OK!'+#10);
Write(LogFile3,'...'+#10);
end;
end;
//原消息开始重发
//处理COM消息队列数据库
Try
ADOQuery4.SQL.Clear;
ADOQuery4.SQL.Text:='Select * from DslPort_Msg where Send_Tag=''T''';
ADOQuery4.Open;
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到ADSL的NAK消息后，无法重新发送原命令消息。');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到ADSL的NAK消息后，无法重新发送原命令消息。'+#10);
Write(LogFile3,'...'+#10);
end;
end;

ADOQuery4.First;
While Not ADOQuery4.Eof do
begin
Send_Msg:='';
Send_Msg:=ADOQuery4.FieldByName('MSG').Text;
Len3:=Length(Send_Msg);
Move(Pchar(Send_Msg)^,SBuf3,Len3);
if DSL_MSG_OFF=False then
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG Error! '+Send_Msg);
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG Error! '+Send_Msg+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG OK! '+Send_Msg);
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Send MSG OK! '+Send_Msg+#10);
Write(LogFile3,'...'+#10);
end;
end;

Application.ProcessMessages;
Sleep(Form4.FlatSpinEditInteger4.Value); //暂停100毫秒
Application.ProcessMessages;

ADOQuery4.Next;
end;
//重发消息结束
ADOQuery4.Close;
//跳出接收函数
exit;
end;

if DECS=EQU then //表明请求发送应答信号
begin
Len3:=1;
SBuf3[1]:=Byte(ACK);
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU But Send ACK Error !!! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU But Send ACK Error !!! '+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU Send ACK OK! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv EQU Send ACK OK! '+#10);
Write(LogFile3,'...'+#10);
end;
end;
//跳出接收函数
exit;
end;

if DECS=ACK then //表明数据发送成功，消息列表中消除已经发送成功的一条记录
begin
Len3:=1;
SBuf3[1]:=Byte(ACK);
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK But Send ACK Error !!! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK But Send ACK Error !!! '+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK Send ACK Ok! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv ACK Send ACK OK! '+#10);
Write(LogFile3,'...'+#10);
end;
end;
exit;
end;

if (Copy(DECS,1,1)=STX)and(Copy(DECS,Length(DECS)-2,1)=ETX) then //酒店PABX消息正确数据封装方式已经被接收消息中有$0D$0A 回车换行
begin
//正确接收到酒店PABX的消息
TP:=DECS;
//可能有重复消息队列要分段处理
repeat
TP:=Copy(DECS,1,POS(ETX,DECS));

Msg:=Pchar(Copy(TP,2,Length(TP)-2));
FN:=copy(Msg,1,2);

RN:='';
RT:='';

if FN='AR' then //接收到ChickIn信号
begin
P:=pos('|RT',Msg);
if P>0 then
begin

RN:=GetFieldValue(Msg,'|DN');
RT:=GetFieldValue(Msg,'|RT');
CN:=GetFieldValue(Msg,'|CN');

if CN='' then CN:='0';
CPT:='';

Try
ADOQuery4.SQL.Clear;
ADOQuery4.SQL.Text:='Delete from DslPort_Msg where Send_Tag=''T'' and FN=:FN and RN=:RN ';
ADOQuery4.Parameters.ParamByName('FN').Value:='AC';
ADOQuery4.Parameters.ParamByName('RN').Value:=RN;
ADOQuery4.ExecSQL;

Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到ADSL接口AR消息，更新 DslPort_Msg 消息数据库成功房号为：'+RN+' 申请卡号：'+CN+' 张');
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到ADSL接口AR消息，更新 DslPort_Msg 消息数据库成功房号为：'+RN+' 申请卡号：'+CN+' 张'+#10);
Write(LogFile3,'...'+#10);
end;

Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到ADSL的AR消息后，无法清除原消息队列记录。');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到ADSL的AR消息后，无法清除原消息队列记录。'+#10);
Write(LogFile3,'...'+#10);
end;
end;

case StrToInt(RT) of
10: CPT := '操作成功';
11: CPT := '数据库操作失败';
12: CPT := '输入参数非法';
13: CPT := '群不存在';
14: CPT := '房间不存在';
15: CPT := '服务等级不存在';
16: CPT := '基本费率不存在';
17: CPT := '该房间已经有唯一用户与之绑定，不能再激活卡号';
18: CPT := '该房间已经有用户分配了卡号，不能再进行唯一绑定房间的操作';
19: CPT := '没有空闲卡可以分配';
20: CPT := '房间已分配的卡号数已经达到了额定限额，不能再激活卡号';
30: CPT := '酒店接口错误';
else
CPT := '未知错误';
end;

if CPT<>'' then
begin
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** ADSL 接口操作错误！，接收到ADSL的错误消息为 : '+CPT );
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** ADSL 接口操作错误！，接收到ADSL的错误消息为 : '+CPT+#10);
Write(LogFile3,'...'+#10);
end;
end;
end;
end;

if FN='DR' then //接收到ChickOut信号
begin
P:=pos('|RT',Msg);
if P>0 then
begin
RT:=GetFieldValue(Msg,'|RT');

CPT:='';

Try
ADOQuery4.SQL.Clear;
ADOQuery4.SQL.Text:='Delete from DslPort_Msg where Send_Tag=''T'' and FN=:FN ';
ADOQuery4.Parameters.ParamByName('FN').Value:='DC';
ADOQuery4.ExecSQL;

Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 DR 消息！，更新 DslPort_Msg 消息数据库成功 ');
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 DR 消息！，更新 DslPort_Msg 消息数据库成功 ');
Write(LogFile3,'...'+#10);
end;

Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到 ADSL 的 DR 消息后，无法清除原消息队列记录。');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到 ADSL 的 DR 消息后，无法清除原消息队列记录。'+#10);
Write(LogFile3,'...'+#10);
end;
end;

case StrToInt(RT) of
10: CPT := '操作成功';
11: CPT := '数据库操作失败';
12: CPT := '输入参数非法';
13: CPT := '群不存在';
14: CPT := '房间不存在';
17: CPT := '卡号不存在';
18: CPT := '该房间未发行卡';
19: CPT := '去激活卡号失败，原因为该卡不是该房间的分配卡';
30: CPT := '酒店接口错误';
else
CPT := '未知错误';
end;

if CPT<>'' then
begin
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** ADSL 接口操作错误！，接收到ADSL的错误消息为 : '+CPT );
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** ADSL 接口操作错误！，接收到ADSL的错误消息为 : '+CPT+#10);
Write(LogFile3,'...'+#10);
end;
end;

end;
end;

if FN='SB' then //接收到话单
begin
//<STX>SB|DN1001|CN1001|BT2001/05/08,09:49:08|ET2001/05/09,09:49:08|FL240000|CT0|FS1000|FP10|FE2400|LS657|<ETX>
DN:=GetFieldValue(Msg,'|DN');
CN:=GetFieldValue(Msg,'|CN');
BT:=GetFieldValue(Msg,'|BT');
ET:=GetFieldValue(Msg,'|ET');
LS:=GetFieldValue(Msg,'|LS');
//计费信息需要写入COMPort_Msg数据库

if Form4.FlatComboBox4.Text='是' then //按天入帐的情况
begin
if ADODslFee.Active=True then ADODslFee.Active:=False;
Try
ADODslFee.SQL.Clear;
ADODslFee.SQL.Text:='Select * from DslFee where DT Like :TP1 and DN=:TP2 and Fee<>''0.00''';
ADODslFee.Parameters.ParamByName('TP1').Value:=DatetoStr(Now)+'%';
ADODslFee.Parameters.ParamByName('TP2').Value:=DN;
ADODslFee.Open;

if ADODslFee.RecordCount=0 then
begin //按天计费的当天第一条记录
Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into DslFee (LS,DN,BT,ET,CN,TA,TM,FEE,DT,BC,ABA,MP,DP,TP,PERDAY,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12,:TP13,:TP14,:TP15,:TP16)';
//转换开始时间的日期格式
ET1:=Copy(ET,1,POS(',',ET)-1);
ET2:=Copy(ET,POS(',',ET)+1,Length(ET)-POS(',',ET));
ET1:=Copy(ET1,1,4)+'-'+Copy(ET1,6,2)+'-'+Copy(ET1,9,2);
ET:=ET1+' '+ET2;
//转换结束时间的日期格式
BT1:=Copy(BT,1,POS(',',BT)-1);
BT2:=Copy(BT,POS(',',BT)+1,Length(BT)-POS(',',BT));
BT1:=Copy(BT1,1,4)+'-'+Copy(BT1,6,2)+'-'+Copy(BT1,9,2);
BT:=BT1+' '+BT2;

ADOTP.Parameters.ParamByName('TP1').Value:=LS;
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=BT;
ADOTP.Parameters.ParamByName('TP4').Value:=ET;
ADOTP.Parameters.ParamByName('TP5').Value:=CN;
ADOTP.Parameters.ParamByName('TP6').Value:=Form4.FlatEdit3.Text;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP9').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP10').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP11').Value:='F';
ADOTP.Parameters.ParamByName('TP12').Value:=Form4.FlatEdit6.Text;
ADOTP.Parameters.ParamByName('TP13').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP14').Value:=Form4.FlatEdit4.Text;
ADOTP.Parameters.ParamByName('TP15').Value:='T';
ADOTP.Parameters.ParamByName('TP16').Value:='按天计费的当天第一条记录，按天计费费率为：'+Form4.FlatEdit3.Text;
ADOTP.ExecSQL;
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，更新 DslFee 临时帐务数据库成功房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，更新 DslFee 临时帐务数据库成功房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
End;

Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into Rmcharge (System,RmNo,TotalAmount,ChargeFee,StartTime,EndTime,MiscInfo,Free,Lost,ABA,DT,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12)';
ADOTP.Parameters.ParamByName('TP1').Value:='ADSL';
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP4').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP5').Value:=BT;
ADOTP.Parameters.ParamByName('TP6').Value:=ET;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:='F';
ADOTP.Parameters.ParamByName('TP9').Value:='F';
ADOTP.Parameters.ParamByName('TP10').Value:='F';
ADOTP.Parameters.ParamByName('TP11').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP12').Value:='按天计费的当天第一条记录，按天计费费率为：'+Form4.FlatEdit3.Text;
ADOTP.ExecSQL;

Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，更新 RoomCharge 帐务数据库成功房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，更新 RoomCharge 帐务数据库成功房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
End;

//入帐特定代码字符串 = 'DEPTCODE|RoomNo| Internet Fee |2003-02-01 13:00:00|2003-02-02 13:01:01|140.50';
TP_MSG:=Edit3.Text+'|'+DN+'| Internet Fee |'+BT+'|'+ET+'|'+Format('%0.2f',[Form4.FlatEdit3.Text])+'|';

if DSLTP.Active=True then DSLTP.Active:=False;
DSLTP.SQL.Text:='Insert into ComPort_Msg (MSG,Send_Tag,DT) Values TP1,:TP2,:TP3)';
DSLTP.Parameters.ParamByName('TP1').Value:=TP_MSG;
DSLTP.Parameters.ParamByName('TP2').Value:='F';
DSLTP.Parameters.ParamByName('TP3').Value:=DateTimeToStr(Now);
Try
DSLTP.ExecSQL;
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(DN)+' 金额为 '+Form4.FlatEdit3.Text);
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(DN)+' 金额为 '+Form4.FlatEdit3.Text+#10);
Write(LogFile3,'...'+#10);
end;
end;
COM_MSG_ON:=True;
end
else
begin //按天计费的非当天第一条记录，写入标记位ABA，同时写入Memo。
Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into DslFee (LS,DN,BT,ET,CN,TA,TM,FEE,DT,BC,ABA,MP,DP,TP,PERDAY,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12,:TP13,:TP14,:TP15,:TP16)';
//转换开始时间的日期格式
ET1:=Copy(ET,1,POS(',',ET)-1);
ET2:=Copy(ET,POS(',',ET)+1,Length(ET)-POS(',',ET));
ET1:=Copy(ET1,1,4)+'-'+Copy(ET1,6,2)+'-'+Copy(ET1,9,2);
ET:=ET1+' '+ET2;
//转换结束时间的日期格式
BT1:=Copy(BT,1,POS(',',BT)-1);
BT2:=Copy(BT,POS(',',BT)+1,Length(BT)-POS(',',BT));
BT1:=Copy(BT1,1,4)+'-'+Copy(BT1,6,2)+'-'+Copy(BT1,9,2);
BT:=BT1+' '+BT2;

ADOTP.Parameters.ParamByName('TP1').Value:=LS;
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=BT;
ADOTP.Parameters.ParamByName('TP4').Value:=ET;
ADOTP.Parameters.ParamByName('TP5').Value:=CN;
ADOTP.Parameters.ParamByName('TP6').Value:=Form4.FlatEdit3.Text;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:='0.00';
ADOTP.Parameters.ParamByName('TP9').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP10').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP11').Value:='T';
ADOTP.Parameters.ParamByName('TP12').Value:=Form4.FlatEdit6.Text;
ADOTP.Parameters.ParamByName('TP13').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP14').Value:=Form4.FlatEdit4.Text;
ADOTP.Parameters.ParamByName('TP15').Value:='T';
ADOTP.Parameters.ParamByName('TP16').Value:='按天计费的非当天第一条记录，放弃入帐，按天计费费率为：'+Form4.FlatEdit3.Text;
ADOTP.ExecSQL;
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按天计费已有话单此话单放弃，写入 DslFee 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按天计费已有话单此话单放弃，写入 DslFee 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
End;

Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into Rmcharge (System,RmNo,TotalAmount,ChargeFee,StartTime,EndTime,MiscInfo,Free,Lost,ABA,DT,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12)';
ADOTP.Parameters.ParamByName('TP1').Value:='ADSL';
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP4').Value:='0.00';
ADOTP.Parameters.ParamByName('TP5').Value:=BT;
ADOTP.Parameters.ParamByName('TP6').Value:=ET;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:='F';
ADOTP.Parameters.ParamByName('TP9').Value:='F';
ADOTP.Parameters.ParamByName('TP10').Value:='T';
ADOTP.Parameters.ParamByName('TP11').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP12').Value:='按天计费的非当天第一条记录，放弃入帐，按天计费费率为：'+Form4.FlatEdit3.Text;
ADOTP.ExecSQL;

Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按天计费已有话单此话单放弃，写入 RoomCharge 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按天计费已有话单此话单放弃，写入 RoomCharge 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
End;
end;
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到 ADSL 的 SB 消息后，无法打开 DslFee 临时帐务数据库。');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到 ADSL 的 SB 消息后，无法打开 DslFee 临时帐务数据库。'+#10);
end;
end;
end
else
begin //不是按天入帐的情况
if ADODslFee.Active=True then ADODslFee.Active:=False;
Try
ADODslFee.SQL.Clear;
ADODslFee.SQL.Text:='Select * from DslFee where DT Like :TP1 and DN=:TP2';
ADODslFee.Parameters.ParamByName('TP1').Value:=DatetoStr(Now)+'%';
ADODslFee.Parameters.ParamByName('TP2').Value:=DN;
ADODslFee.Open;
TotalFee:=0;

if ADODslFee.RecordCount=0 then
begin
Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into DslFee (LS,DN,BT,ET,CN,TA,TM,FEE,DT,BC,ABA,MP,DP,TP,PERDAY,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12,:TP13,:TP14,:TP15,:TP16)';
ADOTP.Parameters.ParamByName('TP1').Value:=LS;
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=BT;
ADOTP.Parameters.ParamByName('TP4').Value:=ET;
ADOTP.Parameters.ParamByName('TP5').Value:=CN;
ADOTP.Parameters.ParamByName('TP6').Value:=Form4.FlatEdit5.Text;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:='0.00';
ADOTP.Parameters.ParamByName('TP8').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP9').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP10').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP11').Value:='F';
ADOTP.Parameters.ParamByName('TP12').Value:=Form4.FlatEdit6.Text;
ADOTP.Parameters.ParamByName('TP13').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP14').Value:=Form4.FlatEdit4.Text;
ADOTP.Parameters.ParamByName('TP15').Value:='F';
ADOTP.Parameters.ParamByName('TP16').Value:='按时间计费的记录，当天的起步价为：'+Form4.FlatEdit5.Text;
ADOTP.ExecSQL;
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，当天的起步价，写入 DslFee 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，当天的起步价，写入 DslFee 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
End;

Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into Rmcharge (System,RmNo,TotalAmount,ChargeFee,StartTime,EndTime,MiscInfo,Free,Lost,ABA,DT,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12)';
ADOTP.Parameters.ParamByName('TP1').Value:='ADSL';
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP4').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP5').Value:=BT;
ADOTP.Parameters.ParamByName('TP6').Value:=ET;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:='0.00';
ADOTP.Parameters.ParamByName('TP8').Value:='F';
ADOTP.Parameters.ParamByName('TP9').Value:='F';
ADOTP.Parameters.ParamByName('TP10').Value:='F';
ADOTP.Parameters.ParamByName('TP11').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP12').Value:='按时间计费的记录，当天的起步价为：'+Form4.FlatEdit5.Text;
ADOTP.ExecSQL;

Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，当天的起步价，写入 RoomCharge 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，当天的起步价，写入 RoomCharge 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
End;

//入帐特定代码字符串 = 'DEPTCODE|RoomNo| Internet Fee |2003-02-01 13:00:00|2003-02-02 13:01:01|140.50';
TP_MSG:=Edit3.Text+'|'+DN+'| Internet Fee |'+BT+'|'+ET+'|'+Format('%0.2f',[Form4.FlatEdit5.Text])+'|';

if DSLTP.Active=True then DSLTP.Active:=False;
DSLTP.SQL.Text:='Insert into ComPort_Msg (MSG,Send_Tag,DT) Values TP1,:TP2,:TP3)';
DSLTP.Parameters.ParamByName('TP1').Value:=TP_MSG;
DSLTP.Parameters.ParamByName('TP2').Value:='F';
DSLTP.Parameters.ParamByName('TP3').Value:=DateTimeToStr(Now);
Try
DSLTP.ExecSQL;
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(DN)+' 金额为 '+Form4.FlatEdit5.Text);
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(DN)+' 金额为 '+Form4.FlatEdit5.Text+#10);
Write(LogFile3,'...'+#10);
end;
end;
COM_MSG_ON:=True;

end;
Try
while Not ADODslFee.Eof do
begin
TotalFee:=TotalFee+StrToFloat(ADODslFee.FieldByName('Fee').AsString);
ADODslFee.Next;
end;
Except
TotalFee:=0;
End;

if TotalFee<StrToFloat(Form4.FlatEdit4.Text) then
begin
Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into DslFee (LS,DN,BT,ET,CN,TA,TM,FEE,DT,BC,ABA,MP,DP,TP,PERDAY,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12,:TP13,:TP14,:TP15,:TP16)';
//转换开始时间的日期格式
ET1:=Copy(ET,1,POS(',',ET)-1);
ET2:=Copy(ET,POS(',',ET)+1,Length(ET)-POS(',',ET));
ET1:=Copy(ET1,1,4)+'-'+Copy(ET1,6,2)+'-'+Copy(ET1,9,2);
ET:=ET1+' '+ET2;
//转换结束时间的日期格式
BT1:=Copy(BT,1,POS(',',BT)-1);
BT2:=Copy(BT,POS(',',BT)+1,Length(BT)-POS(',',BT));
BT1:=Copy(BT1,1,4)+'-'+Copy(BT1,6,2)+'-'+Copy(BT1,9,2);
BT:=BT1+' '+BT2;

ADOTP.Parameters.ParamByName('TP1').Value:=LS;
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=BT;
ADOTP.Parameters.ParamByName('TP4').Value:=ET;
ADOTP.Parameters.ParamByName('TP5').Value:=CN;
ADOTP.Parameters.ParamByName('TP6').Value:=Format('%0.0f',[(StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)]);
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);

if (StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)<StrToFloat(Form4.FlatEdit4.Text)-TotalFee then
ADOTP.Parameters.ParamByName('TP8').Value:=Format('%0.0f',[(StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)])
else
ADOTP.Parameters.ParamByName('TP8').Value:=FloatToStr(StrToFloat(Form4.FlatEdit4.Text)-TotalFee);

ADOTP.Parameters.ParamByName('TP9').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP10').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP11').Value:='F';
ADOTP.Parameters.ParamByName('TP12').Value:=Form4.FlatEdit6.Text;
ADOTP.Parameters.ParamByName('TP13').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP14').Value:=Form4.FlatEdit4.Text;
ADOTP.Parameters.ParamByName('TP15').Value:='F';
ADOTP.Parameters.ParamByName('TP16').Value:='按时间计费的记录，每天的封顶价为：'+Form4.FlatEdit4.Text;
ADOTP.ExecSQL;
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费写入 DslFee 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费写入 DslFee 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
End;

Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into Rmcharge (System,RmNo,TotalAmount,ChargeFee,StartTime,EndTime,MiscInfo,Free,Lost,ABA,DT,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12)';
ADOTP.Parameters.ParamByName('TP1').Value:='ADSL';
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=Format('%0.0f',[(StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)]);

if (StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)<StrToFloat(Form4.FlatEdit4.Text)-TotalFee then
ADOTP.Parameters.ParamByName('TP4').Value:=Format('%0.0f',[(StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)])
else
ADOTP.Parameters.ParamByName('TP4').Value:=FloatToStr(StrToFloat(Form4.FlatEdit4.Text)-TotalFee);

ADOTP.Parameters.ParamByName('TP5').Value:=BT;
ADOTP.Parameters.ParamByName('TP6').Value:=ET;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:='F';
ADOTP.Parameters.ParamByName('TP9').Value:='F';
ADOTP.Parameters.ParamByName('TP10').Value:='F';
ADOTP.Parameters.ParamByName('TP11').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP12').Value:='按时间计费的记录，每天的封顶价为：'+Form4.FlatEdit4.Text;
ADOTP.ExecSQL;

Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费写入 RoomCharge 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费写入 RoomCharge 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
End;

//入帐特定代码字符串 = 'DEPTCODE|RoomNo| Internet Fee |2003-02-01 13:00:00|2003-02-02 13:01:01|140.50';
TP_MSG:=Edit3.Text+'|'+DN+'| Internet Fee |'+BT+'|'+ET+'|'+Format('%0.2f',[ADOTP.Parameters.ParamByName('TP4').Value])+'|';

if DSLTP.Active=True then DSLTP.Active:=False;
DSLTP.SQL.Text:='Insert into ComPort_Msg (MSG,Send_Tag,DT) Values TP1,:TP2,:TP3)';
DSLTP.Parameters.ParamByName('TP1').Value:=TP_MSG;
DSLTP.Parameters.ParamByName('TP2').Value:='F';
DSLTP.Parameters.ParamByName('TP3').Value:=DateTimeToStr(Now);
Try
DSLTP.ExecSQL;
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(DN)+' 金额为 '+Form4.FlatEdit5.Text);
Memo3.Lines.Add('...');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，计费信息无法写入 ComPort_Msg 数据库房号为 '+Pchar(DN)+' 金额为 '+Form4.FlatEdit5.Text+#10);
Write(LogFile3,'...'+#10);
end;
end;
COM_MSG_ON:=True;

end
else
begin
Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into DslFee (LS,DN,BT,ET,CN,TA,TM,FEE,DT,BC,ABA,MP,DP,TP,PERDAY,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12,:TP13,:TP14,:TP15,:TP16)';
//转换开始时间的日期格式
ET1:=Copy(ET,1,POS(',',ET)-1);
ET2:=Copy(ET,POS(',',ET)+1,Length(ET)-POS(',',ET));
ET1:=Copy(ET1,1,4)+'-'+Copy(ET1,6,2)+'-'+Copy(ET1,9,2);
ET:=ET1+' '+ET2;
//转换结束时间的日期格式
BT1:=Copy(BT,1,POS(',',BT)-1);
BT2:=Copy(BT,POS(',',BT)+1,Length(BT)-POS(',',BT));
BT1:=Copy(BT1,1,4)+'-'+Copy(BT1,6,2)+'-'+Copy(BT1,9,2);
BT:=BT1+' '+BT2;

ADOTP.Parameters.ParamByName('TP1').Value:=LS;
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=BT;
ADOTP.Parameters.ParamByName('TP4').Value:=ET;
ADOTP.Parameters.ParamByName('TP5').Value:=CN;
ADOTP.Parameters.ParamByName('TP6').Value:=Format('%0.0f',[(StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)]);
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:='0.00';
ADOTP.Parameters.ParamByName('TP9').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP10').Value:=Form4.FlatEdit5.Text;
ADOTP.Parameters.ParamByName('TP11').Value:='T';
ADOTP.Parameters.ParamByName('TP12').Value:=Form4.FlatEdit6.Text;
ADOTP.Parameters.ParamByName('TP13').Value:=Form4.FlatEdit3.Text;
ADOTP.Parameters.ParamByName('TP14').Value:=Form4.FlatEdit4.Text;
ADOTP.Parameters.ParamByName('TP15').Value:='F';
ADOTP.Parameters.ParamByName('TP16').Value:='按时间计费的记录，已经超过封顶价放弃入帐，每天的封顶价为：'+Form4.FlatEdit4.Text;
ADOTP.ExecSQL;
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，已经超过封顶价放弃入帐，写入 DslFee 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，已经超过封顶价放弃入帐，写入 DslFee 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 DslFee 临时帐务数据库 ');
End;

Try
ADOTP.SQL.Clear;
ADOTP.SQL.Text:='Insert into Rmcharge (System,RmNo,TotalAmount,ChargeFee,StartTime,EndTime,MiscInfo,Free,Lost,ABA,DT,Memo) ValuesTP1,:TP2,:TP3,:TP4,:TP5,:TP6,:TP7,:TP8,:TP9,:TP10,:TP11,:TP12)';
ADOTP.Parameters.ParamByName('TP1').Value:='ADSL';
ADOTP.Parameters.ParamByName('TP2').Value:=DN;
ADOTP.Parameters.ParamByName('TP3').Value:=Format('%0.0f',[(StrToFloat(Form4.FlatEdit6.Text)*(StrToDateTime(ET)-StrToDateTime(BT))*24*60)]);
ADOTP.Parameters.ParamByName('TP4').Value:='0.00';
ADOTP.Parameters.ParamByName('TP5').Value:=BT;
ADOTP.Parameters.ParamByName('TP6').Value:=ET;
//计算使用时长,时长标准为秒
ADOTP.Parameters.ParamByName('TP7').Value:=Format('%0.0f',[(StrToDateTime(ET)-StrToDateTime(BT))*24*60*60]);
ADOTP.Parameters.ParamByName('TP8').Value:='F';
ADOTP.Parameters.ParamByName('TP9').Value:='F';
ADOTP.Parameters.ParamByName('TP10').Value:='T';
ADOTP.Parameters.ParamByName('TP11').Value:=DateTimeToStr(Now);
ADOTP.Parameters.ParamByName('TP12').Value:='按时间计费的记录，已经超过封顶价放弃入帐，每天的封顶价为：'+Form4.FlatEdit4.Text;
ADOTP.ExecSQL;
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，已经超过封顶价放弃入帐，写入 RoomCharge 数据库成功，房号：'+DN);
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 按时间计费，已经超过封顶价放弃入帐，写入 RoomCharge 数据库成功，房号：'+DN);
Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
if SFCB3.Checked=True then Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 收到 ADSL 接口 SB 消息！，无法更新 RoomCharge 帐务数据库 ');
End;
end;

Except
Memo3.Lines.Add('DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到 ADSL 的 SB 消息后，无法打开 DslFee 临时帐务数据库。');
if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Info '+DateTimeToStr(NOW)+' *** 操作接口数据库错误！，接收到 ADSL 的 SB 消息后，无法打开 DslFee 临时帐务数据库。'+#10);
end;
End;
end;

//需要消息回应 <STX>SR|LS|<ETX>
TNP:=STX+'SR|LS'+LS+'|'+ETX;
Len3:=Length(TNP);
Move(Pchar(TNP)^,SBuf3,Len3);
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv SB But Send SR Error !!! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv SB But Send SR Error !!! '+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv SB Send SR OK !');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv SB But Send SR OK ! '+#10);
Write(LogFile3,'...'+#10);
end;
end;
end;

DECS:=Copy(DECS,POS(ETX,DECS)+2,Length(DECS)-POS(ETX,DECS)-2);
until ((POS(ETX,DECS)=Length(DECS)-2) and (DECS=TP)) or (DECS='');

//消息处理结束
exit;
end;

//如果没有接收到正确的消息，就发送接收错误消息给酒店的PABX
Len3:=1;
SBuf3[1]:=Byte(NAK);
if SendData3(Len3)=False then //调用发送函数
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error But Send NAK Error !!! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error But Send NAK Error !!! '+#10);
Write(LogFile3,'...'+#10);
end;
end
else
begin
Memo3.Lines.Add('DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error Send NAK OK! ');
Memo3.Lines.Add('...');

if SFCB3.Checked=True then
begin
Write(LogFile3,'DslPort Send '+DateTimeToStr(NOW)+' TXT <--- Recv Error Send NAK OK! '+#10);
Write(LogFile3,'...'+#10);
end;
end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var X,Y : integer;
begin
X:=Comm1.GetModemState;
Y:=Comm2.GetModemState;

if X=0 then Label1.Caption:='脱机' else Label1.Caption:='联机';
if Y=0 then Label2.Caption:='脱机' else Label2.Caption:='联机';

end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo2.Lines.Add('TcpPort Info '+DateTimeToStr(NOW)+' **** Socket Error >>> '+IntToStr(ErrorCode));

if SFCB2.Checked=True then
begin
Write(LogFile2,'TcpPort Info '+DateTimeToStr(NOW)+' **** Socket Error >>> '+IntToStr(ErrorCode)+#10); //写入Log文件
end;

ErrorCode:=0;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
Form6.ShowModal;
end;

end.

tonyliu · 2006-05-08

多人接受答案了。

用pcomm的高手请帮帮忙。(100分)

tonyliu

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

Mike1234567890

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

41426277

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

网中戏

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

kaoleoloi

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

阿九

Unregistered / Unconfirmed

天道酬勤

Unregistered / Unconfirmed

lxw5214

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

天使屁屁猪

Unregistered / Unconfirmed

tonyliu

Unregistered / Unconfirmed

Similar threads