給你一個demo﹐你好好看看吧﹗
unit umessage;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, base, ExtCtrls, Sockets, StdCtrls, Buttons, Menus, TrayIcon,
wwdblook;
type
Tfrmmessage = class(Tfrmbase)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
btnsend: TPanel;
memrecv: TMemo;
memsend: TMemo;
Label1: TLabel;
edtremoteport: TEdit;
Label2: TLabel;
edtlocalport: TEdit;
Label3: TLabel;
TcpServer1: TTcpServer;
TcpClient1: TTcpClient;
buttonsend: TSpeedButton;
buttonexit: TSpeedButton;
buttonrefresh: TSpeedButton;
TrayNotifyIcon1: TTrayNotifyIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
edtremotehost: TwwDBLookupCombo;
Panel6: TPanel;
Image1: TImage;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
procedure TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure buttonsendClick(Sender: TObject);
procedure buttonrefreshClick(Sender: TObject);
procedure buttonexitClick(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TClientDataThread = class(TThread)
private
public
ListBuffer :TStringList;
TargetList :TStrings;
procedure synchAddDataToControl;
constructor Create(CreateSuspended: Boolean);
procedure Execute;
override;
procedure Terminate;
end;
var
frmmessage: Tfrmmessage;
implementation
uses Global, cdata, messagebrowse_a, messagebrowse_r, messagebrowse_s;
{$R *.dfm}
{ TClientDataThread }
constructor TClientDataThread.Create(CreateSuspended: Boolean);
begin
inherited create(createsuspended);
freeonterminate:=true;
listBuffer:=TstringList.Create;
end;
procedure TClientDataThread.Execute;
begin
synchronize(Synchadddatatocontrol);
end;
procedure TClientDataThread.synchAddDataToControl;
begin
Targetlist.AddStrings(ListBuffer);
end;
procedure TClientDataThread.Terminate;
begin
ListBuffer.Free;
Inherited;
end;
procedure Tfrmmessage.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
s:string;
dataThread:TclientdataThread;
begin
inherited;
Datathread:=Tclientdatathread.Create(true);
datathread.TargetList:=memrecv.Lines;
datathread.ListBuffer.Add('Remote Host :'+Clientsocket.LookupHostName(clientsocket.RemoteHost)+'('+clientsocket.RemoteHost+')');
datathread.ListBuffer.Add('=======================begin
Message============================');
s:=clientsocket.Receiveln;
while s<>''do
begin
dataThread.ListBuffer.Add(S);
s:=clientsocket.Receiveln;
end;
dataThread.ListBuffer.Add('========================End Message============================');
dataThread.ListBuffer.Add(' ');
Datathread.Resume;
end;
procedure Tfrmmessage.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
inherited;
frmmessage:=nil;
end;
procedure Tfrmmessage.FormCreate(Sender: TObject);
begin
inherited;
edtlocalport.Text:='5000';
edtremoteport.Text:='5000';
traynotifyicon1.Hint:='內部通信系統';
end;
procedure Tfrmmessage.buttonsendClick(Sender: TObject);
var
i,j:integer;
str,localIP,sendname,computername,receiptname,receiptnote:string;
begin
inherited;
localip:=GS_localip;
computername:=gs_computername;
sendname:=gs_username;
receiptname:=Trim(edtremotehost.Text);
receiptnote:=memsend.
Text;
data.SocketConnection.AppServer.upmessage(sendname,computername,localip,receiptname,receiptnote);
if edtremotehost.Text='' then
edtremotehost.Text:=gs_computername;
for j:=0 to memsend.
Lines.Count-1do
str:=str+#13#10+memsend.
Lines[j];
memrecv.Lines.Add('----------------------------------------------------------------');
memrecv.Lines.Add(trim(str));
memrecv.Lines.Add('----------------------------------------------------------------');
memrecv.Refresh;
Tcpclient1.RemoteHost:=Trim(edtremotehost.Text);
Tcpclient1.RemotePort:=Trim(edtremoteport.Text);
try
if Tcpclient1.Connect then
for i:=0 to memsend.
Lines.Count-1do
Tcpclient1.Sendln(memsend.
Lines);
finally
Tcpclient1.Disconnect;
end;
memsend.
Clear;
end;
procedure Tfrmmessage.buttonrefreshClick(Sender: TObject);
begin
inherited;
TcpServer1.LocalPort:=EdtLocalport.Text;
TcpServer1.Active:=True;
end;
procedure Tfrmmessage.buttonexitClick(Sender: TObject);
begin
inherited;
frmmessage.Hide;
end;
procedure Tfrmmessage.FormHide(Sender: TObject);
begin
inherited;
traynotifyicon1.IconVisible:=True;
end;
procedure Tfrmmessage.N1Click(Sender: TObject);
begin
inherited;
frmmessage.Show;
end;
procedure Tfrmmessage.N9Click(Sender: TObject);
begin
inherited;
frmmessage.Close;
end;
procedure Tfrmmessage.N3Click(Sender: TObject);
begin
inherited;
openform(Tfrmmessagebrowse_r,frmmessagebrowse_r,self);
end;
procedure Tfrmmessage.N5Click(Sender: TObject);
begin
inherited;
openform(Tfrmmessagebrowse_s,frmmessagebrowse_s,self);
end;
procedure Tfrmmessage.N7Click(Sender: TObject);
begin
inherited;
openform(Tfrmmessagebrowse_a,frmmessagebrowse_a,self);
end;
procedure Tfrmmessage.SpeedButton1Click(Sender: TObject);
begin
inherited;
openform(Tfrmmessagebrowse_a,frmmessagebrowse_a,self);
end;
procedure Tfrmmessage.SpeedButton2Click(Sender: TObject);
begin
inherited;
openform(Tfrmmessagebrowse_s,frmmessagebrowse_s,self);
end;
procedure Tfrmmessage.SpeedButton3Click(Sender: TObject);
begin
inherited;
openform(Tfrmmessagebrowse_r,frmmessagebrowse_r,self);
end;
end.