用pcomm的高手请帮帮忙。 找傻瓜进销存破解
财务软件版1楼: 最近在写一个门禁系统，没什么经验，用的是RS485做通信，打算用pcomm操作串口传接下位机数据，不知哪位大哥有这方面的经验，给在下指点一二，或者给各源代码做参考。
我还打算系统可以支持udp和RS485两种方式。欢迎有经验的朋友给与帮助，谢谢！
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^[I] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
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[I])));
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,q:pchar;
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[i]:=word;
inc(i);
end;
fieldname[i]:=p;
result:=i+1;
end;
}
function TForm1.GetFieldValue(MSG,CMD:string):string;
//功能：返回指定代码字段的内容 传入值：Msg为特定的消息串，Cmd为特定的消息字头, 返回值为消息内容
//例子：AC|DN1001|CT2|DG0|MO10000|BD1|CN1|
//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[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(S[I]) + 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[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(S[I]) + 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[i],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[i],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[i],2)+＇＇＇＇; //HEX Disp
DECS:=DECS+Char(RBuf1[i]); //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 InformationGI|G#|RN|GN|DA|TI|GG|GD|
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 InformationAC|DN|CT|DG|MO|BD|CN|
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 InformationDC|DT|DN|CN|
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[i],2)+＇＇＇＇; //HEX Disp
DECS:=DECS+Char(RBuf3[i]); //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
//SB|DN1001|CN1001|BT2001/05/08,09:49:08|ET2001/05/09,09:49:08|FL240000|CT0|FS1000|FP10|FE2400|LS657|
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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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
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) Values(:TP1,: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) 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) Values(:TP1,: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) 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) Values(:TP1,: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) Values(:TP1,: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;
//需要消息回应SR|LS|
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.
我还打算系统可以支持udp和RS485两种方式。欢迎有经验的朋友给与帮助，谢谢！
2楼: 自己顶一下
如果有代码请帮忙发送到sirusoft@hotmail.com,谢谢！ 如管家婆软件教程
3楼: 呵呵，这个应该不难
你把485当作是232好了
4楼: 我也知道是这样,但没有用过pcomm，听说这个动态库比较好。
5楼: 我都做过
下啦机
/
1.电脑232->485->下啦机
＼
下啦机
2.电脑UDP(或TCP)->422设备->232(或再到->485)->下啦机
6楼: To:41426277兄，你用的是什么控件操作串口
能否给我发一份源码供我参考？sirusoft@hotmail.com
不胜感激！
财务软件版7楼: 欢迎讨论。分不够再加！
8楼: 同行啊！我们也是做门禁的。
9楼: To:网中戏，能否交流一下？QQ:39913823
10楼: 自己再顶!
11楼: 帮顶！
╭=========================================╮
80G海量源代码,控件，书籍全免费狂下不停！
http://www.source520.com
个人网站站长开发推广同盟，让所有人知道你的世界！
http://www.source520.com/search/search.asp
╰=========================================╯
12楼: 怎么没人来拿分呢？大富翁们都哪去了？ 如傻瓜进销存破解
13楼: spComm也不错
财务软件版14楼: 直接引用pcomm.pas就可以了。
15楼: 我使用spcomm操作串口，网上有很多例子
16楼: TO：lxw5214哪里有好的例子，我找了好久没找到
17楼: 几年以前写的程序，你可以参考看看。
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^[I] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
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[I])));
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,q:pchar;
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[i]:=word;
inc(i);
end;
fieldname[i]:=p;
result:=i+1;
end;
}
function TForm1.GetFieldValue(MSG,CMD:string):string;
//功能：返回指定代码字段的内容 传入值：Msg为特定的消息串，Cmd为特定的消息字头, 返回值为消息内容
//例子：
//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[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(S[I]) + 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[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(S[I]) + 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[i],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[i],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[i],2)+＇＇＇＇; //HEX Disp
DECS:=DECS+Char(RBuf1[i]); //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
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
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
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[i],2)+＇＇＇＇; //HEX Disp
DECS:=DECS+Char(RBuf3[i]); //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
//
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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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) Values(:TP1,: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
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) Values(:TP1,: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)
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) Values(:TP1,: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)
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) Values(:TP1,: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) Values(:TP1,: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;
//需要消息回应
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.
18楼: 多人接受答案了。
联系我们
