别人的代码,也给你:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, bsSkinData, IdUDPServer, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPClient, bsSkinCtrls, bsSkinBoxCtrls, BusinessSkinForm,
ExtCtrls, WinSock, IdSocketHandle, Menus, Mask, bsSkinMenus, ScktComp;
type
TForm1 = class(TForm)
IdUDPServer1: TIdUDPServer;
bsSkinData1: TbsSkinData;
bsSkinMemo1: TbsSkinMemo;
bsSkinButton1: TbsSkinButton;
bsSkinButton2: TbsSkinButton;
bsBusinessSkinForm1: TbsBusinessSkinForm;
bsCompressedStoredSkin1: TbsCompressedStoredSkin;
Timer1: TTimer;
IdUDPClient1: TIdUDPClient;
bsSkinMainMenuBar1: TbsSkinMainMenuBar;
OpenDialog1: TOpenDialog;
bsSkinLabel1: TbsSkinLabel;
bsSkinEdit1: TbsSkinEdit;
bsSkinPanel1: TbsSkinPanel;
bsSkinPanel2: TbsSkinPanel;
bsSkinListBox1: TbsSkinListBox;
bsSkinMemo2: TbsSkinMemo;
IdUDPServer2: TIdUDPServer;
IdUDPClient2: TIdUDPClient;
bsSkinPopupMenu1: TbsSkinPopupMenu;
N5: TMenuItem;
SaveDialog1: TSaveDialog;
bsSkinMainMenu1: TbsSkinMainMenu;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
bsSkinButton3: TbsSkinButton;
ClientSocket1: TClientSocket;
OpenDialog2: TOpenDialog;
ServerSocket1: TServerSocket;
bsSkinButton5: TbsSkinButton;
ClientSocket2: TClientSocket;
ServerSocket2: TServerSocket;
bsSkinGauge1: TbsSkinGauge;
Timer2: TTimer;
bsSkinLabel2: TbsSkinLabel;
procedure bsSkinButton2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
procedure FormActivate(Sender: TObject);
procedure bsSkinMemo1Change(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N2Click(Sender: TObject);
procedure bsSkinListBox1ListBoxClick(Sender: TObject);
procedure bsSkinEdit1Change(Sender: TObject);
procedure bsSkinButton1Click(Sender: TObject);
procedure IdUDPServer2UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
procedure FormResize(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure bsSkinButton3Click(Sender: TObject);
procedure ServerSocket2ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure bsSkinButton5Click(Sender: TObject);
procedure ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const DataSize=4096; //每次传送的字节数
var
Form1: TForm1;
HostIp: string; //本机IP
Hostname: string; //本机名
BroadCastIP: string; //广播IP
path: string; //程序运行位置
desIP: string; //接收信息方IP
//以下用于传送文件
fs,DestFileStream: TFileStream; //文件流,用于传送文件与接收文件
FileSize: Longint; //要传送的文件大小
FilenfoReceived:Boolean; //表示是否已接收到文件名及文件大小信息
FileName:string; //文件名
buff: pointer; //当前传送的位置
RealCount: integer; //实际的传送字节数
CostTime:integer; //传送时间
trans: boolean; //是否在传送文件
implementation
uses shellapi,unit2, Unit3, Math;
{$R *.dfm}
//取本机IP地址
function GetIP:String;
var
WSData: TWSAData;
Buffer: array[0..63] of Char;
HostEnt: PHostEnt;
PPInAddr: ^PInAddr;
IPString: String;
begin
IPString:='';
try
WSAStartUp($101, WSData);
GetHostName(Buffer, SizeOf(Buffer));
HostEnt:=GetHostByName(Buffer);
if Assigned(HostEnt) then
begin
PPInAddr:=@(PInAddr(HostEnt.H_Addr_List^));
while Assigned(PPInAddr^) do
begin
IPString:=StrPas(INet_NToA(PPInAddr^^));
Inc(PPInAddr);
end;
end;
Result := IPString;
finally
try
WSACleanUp;
except
end;
end;
end;
//获取文件大小
function GetFileSize(const FileName: String): LongInt;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else
Result := -1;
end;
procedure TForm1.bsSkinButton2Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
host : pchar;
w
Word;
i: integer;
begin
HostIp := GetIP();
i := length(trim(HostIp));
while true do
begin
if copy(HostIp,i,1)='.' then
break;
i := i-1;
end;
BroadCastIP := copy(HostIp,1,i)+'255';
GetMem(host,255);
w:= 255;
if getcomputername(host,w) then
Hostname := host;
IdUDPClient1.Host := '255.255.255.255'; //BroadCastIP;
path := ExtractFilePath(Application.ExeName);
ServerSocket1.open;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
IdUDPClient1.Send('add'+HostIp+'--'+Hostname);
end;
procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
var
sss: string;
ex: boolean;
len,i: integer;
begin
ex := False;
SetLength(sss, AData.Size);
AData.Read(sss[1], AData.Size);
len := length(sss);
//用户上线
if copy(sss,1,3)='add' then
begin
sss := copy(sss,4,len-3);
if sss <> HostIp+'--'+Hostname then
begin
if bsSkinListBox1.Items.Count <> 0 then
begin
i := 0;
while (i< bsSkinListBox1.Items.Count) do
begin
if sss = bsSkinListBox1.Items
then
begin
ex := true;
break;
end;
i := i + 1;
end;
if ex = False then
begin
bsSkinListBox1.Items.Add(sss);
Form2.bsSkinLabel1.Caption := '好友:' + sss + ' 上线啦!';
Form2.ShowModal;
end;
end;
if bsSkinListBox1.Items.Count = 0 then
begin
bsSkinListBox1.Items.Add(sss);
Form2.bsSkinLabel1.Caption := '好友:' + sss + ' 上线啦!';
Form2.ShowModal;
end;
end;
end;
//用户下线
if copy(sss,1,3)='del' then
begin
i := 0;
sss := copy(sss,4,len-3);
if bsSkinEdit1.Text = sss then
begin
bsSkinEdit1.Text := '';
bsSkinButton3.Enabled:=false;
end;
while i<= bsSkinListBox1.Items.Count do
begin
if bsSkinListBox1.Items = sss then
begin
bsSkinListBox1.Items.Delete(i);
bsSkinListBox1.Refresh;
break;
end;
i := i + 1;
end;
Form2.bsSkinLabel1.Caption := '好友:' + sss + ' 已经下线!';
Form2.ShowModal;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
trans:=false;
bsSkinMemo1.Enabled := false;
bsSkinButton1.Enabled := false;
bsSkinButton3.Enabled := false;
bsSkinButton5.Enabled := false;
Timer1Timer(nil);
end;
procedure TForm1.bsSkinMemo1Change(Sender: TObject);
begin
if bsSkinMemo1.Text <> '' then
bsSkinButton1.Enabled := true
else
bsSkinButton1.Enabled := false;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Application.MessageBox('真的要关闭本程序吗?','提示',MB_YESNO+MB_ICONQUESTION)=ID_yes then
begin
IdUDPClient1.Send('del'+HostIp+'--'+Hostname);
Action := caFree;
end
else
Action := caNone;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
OpenDialog1.InitialDir := path+'skins/';
OpenDialog1.FileName := '';
if OpenDialog1.Execute then
if OpenDialog1.FileName <> '' then
bsSkinData1.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.bsSkinListBox1ListBoxClick(Sender: TObject);
var
i: integer;
begin
if bsSkinListBox1.Items.Count <> 0 then
begin
bsSkinButton3.Enabled := true;
bsSkinEdit1.Text := bsSkinListBox1.Items[bsSkinListBox1.ItemIndex];
i := 1;
while i < length(bsSkinEdit1.Text) do
begin
if copy(bsSkinEdit1.Text,i,1) = '-' then
break;
i := i + 1;
end;
desIP := copy(bsSkinEdit1.Text,1,i-1);
if trans=false then
begin
ClientSocket1.Close;
ClientSocket2.Close;
ClientSocket1.Address:=desIP;
ClientSocket2.Address:=desIP;
ClientSocket1.Open;
ClientSocket2.Open;
end;
end
else
begin
bsSkinButton3.Enabled := false;
bsSkinEdit1.Text := '';
end;
end;
procedure TForm1.bsSkinEdit1Change(Sender: TObject);
begin
if bsSkinEdit1.Text = '' then
bsSkinMemo1.Enabled := false
else
bsSkinMemo1.Enabled := True;
end;
procedure TForm1.bsSkinButton1Click(Sender: TObject);
begin
IdUDPClient2.Host := desIP;
IdUDPClient2.Send(HostIp+'--'+Hostname+' 对你说:');
IdUDPClient2.Send(' '+bsSkinMemo1.Text);
bsSkinMemo2.Lines.Add('你对 '+bsSkinEdit1.Text+' 说:');
bsSkinMemo2.Lines.Add(' '+bsSkinMemo1.Text);
bsSkinMemo1.Text := '';
end;
procedure TForm1.IdUDPServer2UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
var
s: string;
begin
SetLength(s, AData.Size);
AData.Read(s[1], AData.Size);
bsSkinMemo2.Lines.Add(s);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Form1.Width := 567;
Form1.Height := 427;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
form3.showmodal;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
SaveDialog1.InitialDir := path;
SaveDialog1.FileName := 'chat.txt';
if SaveDialog1.Execute then
begin
bsSkinMemo2.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
OpenDialog1.InitialDir := path+'skins/';
OpenDialog1.FileName := '';
if OpenDialog1.Execute then
if OpenDialog1.FileName <> '' then
bsSkinData1.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.N9Click(Sender: TObject);
begin
form3.showmodal;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s:string;
i,j,len:integer;
sourceIP:string;
begin
s:=Socket.ReceiveText;
len:=length(s);
if copy(s,1,3)='ask' then
begin
s:=copy(s,4,len-3);
i:=1;
j:=1;
while true do
begin
if copy(s,j,1)='-' then break;
j:=j+1;
end;
while true do
begin
if copy(s,i,1)=';' then break;
i:=i+1;
end;
sourceIP:=copy(s,1,j-1);
len:=length(s);
if Application.MessageBox(PAnsiChar('用户 '+copy(s,1,i-1)+' 要传文件给你,是否接收?'),'提示',MB_YESNO+MB_ICONQUESTION)=ID_YES then
begin
SaveDialog1.FileName:=copy(s,i+1,len-i);
if SaveDialog1.Execute then
Socket.SendText('Ready') //准备接收
else
Socket.SendText('ansNo') //不接收
end
else
Socket.SendText('ansNo'); //不接收
end;
end;
procedure TForm1.bsSkinButton3Click(Sender: TObject);
begin
bsSkinButton5.Enabled:=false;
if OpenDialog2.Execute then
begin
ClientSocket1.Socket.SendText('ask'+HostIp+'-'+Hostname+';'+ExtractFileName(OpenDialog2.FileName));
Application.MessageBox('信息已经发出,等待对方应答!','提示',MB_OK);
end
end;
procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var RealCount:integer;
FileInfo:string;
Buffointer;
i,len:integer;
begin
if (not FilenfoReceived) then
begin
bsSkinLabel2.Caption:='';
Timer2.Interval:=1000;
FilenfoReceived:=true;
FileInfo:=socket.ReceiveText;
i:=1;
len:=length(FileInfo);;
while true do
begin
if copy(FileInfo,i,1)='/' then break;
i:=i+1;
end;
FileName:=copy(FileInfo,1,i-1); //服务端发送的文件名与文件长度之间有一“/”
FileSize:=StrToInt(copy(FileInfo,i+1,len-i));
bsSkinGauge1.MaxValue:=FileSize;
//建立目标文件
DestFileStream:=TFileStream.Create(ExtractFileName(FileName),fmCreate or fmOpenWrite);
end
else
begin
//开始接收文件
getmem(buff,datasize);
RealCount:=Socket.ReceiveBuf(Buff^,datasize);
DestFileStream.WriteBuffer(Buff^,RealCount); //将接收到的文件内容写入目标文件
bsSkinGauge1.Value:=DestFileStream.Size;
Socket.SendText('Ready'); //返回一条信息,准备接收后续数据
freemem(buff);
if DestFileStream.size>=FileSize then
begin
Timer2.Interval:=0;
DestFileStream.Free;
FilenfoReceived:=false;
Socket.SendText('Over');
trans:=false;
Application.MessageBox('文件传送成功完成!','提示',MB_OK);
bsSkinGauge1.Value:=0;
end;
end;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s: string;
begin
s:=Socket.ReceiveText;
if s='ansNo' then
begin
Application.MessageBox('对方不愿意接收文件!','提示',MB_OK);
bsSkinButton5.Enabled:=false;
end;
If s='Ready' then
begin
Application.MessageBox('对方已准备接收,请发送!','提示',MB_OK);
bsSkinButton5.Enabled:=true;
end;
end;
procedure TForm1.bsSkinButton5Click(Sender: TObject);
var
s: string;
begin
trans:=true;
fs:=TFileStream.Create(OpenDialog2.FileName,fmOpenRead);
//获取文件大小
FileSize:=GetFileSize(OpenDialog2.FileName);
bsSkinGauge1.MaxValue:=FileSize;
bsSkinGauge1.MinValue:=0;
bsSkinGauge1.Value:=0;
bsSkinLabel2.Caption:='';
CostTime:=0;
Timer2.Interval:=1000;
//先发文件名与字节数
s:=ExtractFileName(OpenDialog2.FileName)+'/'+InttoStr(FileSize);
ClientSocket2.Socket.SendText(s);
//开始发送文件
getmem(buff,datasize);
//RealCoun为实际读取的字节数
RealCount:=fs.Read(buff^,datasize);
ClientSocket2.socket.sendbuf(buff^,RealCount);
bsSkinButton3.Enabled:=false;
bsSkinButton5.Enabled:=false;
end;
procedure TForm1.ClientSocket2Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s:string;
begin
s:=Socket.ReceiveText;
if s='Ready' then
begin
getmem(buff,datasize);
RealCount:=fs.Read(buff^,datasize);
bsSkinGauge1.Value:=fs.Position;
ClientSocket2.socket.sendbuf(buff^,RealCount);
end;
if s='Over' then
begin
Timer2.Interval:=0;
bsSkinButton5.Enabled:=false;
bsSkinButton3.Enabled:=true;
freemem(buff,DataSize);
fs.Free;
Application.MessageBox('文件传送成功完成!','提示',MB_OK);
bsSkinGauge1.Value:=0;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
CostTime:=CostTime+1;
bsSkinLabel2.Caption:=IntToStr(CostTime);
bsSkinLabel2.Refresh;
end;
end.