Програми Сервера та Клієнта на Delphi з кодами
Привіт всім! Після Різдвяних та Новорічних свят продовжив свої експерименти в Делфі. Цього разу хочу поділитися своїми напрацюваннями у створенні програм сервера та клієнта з кодами цих програм.
По перше - це програма Серверу. Програма реалізована з використанням компонентів IdIPWatch та TServerSocet щодо роботи в локальній мережі. Приводжу повний код цієї програми для інтерфейсу, який зображено на першому рисунку:
============ Code of the Server program =========
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, Spin, ExtCtrls, ComCtrls, IdGlobal, StrUtils,
IdStack, IdSocketHandle, IdIPAddress, IdBaseComponent, IdComponent, IdIPWatch;
type
TForm1 = class(TForm)
SpinEdit1: TSpinEdit; // SpinEdit to select server port
ServerSocket1: TServerSocket; // ServerSocket component for handling server connections
btn1: TButton; // Button to start the server
btn2: TButton; // Button to stop the server
Edit1: TEdit; // Edit box for entering messages
Lbl2: TLabel; // Label for displaying IP address
Panel1: TPanel; // Panel for displaying server status
Btn3: TButton; // Button to clear the log
Lbl3: TLabel; // Label for displaying messages
RichEdit1: TRichEdit; // RichEdit to display log messages
Button1: TButton; // Button to display local IP address
IdIPWatch1: TIdIPWatch; // Component to watch IP address changes
procedure btn1Click(Sender: TObject); // Procedure to start the server
procedure btn2Click(Sender: TObject); // Procedure to stop the server
procedure Edit1KeyPress(Sender: TObject; var Key: Char); // Procedure to handle Enter key press in Edit1
procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); // Procedure to handle data read from clients
procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); // Procedure to handle client disconnection
procedure FormCreate(Sender: TObject); // Procedure to initialize the form
procedure FormClose(Sender: TObject; var Action: TCloseAction); // Procedure to handle form close event
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); // Procedure to handle form close query event
procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket); // Procedure to handle client connection
procedure Btn3Click(Sender: TObject); // Procedure to clear the log
procedure SpinEdit1Change(Sender: TObject); // Procedure to handle changes in SpinEdit1
procedure Button1Click(Sender: TObject); // Procedure to display local IP address
private
Clients: TList; // List to keep track of connected clients
procedure BroadcastMessage(const AMsg: string; ASenderSocket: TCustomWinSocket); // Procedure to broadcast messages to all clients
public
{ Public declarations }
end;
var
Form1: TForm1;
UTC: tSystemTime; // Variable to store UTC date & time
TimeNow: string; // Variable to store current time as a string
implementation
{$R *.dfm}
// Procedure to initialize the form
procedure TForm1.FormCreate(Sender: TObject);
begin
Clients := TList.Create; // Initialize the clients list
RichEdit1.Clear; // Clear the RichEdit
Edit1.Clear; // Clear the Edit1
Edit1.Enabled := False; // Disable Edit1 initially
btn1.Enabled := True; // Enable the start button
btn2.Enabled := False; // Disable the stop button
Panel1.Font.Color := clRed; // Set the panel font color to red
Panel1.Caption := 'Server OFF'; // Set the initial server status
end;
// Procedure to display local IP address
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.Lines.Add(IdIPWatch1.LocalIP); // Add the local IP address to the RichEdit
end;
// Procedure to start the server
procedure TForm1.btn1Click(Sender: TObject);
begin
ServerSocket1.Port := SpinEdit1.Value; // Set the server port
ServerSocket1.Active := True; // Activate the server
btn2.Enabled := True; // Enable the stop button
btn1.Enabled := False; // Disable the start button
Panel1.Font.Color := clNavy; // Set the panel font color to navy
Panel1.Caption := 'Server ON'; // Set the server status to ON
end;
// Procedure to stop the server
procedure TForm1.btn2Click(Sender: TObject);
begin
ServerSocket1.Active := False; // Deactivate the server
btn1.Enabled := True; // Enable the start button
btn2.Enabled := False; // Disable the stop button
Panel1.Font.Color := clRed; // Set the panel font color to red
Panel1.Caption := 'Server OFF'; // Set the server status to OFF
Edit1.Enabled := False; // Disable Edit1
end;
// Procedure to handle Enter key press in Edit1
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
S: string;
begin
if Key = Chr(13) then // If Enter key is pressed
begin
Key := Chr(0); // Reset the key
S := Edit1.Text; // Get the text from Edit1
try
// Broadcast the message to all connected clients
BroadcastMessage(S, nil);
finally
Edit1.Clear; // Clear the Edit1
GetSystemTime(UTC); // Get the current UTC time
TimeNow := Format('%.2d', [UTC.wHour]) + ':' + Format('%.2d', [UTC.wMinute]); // Format the time as a string
RichEdit1.SelAttributes.Color := clRed; // Set the text color to red
RichEdit1.Lines.Add(TimeNow + ' TX> ' + S); // Add the message to the RichEdit
Edit1.SetFocus; // Set focus back to Edit1
end;
end;
end;
// Procedure to broadcast messages to all clients
procedure TForm1.BroadcastMessage(const AMsg: string; ASenderSocket: TCustomWinSocket);
var
i: Integer;
ClientSocket: TCustomWinSocket;
begin
for i := 0 to ServerSocket1.Socket.ActiveConnections - 1 do
begin
ClientSocket := ServerSocket1.Socket.Connections[i];
if ClientSocket <> ASenderSocket then
ClientSocket.SendText(AMsg);
end;
end;
// Procedure to handle client connection
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Clients.Add(Socket); // Add the client socket to the clients list
GetSystemTime(UTC); // Get the current UTC time
TimeNow := Format('%.2d', [UTC.wHour]) + ':' + Format('%.2d', [UTC.wMinute]); // Format the time as a string
RichEdit1.SelAttributes.Color := clMaroon; // Set the text color to maroon
RichEdit1.Lines.Add(TimeNow + ' Client ' + IntToHex(Integer(Socket), 8) + ' connected'); // Add the connection message to the RichEdit
Edit1.Enabled := True; // Enable Edit1
Edit1.SetFocus; // Set focus to Edit1
end;
// Procedure to handle data read from clients
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Received: string;
r: TStringList;
begin
Received := Socket.ReceiveText; // Receive text from the client
GetSystemTime(UTC); // Get the current UTC time
TimeNow := Format('%.2d', [UTC.wHour]) + ':' + Format('%.2d', [UTC.wMinute]); // Format the time as a string
RichEdit1.SelAttributes.Color := clBlue; // Set the text color to blue
RichEdit1.Lines.Add(TimeNow + ' RX from ' + IntToHex(Integer(Socket), 8) + ' > ' + Received); // Add the received message to the RichEdit
Socket.SendText('CFM "' + Received + '"'); // Send confirmation to the client
BroadcastMessage(Received, Socket); // Broadcast the received message to other clients
// Log the received message to a file
r := TStringList.Create;
try
if FileExists('log.txt') then
r.LoadFromFile('log.txt');
r.Add(TimeNow + ' > ' + Received);
r.SaveToFile('log.txt');
finally
r.Free;
end;
end;
// Procedure to handle client disconnection
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
GetSystemTime(UTC); // Get the current UTC time
TimeNow := Format('%.2d', [UTC.wHour]) + ':' + Format('%.2d', [UTC.wMinute]); // Format the time as a string
Clients.Remove(Socket); // Remove the client socket from the clients list
RichEdit1.SelAttributes.Color := clMaroon; // Set the text color to maroon
RichEdit1.Lines.Add(TimeNow + ' Client ' + IntToHex(Integer(Socket), 8) + ' disconnected'); // Add the disconnection message to the RichEdit
end;
// Procedure to clear the log
procedure TForm1.Btn3Click(Sender: TObject);
begin
RichEdit1.Clear; // Clear the RichEdit
end;
// Procedure to handle form close event
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.Active := False; // Deactivate the server
end;
// Procedure to handle form close query event
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
ServerSocket1.Active := False; // Deactivate the server
end;
// Procedure to handle changes in SpinEdit1
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
btn2.Click; // Stop the server
btn1.Click; // Start the server with the new port
end;
end.
Для роботи з Сервером використовується програма Клієнта, інтерфейс якої зображено на другому рисунку.
Програма реалізована з використанням компоненту TClientSocet щодо роботи в локальній мережі. Приводжу повний код програми Клієнта:
=============== Code of the Client program ============
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ScktComp, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket; // Client socket component for managing the client-server connection
edt1: TEdit; // Edit box for entering the server address
se1: TSpinEdit; // Spin edit for entering the server port
btn1: TButton; // Button for connecting to the server
edt2: TEdit; // Edit box for entering the message to send
Lbl1: TLabel; // Label for server address
Lbl2: TLabel; // Label for server port
Lbl3: TLabel; // Label for message input
Btn2: TButton; // Button for disconnecting from the server
Panel1: TPanel; // Panel for displaying connection status
RichEdit1: TRichEdit; // Rich edit box for displaying messages
Btn3: TButton; // Button for clearing the message box
procedure btn1Click(Sender: TObject); // Event handler for the connect button click
procedure edt2KeyPress(Sender: TObject; var Key: Char); // Event handler for key press in the message input box
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); // Event handler for reading data from the server
procedure FormCreate(Sender: TObject); // Event handler for form creation
procedure Btn2Click(Sender: TObject); // Event handler for the disconnect button click
procedure FormClose(Sender: TObject; var Action: TCloseAction); // Event handler for form close
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); // Event handler for form close query
procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); // Event handler for successful connection to the server
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); // Event handler for socket errors
procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket); // Event handler for disconnection from the server
procedure Btn3Click(Sender: TObject); // Event handler for the clear button click
procedure FormShow(Sender: TObject); // Event handler for form show
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
UTC: tSystemTime; // Variable to store UTC date & time
TimeNow: string; // Variable to store current time as a string
implementation
{$R *.dfm}
// This procedure is called when the form is created. It initializes the user interface.
procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1.Clear; // Clear the messages box
edt2.Enabled := False; // Disable the message input box until connected to the server
Btn2.Enabled := False; // Disable the disconnect button until connected to the server
Panel1.Font.Color := clNavy; // Set the panel font color
Panel1.Caption := 'Waiting for a connection to the server'; // Display the initial status message
end;
// This procedure is called when the connect button is clicked. It attempts to connect to the server.
procedure TForm1.btn1Click(Sender: TObject);
begin
ClientSocket1.Host := edt1.Text; // Set the server address from the input box
ClientSocket1.Port := se1.Value; // Set the server port from the spin edit
ClientSocket1.Open; // Open the connection to the server
end;
// This procedure is called when a key is pressed in the message input box. It sends the message if Enter is pressed.
procedure TForm1.edt2KeyPress(Sender: TObject; var Key: Char);
var
Msg: string; // Variable to store the message
begin
if edt2.Text = '' then Exit; // Exit if the input box is empty
if Key = #13 then // Check if Enter key is pressed
begin
Key := #0; // Reset the key press
Msg := edt2.Text; // Store the message from the input box
try
ClientSocket1.Socket.SendText(Msg); // Send the message to the server
GetSystemTime(UTC); // Get the current UTC time
TimeNow := Format('%.2d', [UTC.wHour]) + ':' + Format('%.2d', [UTC.wMinute]); // Format the time as a string
RichEdit1.SelAttributes.Color := clRed; // Set the text color for sent messages
RichEdit1.Lines.Add(TimeNow + ' TX> ' + Msg); // Add the sent message to the messages box
finally
edt2.Clear; // Clear the input box
edt2.SetFocus; // Set focus back to the input box
end;
end;
end;
// This procedure is called when data is received from the server. It displays the received message.
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
GetSystemTime(UTC); // Get the current UTC time
TimeNow := Format('%.2d', [UTC.wHour]) + ':' + Format('%.2d', [UTC.wMinute]); // Format the time as a string
RichEdit1.SelAttributes.Color := clBlue; // Set the text color for received messages
RichEdit1.Lines.Add(TimeNow + ' RX> ' + Socket.ReceiveText); // Add the received message to the messages box
end;
// This procedure is called when the disconnect button is clicked. It closes the connection to the server.
procedure TForm1.Btn2Click(Sender: TObject);
begin
ClientSocket1.Close; // Close the connection to the server
end;
// This procedure is called when the form is closing. It ensures the connection to the server is closed.
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClientSocket1.Close; // Close the connection to the server
end;
// This procedure is called when the form is queried for closing. It ensures the connection to the server is closed.
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
ClientSocket1.Close; // Close the connection to the server
end;
// This procedure is called when a connection to the server is successfully established.
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Panel1.Font.Color := clNavy; // Set the panel font color
Panel1.Caption := 'Connected!'; // Display the connection status
edt2.Enabled := True; // Enable the message input box
btn1.Enabled := False; // Disable the connect button
Btn2.Enabled := True; // Enable the disconnect button
edt2.SetFocus; // Set focus to the message input box
end;
// This procedure is called when an error occurs in the socket connection. It displays an error message.
procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Panel1.Font.Color := clRed; // Set the panel font color
Panel1.Caption := 'Connection error!'; // Display the error message
ErrorCode := 0; // Reset the error code
end;
// This procedure is called when the connection to the server is disconnected.
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Panel1.Font.Color := clRed; // Set the panel font color
Panel1.Caption := 'Connection broken!'; // Display the disconnection status
edt2.Enabled := False; // Disable the message input box
btn1.Enabled := True; // Enable the connect button
Btn2.Enabled := False; // Disable the disconnect button
end;
// This procedure is called when the clear button is clicked. It clears the messages box.
procedure TForm1.Btn3Click(Sender: TObject);
begin
RichEdit1.Clear; // Clear the messages box
end;
// This procedure is called when the form is shown. It sets the initial focus to the server address input box.
procedure TForm1.FormShow(Sender: TObject);
begin
edt1.SetFocus; // Set focus to the server address input box
edt1.SelStart := edt1.SelLength + 1; // Set the cursor to the end of the input text
edt2.Clear; // Clear the message input box
end;
end.
Сподіваюся, що ця інформація стане в нагоді тим, хто займається створенням програм для обміну даними в локальних мережах.
Так виглядає робота програми Серверу і двох програм Клієнтів у мережі.
Мої найкращі побажання відвідувачам мого блогу! Всім мирного неба над головою! 73!
