簡單實現,沒有控制,要用好的話加點控制就行了。
服務器:
-------------------------------------------------------------------------------
unit SvrMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent, IdUDPBase,
IdUDPServer, IdSocketHandle;
type
TfrmServer = class(TForm)
mmoA: TMemo;
idusA: TIdUDPServer;
pnl1: TPanel;
lbl1: TLabel;
edtPort: TEdit;
btnSet: TButton;
procedure idusAUDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
procedure btnSetClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
TDataHeader = packed record
Cmd: Byte;
Len: Integer;
end;
var
frmServer: TfrmServer;
FHeaded: Boolean;
FHeader: TDataHeader;
FRecCount: Integer;
FStream: TMemoryStream;
implementation
{$R *.dfm}
procedure TfrmServer.btnSetClick(Sender: TObject);
begin
try
idusA.Active := False;
idusA.DefaultPort := StrToInt(edtPort.Text);
idusA.Active := True;
FHeaded := False;
btnSet.Enabled := False;
except
ShowMessage('Set error!');
end;
end;
procedure TfrmServer.idusAUDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
var
buf : PChar;
nLen: Integer;
begin
if not FHeaded then
begin
FRecCount := 0;
AData.Read(FHeader, SizeOf(TDataHeader));
if FHeader.Cmd = 0 then
begin
mmoA.Lines.Add('receive a text from ' + ABinding.PeerIP + ':');
end
else
begin
if Assigned(FStream) then
FreeAndNil(FStream);
FStream := TMemoryStream.Create;
mmoA.Lines.Add('receive a jpg from ' + ABinding.PeerIP);
end;
FHeaded := True;
end
else
begin
if FHeader.Len - FRecCount > 1024 then
nLen := 1024
else
nLen := FHeader.Len - FRecCount;
if nLen > AData.Size then
nLen := AData.Size;
GetMem(buf, nLen);
ZeroMemory(buf, nLen);
try
AData.ReadBuffer(buf^, nLen);
FRecCount := FRecCount + nLen;
if FHeader.Cmd = 0 then
begin
mmoA.Lines.Add(buf);
FHeaded := False;
end
else
begin
FStream.WriteBuffer(buf^, nLen);
if FRecCount >= FHeader.Len then
begin
FStream.SaveToFile('c:/1.jpg');
FreeAndNil(FStream);
FHeaded := False;
mmoA.Lines.Add('save to c:/1.jpg.');
end;
end;
finally
FreeMem(buf, nLen);
end;
end;
end;
procedure TfrmServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FStream) then
FreeAndNil(FStream);
end;
end.
******************************************************************************
客戶端:
-----------------------------------------------------------------------------
unit CltMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient;
type
TfrmClient = class(TForm)
iducA: TIdUDPClient;
lbl1: TLabel;
edtA: TEdit;
btnSendT: TButton;
lbl2: TLabel;
edtB: TEdit;
btnSendF: TButton;
lbl3: TLabel;
edtHost: TEdit;
edtPort: TEdit;
Label1: TLabel;
btnSet: TButton;
procedure btnSetClick(Sender: TObject);
procedure btnSendTClick(Sender: TObject);
procedure btnSendFClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TDataHeader = packed record
Cmd: Byte;
Len: Integer;
end;
var
frmClient: TfrmClient;
implementation
{$R *.dfm}
procedure TfrmClient.btnSetClick(Sender: TObject);
begin
try
iducA.Host := edtHost.Text;
iducA.Port := StrToInt(edtPort.Text);
iducA.Active := True;
btnSet.Enabled := False;
btnSendT.Enabled := True;
btnSendF.Enabled := True;
except
ShowMessage('Host or Port Error!');
btnSet.Enabled := True;
btnSendT.Enabled := False;
btnSendF.Enabled := False;
end;
end;
procedure TfrmClient.btnSendTClick(Sender: TObject);
var
dh : TDataHeader;
buf : PChar;
nLen: Integer;
begin
nLen := Length(edtA.Text) + 1;
if (not iducA.Active) or (nLen < 2) then
Exit;
btnSendT.Enabled := False;
GetMem(buf, nLen);
ZeroMemory(buf, nLen);
try
CopyMemory(buf, PChar(edtA.Text), nLen - 1);
dh.Cmd := 0;
dh.Len := nLen;
iducA.SendBuffer(dh, SizeOf(TDataHeader));
iducA.SendBuffer(buf^, nLen);
finally
FreeMem(buf, nLen);
btnSendT.Enabled := True;
end;
end;
procedure TfrmClient.btnSendFClick(Sender: TObject);
var
dh : TDataHeader;
buf : PChar;
nSend : Integer;
nLen : Integer;
FStream : TMemoryStream;
begin
if not FileExists(edtB.Text) then
begin
ShowMessage('File not found!');
Exit;
end;
FStream := TMemoryStream.Create;
GetMem(buf, 1024);
ZeroMemory(buf, 1024);
try
btnSendF.Enabled := False;
FStream.LoadFromFile(edtB.Text);
FStream.Position := 0;
dh.Cmd := 1;
dh.Len := FStream.Size;
iducA.SendBuffer(dh, SizeOf(TDataHeader));
nSend := 0;
while nSend < FStream.Size do
begin
if FStream.Size - nSend > 1024 then
nLen := 1024
else
nLen := FStream.Size - nSend;
FStream.ReadBuffer(buf^, nLen);
iducA.SendBuffer(buf^, nLen);
nSend := nSend + nLen;
Sleep(10);
end;
finally
FreeAndNil(FStream);
FreeMem(buf, 1024);
btnSendF.Enabled := True;
end;
end;
end.