www.pudn.com > 2004021618574529928.rar > MainForm.pas
//技术讨论群组软件
//开发者：张国伟
//2004-2-7 QQ：38326155
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, ScktComp, DB, ADODB, Winsock, StrUtils,
TrayBarIcon;
type
POnlineInf=^TOnlineInf;
TOnlineInf=record //在线主机信息
UserName:String[255]; //用户标识
ControlSoc:TSocket; //客户机控制信号套接字
end;
type
TfrmMain = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
SSEListUser: TListBox;
Panel3: TPanel;
RELog: TRichEdit;
TCPData: TServerSocket;
StatusBar1: TStatusBar;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
Label1: TLabel;
Timer: TTimer;
TrayIcon: TTrayIcon;
procedure TCPDataClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TCPDataClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure TimerTimer(Sender: TObject);
procedure TCPDataClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure TrayIconDblClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
procedure SendOnlinesInfo;
end;
var
frmMain: TfrmMain;
Onlines:TList;
MaxClient:Integer=1000;
implementation
uses UnitFunction;
{$R *.dfm}
procedure TfrmMain.SendOnlinesInfo;
var
Buf:array of Byte;
I:Integer;
Len,TempLen:Integer;
begin
SetLength(Buf,16 + SizeOf(Integer));
for I:= 0 to 16 - 1 do
begin
if ((I mod 2) = 0) then Buf[I]:=$A
else Buf[I]:=$F;
end;
PInteger(@Buf[16])^:=Onlines.Count;
for I:= 0 to Onlines.Count - 1 do
begin
Len:=LengTh(POnlineInf(Onlines.Items[I]).UserName);
TempLen:=LengTh(Buf);
SetLength(Buf,TempLen + Len + 1 + SizeOf(Integer));
CopyMemory(@Buf[TempLen],@POnlineInf(Onlines.Items[I]).UserName[1],Len);
Buf[TempLen + Len]:=0;
PInteger(@Buf[TempLen + Len +1])^:=POnlineInf(Onlines.Items[I]).ControlSoc;
end;
Len:=LengTh(Buf);
for I:= 0 to Onlines.Count - 1 do
begin
send(POnlineInf(Onlines.Items[I]).ControlSoc,Buf[0],Len,0);
Sleep(0);
end;
end;
procedure TfrmMain.TCPDataClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure AddUserInfo(UserName:String;Control:TSocket); //记录登录主机信息
var
TempInf:POnlineInf;
I:Integer;
begin
if SSEListUser.Items.Count >= MaxClient then
begin
Socket.SendText('$Z$MaxClient');
with RELog do //写入事件日志
begin
Lines.Add(DateTimeToStr(Now));
Lines.Add(UserName+' 连接');
Lines.Add('登录已拒绝，因服务器已达到最高人数');
Lines.Add('远程位置: '+Socket.RemoteAddress);
Lines.Add('');
end;
Exit;
end;
TempInf:=New(POnlineInf);
if SSEListUser.Items.Count > 0 then
begin
for I:= 0 to SSEListUser.Items.Count - 1 do //处理相同用户名
begin
if UserName = SSEListUser.Items.Strings[I] then
begin
Socket.SendText('$Z$Logon');
with RELog do //写入事件日志
begin
Lines.Add(DateTimeToStr(Now));
Lines.Add(UserName+' 连接');
Lines.Add('登录已拒绝，因用户名相同');
Lines.Add('远程位置: '+Socket.RemoteAddress);
Lines.Add('');
end;
Exit;
end;
end;
end;
TempInf.ControlSoc:=Control;
TempInf.UserName:=UserName;
Onlines.Add(TempInf);
SSEListUser.Items.Add(TempInf.UserName);
with RELog do //写入事件日志
begin
Lines.Add(DateTimeToStr(Now));
Lines.Add(TempInf.UserName+' 连接');
Lines.Add('远程位置: '+Socket.RemoteAddress);
Lines.Add('');
end;
Sleep(0);
SendOnlinesInfo;
end;
procedure DelUserInfo(UserName:String;Control:TSocket); //删除登录主机信息
var
TempInf:POnlineInf;
I:Integer;
TempCount:Integer;
begin
TempInf:=New(POnlineInf);
TempInf.ControlSoc:=Control;
TempInf.UserName:=UserName;
TempCount:=Onlines.Count - 1;
for i:=0 to TempCount do
if (POnlineInf(Onlines.Items[I]).UserName = UserName) and (POnlineInf(Onlines.Items[I]).ControlSoc = TempInf.ControlSoc) then
begin
Dispose(Onlines.Items[I]);
Onlines.Delete(I);
Break;
end;
TempCount:=SSEListUser.Items.Count - 1;
for I:=0 to TempCount do
if TempInf.UserName = SSEListUser.Items[I] then
begin
if SSEListUser.Items.IndexOf(TempInf.UserName) <> -1 then
SSEListUser.Items.Delete(SSEListUser.Items.IndexOf(TempInf.UserName));
Break;
end;
with RELog do //写入事件日志
begin
Lines.Add(DateTimeToStr(Now));
Lines.Add(TempInf.UserName+' 退出');
Lines.Add('远程位置: '+Socket.RemoteAddress);
Lines.Add('');
end;
SendOnlinesInfo;
end;
procedure TalkInfo(InBuf:array of Byte;Len:Integer;S:TSocket); //转发聊天信息
var
I:Integer;
SourceName:String;
TalkStr:String;
TIdNum:Integer;
BasePos:Integer;
TargetName:String;
TempBuf:array of Byte;
ProcessBuf:array of Byte;
TempContent:String;
begin
SetLength(TempBuf,Len); //开辟临时内存块
CopyMemory(@TempBuf[0],@InBuf[0],Len);
BasePos:=16; //超始位置
SetLength(ProcessBuf,Len + SizeOf(Integer));
CopyMemory(@ProcessBuf[0],@TempBuf[0],BasePos);
TIdNum:=Pinteger(@InBuf[BasePos])^; //取得收信息者 Socket 句柄
Pinteger(@ProcessBuf[Basepos])^:=S; //填充发送者 Socket 句柄
Inc(BasePos,SizeOf(Integer));
Pinteger(@ProcessBuf[BasePos])^:=TIdNum; //填充收信息 Socket 句柄
Inc(BasePos,SizeOf(Integer));
TempContent:=GetChatContent(TempBuf,LengTh(TempBuf)); //获取信息内容
CopyMemory(@ProcessBuf[BasePos],@TempContent[1],LengTh(TempContent)); //填充信息内容
ProcessBuf[Length(ProcessBuf) - 1]:=0;
begin
for I:= 0 to Onlines.Count - 1 do
send(POnlineInf(Onlines.Items[I]).ControlSoc,ProcessBuf[0],Length(ProcessBuf),0);
end;
end;
var
Buf:array of Byte;
Data:WideString;
Len:Integer;
UserName, Pwd, Email:String;
DelControlData:String;
IsTalkInf:Boolean;
IsUpdateSMsg:Boolean;
I:Integer;
TempServerMsg:String;
begin
Len:=Socket.ReceiveLength;
SetLength(Buf,Len);
Socket.ReceiveBuf(Buf[0],Len);
Data:=String(Buf);
if pos('$Z$Check',Data)=1 then //用户名检测
begin
UserName:=Copy(Data,9,255);
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('select User_Name from UserInfo where User_Name='+''''+UserName+'''');
Open;
end;
if ADOQuery.RecordCount = 0 then
Socket.SendText('$Z$CanReg')
else
Socket.SendText('$Z$NoReg');
//TCPData.Socket.Connections[TCPData.Socket.ActiveConnections - 1].Close;
end;
if pos('$Z$Reg',Data)=1 then //注册
begin
DelControlData:=Copy(Data,7,255);
UserName:=Copy(Trim(DelControlData),1,Pos(' ',Trim(DelControlData))-1);
DelControlData:=Copy(DelControlData,LengTh(UserName) + 1,255);
Pwd:=Copy(Trim(DelControlData),1,Pos(' ',Trim(DelControlData))-1);
DelControlData:=Copy(DelControlData,LengTh(Pwd) + 2,255);
Email:=Copy(Trim(DelControlData),1,255);
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('select User_Name from UserInfo where User_Name='+''''+UserName+'''');
Open;
end;
if ADOQuery.RecordCount = 0 then
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('insert into UserInfo values '+'('+ '''' + UserName + '''' + ',' + '''' + Pwd + '''' + ',' + '''' + Email + '''' + ',' + '0' + ',' + '''' + DateTimeToStr(Now) + '''' + ')');
ExecSQL;
Socket.SendText('$Z$CompleteReg');
//发送注册用户数
begin
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('select * from UserInfo');
Open;
end;
for I:= 0 to TCPData.Socket.ActiveConnections - 1 do
begin
TCPData.Socket.Connections[I].SendText('$Z$AllCount' + IntToStr(ADOQuery.RecordCount));
end;
end;
end
else
Socket.SendText('$Z$NoReg');
end;
if pos('$Z$Login',Data)=1 then
begin
DelControlData:=Copy(Data,9,255);
UserName:=Copy(Trim(DelControlData),1,pos(' ',Trim(DelControlData))-1);
Pwd:=copy(Trim(DelControlData),pos(' ',Trim(DelControlData))+1,length(Trim(DelControlData))-pos(' ',Trim(DelControlData)));
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('select * from UserInfo where User_Name=' + '''' + UserName + '''');
Open;
end;
if ADOQuery.RecordCount = 0 then
begin
Socket.SendText('$Z$NoUser');
Exit;
end
else
begin
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('select User_Pwd from UserInfo where User_Name=' + '''' + UserName + '''');
Open;
end;
if Pwd = ADOQuery.FieldByName('User_Pwd').AsString then
begin
Socket.SendText('$Z$LoginOk');
AddUserInfo(UserName,Socket.SocketHandle);
end
else
Socket.SendText('$Z$NoPwd');
end;
SendOnlinesInfo;
end;
if pos('$Z$OneCount',Data)=1 then //发送注册用户数
begin
with ADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('select * from UserInfo');
Open;
end;
Sleep(200);
Socket.SendText('$Z$OneCount' + IntToStr(ADOQuery.RecordCount));
end;
if pos('$Z$GetServerMsg',Data)=1 then //要求服务器消息
begin
SendServerMsg(GetServerMsg,Socket.SocketHandle);
end;
if pos('',Data)=1 then //要求服务器广播登录消息 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
begin
TempServerMsg:=GetServerMsg;
for I:= 0 to Onlines.Count - 1 do
begin
SendServerMsg(TempServerMsg,POnlineInf(Onlines.Items[I]).ControlSoc);
Sleep(0);
end;
end;
if pos('',Data)=1 then //要求服务器广播临时消息 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
begin
TempServerMsg:=Copy(Data,20,2000);
for I:= 0 to Onlines.Count - 1 do
begin
SendServerMsg(TempServerMsg,POnlineInf(Onlines.Items[I]).ControlSoc);
Sleep(0);
end;
end;
if pos('$Z$Out',Data)=1 then //退出
begin
UserName:=Copy(Data,7,255);
DelUserInfo(UserName,Socket.SocketHandle);
end;
IsTalkInf:=True;
for I:= 0 to 16 - 1 do
begin
if ((I mod 2) = 0) then IsTalkInf:=IsTalkInf and (Buf[I]=$F)
else IsTalkInf:=IsTalkInf and (Buf[I]=$A);
if not IsTalkInf then Break;
end;
if IsTalkInf then TalkInfo(Buf,Len,Socket.SocketHandle);
IsUpdateSMsg:=True; //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
for I:= 0 to 16 - 1 do
begin
if ((I mod 2) = 0) then IsUpdateSMsg:=IsUpdateSMsg and (Buf[I]=$B)
else IsUpdateSMsg:=IsUpdateSMsg and (Buf[I]=$F);
if not IsUpdateSMsg then Break;
end;
if IsUpdateSMsg then UpdateSMsg(Buf,Len);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Onlines:=TList.Create;
TrayIcon.Icon:=Application.Icon;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Onlines.Free;
end;
procedure TfrmMain.TCPDataClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
I:Integer;
TemStr:String;
TempCount:Integer;
begin
TempCount:=Onlines.Count - 1;
for I:=0 to TempCount do
if (POnlineInf(Onlines.Items[I]).ControlSoc = Socket.SocketHandle) then
begin
TemStr:=POnlineInf(Onlines.Items[I]).UserName;
Dispose(Onlines.Items[I]);
Onlines.Delete(I);
Break;
end;
TempCount:=SSEListUser.Items.Count - 1;
for I:=0 to TempCount do
if Pos(TemStr,SSEListUser.Items[I]) <> 0 then
begin
if SSEListUser.Items.IndexOf(TemStr) <> -1 then
SSEListUser.Items.Delete(SSEListUser.Items.IndexOf(TemStr));
Break;
end;
with RELog do //写入事件日志
begin
Lines.Add(DateTimeToStr(Now));
Lines.Add('客户机连接断开');
Lines.Add('远程位置: '+Socket.RemoteAddress);
Lines.Add('');
end;
SendOnlinesInfo;
end;
procedure TfrmMain.TimerTimer(Sender: TObject);
begin
StatusBar1.Panels[0].Text:=Format('共有 %s 人在线',[IntToStr(SSEListUser.Count)]);
end;
procedure TfrmMain.TCPDataClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
end;
procedure TfrmMain.TrayIconDblClick(Sender: TObject);
begin
TrayIcon.ShowMainForm;
SetForegroundWindow(frmMain.Handle);
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Application.messagebox('关闭服务器程式将导致全部用户无法使用群组讨论服务，您确认吗？','执行确认',MB_YESNO + MB_DEFBUTTON2 + MB_ICONWARNING + MB_TASKMODAL)=IDNO then
Abort;
end;
end.