📄 main.~pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Buttons, dxsbar, Menus, ImgList, NMUDP, MMSystem,
TimerLst, HotKeySpy, CoolTrayIcon, IniFiles;
type
{ TWndRec=record //自定义的类
// Hnd:THandle;
QQNum:string;
PForm:TForm;
end;
}
TFrmMain_QQ = class(TForm)
PMOnline: TPopupMenu;
PMMain: TPopupMenu;
ItmOnline: TMenuItem;
N2: TMenuItem;
ItmHide: TMenuItem;
ItmOffline: TMenuItem;
ItmLeave1: TMenuItem;
ItmLeave2: TMenuItem;
ItmShowMainForm: TMenuItem;
N8: TMenuItem;
ItmSetup: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
ItmExit: TMenuItem;
ItmLoginAgain: TMenuItem;
PMItem: TPopupMenu;
PMGroup: TPopupMenu;
ItmRenameGroup: TMenuItem;
ItmAddGroup: TMenuItem;
ItmDelGroup: TMenuItem;
ItmSendMsg: TMenuItem;
N16: TMenuItem;
ItmDelFriend: TMenuItem;
N23: TMenuItem;
ItmImgSmall: TMenuItem;
ItmImgLarge: TMenuItem;
Udp: TNMUDP;
Panel1: TPanel;
BtnChatroom: TSpeedButton;
BtnHomepage: TSpeedButton;
BtnSearch: TSpeedButton;
BtnMsg: TSpeedButton;
BtnMain: TSpeedButton;
BtnOnline: TSpeedButton;
SideBar: TdxSideBar;
ItmBeBaddy: TMenuItem;
N15: TMenuItem;
ItmSelfSetup2: TMenuItem;
ItmSysSetup: TMenuItem;
ItmSelfSetup: TMenuItem;
RxTimerList: TRxTimerList;
TimHideForm: TRxTimerEvent;
HotKeySpy1: THotKeySpy;
TrayIcon: TCoolTrayIcon;
ItmLeave3: TMenuItem;
ItmLeave4: TMenuItem;
ItmByMe: TMenuItem;
N1: TMenuItem;
procedure BtnOnlineClick(Sender: TObject);
procedure BtnMainClick(Sender: TObject);
procedure ItmExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure UDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
function SendOnlineMessage:boolean;
procedure ExtractMsg(s:string);
// procedure IAmOnline(sMyQQNum,sMyName,sMyIP:string;iMyFaceID:integer);
procedure ItmImgLargeClick(Sender: TObject);
procedure ItmImgSmallClick(Sender: TObject);
procedure BtnSearchClick(Sender: TObject);
{ procedure LstFriendsClickItem(Sender: TObject;
Item: TabcButtonListItem);}
procedure BtnBarChange(Sender: TObject);
procedure ItmSendMsgClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SideBarItemClick(Sender: TObject; Item: TdxSideBarItem);
procedure SideBarDblClick(Sender: TObject);
procedure SideBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ItmSetupClick(Sender: TObject);
procedure ItmSelfSetupClick(Sender: TObject);
procedure ItmSelfSetup2Click(Sender: TObject);
procedure ItmSysSetupClick(Sender: TObject);
procedure ItmDelFriendClick(Sender: TObject);
procedure ItmBeBaddyClick(Sender: TObject);
procedure ItmRenameGroupClick(Sender: TObject);
procedure ItmAddGroupClick(Sender: TObject);
procedure ItmDelGroupClick(Sender: TObject);
procedure TimHideFormTimer(Sender: TObject);
procedure HotKeySpy1HotKeys0HotKey(Sender: TObject);
procedure Offline;
procedure ItmOfflineClick(Sender: TObject);
procedure ItmHideClick(Sender: TObject);
procedure ItmOnlineClick(Sender: TObject);
procedure ItmLoginAgainClick(Sender: TObject);
procedure ItmShowMainFormClick(Sender: TObject);
procedure TrayIconDblClick(Sender: TObject);
procedure TrayIconClick(Sender: TObject);//自定义过程
procedure MyTimer(Sender:TObject);
procedure BtnHomepageClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure N11Click(Sender: TObject);
procedure ItmLeave1Click(Sender: TObject);
procedure ItmLeave2Click(Sender: TObject);
procedure ItmLeave3Click(Sender: TObject);
procedure ItmLeave4Click(Sender: TObject);
procedure ItmByMeClick(Sender: TObject);
procedure N10Click(Sender: TObject);//write by Jie.Gu
// TStrArray = Array[1..5] of string;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain_QQ: TFrmMain_QQ;
aMsg:Array[1..5] of string;
// WndRecArr:array of TWndRec;
implementation
uses by_user, dm_share, Var_Share, Frind_friends, msg, untSetup, login,
untAbout;
{type
TWndRec=record //自定义的类
// Hnd:THandle;
QQNum:string;
PForm:TFrmMsg;
end;
}
var
bHide:boolean=False;{分辨窗体是否隐藏}
// WndRecArr:array of TWndRec;
{$R *.dfm}
//发送下线信息(自定义过程)
procedure TFrmMain_QQ.Offline;
var
sMsg:string;
MyStream:TMemoryStream;
begin
sMsg:='OFF*'+sQQNumber+'*';
MyStream := TMemoryStream.Create;
try
MyStream.Write(sMsg[1],Length(sMsg));
Udp.LocalPort:=8088;
Udp.RemotePort:=8088;
Udp.RemoteHost:=GetGBIP(g_sIP);
Udp.SendStream(MyStream);
finally
MyStream.Free;
end;
end;
//分解收到的信息
procedure TFrmMain_QQ.ExtractMsg(s:string);
var
i:integer;
sTemp:string;
iTime:integer;
iPos:integer;
begin
//判断循环次数
sTemp:=s[1]+s[2]+s[3];
if sTemp='SYS' then iTime:=2;
if sTemp='ONL' then iTime:=4;
if sTemp='OFF' then iTime:=2;
if sTemp='HID' then iTime:=2;
if sTemp='LEA' then iTime:=2;
if sTemp='MSG' then iTime:=5;
if sTemp='IMO' then iTime:=4;//改为4，原来为2
if sTemp='FIN' then iTime:=1;
if sTemp='YFM' then iTime:=4;
// if sTemp='ATD' then iTime:=5;//‘ATD’意为 ADD TO DATABASE，是在查找用户时，存储在线用户信息的，不属于通讯协议
//开始分解
for i := 1 to iTime do
begin
iPos:=Pos('*',s);
aMsg[i]:=Copy(s,1,iPos-1);
Delete(s,1,iPos);
end;
end;
//收到ONL（上线通知）信息后，返回IMO（我在线）的信息
{procedure TFrmMain.IAmOnline(sMyQQNum,sMyName,sMyIP:string;iMyFaceID:integer);
begin
with DMShare.TblFriends do
begin
First;
if Locate('QQNumber',sMyQQNum,[]) then
begin
//判断用户信息，如果有改变则更新数据库
if FieldValues['UserName']<>sMyName then FieldValues['UserName']:=sMyName;
if FieldValues['IP']<>sMyIP then FieldValues['IP']:=sMyIP;
if FieldValues['FaceID']<>iMyFaceID then FieldValues['FaceId']:=iMyFaceID;
end;
end;
end;}
procedure TFrmMain_QQ.BtnOnlineClick(Sender: TObject);
begin
PMOnline.Popup(FrmMain_QQ.Left+FrmMain_QQ.Width-25,FrmMain_QQ.Top+FrmMain_QQ.Height-5);
end;
procedure TFrmMain_QQ.BtnMainClick(Sender: TObject);
begin
PMMain.Popup(FrmMain_QQ.Left+5,FrmMain_QQ.Top+FrmMain_QQ.Height-5);
end;
procedure TFrmMain_QQ.ItmExitClick(Sender: TObject);
begin
Close;
end;
//发送上线信息
function TFrmMain_QQ.SendOnlineMessage:boolean;
var
MyStream:TMemoryStream;
sMsg:string;
begin
sMsg:='ONL*'+sQQNumber+'*'+sUserName+'*'+IntToStr(iFaceID)+'*';
MyStream:=TMemoryStream.Create;
try
MyStream.Write(sMsg[1],Length(sMsg));
Udp.LocalPort:=8088;
Udp.RemotePort:=8088;
Udp.RemoteHost:=GetGBIP(g_sIP);
Udp.SendStream(Mystream);
Result:=True; //这个返回值是乱定义地，事实上无法确认发送是否成功。或许以后会用到 :-)
finally
MyStream.Free;
end;
end;
procedure TFrmMain_QQ.FormCreate(Sender: TObject);
var
i:integer;
NewItem:TdxSideBarItem;
MyIni:TIniFile;
StrLst:TStringList;
begin
SetLength(WndRecArr,255);{分配空间，同时创建的FrmMsg应该不会超过255吧!}
//删除临时目录
if DirectoryExists(ExtractFilePath(Application.ExeName)+'temp') then
begin
Deltree(ExtractFilePath(Application.ExeName)+'temp');
end;
//再建一个TEMP目录
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'temp') then
begin
MkDir(ExtractFilePath(Application.ExeName)+'temp');
end;
TrayIcon.CycleIcons:=False;
TrayIcon.IconList:=nil;
// DMShare.IconList.GetIcon(0,TrayIcon.Icon);
FrmMain_QQ.Caption:=sUserName;
FrmMain_QQ.Width:=100;
SideBar.LargeImages:=DMShare.ImgLarge;
SideBar.SmallImages:=DMShare.ImgSmall;
FrmMain_QQ.SendOnlineMessage;//发送上线信息
//从数据库中读取好友信息，并添加在BtnBar中
with DMShare.TblFriends do
begin
if Active then First;
while not Eof do
begin
if not FieldValues['IsBaddy'] then//不是坏人，则加入“我的好友”
begin
SideBar.ActiveGroupIndex:=0;
NewItem:=SideBar.ActiveGroup.Items.Add;
NewItem.Caption:=FieldValues['UserName'];
NewItem.LargeImage:=FieldValues['FaceID']+85;
NewItem.SmallImage:=FieldValues['FaceID']+85;
NewItem.Tag:=StrToInt(FieldValues['QQNumber']);
end
else
begin//是坏人，则加入“黑名单”列表
SideBar.ActiveGroupIndex:=2;
NewItem:=SideBar.ActiveGroup.Items.Add;
NewItem.Caption:=FieldValues['UserName'];
NewItem.LargeImage:=FieldValues['FaceID']+85;
NewItem.SmallImage:=FieldValues['FaceID']+85;
NewItem.Tag:=StrToInt(FieldValues['QQNumber']);
end;
Next;
end;
end;
//将“我的好友”这个组设置为ActiveGroup
SideBar.Groups[0].MakeActive;
//create the SETUP.INI file
if not FileExists(ExtractFilePath(Application.ExeName)+'setup.ini') then
begin
StrLst := TStringList.Create;
try
StrLst.Append('[INFO]');
StrLst.Append('LastUser=');
StrLst.SaveToFile(ExtractFilePath(Application.ExeName)+'setup.ini');
finally
StrLst.Free;
end;
end;
//create the FNDSETUP.INI file
if not FileExists(ExtractFilePath(Application.ExeName)+sQQNumber+'\fndsetup.ini') then
begin
StrLst := TStringList.Create;
try
StrLst.Append('[SETUP]');
StrLst.Append('AutoShowMsg=0');
StrLst.Append('AskClose=1');
StrLst.Append('OnlineInfo=1');
StrLst.Append('FormLeft=50');
StrLst.Append('FormTop=50');
StrLst.Append('LeaveMsg1=这是NetMessage的自动回复信息，我不在……');
StrLst.Append('LeaveMsg2=工作中，请勿打扰……');
StrLst.Append('LeaveMsg3=我去吃饭了，呆会儿见~~~~~~');
StrLst.Append('LeaveMsg4=我忙，呆会儿再聊……');
StrLst.SaveToFile(ExtractFilePath(Application.ExeName)+sQQNumber+'\FndSetup.ini');
finally
StrLst.Free;
end;
end;
//从FNDSETUP.INI文件中读取设置并赋值给全局变量
MyIni := TIniFile.Create(ExtractFilePath(Application.ExeName)+sQQNumber+'\FndSetup.ini');
try
bAutoShowMsg:=MyIni.ReadBool('setup','AutoShowMsg',False);
bOnlineInfo:=MyIni.ReadBool('setup','OnlineInfo',True);
bAskClose:=MyIni.ReadBool('setup','AskClose',False);
FrmMain_QQ.Top:=MyIni.ReadInteger('setup','FormTop',50);
FrmMain_QQ.Left:=MyIni.ReadInteger('setup','FormLeft',50);
//设置离线消息菜单项的 Caption
ItmLeave1.Caption:=MyIni.ReadString('setup','LeaveMsg1','这是NetMessage的自动回复信息，我不在……');
ItmLeave2.Caption:=MyIni.ReadString('setup','LeaveMsg2','工作中，请勿打扰……');
ItmLeave3.Caption:=MyIni.ReadString('setup','LeaveMsg3','我去吃饭了，呆会儿见~~~~~~');
ItmLeave4.Caption:=MyIni.ReadString('setup','LeaveMsg4','我忙，呆会儿再聊……');
finally
MyIni.Free;
end;
end;
procedure TFrmMain_QQ.UDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
sMsg,sPath,sBmpName:string;
MyStream:TMemoryStream;
Hnd:THandle;
// bIsInDB,bIsInImgLsgBox:boolean;
i:integer;
MyFace,SmallFace:TBitmap;
begin
// if FromIP=g_sIP then Exit;{过滤自己的信息}
if NumberBytes=-1 then Exit;//{此句可以消除write stream error的错误}
//把收到的流信息转换为string类型，并赋值给变量sMsg
MyStream := TMemoryStream.Create;
try
Udp.ReadStream(MyStream);
SetLength(sMsg,NumberBytes);
MyStream.Read(sMsg[1],NumberBytes);
finally
Mystream.Free;
end;
//showmessage(smsg);
FrmMain_QQ.ExtractMsg(sMsg);//先分解，下面为判断后处理
//showmessage(amsg[1]);/////////////////////////////////////////////////////////////
//判断是否为“上线”信息，并且判断用户信息，更新好友数据库
if aMsg[1]='ONL' then
begin
MyStream:=TmemoryStream.Create;
try
sMsg:='IMO'+'*'+sQQNumber+'*'+sUserName+'*'+IntToStr(iFaceID)+'*';//原来为2位，现在改为4位
MyStream.Write(sMsg[1],Length(sMsg));
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -