你要的话给我一封信啊[email protected]
解决方案 »
- 怎样向clientdataset动态建立字段
- delphi edit自动提示
- 我的程序是在1024*768在下做的,到了800*600有一些按扭就被遮了。
- 请问控件TClientDataSet在其Params属性中设置好参数后,如何设置SQL语句???
- 小小即将生日之际,中国软件技术大会开幕之时,祝小小与百合共创美好未来!
- 请教串口编程问题!
- 如何用Winsock API发送邮件(支持SMTP身份验证)
- 打开文件,高手请进!
- 用sendmessage发送什么消息,可以关闭程序本身?
- 关于李维的《Delphi5.x ADO/MTS/COM+高级程序设计》一书的问题(调用存储过程的例子)。
- linux下有好的c++编译器吗
- 怎样将新内容添加到combobox中呀?
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, ComCtrls, ScktComp, Menus,Winsock, ToolWin,
ImgList,unit1,shellapi; const
wm_MyCallBack=WM_USER+1;type
TChatForm = class(TForm)
MainMenu1: TMainMenu;
Filef1: TMenuItem;
FileListenItem: TMenuItem;
Disconect: TMenuItem;
ClientSocket: TClientSocket;
ServerSocket: TServerSocket;
StatusBar1: TStatusBar;
Panel1: TPanel;
N1: TMenuItem;
Exit: TMenuItem;
Bevel1: TBevel;
Memo1: TMemo;
Memo2: TMemo;
Splitter1: TSplitter;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
Exit1: TMenuItem;
Open1: TMenuItem; procedure FileConnectItemClick(Sender: TObject); procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
Procedure ServerSocketError(Sender:Tobject;Number:Smallint;
var Descreption:string; Scode:integer; const source,HelpFile:String;
HelpContext:integer; Var CancellDisplay:wordbool);
procedure FileListenItemClick(Sender: TObject);
procedure DisconectClick(Sender: TObject);
procedure ExitClick(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure AddtrayIcon;
// procedure wm_MyCallback;
procedure DeletetrayIcon;
procedure onnotify(var msg:Tmessage);message wm_MyCallBack;
procedure Exit1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Exit1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
protected
IsServer:boolean;
end;
var
ChatForm: TChatForm;
server:string;
i:integer;
bool:boolean;
IconData :NOTIFYICONDATA;
implementation{$R *.DFM}procedure Link_Count;
Var
Find_connect: P_SocketLinkStru;
begin
with ChatForm do
begin
Find_connect:= Head_SKS;
while Find_connect <> Nil do
Find_connect:= Find_connect.Next_C_Socket;
end;
end;procedure TChatForm.FileConnectItemClick(Sender: TObject);
begin
if ClientSocket.Active then ClientSocket.Active:=False;
if InputQuery('Computer to Connect to','Address Name:',Server) then
if length(server)>0 then
with ClientSocket do
begin
Host:=Server;
Active:=True;
FileListenItem.Checked:=False;
end ;
end;procedure TChatForm.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels[0].Text:='You have connected to: ' +Socket.RemoteHost;
Memo1.Lines.Clear;
ChatForm.Caption:='You have connected to'+Socket.RemoteHost;end;procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Clear;
ChatForm.Caption:='My Chat Room';
end;procedure TChatForm.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo2.Lines.Add('Error Connecting to:'+Server);
ErrorCode:=0;
end;procedure TChatForm.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('From '+Socket.RemoteHost+': '+Socket.ReceiveText);
if bool=true then
begin
chatform.Show;
deletetrayicon;
end;
end;procedure TChatForm.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer:=True;
Statusbar1.Panels[0].Text:='You have connected to: '+Socket.RemoteAddress;
end;procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Clear;
Memo2.Lines.Clear;
ChatForm.Caption:='You have Connected to '+Socket.RemoteHost;
Server:=clientSocket.Host;
end;procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
serversocket.Active:=True;
clientsocket.Active:=false;
StatusBar1.Panels[0].Text:='Listening...';
ChatForm.Caption:='My Chat Room';
end;procedure TChatForm.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('From '+Socket.RemoteHost+': ' +Socket.ReceiveText);
if bool=true then
begin
chatform.show;
deletetrayicon;
end;
end;Procedure TchatForm.ServerSocketError(Sender:Tobject;Number:Smallint;
var Descreption:string; Scode:integer; const source,HelpFile:String;
HelpContext:integer; Var CancellDisplay:wordbool);
begin
Showmessage(Descreption);
end;procedure TChatForm.FileListenItemClick(Sender: TObject);
begin
FileListenItem.Checked:=Not FileListenItem.Checked;
if FileListenItem.Checked then
begin
ClientSocket.Active:=False;
ServerSocket.Active:=True;
Statusbar1.Panels[0].Text:='Listening...';
end
else
begin
if ServerSocket.Active then
ServerSocket.Active:=False;
Statusbar1.Panels[0].Text:='';
end;
if bool=false then
begin
addtrayicon;
bool:=true;
chatform.Hide;
end
else if bool=true then
bool:=false;
end;procedure TChatForm.DisconectClick(Sender: TObject);
begin
ClientSocket.Active:=false;
ServerSocket.Active:=true;
Statusbar1.Panels[0].Text:='Listening...';
end;procedure TChatForm.ExitClick(Sender: TObject);
begin
ServerSocket.Close;
clientSocket.Close;
close;
end;procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Timer1Timer(Sender);
i:=0;
if Key = VK_Return then
if IsServer then
while (i >= 0) And (i<serversocket.Socket.ActiveConnections) do
begin
ServerSocket.Socket.Connections[i].SendText(Memo1.Lines[Memo1.Lines.Count - 1]);
i:=i+1;
end
else
ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);
end;procedure TChatForm.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewWidth < 563 then NewWidth := 563;
if NewHeight < 397 then NewHeight :=397;
Resize := True;
end;procedure TChatForm.Timer1Timer(Sender: TObject);
Var
Find_connect: P_SocketLinkStru;
i:integer;
begin
try
Find_connect:= Head_SKS;
while Find_connect <> Nil do
begin
if Find_connect.C_Socket.Active = False then
begin
i:= 0;
while (i >= 0) And (i<serversocket.Socket.ActiveConnections) do
i:= i+1;
end
else
Find_connect:= Find_connect.Next_C_Socket;
end;
Link_Count;
except
Application.MessageBox('Fail connect','Error',MB_OK);
end;
end;procedure tchatform.addtrayicon;
Var
trayicontip:pChar;
szTip:string;
str:array[0..20]of char;begin
szTip:='asdfasdf';with icondata do
begin
cbsize:=sizeof(icondata);
wnd:=handle;
uID := 0;
uCallBackMessage := wm_MyCallBack;
uFlags := nif_Icon Or nif_Message Or nif_Tip;
hIcon := LoadIcon(hInstance,'MYICON');
szTip:='服务器正在监听...';
// StrCopy(szTip,PChar(TrayIconTip));
End;
Shell_NotifyIcon(nim_Add,@IconData);
end;
procedure tchatform.DeletetrayIcon;
begin
icondata.cbsize:=sizeof(icondata);
shell_notifyicon(nim_delete,@icondata);
end;
procedure tchatform.onnotify(var msg:Tmessage);
var
mouse:tpoint;
begin
If (msg.LParam = wm_LButtonDown) Then
begin
chatform.show;
deletetrayicon;
end
Else If (msg.LParam = WM_RButtonDown) Then
begin
getcursorpos(mouse);
setforegroundwindow(application.handle);
application.ProcessMessages;
PopupMenu1.popup(mouse.x,mouse.y);
End;
End;procedure TChatForm.Exit1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
chatform.Close;
end;procedure TChatForm.Exit1Click(Sender: TObject);
begin
chatform.close;
end;procedure TChatForm.Open1Click(Sender: TObject);
begin chatform.show;
end;procedure TChatForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
deletetrayicon;
end;procedure TChatForm.FormCreate(Sender: TObject);
begin
bool:=false;
end;
{
if bool=true then
chatform.hide
else
begin
addtrayicon;
chatform.hide;
end;}
end.
uses
ScktComp, Winsock;
Type
P_SocketLinkStru = ^SocketLinkStru;
SocketLinkStru = Record
C_Socket: TClientSocket;
Connect_Biao: Integer;
C_SocketHandle: TSocket;
Next_C_Socket: P_SocketLinkStru;
End;Var
In_Port, Out_Port: Integer;
Out_Address: String;
Head_SKS: P_SocketLinkStru;
implementationend.