Creating a Chat Application (local) with Delphi

Start a new project. Put one RichEdit,EditBox,ComboBox,Timer,MediaPlayer,TcpServer,
TcpClient,PopupMenu,SaveDialog,ChckBox and one button on the form.
The program contains two units. The first one (Unit1.pas) is the main program
and the second unit (Unit2.pas) contains the procedures for encrypting and decrypting.
And here is the code:

Unit1:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Sockets, Menus, MPlayer,ShellAPI, ExtCtrls;

const
WM_ICONTRAY2 = WM_USER + 1;
edkey = 6539;

type
TForm1 = class(TForm)
Host: TEdit;
Button1: TButton;
TcpClient1: TTcpClient;
TcpServer1: TTcpServer;
MediaPlayer1: TMediaPlayer;
Chat: TRichEdit;
Mes: TComboBox;
PopupMenu1: TPopupMenu;
CheckBox1: TCheckBox;
Timer1: TTimer;
SaveDialog1: TSaveDialog;
Clear1: TMenuItem;
Save1: TMenuItem;
procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY2;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
procedure Clear1Click(Sender: TObject);
procedure MesKeyPress(Sender: TObject; var Key: Char);
procedure HostKeyPress(Sender: TObject; var Key: Char);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ChatKeyPress(Sender: TObject; var Key: Char);
procedure FormShow(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure FormHide(Sender: TObject);
private
TrayIconData2: TNotifyIconData;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
icon1 : TIcon;
mescount : integer;
implementation
Uses Unit2;
{$R *.dfm}

procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
with ARichEdit do
begin
SelStart := Length(Text);
SelAttributes.Color := AColor;
SelAttributes.Size := 8;
SelAttributes.Name := 'MS Sans Serif';
Lines.Add(AText);
end;
end;

procedure TForm1.TrayMessage(var Msg: TMessage);
begin
case Msg.lParam of
WM_LBUTTONDOWN:
begin
Form1.Show;
end;
WM_RBUTTONDOWN:
begin
Form1.Show;
end;
end;
end;

function GetComputerName: string;
var
buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
Size: Cardinal;
begin
Size := MAX_COMPUTERNAME_LENGTH + 1;
Windows.GetComputerName(@buffer, Size);
Result := StrPas(buffer);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TcpClient1.RemoteHost := Host.Text;
TcpClient1.Connect;
try
if TcpClient1.Connect then begin
TcpClient1.Sendln(Unit2.Encrypt(Mes.Text,edkey));
sleep(10);
AddColoredLine(Chat,'<<'+TimeToStr(now)+ '>> '+GetComputerName+'-->'+Host.Text+':'+Mes.Text,clBlack);
Shell_NotifyIcon(NIM_DELETE, @TrayIconData2);
end;
finally
TcpClient1.Disconnect;
end;
Mes.Items.Add(Mes.Text);
Mes.SelectAll;
Mes.SetFocus;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//media file that will be played when you receive a message
MediaPlayer1.FileName := ExtractFilePath(Application.ExeName)+'\Wav\calling.wav';
if FileExists(MediaPlayer1.FileName) then
MediaPlayer1.Open;
TcpClient1.Active := false;
TcpServer1.Active := false;
TcpServer1.LocalPort := '3344';
TcpClient1.RemotePort := '3344';
TcpServer1.Active := true;
TcpClient1.Active := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
TcpClient1.Disconnect;
TcpClient1.Active := false;
TcpServer1.Active := false;
MediaPlayer1.Close;
Shell_NotifyIcon(NIM_DELETE, @TrayIconData2);
end;

procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
s,s1 : string;
j : integer;
crc : string;
begin
inc(mescount);
if mescount > 1 then
CheckBox1.Checked := true;
sleep(200);
//Message.ico is the file of the icon that will appear when you receive a message
if FileExists(ExtractFilePath(Application.ExeName)+'Message.ico') then Begin
icon1 := TIcon.Create;
icon1.LoadFromFile(ExtractFilePath(Application.ExeName)+'Message.ico');
with TrayIconData2 do
begin
cbSize := SizeOf(TrayIconData2);
Wnd := Handle;
uID := 0;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
uCallbackMessage := WM_ICONTRAY2;
hIcon := icon1.Handle;
StrPCopy(szTip, Application.Title);
end;
try
Shell_NotifyIcon(NIM_ADD, @TrayIconData2);
finally
icon1.Free;
end;
end;
s := Decrypt(ClientSocket.Receiveln,edkey);

while s <> '' do begin
sleep(10);
AddColoredLine(Chat,'<<'+TimeToStr(now)+ '>>'+ClientSocket.LookupHostName(ClientSocket.RemoteHost)+'('+ClientSocket.RemoteHost+'):
'+s,clBlue);
s := Decrypt(ClientSocket.Receiveln,edkey);
if mescount < 2 then
if FileExists(MediaPlayer1.FileName) then begin
MediaPlayer1.Open;
Form1.MediaPlayer1.Play;
end;
end;
end;

procedure TForm1.Clear1Click(Sender: TObject);
begin
Chat.Clear;
end;

procedure TForm1.MesKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
Button1.Click;
if key = #27 then
Form1.Hide;
end;

procedure TForm1.HostKeyPress(Sender: TObject; var Key: Char);
begin
if key = #27 then
Form1.Hide;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = #27 then
Form1.Hide;
end;

procedure TForm1.ChatKeyPress(Sender: TObject; var Key: Char);
begin
if key = #27 then
Form1.Hide;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Form1.Update;
Form1.UpdateControlState;
Form1.Refresh;
Form1.Repaint;

Mes.SelectAll;
Mes.SetFocus;
Chat.Repaint;
Shell_NotifyIcon(NIM_DELETE, @TrayIconData2);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Chat.Repaint;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked = true then
TcpServer1.Active := false
else
TcpServer1.Active := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
mescount := 0;
if CheckBox1.Checked = true then begin
CheckBox1.Checked := false;
TcpServer1.Active := true;
end;
end;

procedure TForm1.Save1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Chat.Lines.SaveToFile(SaveDialog1.FileName+'.rtf');
end;

procedure TForm1.FormHide(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIconData2);
end;

end.

Unit2:
unit Unit2;
interface

function Decrypt(const S: AnsiString; Key: Word): AnsiString;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;

implementation

const
C1 = 52845;
C2 = 22719;

function Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0);
var
I: LongInt;
begin
case Length(S) of
2:
begin
I := Map[S[1]] + (Map[S[2]] shl 6);
SetLength(Result, 1);
Move(I, Result[1], Length(Result))
end;
3:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
SetLength(Result, 2);
Move(I, Result[1], Length(Result))
end;
4:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
(Map[S[4]] shl 18);
SetLength(Result, 3);
Move(I, Result[1], Length(Result))
end
end
end;

function PreProcess(const S: AnsiString): AnsiString;
var
SS: AnsiString;
begin
SS := S;
Result := '';
while SS <> '' do
begin
Result := Result + Decode(Copy(SS, 1, 4));
Delete(SS, 1, 4)
end
end;

function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
var
I: Word;
Seed: Word;
begin
Result := S;
Seed := Key;
for I := 1 to Length(Result) do
begin
Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
end
end;

function Decrypt(const S: AnsiString; Key: Word): AnsiString;
begin
Result := InternalDecrypt(PreProcess(S), Key)
end;

function Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
I: LongInt;
begin
I := 0;
Move(S[1], I, Length(S));
case Length(S) of
1:
Result := Map[I mod 64] + Map[(I shr 6) mod 64];
2:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64];
3:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
end
end;

function PostProcess(const S: AnsiString): AnsiString;
var
SS: AnsiString;
begin
SS := S;
Result := '';
while SS <> '' do
begin
Result := Result + Encode(Copy(SS, 1, 3));
Delete(SS, 1, 3)
end
end;

function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
var
I: Word;
Seed: Word;
begin
Result := S;
Seed := Key;
for I := 1 to Length(Result) do
begin
Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
end
end;

function Encrypt(const S: AnsiString; Key: Word): AnsiString;
begin
Result := PostProcess(InternalEncrypt(S, Key))
end;

end.