main.pas

这是一个可以在小局域网内聊天的小工具

if (Header='Chat') then
  ReceivedChatMsg(TrueFromIP,Msg);
end;

procedure TMainForm.LoginItemClick(Sender: TObject);
begin
SendLoginMsg(BroadCastIP);
ChatRoomItem.Enabled:=True;
PChatRoomItem.Enabled:=True;
end;

procedure TMainForm.ReceivedBroadCastMsg(const FromIP,Msg:String);
//接收到了广播信息，用于聊天室
//头信息
//1、'InRoom':进入房间
//2、'OtRoom':出房间
//3、'ChatMg':聊天信息
var
  Header:String;
begin
if not InChatRoom then exit;
Header:=Copy(Msg,1,HeaderLen);
if Header='InRoom' then
  begin
  ReceivedInRoomMsg(FromIP,Copy(Msg,HeaderLen+1,Length(Msg)-HeaderLen));
  exit;
  end;
if Header='OtRoom' then
  begin
  ReceivedOutRoomMsg(FromIP);
  exit;
  end;
if Header='ChatMg' then ReceivedChatRoomMsg(FromIP,Copy(Msg,HeaderLen+1,Length(Msg)-HeaderLen));
end;

procedure TMainForm.ReceivedChatMsg(const FromIP,Msg:String);
//接收到了个人的聊天信息
var
  ReceivedMsgForm:TReceivedMsgForm;
begin
if FromIP=LocalIP then  //自己不应该给自己发信息吧 :)
  exit;
ReceivedMsgForm:=FindWindowByIP(FromIP);
if ReceivedMsgForm=Nil then
  ReceivedMsgForm:=TReceivedMsgForm.Create(Self);
ReceivedMsgForm.FromIP:=FromIP;
with ReceivedMsgForm do
  begin
  RemoteComputerName:=GetComputerNameByIP(FromIP);
  MsgList.Add(Msg);
  if MsgList.Count>1 then btnNext.Enabled:=True;
  NoteBook.ActivePage:='ReceivedMsg';
  Show;
  if AutoPopupItem.Checked then
    begin
    Application.BringToFront;
    end
  else
    begin
    TrayIcon.Hint:='您有新信息';
    end;
  end;
end;

procedure TMainForm.ReceivedLoginMsg(const FromIP,Msg:String);
//接收到了登录信息
var
  RemoteComputerName:String;
begin
  if FindIP(FromIP)=-1 then
    begin
    RemoteComputerName:=Msg;
    AddUser(FromIP,RemoteComputerName);
    SendLoginMsg(FromIP);
    end;
end;

procedure TMainForm.ReceivedLogoutMsg(const FromIP:String);
//接收到了退出信息
begin
DelUser(FromIP);
end;

procedure TMainForm.LogoutItemClick(Sender: TObject);
begin
SendLogoutMsg;
ChatRoomItem.Enabled:=False;
PChatRoomItem.Enabled:=False;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SendLogoutMsg;
end;

procedure TMainForm.UserListBoxDblClick(Sender: TObject);
var
  i:Integer;
  UserInfo,sFromIP,sRemoteComputerName:String;
  ReceivedMsgForm:TReceivedMsgForm;
begin
i:=UserListBox.ItemIndex;
UserInfo:=UserList.Strings[i];
sFromIP:=Trim(Copy(UserInfo,1,IPLen));
if sFromIP=LocalIP then exit;
sRemoteComputerName:=Copy(UserInfo,IPLen+1,Length(UserInfo)-IPLen);
ReceivedMsgForm:=FindWindowByIP(sFromIP);
if ReceivedMsgForm=Nil then
  ReceivedMsgForm:=TReceivedMsgForm.Create(Self);
with ReceivedMsgForm do
  begin
  FromIP:=sFromIP;
  RemoteComputerName:=sRemoteComputerName;
  NoteBook.ActivePage:='Answer';
  Show;
  end;
end;

function TMainForm.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 TReceivedMsgForm(Screen.Forms[i]).FromIP=IP then
      begin
      Result:=TReceivedMsgForm(Screen.Forms[i]);
      exit;
      end;
    end;
  end;
end;

function TMainForm.GetComputerNameByIP(const IP: String): String;
//通过IP获得机器名
var
  i:Integer;
  ts:String;
begin
Result:='';
i:=FindIP(IP);
if i>=0 then
  begin
  ts:=UserList.Strings[i];
  Result:=Copy(ts,IPLen+1,Length(ts)-IPLen);
  end;
end;

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

procedure TMainForm.ChatRoomItemClick(Sender: TObject);
var
  S:String;
begin
if InChatRoom then
  begin
  ChatRoomForm.WindowState:=wsMaximized;
  ChatRoomForm.show;
  exit;
  end;
NickNameForm:=TNickNameForm.Create(Self);
NickNameForm.NickNameEdit.Text:=ComputerName;
NickNameForm.ShowModal;
s:=NickNameForm.NickNameEdit.Text;
NickNameForm.Free;
ChatRoomForm:=TChatRoomForm.Create(Self);
ChatRoomForm.NickName:=s;
ChatRoomForm.show;
InChatRoom:=True;
SendInRoomMsg(BroadCastIP,s,True);
end;

procedure TMainForm.SendMsg(const IP, Msg: String);
//向IP发送信息
begin
IniMsgStream;
MsgStream.Write(Msg[1],Length(Msg));
NMUDP.RemoteHost:=IP;
NMUDP.SendStream(MsgStream);
end;

procedure TMainForm.SendChatRoomMsg(const IP,Msg: String);
//广播聊天消息
var
  s:String;
begin
s:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','ChatMg'])+Msg;
SendMsg(IP,s);
end;

procedure TMainForm.SendInRoomMsg(const IP,NickName: String;const Echo:Boolean);
//广播进入聊天室的信息
var
  Msg:String;
begin
if Echo then
  Msg:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','InRoom'])+'1'+NickName
else
  Msg:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','InRoom'])+'0'+NickName;
SendMsg(IP,Msg);
end;

procedure TMainForm.SendOutRoomMsg;
//广播离开聊天室的信息
var
  Msg:String;
begin
Msg:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','OtRoom']);
SendMsg(BroadCastIP,Msg);
end;

procedure TMainForm.ReceivedChatRoomMsg(const FromIP, Msg: String);
//收到聊天室信息
var
  Temp,iColor:Integer;
  s:String;
begin
s:=Trim(Copy(Msg,1,2)); //获得颜色
iColor:=StrToInt(s);
s:=Copy(Msg,3,Length(Msg)-2);
with ChatRoomForm do
  begin
  Temp:=Length(ChatMsgRichEdit.Text);
  ChatMsgRichEdit.Lines.Add(s);
  ChatMsgRichEdit.SelStart:=Temp;//这两句能保证RichEdit的最下面一行能显示出来
  ChatMsgRichEdit.SelLength:=Length(s);
  ChatMsgRichEdit.SelAttributes.Color:=ColorArray[iColor];
  ChatMsgRichEdit.SelLength:=0;
  end;
end;

procedure TMainForm.ReceivedInRoomMsg(const FromIP, UserName: String);
//收到进聊天室信息
var
  i:Integer;
  Echo,s:String;
begin
with ChatRoomForm do
  begin
  i:=FindIP(FromIP);
  Echo:=Copy(UserName,1,1);
  if i=-1 then
    begin
    UserInRoomList.Add(FromIP);
    s:=Copy(UserName,2,Length(UserName)-1);
    UserListBox.Items.Add(S);
    cbUserList.Items.Add(S);
    if Echo='1' then
     begin
     with ChatMsgRichEdit do
      begin
      i:=Length(Text);
      s:='系统消息：['+s+']进入聊天室';
      Lines.Add(s);
      SelStart:=i;
      SelLength:=Length(s);
      SelAttributes.Color:=clRed;
      SelAttributes.Style:=[fsBold];
      SelLength:=0;
      end;
     SendInRoomMsg(FromIP,NickName,False);
     end;
    end;
  StatusBar.Panels[0].Text:='在线总人数：'+IntToStr(UserList.Count)+'位';
  StatusBar.Panels[1].Text:='聊天室总人数：'+IntToStr(UserInRoomList.Count-1)+'位';
  end;
end;

procedure TMainForm.ReceivedOutRoomMsg(const FromIP: String);
//收到出聊天室信息
var
  i:Integer;
  TempName,s:String;
begin
with ChatRoomForm do
  begin
  i:=FindIP(FromIP);
  TempName:=UserListBox.Items[i];
  if i<>-1 then
    begin
    UserInRoomList.Delete(i);
    UserListBox.Items.Delete(i);
    cbUserList.Items.Delete(i);
    end;
    with ChatMsgRichEdit do
      begin
      i:=Length(Text);
      s:='系统消息：['+TempName+']退出聊天室';
      Lines.Add(s);
      SelStart:=i;
      SelLength:=Length(s);
      SelAttributes.Color:=clRed;
      SelAttributes.Style:=[fsBold];
      SelLength:=0;
      end;
  StatusBar.Panels[0].Text:='在线总人数：'+IntToStr(UserList.Count)+'位';
  StatusBar.Panels[1].Text:='聊天室总人数：'+IntToStr(UserInRoomList.Count-1)+'位';
  end;
end;

procedure TMainForm.AutoPopupItemClick(Sender: TObject);
begin
//TMenuItem(Sender).checked:=not TMenuItem(Sender).Checked;
//不知为什么这一句不能对两个菜单项都起作用？？？
AutoPopupItem.Checked:=not AutoPopupItem.Checked;
PAutoPopupItem.Checked:=not PAutoPopupItem.Checked;
end;

procedure TMainForm.N14Click(Sender: TObject);
var
  Icon:Integer;
  Title,Msg:String;
begin
Icon:=LoadIcon(hinstance,'mainicon');
Title:='NetICQ V1.0';
Msg:='赵亦平 于 2000.12.6'#13#10'http://delphis.yeah.net';
ShellAbout(Handle,PChar(Title),PChar(Msg),Icon);
end;

end.