?? unit1.pas
字號:
unit Unit1;
interface
uses
winsock,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp,GeneralSource, ExtCtrls, Grids, DBGrids, Db, ADODB,
Buttons, Menus, ImgList, ToolWin, ComCtrls, ActnList, AppEvnts,
RzTray, RzCommon;
const
UM_RESTORE_APPLICATION=WM_User+101;
type
TSession=Record
Msg:string;
Handle:string;
Param1:string;
Param2:string;
Param3:string;
Param4:string;
Param5:string;
Param6:string;
end;
TForm1 = class(TForm)
s: TServerSocket;
Image1: TImage;
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Label1: TLabel;
Splitter2: TSplitter;
ListBox2: TListBox;
Image2: TImage;
ListBox1: TListBox;
Panel5: TPanel;
Panel6: TPanel;
Memo1: TMemo;
Panel7: TPanel;
Memo2: TMemo;
MainMenu1: TMainMenu;
N11: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
B1: TMenuItem;
S1: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
E1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
U1: TMenuItem;
ImageList1: TImageList;
ActionList1: TActionList;
Timer1: TTimer;
N10: TMenuItem;
StatusBar1: TStatusBar;
Splitter3: TSplitter;
Label2: TLabel;
Panel8: TPanel;
BitBtn3: TBitBtn;
BitBtn2: TBitBtn;
BitBtn1: TBitBtn;
Panel9: TPanel;
Label3: TLabel;
G1: TMenuItem;
ControlBar1: TControlBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton9: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolBar2: TToolBar;
RzTrayIcon1: TRzTrayIcon;
Action1: TAction;
ini: TRzRegIniFile;
procedure sClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure sClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ListBox2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure BitBtn3Click(Sender: TObject);
procedure E1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure U1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure B1Click(Sender: TObject);
procedure G1Click(Sender: TObject);
private
{ Private declarations }
UserName,Sex:string;
procedure UpUser(Handle:integer;ID,Host,Address:string;Logined:integer);
function SelectUser(ID,PasswordA:string;a,b,c:integer;var UserName,Sex:string):Boolean;
procedure GetUserList(Handle:integer;ID,UserName,Sex:string);
procedure GetUserList1(Handle:integer;ID,SearchID, SearchName:string);
procedure GetUserInfoByID(ID:String);
procedure ClearOffUser;
function GetTextID(Text: string; BreakSymbol: string = '.'): string;
function GetTextName(Text: string; BreakSymbol: string = '.'): string;
procedure UMRestoreApplication(var Message : TMessage); message UM_RESTORE_APPLICATION;
procedure StrToList(Str: string; var List: TStrings;BreakSymbol: string = ';');
function StringsToStr(Str: string;BreakSymbol: string = ';'): string;
procedure WMQueryEndSession(var Msg: TMessage);message WM_QueryEndSession;
procedure CloseTheInstance;
procedure ReturnGameCommand(MyHandle,UserHandle,CommandStr,Param1,Param2,Param4,Param5:string);
public
{ Public declarations }
RecText:PPs;
Logined:Boolean;
Locked:Boolean;
UserList:Tstrings;
UserRemark:array of string;
CommandStr:string;
function NewID(Handle:integer=0):string;
procedure UpdateState;
procedure SendAllUser(Handle:integer;UserName,Sex,Logined,Registered,ID:string);
procedure InsUser(ID:string;UserName,PasswordA,Host,Address:string;
Handle:integer;Logined,Sex:integer;Remark:string;ImageIndex:integer);
procedure BrowseUser;
function GetIndexByHandle(Handle:integer):integer;
procedure SendBy(cs:TCustomWinSocket;Msg,Handle,Param1,Param2,Param3,Param4,Param5,Param6:string);
end;
var
Form1: TForm1;
implementation
uses ChatSource, Unit2, Unit3, Unit4, Unit5, Unit7;
{$R *.DFM}
procedure xx(n,s:string);
var
Txtfile:TextFile;
begin
Assignfile(Txtfile,n);
if fileExists(n) then
Append(Txtfile)
else
Rewrite(Txtfile);
try
writeln(Txtfile,s);
finally
closefile(Txtfile);
end;
end;
function TForm1.GetTextID(Text: string; BreakSymbol: string = '.'): string;
var
I: Integer;
begin
I := Pos(BreakSymbol, Text);
if I > 0 then
Result := Copy(Text, 1, I - 1)
else Result := Text;
end;
function TForm1.GetTextName(Text: string; BreakSymbol: string = '.'): string;
var
I: Integer;
begin
I := Pos(BreakSymbol, Text);
if I > 0 then
Result := Copy(Text, I + Length(BreakSymbol),
Length(Text) - I - Length(BreakSymbol) + 1)
else Result := Text;
end;
procedure TForm1.sClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Tmps:String;
i:integer;
ID:string;
Txtfile:TextFile;
UserInfoList:TStrings;
Session:TSession;
MyHandle,UserHandle,Param1,Param2,Param4,Param5:string;
begin
Tmps:=Socket.ReceiveText;
RecText:=nil;
RecText:=GetSession(Pchar(Tmps),7);
Session.Msg:=RecText^[0];
Session.Handle:=RecText^[1];
Session.Param1:=RecText^[2];
Session.Param2:=RecText^[3];
Session.Param3:=RecText^[4];
Session.Param4:=RecText^[5];
Session.Param5:=RecText^[6];
Session.Param6:=RecText^[7];
if Session.Msg<>'T' then
if Session.Msg<>'A' then
begin
ListBox2.Items.Add(DateTimetoStr(Now)+' '+Tmps);
Assignfile(Txtfile,'Sys.log');
if fileExists('Sys.log') then
Append(Txtfile)
else
Rewrite(Txtfile);
try
writeln(Txtfile,ListBox2.Items.Strings[ListBox2.Items.Count-1]);
finally
closefile(Txtfile);
end;
if ListBox2.Items.Count =21 then
ListBox2.Items.Delete(0);
end;
if Session.Msg='admin' then
begin
Memo1.Lines.Add(Session.Param1);
SendMessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
flashwindow(Application.handle,true);
end;
case Ord(Session.Msg[1]) of
Ord('W')://添加好友
begin
chat.RealTemp.Close;
chat.RealTemp.SQL.Clear;
chat.RealTemp.SQL.Add('insert into Groups(ID,SubID)');
chat.RealTemp.SQL.Add('values('+''''+Session.Param1+''','''+Session.Param2+''''+')');
chat.RealTemp.ExecSQL;
SelectUser(session.Param2,'A',0,0,1,UserName,Sex);
if Session.Param5='1' then
begin
SendBy(Socket,'G',inttostr(chat.qryUserHandle.Value),
Session.Param3,Session.Param4,Session.Param5,'1',Session.Param2,'1')
end
else
begin
SendBy(Socket,'G',inttostr(chat.qryUserHandle.Value),
Session.Param3,Session.Param4,Session.Param5,'2',Session.Param2,'1')
end; //通知自己已添加好友
end;
Ord('G')://查找用戶
begin
GetUserList1(Socket.SocketHandle,Session.Param1,Session.Param2,Session.Param3); //客戶取得用戶列表
end;
Ord('J')://中斷游戲
begin
i:=GetIndexbyHandle(strtoint(Session.Param3));
SendBy(s.Socket.Connections[i],'J',Session.Handle,Session.Param2,'','','','','');
end;
Ord('P')://開始 游戲(測試)
begin
MyHandle:=Session.Param3;
UserHandle:=Session.Handle;
Param1:=Session.Param1;
Param2:=Session.Param2;
Param4:=Session.Param4;
Param5:=Session.Param5;
CommandStr:=CommandStr+Session.Param6+#13;
ReturnGameCommand(MyHandle,UserHandle,CommandStr,Param1,Param2,Param4,Param5);
MyHandle:='';
UserHandle:='';
CommandStr:='';
Param1:='';
Param2:='';
Param4:='';
Param5:='';
end;
Ord('V')://接受游戲
begin
i:=GetIndexbyHandle(strtoint(Session.Param3));
SendBy(s.Socket.Connections[i],'V',Session.Param1,Session.Param2,Session.Param3,Session.Param4,'',Session.Param5,'');
end;
Ord('K')://拒絕游戲
begin
i:=GetIndexbyHandle(strtoint(Session.Param4));
SendBy(s.Socket.Connections[i],'K',Session.Param1,Session.Param2,Session.Param3,'','',Session.Param5,'');
end;
Ord('I'):// 詢問游戲是否開始
begin
SelectUser(session.Param4,'A',0,0,1,UserName,Sex);
i:=GetIndexbyHandle(strtoint(Session.Handle));
SendBy(s.Socket.Connections[i],'I',Session.Param2,Session.Param1,Session.Param3,Session.Param4,Session.Param2,inttostr(byte(chat.qryUserLogined.Value)),'');
end;
Ord('D')://清除掉線用戶
begin
ClearOffUser;
BrowseUser;
end;
Ord('N')://文件傳輸失敗
begin
i:=GetIndexbyHandle(strtoint(Session.Param3));
SendBy(s.Socket.Connections[i],'N',Session.Handle,Session.Param2,'','','','','');
end;
Ord('Y')://取消接收文件
begin
i:=GetIndexbyHandle(strtoint(Session.Param4));
SendBy(s.Socket.Connections[i],'Y',Session.Param1,Session.Param2,Session.Param3,'','',Session.Param5,'');
end;
Ord('O')://用戶確認接收文件
begin
i:=GetIndexbyHandle(strtoint(Session.Param2));
SendBy(s.Socket.Connections[i],'C',Session.Param2,Session.Param1,Session.Param3,Session.Handle,'','','');
end;
Ord('S')://傳輸文件
begin
i:=GetIndexbyHandle(strtoint(Session.Handle));
SendBy(s.Socket.Connections[i],'Q',Session.Param2,Session.Param1,Session.Param3,Session.Param4,Session.Param2,'','');
end;
Ord('M')://測試連接
begin
i:=GetIndexbyHandle(Socket.SocketHandle);
SendBy(s.Socket.Connections[i],'M','','','','','','','');
end;
Ord('X')://修改個人記錄
begin
Chat.UpTemp.Close ;
Chat.UpTemp.SQL.Clear ;
Chat.UpTemp.SQL.Add('Update UserInfo');
Chat.UpTemp.SQL.Add('Set UserName='''+Session.Param1+'''');
Chat.UpTemp.SQL.Add(',Sex='+Session.Param2);
Chat.UpTemp.SQL.Add(',PasswordA='''+GetTextName(Session.Param3)+'''');
Chat.UpTemp.SQL.Add(',ImageIndex='+Session.Param4);
Chat.UpTemp.SQL.Add(',Remark='''+Session.Param5+'''');
Chat.UpTemp.SQL.Add('Where ID='''+Session.Param6+'''');
Chat.UpTemp.SQL.Add('and PasswordA='''+GetTextID(Session.Param3)+'''');
Chat.UpTemp.ExecSQL;
if Chat.UpTemp.RowsAffected=1 then
begin
for i:=0 to UserList.Count-1 do
if Session.Param6=GetTextID(UserList.Strings[i],';') then
begin
Chat.UpTemp.SQL.Clear;
Chat.UpTemp.SQL.Add('Select Host,Address,Handle from UserInfo');
Chat.UpTemp.SQL.Add('where ID='''+Session.Param6+'''');
Chat.UpTemp.Open;
UserList.Strings[i]:=Session.Param6+';'+
Session.Param1+';'+
Chat.UpTemp.Fields[0].Text+';'+
Chat.UpTemp.Fields[1].Text+';'+
Session.Param4+';'+
Session.Param2+';'+
Chat.UpTemp.Fields[2].Text;
UserRemark[i]:=Session.Param5;
Chat.UpTemp.Close;
Break;
end;
i:=GetIndexbyHandle(Socket.SocketHandle);
SendBy(s.Socket.Connections[i],'X','','','','','','','');
end
else
begin
i:=GetIndexbyHandle(Socket.SocketHandle);
SendBy(s.Socket.Connections[i],'X','','Error','','','','','');
end;
i:=ListBox1.Items.IndexOf(Session.Param6+'('+Session.Handle+')');
ListBox1.Items.Strings[i]:=Session.Param6+'('+Session.Param1+')'
end;
Ord('B')://取得本人信息
begin
i:=GetIndexbyHandle(Socket.SocketHandle);
GetUserInfoByID(Session.Param1);
SendBy(s.Socket.Connections[i],'B','',Chat.Temp.fieldbyname('UserName').AsString,
Chat.Temp.fieldbyname('ID').AsString,
Chat.Temp.fieldbyname('ImageIndex').AsString,
Chat.Temp.fieldbyname('Sex').AsString,
Chat.Temp.fieldbyname('Remark').AsString,'');
Chat.Temp.Close ;
end;
Ord('U')://返回聊天用戶信息
begin
tag:=GetIndexbyHandle(strtoint(Session.Handle));
UserInfoList:=TStringList.Create;
for i:=0 to UserList.Count-1 do
if Session.Param2=GetTextID(UserList.Strings[i],';') then
begin
StrtoList(UserList.Strings[i],UserInfoList);
SendBy(s.Socket.Connections[tag],'U',
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -