⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 delphi 编的一个语音的聊天系统.还是能用的,要是有错误请多多指教
💻 ~PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdSocketHandle,
  ExtCtrls, ComCtrls, StdCtrls, Menus, Grobal, IdTCPServer;

type
  TForm1 = class(TForm)
    UDPServer: TIdUDPServer;
    Timer: TTimer;
    StatusBar: TStatusBar;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    ListView: TListView;
    TCPServer: TIdTCPServer;
    Panel: TPanel;
    GroupBox: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    StatusTimer: TTimer;
    procedure UDPServerUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure TimerTimer(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TCPServerExecute(AThread: TIdPeerThread);
    procedure N5Click(Sender: TObject);
    procedure StatusTimerTimer(Sender: TObject);
  private
    { Private declarations }
    procedure UDPStreamServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure UDPStreamServer2UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ClientList:TStringList;
  AllDataSize:Integer;
  DataSize:Array[1..2] of Integer;
  UDPStreamServer:Array[1..2] of TIdUDPServer;
  PortUseFlags:Array[1..2] of Boolean;
  PortStatus:Array[1..2] of SmallInt;
  ClientStatus:Array[1..65535] of SmallInt;
implementation

{$R *.dfm}

procedure TForm1.UDPServerUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
RecvInfo,Cmd:String;
i,j,SelectServer:integer;
LoginFlags:Boolean;
UserInfo:TListItem;
begin
LoginFlags:=False;
SetLength(RecvInfo,AData.Size);
AData.Read(RecvInfo[1],AData.Size);
SelectServer:=StrToInt(Copy(RecvInfo,1,1));
Cmd:=Copy(RecvInfo,2,Length(RecvInfo)-1);
if Cmd='Login' then
begin
for i:=0 to ClientList.Count-1 do
begin
if ABinding.PeerIP+'/'+IntToStr(ABinding.PeerPort)+'/'+IntToStr(SelectServer)=ClientList.Strings[i] then  LoginFlags:=True;
break;
end;
if not LoginFlags then
begin
ClientList.Add(ABinding.PeerIP+'/'+IntToStr(ABinding.PeerPort)+'/'+IntToStr(SelectServer));
ClientStatus[ClientList.Count]:=0;
UserInfo:=ListView.Items.Add;
UserInfo.Caption:=ABinding.PeerIP;
UserInfo.SubItems.Add(IntToStr(ABinding.PeerPort));
UserInfo.SubItems.Add(IntToStr(SelectServer));
UserInfo.SubItems.Add(DateTimeToStr(Now));
end;
end;

if Cmd='OutLogin' then
begin
for i:=0 to ClientList.Count-1 do
begin
if ABinding.PeerIP+'/'+IntToStr(ABinding.PeerPort)+'/'+IntToStr(SelectServer)=ClientList.Strings[i] then
begin
ClientList.Delete(i);
ClientStatus[i+1]:=0;
    for j := 0 to ListView.Items.Count - 1 do
    begin
      if (ListView.Items.Item[j].Caption = ABinding.PeerIP) and
        (ListView.Items.Item[j].SubItems[0] = IntToStr(ABinding.PeerPort)) and
        (ListView.Items.Item[j].SubItems[1] = IntToStr(SelectServer)) then
      begin
        ListView.Items.Delete(j);
        break;
      end;
    end;
break;
end;
end;
end;

end;

procedure TForm1.UDPStreamServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
i,Port:integer;
Host:String;
memStream:TMemoryStream;
Terms:TStringList;
SelectIdx:Integer;
begin
MemStream:=TMemoryStream.Create;
memStream.LoadFromStream(AData);
Terms:=TStringList.Create;
   for i:=0 to ClientList.Count-1 do
   begin
   AllDataSize:=AllDataSize + memStream.Size;
   DataSize[1]:=DataSize[1]+ memStream.Size;
   SeparateTerms(ClientList.Strings[i],'/',Terms);
   Host:=Terms.Strings[0];
   Port:=StrToInt(Terms.Strings[1]);
   SelectIdx:=StrToInt(Terms.Strings[2]);
   Terms.Clear;
   if SelectIdx=1 then
   begin
   if AData.Size>BufferSize then
        UDPServer.SendBuffer(Host,Port,memStream.Memory^,BufferSize)
   else
        UDPServer.SendBuffer(Host,Port,memStream.Memory^,memStream.Size);
   end;
   end;
Terms.Free;
MemStream.Free;
end;

procedure TForm1.UDPStreamServer2UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
i,Port:integer;
Host:String;
memStream:TMemoryStream;
Terms:TStringList;
SelectIdx:Integer;
begin
MemStream:=TMemoryStream.Create;
memStream.LoadFromStream(AData);
Terms:=TStringList.Create;
   for i:=0 to ClientList.Count-1 do
   begin
   AllDataSize:=AllDataSize + memStream.Size;
   DataSize[2]:=DataSize[2]+ memStream.Size;
   SeparateTerms(ClientList.Strings[i],'/',Terms);
   Host:=Terms.Strings[0];
   Port:=StrToInt(Terms.Strings[1]);
   SelectIdx:=StrToInt(Terms.Strings[2]);
   Terms.Clear;
   if SelectIdx=2 then
   begin
   if AData.Size>BufferSize then
        UDPServer.SendBuffer(Host,Port,memStream.Memory^,BufferSize)
   else
        UDPServer.SendBuffer(Host,Port,memStream.Memory^,memStream.Size);
   end;
   end;
Terms.Free;
MemStream.Free;
end;

procedure TForm1.TimerTimer(Sender: TObject);
var
i,Count1,Count2:integer;
Terms:TStringList;
begin
if PortUseFlags[1] and (DataSize[1]=0) and (ClientList.Count<>0) then inc(PortStatus[1]);
if PortUseFlags[2] and (DataSize[2]=0) and (ClientList.Count<>0) then inc(PortStatus[2]);
if PortStatus[1]>=5 then begin PortUseFlags[1]:=False; PortStatus[1]:=0; end;
if PortStatus[2]>=5 then begin PortUseFlags[2]:=False; PortStatus[2]:=0; end;
StatusBar.Panels[0].Text:=Format(ServerStatusStr,[ClientList.Count,Round(AllDataSize div 1024)]);
if PortUseFlags[1] then Label3.Caption:=PortUseStr else Label3.Caption:=PortNoUseStr;
if PortUseFlags[2] then Label4.Caption:=PortUseStr else Label4.Caption:=PortNoUseStr;
Label7.Caption:=Format(DataStreamSizeStr,[Round(DataSize[1] div 1024)]);
Label8.Caption:=Format(DataStreamSizeStr,[Round(DataSize[2] div 1024)]);

Count1:=0;
Count2:=0;
for i:=0 to ClientList.Count-1 do
begin
Terms:=TStringList.Create;
SeparateTerms(ClientList.Strings[i],'/',Terms);
if StrToInt(Terms.Strings[2])=1 then inc(Count1);
if StrToInt(Terms.Strings[2])=2 then inc(Count2);
end;

Label10.Caption:=IntToStr(Count1);
Label12.Caption:=IntToStr(Count2);

for i:=0 to ClientList.Count-1 do
begin
Inc(ClientStatus[i+1]);
end;


AllDataSize:=0;
DataSize[1]:=0;
DataSize[2]:=0;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
ClientList:=TStringList.Create;
Timer.Enabled:=True;
StatusTimer.Enabled:=True;
UDPServer.Active:=True;
UDPStreamServer[1].Active:=True;
UDPStreamServer[2].Active:=True;
TCPServer.Active:=True;
PortStatus[1]:=0;
PortStatus[2]:=0;
N3.Enabled:=True;
N2.Enabled:=False;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
Timer.Enabled:=False;
StatusTimer.Enabled:=False;
UDPServer.Active:=False;
UDPStreamServer[1].Active:=False;
UDPStreamServer[2].Active:=False;
ClientList.Free;
TCPServer.Active:=False;
ListView.Clear;
N3.Enabled:=False;
N2.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
UDPStreamServer[1]:=TIdUDPServer.Create(self);
with UDPStreamServer[1] do
begin
Name:='UDPStreamServer1';
DefaultPort:=8001;
OnUDPRead:=UDPStreamServer1UDPRead;
end;
UDPStreamServer[2]:=TIdUDPServer.Create(self);
with UDPStreamServer[2] do
begin
Name:='UDPStreamServer2';
DefaultPort:=8002;
OnUDPRead:=UDPStreamServer2UDPRead;
end;
StatusBar.Panels[0].Text:=Format(ServerStatusStr,[0,Round(AllDataSize div 1024)]);
end;

procedure TForm1.TCPServerExecute(AThread: TIdPeerThread);
var
RecvInfo:String;
Header:Integer;
begin
with AThread.Connection do
begin
RecvInfo:=Readln;
if Length(RecvInfo)<>5 then
begin
Disconnect;
Athread.Terminate;
end;

Header:=StrToInt(Copy(RecvInfo,1,1));
RecvInfo:=Copy(RecvInfo,2,Length(RecvInfo)-1);
case Header of

1:begin
if not PortUseFlags[1] then
begin
WriteLn('8001');
PortUseFlags[1]:=True;
end
else
begin
if not PortUseFlags[2] then
begin
WriteLn('8002');
PortUseFlags[2]:=True;
end
else
begin
WriteLn('0000');
end;
end;
Disconnect;
Athread.Terminate;
end;      //1 end

2:begin
if RecvInfo='8001' then PortUseFlags[1]:=False;
if RecvInfo='8002' then PortUseFlags[2]:=False;
Disconnect;
Athread.Terminate;
end;


end;      //case end


end;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.StatusTimerTimer(Sender: TObject);
var
i:integer;
begin
for i:=0 to ClientList.Count-1 do
begin
if ClientStatus[i+1]>30 then
begin
ClientList.Delete(i);
ListView.Items.Delete(i);
end;
end;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -