Summary of Delphi socket communication programming

// Add some practical functions first

// Hexadecimal to integer, which is often used in Message decoding

Function hextoint (stemp: string): integer;
VaR
V, I: integer;
Begin
Hextoint: = 0;
If stemp = ''then exit;
If (stemp [1] = '0') and (stemp [2] = 'X') or (stemp [2] = 'X') then
Stemp: = copy (stemp, 3, length (stemp)-2 );
If stemp = ''then exit;

V: = 0;
For I: = 1 to length (stemp) Do
Case stemp [I]
'0' .. '9': V: = V * 16 + ord (stemp [I])-ord ('0 ');
'A' .. 'F': V: = V * 16 + ord (stemp [I])-ord ('A') + 10;
'A' .. 'F': V: = V * 16 + ord (stemp [I])-ord ('A') + 10;
End;
Hextoint: = V;
End;

// Functions that convert BCD codes and strings. These two functions are almost essential.
// Convert the BCD code to a string

Function bcd2str (P: pchar; POs, Len: integer): string;
VaR
I: integer;
Strresult: string;
Cread: byte;
Creadh, creadl: byte;
Bodd: Boolean;
Begin
Strresult: = '';
If (LEN mod 2) = 1 then
Begin
Len: = (LEN + 1) Div 2;
Bodd: = true;
End else begin
Len: = Len Div 2;
Bodd: = false;
End;
For I: = 0 to Len-1 do
Begin
Cread: = ord (P [POS + I]);
Creadh: = (cread and $ f0) SHR 4;
Strresult: = strresult + inttohex (creadh, 1 );
If (I = Len-1) and bodd then continue;
Creadl: = cread and $ 0f;
Strresult: = strresult + inttohex (creadl, 1 );
End;
Bcd2str: = strresult;
End;

// Convert string to BCD code

Function str2bcd (STR: string): string;
VaR
I, Bytes: byte;
Odd: Boolean;
HEX: string;
Begin
Result: = '';
Odd: = length (STR) mod 2 = 1;
Bytes: = (length (STR) + 1) Div 2;
If odd then STR: = STR + '0 ';
For I: = 0 to bytes-1 do
Begin
HEX: = copy (STR, I * 2 + 1, 2 );
Result: = Result + CHR (hextoint (HEX ));
End;
End;

// Messages are often assembled in socket communication programming. Therefore, the Use Frequency of the move function is very high. Normally, the closed structure is directly moved to a buffer, however, in some cases, we want to move an integer value to a field in the message. When using the move function, you will find that the low position is in the front, and the high position is in the back, which is exactly the opposite of what we want. There is no problem with using this function.

Procedure moveint (size: byte; const value; var BUF );
VaR
Hex, bufstr: string;
Begin
HEX: = inttohex (INTEGER (value), size * 2 );
Bufstr: = str2bcd (HEX );
Move (bufstr [1], Buf, length (bufstr ));
End;

// Generally, the communication program we write runs in a LAN with the network condition approaching the ideal state. Therefore, you can directly use the socket at the receiving end. receivebuf collects a whole message. The structure definition of the message is not very important at this time. However, if the software we write needs to communicate with each other over the Internet, at this time, the definition of the message structure is very important, because the transmission of messages on the Internet is not as smooth as that on the LAN, and the receiving end may need to receive a complete message multiple times before it can be fully received.

// For example, if the sender uses the sendbuf method to send a message whose content is '000000', the receiver may first receive '000000' in receivebuf and then receive '000000' in receivebuf '. At this time, you must clearly define the message header and end, And the transcoding method of the message data area. The program must have a message cache to record the previously received byte stream. Then, after receiving the byte stream again, it tries to detect the end of the message and assemble it into a complete message. If the message cannot be assembled, the message is discarded without further processing.

// The following code implements the assembly process.

Const
Msg_head = # $ Fe;
Msg_tail = # $ EF;
Msg_trsf = # $ FD;
CFD = # $ FD;
CFE = # $ Fe;
CEF = # $ EF;
Cfdflag = # $00;
Cfeflag = # $01;
Cefflag = # $02;

VaR
Cachebuf: array [0 .. 255] of char // global message Cache
Bmsgstart: Boolean; // The start flag of the message.
Bmsgend: Boolean; // message end flag bit
Buflen: integer; // current message length

Procedure someprocedure;
VaR
I: integer;
Begin
Frecvlen: = fsock. cancelength;
Fmsgbuf: = #0;
Fsock. receivebuf (fmsgbuf, frecvlen );
While I <frecvlen do
Begin
If fmsgbuf [I] = msg_head then
Begin
Bmsgstart: = true;
Bmsgend: = false;
Cachebuf: = #0;
Buflen: = 0;
End else if fmsgbuf [I] = msg_tail then
Bmsgend: = true;
If bmsgstart then
Begin
If fmsgbuf [I] <> msg_trsf then
Move (fmsgbuf [I], cachebuf [buflen], 1)
Else begin
Case fmsgbuf [I + 1]
Cfdflag: cachebuf [buflen]: = CFD;
Cfeflag: cachebuf [buflen]: = CFE;
Cefflag: cachebuf [buflen]: = Cef;
End;
INC (I );
End;
INC (buflen );
End;
If bmsgstart and bmsgend then
Begin
// Processmsg; add specific message processing here
Bmsgstart: = false;
End;
INC (I );
End;
End;

// When sending a message, We Need To transcode the message data area to convert the same bytes in the data area and at the end of the message header to other bytes, enable the program to differentiate the real message header and Message end.

// The following functions implement Transcoding

Type
Tsysmsgbuf = array [0 .. 255] of char;

Tmsgpool = record
Sendbuf: tsysmsgbuf;
Len: byte;
End;

Function encodesysmsg (VAR tmpbuf: tsysmsgbuf; tmpbuflen: integer): tmsgpool;
VaR
I, infactcount: integer;
Begin
Result. sendbuf: = #0;
Result. sendbuf [0]: = msg_head;
Infactcount: = 1;
For I: = 1 to tmpbuflen do
Begin
Case tmpbuf [I]
Msg_head:
Begin
Result. sendbuf [infactcount]: = CFD;
INC (infactcount );
Result. sendbuf [infactcount]: = cfeflag;
End;
CFD:
Begin
Result. sendbuf [infactcount]: = CFD;
INC (infactcount );
Result. sendbuf [infactcount]: = cfdflag;
End;
Msg_tail:
Begin
Result. sendbuf [infactcount]: = CFD;
INC (infactcount );
Result. sendbuf [infactcount]: = cefflag;
End;
Else
Result. sendbuf [infactcount]: = tmpbuf [I];
End;
INC (infactcount );
End;
Result. sendbuf [infactcount]: = msg_tail;
Result. Len: = infactcount + 1;
End;

// To ensure the robustness of our communication program, we must maintain the same status at both ends of the receiving and receiving when encountering unpredictable network line problems, we must add the heartbeat mechanism to the Message interaction between the server and the client.

// In fact, this is very simple: for example, if the server a and client B establish a link and start normal communication, the server starts a timer, the client sends a fixed message (Heartbeat message) to the client at a certain time. Upon receiving the message, the client immediately replies to a fixed message (Heartbeat response message ), both the server side and the client side will accumulate the number of unreceived heartbeat messages. If the maximum value is reached, the line is considered abnormal and the connection from the same end is actively cut off. You must know that the onerror event of the socket component cannot be triggered on the peer end. By adding heartbeat, you can ensure that the statuses on both sides remain unchanged without the so-called "false Logon ". You can perform a test by plugging the network cable.

// The following Code demonstrates this mechanism

Procedure tfrmmain. tmrhbtimer (Sender: tobject );
VaR
I: integer;
Client: publish client;
Sock: tcustomwinsocket;
Procedure sendhb;
VaR
Hb_buf: tsysmsgbuf;
Begin
Hb_buf: = buildmsg_hb (imoduleid );
Sock. sendbuf (hb_buf, cmsglen_hb + 2 );
End;
Begin
With clients. locklist do
Begin
Try
For I: = 0 to count-1 do
Begin
Client: = items [I];
Sock: = tcustomwinsocket (client. Thread );
With client ^ do
If regflag then
Begin
If hbackflag then
Begin
Recvnohbct: = 0;
Sendhb;
Hbackflag: = false;
End else begin
INC (recvnohbct );
If recvnohbct> imaxretryct then
Begin
Addclientlog (host, 'user lost response' + inttostr (imaxretryct) + 'times, disconnects ');
Sock. close;
End else begin
Sendhb;
Cbhandler. setclient (client );
Cbhandler. getbill;
Addclientlog (host, 'user lost response, retrying '+ inttostr (recvnohbct ));
End;
End;
End else begin
INC (recvnologct );
If recvnologct> 3 then
Begin
Addclientlog (host, 'Wait for login message timeout, disconnect from connection ');
Sock. close;
End;
End;
End;
Finally
Clients. unlocklist;
End;
End;
End;

// Use classes to encapsulate messages. The message system defined in a communication system should have obvious inheritance characteristics, for example, all messages have a public header, that is, msg_header, but they have different message type fields, data areas, and encoding/decoding methods. Some messages only extend the reserved fields of some messages, class-based encapsulation is the best choice. polymorphism in OOP can be fully utilized.

// If the system is complex, encapsulate the message processing process as a class as much as possible, and write a base class to process the receiving and assembly of the most basic messages, as shown below, this not only makes your program more structured, but also separates the business logic from program components and interfaces. When you need to modify the logic, you do not need to change the code of the interface.

Type
Tdmmsghandler = Class // data synchronization message processor base class
Private
FPN: string;
FDN: string;
Fcalled: string;
Fstarttime: tdatetime;
Fendtime: tdatetime;
Fduration: integer;
Fserial: integer;
//
Fmsgbuf: tsysmsgbuf;
Fsock: tcustomwinsocket;
Frecvlen: integer;
Fheader: tmsgheader;
Fdata: tmsgdata;
//
Fbuftosend: tsysmsgbuf;
Fsockpool: tmsgpool;
Public
Constructor create (Sock: tcustomwinsocket );
Function setmsgbuf: Boolean;
Procedure process; virtual; abstract;
Published
Property _ PN: String read FPN;
Property _ DN: String read FDN;
Property _ called: String read fcalled;
Property _ starttime: tdatetime read fstarttime;
Property _ endtime: tdatetime read fendtime;
Property _ Duration: integer read fduration;
Property _ serial: integer read fserial;
End;

Tdmsermsghandler = Class (tdmmsghandler) // server data synchronization Processor
Private
Fbcg_id: byte;
Fex_id: byte;
Fcb_flag: byte;
Ftrunk_in_id: integer;
Ftrunk_out_id: integer;
Public
Procedure process; override;
Function getdmbill: Boolean;
Procedure senddmbill;
Function updatedmflag: Boolean;
Procedure showdmrec;
Published
Property _ cb_flag: byte read fcb_flag;
Property _ bcg_id: byte read fbcg_id;
Property _ ex_id: byte read fex_id;
Property _ trunk_in_id: integer read ftrunk_in_id;
Property _ trunk_out_id: integer read ftrunk_out_id;
End;

// The above are some of the key points I have summarized in the project practice. Some of them are also unwritten standards for socket communication program design in the communication industry. As I am currently working in a subsidiary of Shanghai Bell and specializes in the development of communication software with telecom business as the core, the company is quite experienced in this regard, many of these experiences have become "Patterns ".

// It should be noted that the C/S communication program developed by Delphi is single-threaded, so the user capacity of the system should be less than 100; otherwise, problems may occur, unless you discard the socket component that comes with Delphi, Use WinSock to re-encapsulate it. Although the tcpserver/tcpclient component in D7 Indy is multi-threaded, there are still many bugs due to the 3rd-party component. Large-scale communication applications must be developed using the C series, such as the most widely used ace in the communication industry. The efficiency of C is incomparable to that of Delphi, especially in the communication industry.