unitmessage.~pas

企业通comicq是一个通讯工具软件,一个通讯工具软件

unit UnitMessage;

interface

uses
  SysUtils
  ,Winsock
  ,Classes
  ,NMUDP
  ,Forms
  ,Dialogs
  ,Graphics
  ,UnitConfig
  ,ScktComp
  ,ReceivedUnit
  ,StdCtrls
  ,ComCtrls;

const
  HeaderLen = 6;
  IPLen     = 15;
  ColorArray: array[0..15] of TColor =
  (clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);

  {
协议简介：
首先由Client发送MP_QUERY，Server接受到后发送MP_ACCEPT或MP_FEFUESE；
Client接受到MP_ACCEPT发送MP_FILEPROPERTY，Server接受到后发送MP_NEXTWILLBEDATA；
Client接受到发送MP_NEXTWILLBEDATA，Server接受到后发送MP_DATA；
Client接受到MP_DATA，发送数据，Server接受数据，并发送MP_NEXTWILLBEDATA；
循环，直到Client发送MP_OVER；
中间可以互相发送MP_CHAT+String；

  点对点数据传输自定义协议
  //Msg的格式：
  //前1位是报头，标志数据传输方式
  //2-16位是本机IP地址，虽然FromIP包含了发信息方的IP，但是如果有代理服务器的话，
  //这个IP有时是代理服务器的IP；
  //17-22是信息标识：
  //  'Login' --上线信息
  //  'Logout'--离线信息
  //  'Broad' --广播信息
  //  'Chat'  --聊天信息
  //  23位起就是实际信息(包括消息文本、计算机名、文件等)
  }

  MP_QUERY          = '1';      //询问
  MP_REFUSE         = '2';      //拒绝
  MP_ACCEPT         = '3';      //接收
  MP_NEXTWILLBEDATA = '4';      //下一步传输数据
  MP_DATA           = '5';      //传输数据
  MP_ABORT          = '6';      //终止
  MP_OVER           = '7';      //传输结束
  MP_CHAT           = '8';      //聊天
  MP_FILEPROPERTY   = '9';      //文件属性
  MP_END            = '0';      //结束

  MP_BYTEPERTRANSFER= 1024;        //每次传输包1K

type
  TTYICQ = Class(TObject)
  private
    UDP:TNMUDP;                 //UDP控件[用于发送局域网广播]
    bReadText:boolean;          //是否读文件数据
    ReceivedMsgForm:TReceivedMsgForm;      //接收消息窗口
    ReceivedMsgFromIP:string;

    BroadCastIP:  String;       //广播IP
    ChatRoomForm:TForm;         //聊天室窗口
    fsRecv:TFileStream;
    fsSend:TFileStream;
    bufRecv:Pointer;
    bufSend:Pointer;
  public
    ClientSocket:TClientSocket; //SOCKET控件
    ComputerName: String;        //计算机名称
    MsgStream:    TMemoryStream; //内存数据流
    Login:        Boolean;       //是否已经登录

    LocalIP:      String;        //本机IP

    ServerIP,Port,UpdateURL:string;
    IsAutoUpdate:boolean;
    InChatRoom:   Boolean;       //是否在聊天室里

    IPList:TStringList;          //IP地址集合
    UserNameList: TStringList;   //用户名称集合

    //通过IP查找接收消息窗口
    function  FindWindowByIP(const IP:String):TReceivedMsgForm;
    //查找IP
    function  FindIP(const IP:String):Integer;

    //取得本地IP地址
    function GetLocalIP:String;

    //根据IP取得计算机名
    function GetComputerNameByIP(const IP:String):String;

    //增加用户
    procedure AddUser(const IP,UserName:string);

    //删除用户
    procedure DelUser(const IP:String);

    //初始化信息流
    procedure IniMsgStream;

    //设置广播IP
    procedure SetBroadCastIp;

    //向IP发送消息
    procedure SendMsg(const IP,Msg:String);

    //广播发送登录消息
    procedure SendLoginMsg(const IP:String);

    //广播发送离线消息
    procedure SendLogoutMsg;

    //收到了登录信息
    procedure ReceivedLoginMsg(const FromIP,Msg:String);

    //收到了离线消息
    procedure ReceivedLogoutMsg(const FromIP:String);

    //收到了广播消息
    procedure ReceivedBroadCastMsg(const FromIP,Msg:String);

    //收到了个人聊天消息
    procedure ReceivedChatMsg(const FromIP,Msg:String);

    //发送进入聊天室消息
    procedure SendInRoomMsg(const IP,NickName:String;const Echo:Boolean);

    //发送离开聊天室消息
    procedure SendOutRoomMsg;

    //发送聊天室消息
    procedure SendChatRoomMsg(const IP,Msg:String);

    //收到了进入聊天室消息
    procedure ReceivedInRoomMsg(const FromIP,UserName:String);

    //收到了离开聊天室消息
    procedure ReceivedOutRoomMsg(const FromIP:String);

    //收到了聊天室消息
    procedure ReceivedChatRoomMsg(const FromIP,Msg:String);

    //保存系统配置文件
    procedure SaveSysConfig(ServerIP,Port,UpdateURL:string;IsAutoUpdate:boolean);

    //保存用户配置文件
    procedure SaveSysUser(UserName,IP:string);

    //取得用户列表文件名
    function GetUserList:string;

    //取得用户
    procedure GetUser(var UserList,IPList:TstringList);

    //传送文件
    procedure SendFile(FileName:string;SendSocket: TCustomWinSocket;Header:string);

    //接收文件数据
    procedure ReceiveData(Socket:TCustomWinSocket;UserListBox:TListView);

    Constructor Create(pUDP:TNMUDP;pClientSocket:TClientSocket);
    Destructor Destroy;override;
  end;
implementation
Constructor TTYICQ.Create(pUDP:TNMUDP;pClientSocket:TClientSocket);
begin
  MsgStream    := TMemoryStream.Create;

  IPList       := TStringlist.Create;
  UserNameList := TStringlist.Create;

  //创建系统配置文件，并读取配置文件参数
  CreateSysConfigFile(ServerIP,Port,UpdateURL,IsAutoUpdate,IPList,UserNameList);

  bReadText       := True;
  LocalIP         := GetLocalIP;
  ComputerName    := GetComputerNameByIP(LocalIP);

  SetBroadCastIP;
  Login           := False;
  InChatRoom      := False;

  UDP    := TNMUDP.Create(nil); //申明UDP对象
  UDP    := pUDP;
  UDP.ReportLevel := Status_Basic;
  UDP.LocalPort   := 8001;//strtoint(Port);
  UDP.RemotePort  := 8001;//strtoint(Port);

  ClientSocket := TClientSocket.Create(nil);
  ClientSocket := pClientSocket;

  ClientSocket.Address  := ServerIP;    //设置代理服务器IP
  ClientSocket.Port     := strtoint(Port);
  ClientSocket.Active   := true;

end;

Destructor TTYICQ.destroy;
begin
  FreeMemory(MsgStream);
  IPList.Free;
  UserNameList.Free;

  UDP.Destroy;

  if ClientSocket.Active then
  begin
    ClientSOcket.Close;
    ClientSocket.Destroy;
  end;
  inherited;
end;

function TTYICQ.FindWindowByIP(const IP:String):TReceivedMsgForm;
//按照IP来查找ReceivedMsgForm窗口，如果未找到则返回Nil;
var
  i:Integer;
begin
  Result := Nil;
  for i:=0 to Screen.FormCount-1 do
  begin
    if Screen.Forms[i].Caption='消息窗口' then
    begin
      if ReceivedMsgFromIP=IP then
      begin
        Result := TReceivedMsgForm(Screen.Forms[i]);
        exit;
      end;
    end;
  end;
end;

function TTYICQ.FindIP(const IP:String):Integer;
var
  i:Integer;
  ts:String;
begin
  Result := -1;
  for i:=0 to IPList.Count-1 do
  begin
    ts := Trim(Copy(IPList.Strings[i],1,15));
    if ts=IP then
    begin
      Result := i;
      exit;
    end;
  end;
end;

function TTYICQ.GetLocalIP:String;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe  : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I    : Integer;
  GInitData      : TWSADATA;
begin
  WSAStartup($101, GInitData);
  try
    Result:='';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do
    begin
      result := StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
    end;
  finally
    WSACleanup;
  end;
end;

function TTYICQ.GetComputerNameByIP(const IP:String):String;
var
  i:Integer;
begin
  Result := '';
  i      := FindIP(IP);
  if i>=0 then
  begin
    Result := UserNameList[i];
  end;
end;

procedure TTYICQ.AddUser(const IP,UserName:string);
var
  s:String;
begin
  s := Trim(Format('%-15s%-255s',[IP,UserName]));
  IPList.Add(s);
  UserNameList.Add(UserName);
end;

procedure TTYICQ.DelUser(const IP:String);
var
  i:Integer;
begin
  i := FindIp(IP);
  if i>=0 then
  begin
    IPList.Delete(i);
    UserNameList.Delete(i);
  end;
end;

procedure TTYICQ.IniMsgStream;
begin
  MsgStream.Clear;
  MsgStream.Position := 0;
  MsgStream.Size     := 0;
end;

procedure TTYICQ.SetBroadCastIp;
var
  i,j,iHead:Integer;
  sHead,s:String;
  ai:array [1..3] of integer;
begin
  {1~126.255.255.255  (A类网广播地址）
  128~191.XXX.255.255 (B类网广播地址）
  192~254.XXX.XXX.255 (C类网广播地址）}
  j := 1;
  for i:=0 to Length(LocalIP) do
  begin
    if LocalIP[i]='.' then
    begin
      ai[j] := i;
      Inc(j);
    end;
    if j>3 then break;
  end;

  sHead := Copy(LocalIp,1,ai[1]-1);
  iHead := StrToInt(sHead);
  if iHead<128 then  //A类网
  begin
    BroadCastIP := sHead+'.255.255.255';
  end
  else
  begin
    if iHead<192 then //B类网
    begin
      s := Copy(LocalIP,1,ai[2]-1);
      BroadCastIP := s+'.255.255';
    end
    else  //C类网
    begin
      s := Copy(LocalIP,1,ai[3]-1);
      BroadCastIP := s+'.255';
    end;
  end;
end;

procedure TTYICQ.SendMsg(const IP,Msg:String);
var
  MyStream:TMemoryStream;
  MsgLen:integer;
begin
  MsgLen   := Length(Msg);
  MyStream := TMemoryStream.Create;
  MyStream.Write(Msg[1],MsgLen);
  try
  UDP.RemoteHost := IP;
  UDP.SendStream(MyStream);
  finally
    MyStream.Free;
  end;
end;