main.~pas

关于DEPHI7.0的网络聊天信息管理系统源代码

begin
if MemoChat.Lines.Count <> 0 then
  begin
  FormMailMsg.EMailMemo.Clear;
  for i := 0 to MemoChat.Lines.Count - 1 do
      begin
      tmpString := MemoChat.Lines.Strings[i];
      FormMailMsg.EMailMemo.Lines.Add(tmpString);
      end;
  end;
 FormMailMsg.Show;
end;

procedure TFormMain.FormCreate(Sender: TObject);
var FriendName : String;
    i: Integer;
begin
if InputBox('请输入密码','注册软件请访问'+#10+#13+'http://journer.yeah.net'
              +#10+#13+'你的密码是：','journer') <> 'journer' then close
else
begin
  myIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'NetChat.ini');
  UserID := myIni.ReadInteger('当前聊者','序号', 0);
  SocketID := myIni.ReadString('Socket', '端口号','5858');
  Assignfile(FriendFile, 'Friend.dat');
  Reset(FriendFile);
  Seek(FriendFile, UserID);
  Read(FriendFile, ThisUser);
  FriendHide := False;
  //刷新朋友列表
  if FileSize(FriendFile) <> 0 then
  begin
    try
       i := 0;
       repeat
         Seek(FriendFile,i);
         i := i+1;
         Read(FriendFile, ThisUser);
         FriendName := ThisUser.UserComputerName;
         ListBoxFriend.Items.Add(FriendName);
       until Eof(FriendFile);
    finally
       CloseFile(FriendFile);
    end;
  TalkAboutComputer := ListBoxFriend.Items[UserID];
  EditChat.Text :=  TalkAboutComputer;
  end;
  MemoSend.Clear;
 end;
 TcpServer1.LocalPort := EditPort.Text;
 TcpServer1.Active := True;
end;

Function FindAllComputer(var ComputerList : TStringList ): Boolean;
var WorkGroupList, TempList: TStringList;
    i, j : Integer;
begin
  WorkGroupList := TStringList.Create;
  TempList := TStringList.Create;
  //查找所有在线用户,将其添加到用户列表中
  Result := False;
  try
  GetWorkGroupList(WorkGroupList);
  for i := 0 to WorkGroupList.Count - 1 do
      begin
        GetComputerList(WorkGroupList.Strings[i],TempList);
        for j := 0 to TempList.Count - 1 do
          begin
          while Pos('\',TempList.Strings[j])<>0 do
              TempList.Strings[j] := copy(TempList.Strings[j],0,
              Pos('\',TempList.Strings[j])-1)
              +copy(TempList.Strings[j],Pos('\',TempList.Strings[j])+1,
              length(TempList.Strings[j]));
            ComputerList.Add(TempList.Strings[j]);
          end;
        TempList.Clear;
      end;
  finally
  TempList.Free;
  WorkGroupList.Free;
  Result := True;
  end;
end;

procedure TFormMain.BTNSendClick(Sender: TObject);
var   I: Integer;
       str: String;
begin
if trim(MemoSend.Lines.text) <> '' then
 begin
  if FindComputer(trim(EditChat.Text)) then
  begin
    TcpClient1.RemoteHost := EditChat.Text;//'Localhost';
    TcpClient1.RemotePort := EditPort.Text;
    try
     if TcpClient1.Connect then
     begin
     for I := 0 to MemoSend.Lines.Count - 1 do
         begin
         str := '';
         str := TcpServer1.LocalHost+' 对 '+ TcpClient1.RemoteHost+
               ' 说：'+#13#10+ MemoSend.Lines[I];
         MemoChat.Lines.Add(str);
         end;
      for I := 0 to MemoSend.Lines.Count - 1 do
         TcpClient1.Sendln(MemoSend.Lines[I]);
      end;
    finally
      TcpClient1.Disconnect;
      MemoSend.Clear;
    end;
  end
  else
      begin
       Application.MessageBox(Pchar('朋友不在线，不能发送消息！'),
              Pchar('错误！'),MB_OK+MB_ICONERROR);
      end;
 end
 else
    begin
     Application.MessageBox(Pchar('不要发送空消息'),
               Pchar('错误！'),MB_OK+MB_ICONERROR);
    end;
end;

procedure TFormMain.TcpServer1Accept(Sender: TObject;
  ClientSocket: TCustomIpClient);
var
  s: string;
  DataThread: TClientDataThread;
begin
  //创建线程
  DataThread:= TClientDataThread.Create(True);
  //设置TagetList到显示区域
  DataThread.TargetList := MemoChat.lines;

  //装入线程ListBuffer
  DataThread.ListBuffer.Add(
      ClientSocket.LookupHostName(ClientSocket.RemoteHost) +
         ' 来自 ' + ClientSocket.RemoteHost +' 说：');
  s := ClientSocket.Receiveln;
  while s <> '' do
  begin
    DataThread.ListBuffer.Add(s);
    s := ClientSocket.Receiveln;
  end;

  //刷新线程
  DataThread.Resume;
end;

procedure TFormMain.FormShow(Sender: TObject);
var sz: dword;
    ComputerList : TStringList;
    i : Integer;
begin
sz := SizeOf(Computername);
GetComputerName(ComputerName, sz);//得到本机的标识
EditMe.Text := ComputerName;
ListBoxUser.Items.Clear;
ComputerList := TStringList.Create;
if FindAllComputer(ComputerList) then
    for i := 0 to ComputerList.Count - 1 do
         ListBoxUser.Items.Add(ComputerList.Strings[i]);
ListBoxUser.ItemIndex:=0;
ComputerList.Free;
end;

function FindComputer(ComputerName: string):Boolean;
var
  WSAData: TWSAData;
  HostEnt: PHostEnt;
begin
  Result := False;
  WSAStartup(2, WSAData);
  HostEnt := Gethostbyname(PChar(ComputerName));
  if HostEnt = nil then Result := False
  else Result:= True;
  WSACleanup;
end;

procedure TFormMain.AddFriendActionExecute(Sender: TObject);
begin
  FormAdd.Show;
end;

procedure TFormMain.DelFriendActionExecute(Sender: TObject);
var i ,j : Integer;
    Buffer1, Buffer2 : array[0..2600] of byte;   //最大80个用户
begin
  i := ListBoxFriend.ItemIndex;
 if (i = UserID)  then
 if Application.MessageBox('“优利”提醒:'+#10+#13+
       '确实要清除当前聊天的朋友吗?','注意!',MB_OKCANCEL+
          MB_ICONINFORMATION+MB_SYSTEMMODAL+MB_DEFBUTTON2) <> IDOK then exit;
  assignfile(FriendFile, 'Friend.dat');
  Reset(FriendFile);
  j := FileSize(FriendFile)-i-1;
 try
   Seek(FriendFile,1);;
   BlockRead(FriendFile, Buffer1, i-1);
   Seek(FriendFile, i+1);
   BlockRead(FriendFile, Buffer2, j );
   Rewrite(FriendFile);
   Truncate(FriendFile);
   Seek(FriendFile, FileSize(FriendFile));
   BlockWrite(FriendFile, Buffer1, i-1);
   Seek(FriendFile, FileSize(FriendFile));
   BlockWrite(FriendFile, Buffer2, j);
  finally
   Seek(FriendFile, 1);
   Read(FriendFile, ThisUser);
   TalkAboutComputer := ThisUser.UserComputerName;
   EditChat.Text :=  TalkAboutComputer;
   CloseFile(FriendFile);
   ListBoxFriend.Items.Delete(i);
  end;
end;

procedure TFormMain.AllClearActionExecute(Sender: TObject);
begin
if ListBoxFriend.Items.Count <> 0 then
  begin
  if Application.MessageBox('“优利”提醒:'+#10+#13+'确实要清除全部好友吗?','注意了!',MB_OKCANCEL+MB_ICONINFORMATION+MB_SYSTEMMODAL+MB_DEFBUTTON2) = IDOK then
     begin
     ListBoxFriend.Clear;
     Assignfile(FriendFile, 'Friend.dat');
     reset(FriendFile);
     try
       rewrite(FriendFile);
     finally
       UserID := -1;
       myIni.writeInteger('当前聊者','序号', UserID);
       CloseFile(FriendFile);
     end;
     end;
  end;
end;

procedure TFormMain.HideFriendActionExecute(Sender: TObject);
begin
if not FriendHide then
   begin
   PanelFriend.Height := Label2.Height + Panel7.Height;
   BTNHide.Caption := '显示(&D)';
   end
else
   begin
   PanelFriend.Height := Label2.Height + Panel7.Height+ 150;
   BTNHide.Caption := '隐藏(&H)';
   end;
Panel1.Refresh;
FriendHide := not FriendHide;
end;

procedure TFormMain.OpenFileActionExecute(Sender: TObject);
begin
OpenDialog1.Title := '请选择文件或输入文件名！';
OpenDialog1.Filter := '优利聊天文件(*.cat)|*.cat|文本文件(*.txt)|*.txt|各种文件(*.*)|*.*';
try
if OpenDialog1.Execute then
   MemoSend.Lines.LoadFromFile(OpenDialog1.FileName);
except
   ShowMessage('无法装入该文件！');
end;
end;

procedure TFormMain.SaveFileActionExecute(Sender: TObject);
begin
if trim(MemoChat.Lines.Text) <> '' then
  begin
  SaveDialog1.Title := '请输入保存文件名！';
  SaveDialog1.Filter := '优利聊天文件(*.cat)|*.cat|文本文件(*.txt)|*.txt';
   try
   if SaveDialog1.Execute then
       MemoChat.Lines.SaveToFile(SaveDialog1.FileName);
   except
   ShowMessage('无法保存文件！');
   end;
  end;
end;

procedure TFormMain.ClearMsgActionExecute(Sender: TObject);
begin
if trim(MemoChat.Lines.Text) <> '' then
  begin
  if Application.MessageBox('“优利”提醒:'+#10+#13+'确实要清除当前对话记录吗?','注意了!',MB_OKCANCEL+MB_ICONINFORMATION+MB_SYSTEMMODAL+MB_DEFBUTTON2) = IDOK then
     MemoChat.Clear;
  end;
end;

procedure TFormMain.PopMenuInfoViewClick(Sender: TObject);
begin
  Assignfile(FriendFile, 'Friend.dat');
  Reset(FriendFile);
  Seek(FriendFile,ListBoxFriend.ItemIndex);
 try
  if not Eof(FriendFile) then
     Read(FriendFile, ThisUser);
 finally
  CloseFile(FriendFile);
 end;
  FormAdd.EditComputer.Text := ThisUser.UserComputerName;
  FormAdd.EditNickName.Text := ThisUser.UserNickName;
  FormAdd.MEditIP.Text := ThisUser.UserIPAddress;
  FormAdd.Show;
end;

procedure TFormMain.ListBoxFriendDblClick(Sender: TObject);
begin
  UserID := ListBoxFriend.ItemIndex;
  TalkAboutComputer := ListBoxFriend.Items[UserID];
  EditChat.Text :=  TalkAboutComputer;
  MyIni.WriteInteger('当前聊者','序号', UserID);
end;

procedure TFormMain.MemoSendDblClick(Sender: TObject);
begin
  BTNSendClick(Sender);
end;

procedure TFormMain.ListBoxUserDblClick(Sender: TObject);
begin
 ListBoxFriend.Items.Add(ListBoxUser.Items[ListBoxUser.ItemIndex]);
 assignfile(FriendFile, 'Friend.dat');
 reset(FriendFile);
 Seek(FriendFile, FileSize(FriendFile));
 TempUser.UserComputerName := ListBoxUser.Items[ListBoxUser.ItemIndex];
 TempUser.UserIPAddress :=  GetIP( TempUser.UserComputerName );
 try
   Write(FriendFile, TempUser);
 finally
   CloseFile(FriendFile);
 end;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TcpClient1.Disconnect;
  TcpServer1.Destroy;
  MyIni.Free;
end;

procedure TFormMain.BTNModifyClick(Sender: TObject);
begin
  MyIni.WriteString('Socket', '端口号', EditPort.Text);
  TcpServer1.LocalPort := EditPort.Text;
  TcpServer1.Active := True;
end;

end.