急！spcomm串口通信，发出命令后接受不到下位机返回的数据，大家帮我看看把！(100分)

蚂蚁根 · 2006-02-24

波特率：2400
数据位：8位
停止位：1位
校验：无
波特率设置正常，运行编译正常，串口打开正常，发送也应该正常，但接受不到数据，用串口调试助手调试，通信没问题，现代码如下：
var
Form1: TForm1;
strsend,RESTR: string;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
comm1.StopComm;
end;

procedure TForm1.Button1Click(Sender: TObject);
//var
// strsend : string;

begin
if trim(edit_send.text)<>''then
begin
strsend := trim(edit_send.text);
comm1.WriteCommData(pchar(strsend),length(strsend));
showmessage(strsend);
end;

end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
i: integer;
rbuf: string;
begin
REstr := '';
setlength(rbuf,bufferlength);

move(buffer^,pchar(@rbuf)^,bufferlength);
for i:=1 to bufferlength do
REstr:=RESTR+rbuf+'';
showmessage(REstr);
memo1.Lines.Add(REstr);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
comm1.startcomm;
end;

end.

sbzldlb · 2006-02-24

有接设备吗？

jamcky · 2006-02-24

你可以在下面设置断点调测一下,看看能不能进入接收，若进入了，就是你的接受部分有问题，若没有，则应该是串口设置部分出问题：

REstr := '';
setlength(rbuf,bufferlength); <------ stop

move(buffer^,pchar(@rbuf)^,bufferlength);
for i:=1 to bufferlength do
REstr:=RESTR+rbuf+'';
showmessage(REstr);
memo1.Lines.Add(REstr);

41426277 · 2006-02-24

是不是下拉机有什么格式协议之类的问题

蚂蚁根 · 2006-02-24

硬件规范:
波特率 ……. ： 2400 bps
数据长度 ……. ： 8 bits
停止位 ……. ： 1 bit
奇偶检验 ……. ：无
1．状态查询
上位机指令：Q1
分组号组1
字节数 2 1
内容 Q1 <CR>

UPS返回信息：
分组号组1 组2 组3
字节数 1 5 1 5 1 5 1
内容 0x28 输入电压值 <SP> I/Pfault voltage <SP> 输出电压值 <SP>

组4 组5 组6 组7 组8
3 1 4 1 4 1 4 1 8
输出电流值 <SP> 输入频率 <SP> 电池电压 <SP> 温度 <SP> UPS状态
这是通信协议，大家看看，我得代码有错吗？我总觉得，是通信协议和转换的问题，是吗？

蚂蚁根 · 2006-02-24

回复jamcky
调试了，进入了，接下来应该怎么作亚？我没看出接受那里错了？

zhlfdm · 2006-02-24

那是接受字符显示不出来，变成16进制的吧

Mike1234567890 · 2006-02-24

有两点注意：
1.设置串口时注意一定要用预定义的常量来设置，不要使用数字
2.和设备实际通讯时有可能会发生通讯不上的情况，原因可是时序不匹配，多等一会儿就应该行了

中鼎 · 2006-02-24

发送事件：
Comm_Min.StopComm;
Comm_Min.StartComm;
Sleep(20);
Comm_Min.WriteCommData(PChar(StrSend_Min),10);
接收：
if Buffer <> nil then
begin
Move(Buffer^,arrReceive,BufferLength);
for i:=1 to 8 do
begin
Str:=Str+inttohex(arrReceive,2);
end;

godelphi2004 · 2006-02-25

这样定义错了：
rbuf: string;
这样没有分配内存空间，换成这样即可：
rbuf: array[0..255] of Char;

蚂蚁根 · 2006-02-25

这么多人的答案我都试过，但还是没有数据被接收，请那位高手完整的将程序告诉我，谢谢
着急呀！
注意：与下位机的通信绝对没问题，我用串口助手调试通信过

zxy666666 · 2006-02-25

同意godelphi2004

ggscw · 2006-02-25

在你发送的报文后面加一个 #13 或是 #10 试试。。。。

N久没写程序了，不一定合适

不过我接过一个测试仪就是这种问题！！！

lxw5214 · 2006-02-25

move(buffer^,rbuf,bufferlength);
调试时先看看rbuf中有没有值；另外，串口反应速度慢，发送指令后需要延时100ms左右再去取数据。如果还不行，等周一我回公司把我调试成功的代码贴出来

lxw5214 · 2006-02-25

我用9600时延时100ms，你用2400,可能还要延长

WUSUBAR · 2006-02-25

发出应该有什么30h 之类的信号提示吧接受后也会返回一个信号的是不是没有按照串口协议来呢？

maxim88 · 2006-02-27

楼主留个信箱吧，给你个例子

jokedj · 2006-02-27

procedure RS232_WRITE(B0,B1,B2,B3,CMD:BYTE);
VAR BUF:ARRAY[0..6] OF BYTE;
NOF

WORD;
BEGIN
BUF[0]:=1;
BUF[1]:=1;
BUF[2]:=1;
BUF[3]:=1;
BUF[4]:=1;
BUF[5]:=1;
BUF[6]:=1;
WriteFile(hComm,BUF,7,NOF,NIL);
END;
procedure RS232_READ;
VAR T: BYTE;
D: DWORD;
Nof : DWORD;
Q: BOOL;
I: INTEGER;
BEGIN
Q:=FALSE;
T:=0;
WHILE NOT Q DO
BEGIN
ReadFile(hComm,T,1,NOF,NIL);
IF NOF=0 THEN Q:=TRUE;
END;
END;

FUNCTION EnumComPorts:String;
var KeyHandle: HKEY;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
begin
RegOpenKeyEx(HKEY_LOCAL_MACHINE,'HARDWARE/DEVICEMAP/SERIALCOMM',0,KEY_READ,KeyHandle);
ValueLen:= 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
RegEnumValue(KeyHandle,0,PChar(ValueName),Cardinal(ValueLen),nil,@ValueType,PByte(PChar(Data)),@DataLen);
SetLength(Data, DataLen);
RESULT:=Data;
RegCloseKey(KeyHandle);
end;

procedure OpenCom(COM1:STRING);
Var cb:dcb;
TimeOut:COMMTIMEOUTS;
begin
hComm:=CreateFile(PCHAR(COM1),Generic_Read OR Generic_Write, 0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
if hComm = INVALID_HANDLE_VALUE then
begin
Showmessage('RS-232開啟錯誤');
CloseHandle(hcomm);
exit;
end;
GetCommState(hComm,cb);
cb.BaudRate :=CBR_4800;//設定鮑率為4800
cb.ByteSize :=8;
cb.Parity :=NOPARITY;//設定為偶同位EVENPARITY
cb.StopBits :=ONESTOPBIT;//設定一個停止位元
SetCommState(hComm,cb);
SetupComm(hcomm,1024,1024);
TimeOut.ReadIntervalTimeout := 10;
TimeOut.ReadTotalTimeoutMultiplier := 0;
TimeOut.ReadTotalTimeoutConstant := 500; //(總讀取 time out 時間 = 5 秒)
TimeOut.WriteTotalTimeoutMultiplier:= 0;
TimeOut.WriteTotalTimeoutConstant := 500; //(總寫入 time out 時間 = 5 秒)
SetCommTimeouts(hComm,TimeOut);
end;

還有不懂再問吧

天使屁屁猪 · 2006-03-01

几年以前写过的程序，没有心思改动了，你就自己看看吧，使用的是SPCOMM控件。

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.

蚂蚁根 · 2006-03-07

谢谢大家

急！spcomm串口通信，发出命令后接受不到下位机返回的数据，大家帮我看看把！(100分)

蚂蚁根

Unregistered / Unconfirmed

sbzldlb

Unregistered / Unconfirmed

jamcky

Unregistered / Unconfirmed

41426277

Unregistered / Unconfirmed

蚂蚁根

Unregistered / Unconfirmed

蚂蚁根

Unregistered / Unconfirmed

zhlfdm

Unregistered / Unconfirmed

Mike1234567890

Unregistered / Unconfirmed

中鼎

Unregistered / Unconfirmed

godelphi2004

Unregistered / Unconfirmed

蚂蚁根

Unregistered / Unconfirmed

zxy666666

Unregistered / Unconfirmed

ggscw

Unregistered / Unconfirmed

lxw5214

Unregistered / Unconfirmed

lxw5214

Unregistered / Unconfirmed

WUSUBAR

Unregistered / Unconfirmed

maxim88

Unregistered / Unconfirmed

jokedj

Unregistered / Unconfirmed

天使屁屁猪

Unregistered / Unconfirmed

蚂蚁根

Unregistered / Unconfirmed

Similar threads