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

📄 main.pas

📁 ICQ客户端源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
(*

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 + -