📄 unit_server_main.~pas
字号:
unit Unit_Server_Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, WinSock, Grids, ComCtrls, StdCtrls, ExtCtrls, DateUtils,IniFiles;
resourcestring
StatusDateTimeFormat = 'mm/dd/yyyy" - "hh:nn:ss:zzz AM/PM';
WelcomeMessage = 'FEFEFE68' ;//+ #13#10 ;
//WelcomeMessage = '欢迎使用GPRS台区考核系统' + #13#10 +
// '珠海华跃金天科技有限公司' + #13#10 +
// '----------------------------------' + #13#10;
ConnectHlpMsg = 'Commands: Help(?)' + #13#10 +
' Refresh chat list(")' + #13#10 +
' Set ScreenName(SNAME=<Screen Name>)' + #13#10;
type TServerConnectionStatus = record
tcsActiveConnections : Integer;
tcsScreenName : string;
tcsLocalHost : string;
tcsLocalAddress : string;
tcsLocalPort : Integer;
// tcsRemoteHost : string;
tcsRemoteAddress : string;
tcsRemotePort : Integer;
tcsServerPrivateMsg : Boolean;
tcsSocketHandle : Integer;
tcsServerSocketHWND : HWND;
end;
type TServerConnectionStatusArray = array of TServerConnectionStatus;
type
TForm_Server_Main = class(TForm)
ChatServerSocket: TServerSocket;
pcLearnSockets: TPageControl;
tsServer: TTabSheet;
gbServerSettings: TGroupBox;
lblServerPort: TLabel;
Label2: TLabel;
lblServerThreadCacheSize: TLabel;
btnServerOpen: TButton;
btnServerClose: TButton;
edServerPort: TEdit;
edServerService: TEdit;
edServerThreadCacheSize: TEdit;
gbServerSocketType: TGroupBox;
rbtnServerNonBlocking: TRadioButton;
rdbtnServerThreadBlocking: TRadioButton;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
lvServerActivity: TListView;
sgServerConnections: TStringGrid;
memReceive: TMemo;
edSend: TEdit;
Label1: TLabel;
ClientIP: TEdit;
TabSheet3: TTabSheet;
Memo1: TMemo;
Timer1: TTimer;
Panel1: TPanel;
Panel2: TPanel;
Button1: TButton;
Button2: TButton;
gbUserDefinedServerSettings: TGroupBox;
cbBroadcastMessage: TCheckBox;
cbLogAllClientMessages: TCheckBox;
procedure btnServerOpenClick(Sender: TObject);
procedure btnServerCloseClick(Sender: TObject);
procedure ChatServerSocketAccept(Sender: TObject; Socket: TCustomWinSocket);
procedure ChatServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ChatServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ChatServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ChatServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ChatServerSocketGetSocket(Sender: TObject; Socket: Integer; var ClientSocket: TServerClientWinSocket);
procedure ChatServerSocketClientWrite(Sender: TObject; Socket: TCustomWinSocket);
procedure ChatServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
procedure ChatServerSocketListen(Sender: TObject; Socket: TCustomWinSocket);
procedure ChatServerSocketThreadEnd(Sender: TObject; Thread: TServerClientThread);
procedure ChatServerSocketThreadStart(Sender: TObject; Thread: TServerClientThread);
procedure btnClearServerSocketLogClick(Sender: TObject);
procedure edSendKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure sgServerConnectionsDblClick(Sender: TObject);
procedure sgServerConnectionsKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure memReceiveKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Panel1CanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure Panel2CanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
//
private
{ Private declarations }
procedure AddConnectionsInfo(ClientInfo : TServerConnectionStatus);
procedure DeleteConnectionsInfo(ClientInfo : TServerConnectionStatus); overload;
procedure DeleteConnectionsInfo(I : Integer); overload;
procedure DisplayConnectionsInfo;
procedure ServerBrodcastMessage;
function CreateLoginList : string;
procedure BroadcastLoginListUpdate(ExcludeSocket: TCustomWinSocket);
procedure SendReadCommand(Data1: byte ;Data2 :byte ) ;
procedure Delay ;
procedure AddConnectionsInfo1;
function HexaToDecimal(Hexa : String ):Integer ;
procedure E901E ;
procedure E902E ;
procedure E911E ;
procedure E912E ;
procedure E941E ;
procedure E942E ;
procedure E951E ;
procedure E952E ;
procedure EB61F ;
procedure EB33F ;
procedure EB34F ;
procedure EB62F ;
procedure EB63F ;
public
{ Public declarations }
end;
var
Form_Server_Main: TForm_Server_Main;
ServerConnectionStatus : TServerConnectionStatusArray;
ReNo , SendNo , SendTime,LogNum,loginnumber : Integer ;
ClickB : Boolean ;
f:tinifile ;
meterno:array[1..100]of string;
LocalHost1,LocalAddress1,RemoteAddress1,TempNo: string;
LocalPort1,RemotePort1,SocketHandle1,timercount : Integer;
ServerPrivateMsg1,connect1 : Boolean;
ServerSocketHWND1 : HWND;
implementation
{$R *.DFM}
procedure TForm_Server_Main.Delay ;
var i , ii : Integer ;
begin
for i := 0 to 20000 do
begin
for ii := 0 to 20000 do
;
end ;
end ;
function TForm_Server_Main.HexaToDecimal(Hexa:String ):Integer ;
const
ValoresHexa : array['A'..'F'] of integer = (10,11,12,13,14,15);
var
nDecimal : Integer ;
nIndex : byte;
begin
nDecimal := 0;
Hexa := Uppercase(Hexa);
for nIndex := Length(Hexa) downto 1 do
if Hexa[nIndex] in ['0'..'9'] then
nDecimal := nDecimal + StrToInt(Hexa[nIndex]) *
Trunc(Exp((Length(Hexa)-nIndex)*ln(16)))
else nDecimal := nDecimal + ValoresHexa[Hexa[nIndex]] *
Trunc(Exp((Length(Hexa)-nIndex)*ln(16)));
HexaToDecimal := nDecimal;
end;
procedure TForm_Server_Main.SendReadCommand(Data1: byte ;Data2 :byte ) ;
var Data:array[0..17] of byte ;
i , x : Integer ;
begin
Data[0] := $fe ;
Data[1] := $fe ;
Data[2] := $fe ;
Data[3] := $fe ;
Data[4] := $68 ;
Data[5] := HexaToDecimal(copy(TempNo,11,2)) ;
Data[6] := HexaToDecimal(copy(TempNo, 9,2)) ;
Data[7] := HexaToDecimal(copy(TempNo, 7,2)) ;
Data[8] := HexaToDecimal(copy(TempNo, 5,2)) ;
Data[9] := HexaToDecimal(copy(TempNo, 3,2)) ;
Data[10] := HexaToDecimal(copy(TempNo, 1,2)) ;
Data[11] := $68 ;
Data[12] := $1 ;
Data[13] := $2 ;
Data[14] := (Data2 + $33) mod 256 ;
Data[15] := (Data1 + $33) mod 256 ;
x := 0 ;
for i := 4 to 15 do
x := x + Data[i] ;
Data[16] := x mod 256 ;
Data[17] := $16 ;
ChatServerSocket.Socket.SendBuf(Data ,18 ) ;
end ;
procedure TForm_Server_Main.btnServerOpenClick(Sender: TObject);
var
PrevCursor : TCursor;
X : TListItem;
str:string;
begin
timercount:=0;
timer1.Enabled :=true;
if ChatServerSocket.Active =false then
begin
PrevCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
str:= ExtractFilePath(Application.ExeName)+'ip.ini';
f:=tinifile.Create(str);
F.WriteString('Transfer', '00', ClientIP.Text );
PrevCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
DisplayConnectionsInfo;
ChatServerSocket.ThreadCacheSize := StrToInt(edServerThreadCacheSize.Text);
ChatServerSocket.Port := StrToInt(edServerPort.Text);
ChatServerSocket.ServerType := stNonBlocking;
X := lvServerActivity.Items.Add;
X.Caption := '打开端口...';
ChatServerSocket.Open;
X.Caption := '打开端口';
memReceive.Lines.Append('Started...' + #13#10);
X.SubItems.Add(ChatServerSocket.Socket.LocalHost);
X.SubItems.Add(ChatServerSocket.Socket.LocalAddress);
X.SubItems.Add(IntToStr(ChatServerSocket.Socket.LocalPort));
Screen.Cursor := PrevCursor;
Screen.Cursor := crDefault;
end;
end;
procedure TForm_Server_Main.btnServerCloseClick(Sender: TObject);
var
I , Y : Integer;
X : TListItem;
begin
if MessageDlg('你要断开与GPRS终端连接吗?',mtWarning,[mbYes,mbNo],0)=mrNo then
begin
exit;
end
else begin
SetLength(ServerConnectionStatus, 0);
ServerConnectionStatus := nil;
X := lvServerActivity.Items.Add;
X.Caption := '关闭端口...';
// X.SubItems.Add(ChatServerSocket.Socket.LocalHost);
// X.SubItems.Add(ChatServerSocket.Socket.LocalAddress);
// X.SubItems.Add(IntToStr(ChatServerSocket.Socket.LocalPort));
with ChatServerSocket.Socket do
begin
for I := 0 to (ActiveConnections - 1) do
if Connections[I].Connected then Connections[I].Close;
end;
ChatServerSocket.Close;
for I := 1 to sgServerConnections.RowCount do
begin
for Y := 1 to sgServerConnections.ColCount do
sgServerConnections.Cells[y,i] := '' ;
end ;
timer1.Enabled :=false;
loginnumber:=0;
timercount:=0;
X.Caption := '关闭端口....';
memReceive.Lines.Append('...Closed' + #13#10) ;
end;
end;
procedure TForm_Server_Main.ChatServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var
ClientConnectInfo : TServerConnectionStatus;
X : TListItem;
i : byte ;
AA :array[0..1] of byte ;
begin
X := lvServerActivity.Items.Add;
X.Caption := '客户端连接...';
with ClientConnectInfo do
begin
tcsActiveConnections := -1;
tcsScreenName := 'Anonymous';
tcsLocalHost := Socket.LocalHost;
tcsLocalAddress := Socket.LocalAddress;
tcsLocalPort := Socket.LocalPort;
tcsRemoteAddress := Socket.RemoteAddress;
tcsRemotePort := Socket.RemotePort;
tcsServerPrivateMsg := False;
tcsSocketHandle := Socket.SocketHandle;
tcsServerSocketHWND := Socket.Handle;
end;
AddConnectionsInfo(ClientConnectInfo);
DisplayConnectionsInfo;
X.Caption := '客户端连接... ';
X.SubItems.Add(Socket.RemoteHost);
X.SubItems.Add(Socket.RemoteAddress);
X.SubItems.Add(IntToStr(Socket.RemotePort));
X.SubItems.Add(FormatDateTime(StatusDateTimeFormat, Now));
end;
procedure TForm_Server_Main.ChatServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var
ClientConnectInfo : TServerConnectionStatus;
X : TListItem;
I : byte ;
begin
X := lvServerActivity.Items.Add;
X.Caption := '断开连接...';
X.SubItems.Add(Socket.RemoteAddress);
X.SubItems.Add(IntToStr(Socket.RemotePort));
with ClientConnectInfo do
begin
tcsActiveConnections := -1;
tcsScreenName := '';
tcsLocalHost := Socket.LocalHost;
tcsLocalAddress := Socket.LocalAddress;
tcsLocalPort := Socket.LocalPort;
tcsRemoteAddress := Socket.RemoteAddress;
tcsRemotePort := Socket.RemotePort;
tcsSocketHandle := Socket.SocketHandle;
tcsServerSocketHWND := Socket.Handle;
tcsServerPrivateMsg := False;
end;
DeleteConnectionsInfo(ClientConnectInfo);
DisplayConnectionsInfo;
X.Caption := '断开连接...';
X.SubItems.Add(FormatDateTime(StatusDateTimeFormat, Now));
BroadcastLoginListUpdate(Socket);
if socket.RemoteAddress <>clientip.Text then
begin
for I := 0 to (ChatServerSocket.Socket.ActiveConnections - 1) do
with ChatServerSocket.Socket.Connections[I] do
begin
if (RemoteAddress=clientip.Text) then
SendText(CreateLoginList ); //Let the other users know that their list should be refreshed
end ;
end;
form_server_main.Cursor :=crDefault;
pcLearnSockets.Cursor := crDefault;
end;
procedure TForm_Server_Main.ChatServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
X : TListItem;
i : byte ;
begin
// X := lvServerActivity.Items.Add;
// X.Caption := 'Client Error: #' + IntToStr(ErrorCode);
// X.SubItems.Add(Socket.RemoteHost);
// X.SubItems.Add(Socket.RemoteAddress);
// X.SubItems.Add(IntToStr(Socket.RemotePort));
try
ErrorCode := 0 ;
Socket.Close ;
//for i := 0 to ChatServerSocket.Socket.ActiveConnections -1 do
// ChatServerSocket.Socket.Connections[i].Close ;
//ChatServerSocket.Close ;
//ChatServerSocket.Open ;
except
ErrorCode := 0 ;
ChatServerSocket.Close ;
ChatServerSocket.Open ;
end ;
//ErrorExents
//eeGeneral //The socket received an error message that does not fit into any of the following categories.
//eeSend //An error occurred when trying to write to the socket connection.
//eeReceive //An error occurred when trying to read from the socket connection.
//eeConnect //A connection request that was already accepted could not be completed.
//eeDisconnect //An error occurred when trying to close a connection.
//eeAccept //A problem occurred when trying to accept a client connection request.
end;
procedure TForm_Server_Main.ChatServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
DataLen , y , i,TempSocket,n ,Meter: Integer ;
X : TListItem;
ReadText, TempMeter, TempIP : string;
ReadByte :array[0..8048] of byte ;
Data : array[0..17] of byte ;
HaveMeter,client : Boolean ;
ClientConnectInfo : TServerConnectionStatus;
begin
client:=false;
DataLen := Socket.ReceiveBuf(ReadByte ,Socket.ReceiveLength ) ;
for i := 0 to DataLen - 1 do
begin
ReadText := ReadText + ',' + IntToHex(readbyte[i],2 ) ;
end ;
if ClickB then
begin
ReNo := ReNo + 1 ;
if (ReNo mod 100) = 0 then Memo1.Clear ;
Memo1.Lines.Add(IntToStr(ReNo ) + ' ' + ReadText + #13 + #10 ) ;
end
else
Memo1.Lines.Add( ReadText + #13 + #10 ) ;
if Memo1.Lines.Count = 200 then Memo1.Clear ;
if (ReadByte[0] = $25) and (ReadByte[1] = $25) and (ReadByte[2] = $25 ) then
begin
HaveMeter := False ;
TempNo := '' ;
for y := 3 to 8 do
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -