unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls, ExtCtrls, IdTCPServer, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, ComCtrls;
type
TForm1 =
class(TForm)
Label1: TLabel;
ss: TServerSocket;
Button1: TButton;
cs: TClientSocket;
chat: TMemo;
LabeledEdit1: TLabeledEdit;
Button2: TButton;
Label2: TLabel;
Button3: TButton;
Edit1: TEdit;
Button4: TButton;
Label3: TLabel;
Button5: TButton;
Button6: TButton;
IdTCPClient1: TIdTCPClient;
IdTCPServer1: TIdTCPServer;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ProgressBar1: TProgressBar;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
ip:
string;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ip:=LabeledEdit1.Text;
cs.Host:=
ip;
cs.Active:=True;
IdTCPClient1.Host:=
ip;
end;
procedure TForm1.Button3Click(Sender: TObject);
var msg:
String;
begin
msg:=Edit1.Text;
chat.Lines.Add(msg);
cs.Socket.SendText(msg);
Edit1.Text:='
';
end;
procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var rec:
String;
begin
rec:=Socket.ReceiveText;
if (rec='
Server Message: Someone is pinging you')
then
begin
chat.Lines.Add(rec);
cs.Socket.SendText('
Server Message: Ping successful. The chat-partner answered.');
end
else
chat.Lines.Add(rec);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
cs.Socket.SendText('
Server Message: Someone is pinging you');
chat.Lines.Add('
Server Message: Ping started');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
chat.Lines.Add('
Server Message: Wellcome to MyChat 1.0');
chat.Lines.Add('
Server Message: Please enter your chat-partners ip in the field at the bottom of the');
chat.Lines.Add('
Server Message: programme and press connect.');
chat.Lines.Add('
Server Message: Then you can ping your chat-partner or send him/her a message.');
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
chat.Lines.Clear;
end;
procedure TForm1.Button6Click(Sender: TObject);
var
fs: TFileStream;
begin
if not OpenDialog1.Execute
then exit;
with IdTCPClient1
do
begin
fs := TFileStream.Create(OpenDialog1.FileName, fmOpenRead
or fmShareDenyWrite);
Connect;
try
OpenWriteBuffer;
try
ProgressBar1.Max := fs.Size;
WriteStream(fs, true, true);
CloseWriteBuffer;
except
CancelWriteBuffer;
raise;
end;
finally
Disconnect;
fs.Free;
end;
end;
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
fs: TFileStream;
SizeOfIncomingStream: integer;
begin
if not SaveDialog1.Execute
then exit;
fs := TFileStream.Create(SaveDialog1.Filename, fmCreate
or fmShareExclusive);
with AThread.Connection
do
try
ProgressBar1.Max := SizeOfIncomingStream;
SizeOfIncomingStream := ReadInteger;
ReadStream(fs, SizeOfIncomingStream);
finally
Disconnect;
fs.Free;
end;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
cs.Active:=False;
ss.Active:=False;
IdTCPServer1.Active:=False;
end;
procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AWorkMode = wmRead
then
ProgressBar1.StepBy(AWorkCount);
if AWorkMode = wmWrite
then
ProgressBar1.StepBy(AWorkCount);
end;
end.