📄 main.pas
字号:
(*
eICQ: the free ICQ for Microsoft(tm) Windows(tm)
Copyright 2003-2004 eICQ ICQ project,
all portions of this codebase are copyrighted to the people
listed in contributors.txt.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
{ *** EXAMPLE APPLICATION COMPLETELY IMPROVED AND UPDATED BY Dalibor Drzik (eraser@senior.cz) *** }
unit Main;
interface
uses
Windows, Messages, Classes, Graphics, Controls, Forms,
ComCtrls, ImgList, Menus, ICQClient, ICQWorks, RecvMsg,
SendMsg, UserInfo, StdCtrls, UserSearch, AutoAway, PktDump,
UserReg, UserRegNew, ExtCtrls, InfoMsgs, CommCtrl,
UserUnReg, ChangePasswd, SendURL, SendSMS, RecvURL, RecvSMS,
About, ShellAPI, StrUtils;
const
// Status Icons
ICON_ONLINE = 0;
ICON_AWAY = 1;
ICON_DND = 2;
ICON_NA = 3;
ICON_INVISIBLE = 4;
ICON_OFFLINE = 5;
ICON_OCCUPIED = 6;
ICON_FFC = 7;
// Listview Indexes
LV_INDEX_STATUS = 0; //STATUS
LV_INDEX_INTIP = 1; //Internal IP
LV_INDEX_EXTIP = 2; //External IP
LV_INDEX_PORT = 3; //Port
LV_INDEX_PROTOVER = 4; //ProtoVer
LV_INDEX_USERCAPS = 5; //UserCaps
LV_INDEX_ONLINETIME = 6; //Online since
LV_INDEX_CLIENT = 7; //ICQ Client
LV_INDEX_MIRANDAVER = 8; //Miranda version
LV_INDEX_NICK = 9; //Nick
LV_INDEX_IDLE = 10;
//Not specified
NA = '<not specified>';
// Declare the cursor constant that contains the resource identifier
// of the system Hand cursor.
// IDC_HAND = MakeIntResource(32649);
// Declare the cursor constant for our own use. Constant value must
// not conflict with any existing Delphi cursor constant.
NIDC_HAND = 32649;
USERINFO_ENTRIES = 6;
WM_NOTIFYICON = wm_user + 400;
MY_WS_EX_LAYERED = $00080000;
MY_LWA_ALPHA = $00000002;
type
_DBCONTACTSETTINGS = record
dwUIN: DWORD;
dwStatus: DWORD;
sInternalIP, sExternalIP: String[15];
wPort: Word;
byProtoVer, byUserCaps: Byte;
dtOnlineTime: TDateTime;
dwClient, dwMirandaVer: DWORD;
sNick: String[20]; // Nick max. 20 chars
end;
type
_DBSETTINGS = record
dwLastStatus: DWORD; // Last Status
bOnTop: Boolean; // Window StayOnTop
sTitleText: String[15]; // Titlebar Text
bHide: Boolean; // Hide or Close main window
bTransparent: Boolean; // Window Transparency
iBlendValue: Integer; // Transparecy level
iLeft, iTop, iHeight, iWidth: Integer; // Position & Size
ProxyType: TProxyType; // Proxy type
ProxyAuth: Boolean; // Proxy requires auth
ProxyHost: String[50]; // Proxy server
ProxyPass: String[50]; // Proxy passwd
ProxyUserID: String[50]; // Username
ProxyPort: Word; // Proxy port
ProxyResolve: Boolean; // Resolve hostnames through proxy
UIN: DWORD; // UIN
Password: String[15]; // Passwd
ICQServer: String[50]; // ICQ login server
ICQPort: Word; // ICQ Port
KeepAlive: Boolean; // Keep connection alive
OnSaver, OnWLock: Boolean; // AutoAway
OnMouse, SetNA: Boolean;
AwayTime, NATime: Word;
MsgAway, MsgNA, MsgDND: String[100]; // AutoAway msgs
MsgOccupied, MsgFFC: String[100];
end;
type
TMainForm = class(TForm)
ListView1: TListView;
IconList: TImageList;
StatusBar1: TStatusBar;
ICQClient1: TICQClient;
popupListMenu: TPopupMenu;
UserInfo1: TMenuItem;
RemoveContact1: TMenuItem;
ReadAwayMessage1: TMenuItem;
AdvIconList: TImageList;
N2: TMenuItem;
popupMenu: TPopupMenu;
sendsms: TMenuItem;
N6: TMenuItem;
findcontact: TMenuItem;
mydetails: TMenuItem;
N7: TMenuItem;
options: TMenuItem;
N8: TMenuItem;
system: TMenuItem;
N9: TMenuItem;
help: TMenuItem;
N10: TMenuItem;
Exit2: TMenuItem;
About1: TMenuItem;
RegisterNewUIN2: TMenuItem;
UnregisterUIN1: TMenuItem;
N11: TMenuItem;
SetMyAuthorization2: TMenuItem;
UnsetMyAuthorization2: TMenuItem;
N12: TMenuItem;
PacketDump1: TMenuItem;
LoadContactListfromServer1: TMenuItem;
N13: TMenuItem;
Message1: TMenuItem;
WebPageAddressURL1: TMenuItem;
N14: TMenuItem;
ViewHistory1: TMenuItem;
Rename1: TMenuItem;
ChangeMyPassword1: TMenuItem;
popupTray: TPopupMenu;
HideShow1: TMenuItem;
N3: TMenuItem;
Exit3: TMenuItem;
eICQWebsite1: TMenuItem;
popupStatus: TPopupMenu;
Offline2: TMenuItem;
Online2: TMenuItem;
Away2: TMenuItem;
NA2: TMenuItem;
Occupied2: TMenuItem;
DND2: TMenuItem;
Freeforchat1: TMenuItem;
Invisible2: TMenuItem;
AutoAwayTimer: TTimer;
KeepAliveTimer: TTimer;
N1: TMenuItem;
GeneralLincence1: TMenuItem;
Help1: TMenuItem;
eICQWebsite2: TMenuItem;
GNUGeneralPublicLicense1: TMenuItem;
N4: TMenuItem;
About2: TMenuItem;
N5: TMenuItem;
Support1: TMenuItem;
IdleTimer: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ICQClient1Login(Sender: TObject);
procedure ICQClient1ConnectionFailed(Sender: TObject);
procedure ICQClient1StatusChange(Sender: TObject; UIN: String;
Status: Cardinal);
procedure ICQClient1UserOffline(Sender: TObject; UIN: String);
procedure popupListMenuPopup(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure UserInfo1Click(Sender: TObject);
procedure ICQClient1UserInfoMore(Sender: TObject; UIN: String;
Age: Word; Gender: Byte; HomePage: String; BirthYear, BirthMonth,
BirthDay: Word; Lang1, Lang2, Lang3: String);
procedure ICQClient1UserInfoAbout(Sender: TObject; UIN, About: String);
procedure ICQClient1UserWorkInfo(Sender: TObject; UIN, WCity, WState,
WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment,
WPosition, WOccupation, WHomePage: String);
procedure ICQClient1UserInfoInterests(Sender: TObject; UIN: String;
Interests: TStringList);
procedure ICQClient1UserFound(Sender: TObject; UIN, Nick, FirstName,
LastName, Email: String; Status: Word; Gender, Age: Byte;
SearchComplete: Boolean; Authorize: Boolean);
procedure ICQClient1UserNotFound(Sender: TObject);
procedure ICQClient1PktParse(Sender: TObject; Buffer: Pointer;
BufLen: Cardinal; Incoming: Boolean);
procedure ICQClient1UserInfoBackground(Sender: TObject; UIN: String;
Pasts, Affiliations: TStringList);
procedure ICQClient1UserGeneralInfo(Sender: TObject; UIN, NickName,
FirstName, LastName, Email, City, State, Phone, Fax, Street,
Cellular, Zip, Country: String; TimeZone: Byte;
PublishEmail: Boolean);
procedure RemoveContact1Click(Sender: TObject);
procedure ICQClient1ServerListRecv(Sender: TObject;
SrvContactList: TList);
procedure ReadAwayMessage1Click(Sender: TObject);
procedure ICQClient1AutoMsgResponse(Sender: TObject; UIN: String;
ID: Word; RespStatus: Byte; Msg: String);
procedure ICQClient1PktDirectParse(Sender: TObject; Buffer: Pointer;
BufLen: Cardinal; Incoming: Boolean);
procedure ICQClient1URLRecv(Sender: TObject; Description, URL,
UIN: String);
procedure ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
ErrorMsg: String);
procedure ICQClient1NewUINRefused(Sender: TObject);
procedure ICQClient1NewUINRegistered(Sender: TObject; UIN: String);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure ICQClient1OfflineMsgRecv(Sender: TObject;
DateTime: TDateTime; Msg, UIN: String);
procedure ICQClient1OfflineURLRecv(Sender: TObject;
DateTime: TDateTime; Description, URL, UIN: String);
procedure ICQClient1MessageRecv(Sender: TObject; Msg, UIN: String);
procedure ICQClient1AddedYou(Sender: TObject; UIN: String);
procedure ICQClient1AuthResponse(Sender: TObject; UIN: String;
Granted: Boolean; Reason: String);
procedure ICQClient1AuthorizationChangedOk(Sender: TObject);
procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
procedure findcontactClick(Sender: TObject);
procedure mydetailsClick(Sender: TObject);
procedure StatusBar1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Exit2Click(Sender: TObject);
procedure SetMyAuthorization2Click(Sender: TObject);
procedure UnsetMyAuthorization2Click(Sender: TObject);
procedure PacketDump1Click(Sender: TObject);
procedure LoadContactListfromServer1Click(Sender: TObject);
procedure RegisterNewUIN2Click(Sender: TObject);
procedure UnregisterUIN1Click(Sender: TObject);
procedure ChangeMyPassword1Click(Sender: TObject);
procedure ICQClient1UnregisterBadPassword(Sender: TObject);
procedure ICQClient1UnregisterOk(Sender: TObject);
procedure ICQClient1InfoChanged(Sender: TObject; InfoType: TInfoType;
ChangedOk: Boolean);
procedure Message1Click(Sender: TObject);
procedure WebPageAddressURL1Click(Sender: TObject);
procedure ICQClient1SMSAck(Sender: TObject; Source, Network,
MsgId: String; Deliverable: Boolean);
procedure ICQClient1SMSRefused(Sender: TObject);
procedure ICQClient1SMSReply(Sender: TObject; Source, SmsSender, Time,
Text: String);
procedure sendsmsClick(Sender: TObject);
procedure ListView1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure eICQWebsite1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Exit3Click(Sender: TObject);
procedure HideShow1Click(Sender: TObject);
procedure StatusClick(Sender: TObject);
procedure ListView1Edited(Sender: TObject; Item: TListItem;
var S: String);
procedure ListView1Editing(Sender: TObject; Item: TListItem;
var AllowEdit: Boolean);
procedure Rename1Click(Sender: TObject);
procedure AutoAwayTimerTimer(Sender: TObject);
procedure optionsClick(Sender: TObject);
procedure KeepAliveTimerTimer(Sender: TObject);
procedure ICQClient1LogOff(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure GeneralLincence1Click(Sender: TObject);
procedure ViewHistory1Click(Sender: TObject);
procedure ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListView1Click(Sender: TObject);
procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure Support1Click(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ICQClient1AdvancedMsgAck(Sender: TObject; UIN: String;
ID: Word; AcceptType: Byte; AcceptMsg: String);
procedure ICQClient1AuthRequest(Sender: TObject; UIN, Reason: String);
procedure ICQClient1OnlineInfo(Sender: TObject; UIN: String;
Port: Word; InternalIP, ExternalIP: String; OnlineTime: TDateTime;
Idle: Word; ICQVersion, MirandaVersion: Cardinal; ProtoVer,
UserCaps: Byte);
procedure IdleTimerTimer(Sender: TObject);
private
procedure ReCreateContactList;
procedure RepaintOfflineCL;
procedure ListViewWndProc(var Message: TMessage);
procedure RefreshRowHeight;
procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
protected
procedure WMNotifyIcon(var Message : TMessage); message WM_NOTIFYICON;
public
FConnecting: Boolean;
FInfoList: TList;
bSetAuthorization: Boolean;
FListViewWndProc: TWndMethod;
hImlMenuIcons: HIMAGELIST;
UserInfoReader: Byte;
tnid: TNotifyIconData;
bEditAble: Boolean;
sUIN: String;
function GetUserInfoIdx(Value: String): Integer;
procedure DoCreateInfoQuery(UIN: String);
procedure DoStatusChange(NewStatus: LongWord);
procedure DeleteFromDB(dwUIN: DWORD);
procedure WriteToDB(dwUIN: DWORD; DBD: _DBCONTACTSETTINGS);
procedure ReadFromDB(DBD: _DBCONTACTSETTINGS);
function ConvertDateTime(DateTime: TDateTime): String;
procedure GetWindowsVersion;
procedure OpenURL(const sURL: String; IsEmail: Boolean);
procedure SetLabel(var lblLabel: TLabel; Enabled: Boolean; URL: Boolean; Text: String);
function LocalTime(const DateTime: TDateTime): TDateTime;
function ReadSettings(): _DBSETTINGS;
procedure WriteSettings(Settings: _DBSETTINGS);
procedure SetSettings(Settings: _DBSETTINGS);
procedure SetCriticalSettings(Settings: _DBSETTINGS);
procedure OnlyNumbers(var EditB: TEdit);
function ValidateRange(Num: String; FType: Byte): Boolean;
procedure LogToFile(const strUIN, Text, NickName: String; Sent: Boolean; const DateTime: String);
function CryptPassword(Encrypt: Boolean; const Value: String): String;
end;
type
_DBCONTACTSETTINGSFILE = file of _DBCONTACTSETTINGS;
type
_DBSETTINGSFILE = file of _DBSETTINGS;
type
TSetLayeredWindowAttributes = function (Hwnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;
var
MainForm: TMainForm;
fDCFlag: LongWord = S_ALLOWDCONN; //S_ALLOWDAUTH;
DBData: _DBCONTACTSETTINGS;
F: _DBCONTACTSETTINGSFILE;
D: _DBSETTINGSFILE;
LVItemHeight: Integer = 17;
IsWinVerNT: Boolean;
IsWinVerNT4Plus: Boolean;
IsWinVer98Plus: Boolean;
IsWinVerMEPlus: Boolean;
IsWinVer2000Plus: Boolean;
IsWinVerXPPlus: Boolean;
OnSaver, OnWLock, OnMouse, SetNA: Boolean;
lastMousePos: TPoint;
mouseStationaryTimer: Integer = 0;
awayModeTimer: Integer = 0;
awaySet: Integer = 0;
naSet: Integer = 0;
AwayTime: Word = 5;
NATime: Word = 20;
originalStatusMode: DWORD;
OnTop: HWND = HWND_TOPMOST;
bHide: Boolean = False;
bTransparent: Boolean = True;
iBlendValue: Byte = 70;
dwLastStatus: DWORD = S_OFFLINE;
bMyDetails: Boolean = False;
OldTestHit: TListItem = nil;
TestHit: TListItem = nil;
MsgAway: String = '';
MsgNA: String = '';
MsgDND: String = '';
MsgOccupied: String = '';
MsgFFC: String = '';
MyGetLastInputInfo: function(var plii: TLastInputInfo): LongBool; stdcall;
MySetLayeredWindowAttributes: TSetLayeredWindowAttributes = nil;
implementation
uses SysUtils, DateUtils, Options;
{$R *.dfm}
function TMainForm.CryptPassword(Encrypt: Boolean; const Value: String): String;
var
i: Word;
begin
Result := '';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -