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)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
chat: TMemo;
cs: TClientSocket;
Edit1: TEdit;
IdTCPClient1: TIdTCPClient;
IdTCPServer1: TIdTCPServer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
LabeledEdit1: TLabeledEdit;
OpenDialog1: TOpenDialog;
ProgressBar1: TProgressBar;
SaveDialog1: TSaveDialog;
ss: TServerSocket;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
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, fmShareDenyNone);
Connect;
try
// OpenWriteBuffer;
try
ProgressBar1.Max := fs.Size;
WriteInteger(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;
ms: TMemoryStream;
SizeOfIncomingStream: integer;
begin
ms := TMemoryStream.Create;
with AThread.Connection
do
try
SizeOfIncomingStream := ReadInteger;
// fs := TFileStream.Create(SaveDialog1.Filename, fmCreate or fmShareExclusive);
// ProgressBar1.Max := SizeOfIncomingStream;
ReadStream(ms, SizeOfIncomingStream);
if not SaveDialog1.Execute
then exit;
ms.SaveToFile(SaveDialog1.FileName);
finally
Disconnect;
FreeAndNil(ms);
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.