unit1.pas

确的目录

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 :DWord;
  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[i] 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[i] = 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);