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

📄 main.pas

📁 ICQ客户端源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  if Length(Value) < 1 then Exit;
  case Encrypt of
    True: for i := 1 to Length(Value) do             // Encrypt
      Result := Result + Chr(Ord(Value[i]) + 5);

    False: begin
      for i := 1 to Length(Value) do
        Result := Result + Chr(Ord(Value[i]) - 5);   // Decrypt
           end;
  end;
end;


procedure TMainForm.LogToFile(const strUIN, Text, NickName: String; Sent: Boolean; const DateTime: String);
var
  FileName: String;
  txt: TextFile;

begin
  FileName := Format('%s%s%s%s', [ExtractFileDir(ParamStr(0)), '\History\', strUIN, '.txt']);

  try
    AssignFile(txt, FileName);
    if FileExists(FileName) then
      Append(txt)
    else
      Rewrite(txt);
      
    case Sent of
      True: Writeln(txt, Format('To: %s (%s) [%s]', [NickName, strUIN, DateTime]));

      False: Writeln(txt, Format('From: %s (%s) [%s]', [NickName, strUIN, DateTime]));
    end;
    Writeln(txt, '-----------------------------------------');
    Writeln(txt, Text);
    Writeln(txt, '');
    Flush(txt);
  finally
    CloseFile(txt);
  end;
end;

function TMainForm.ValidateRange(Num: String; FType: Byte): Boolean;
const
  MAX_BYTE = 255;
  MAX_WORD =  65535;
  MAX_DWORD = 4294967295;
var
  E: Integer;
  V: Int64;
begin
  Val(Num, V, E);

  if E = 0 then begin
    case FType of
      0: begin
          if V > MAX_BYTE then
            Result := False
          else
            Result := True;
         end;

      1: begin
          if V > MAX_WORD then
            Result := False
          else
            Result := True;
         end;

      2: begin
          if V > MAX_DWORD then
            Result := False
          else
            Result := True;
         end;
      else
        Result := False;
    end;
  end else
    Result := False;
end;

procedure TMainForm.OnlyNumbers(var EditB: TEdit);
begin
  SetWindowLong(EditB.Handle, GWL_STYLE, GetWindowLong(EditB.Handle, GWL_STYLE) or ES_NUMBER);
end;

function TMainForm.ReadSettings(): _DBSETTINGS;
var
  FileName: String;
  DBSet: _DBSETTINGS;
  bWasReaded: Boolean;
begin
  FileName := ExtractFilePath(ParamStr(0)) + 'settings.dat';
  bWasReaded := False;
  try
    AssignFile(D, FileName);
    if FileExists(FileName) then begin
      Reset(D);
      while not EOF(D) do
      begin
        Read(D, DBSet);
        DBSet.Password := CryptPassword(False, DBSet.Password);
        bWasReaded := True;
      end;
    end
    else
      Rewrite(D);

  if not bWasReaded then begin
    // Default settings
    DBSet.dwLastStatus := S_OFFLINE;     // Last Status
    DBSet.bOnTop := True;                // Window StayOnTop
    DBSet.sTitleText := 'eICQ';          // Titlebar Text
    DBSet.bHide := True;                 // Hide or Close main window
    DBSet.bTransparent := True;          // Window Transparency
    DBSet.iBlendValue := 70;             // Transparecy level
    DBSet.iLeft := 0;
    DBSet.iTop := 0;
    DBSet.iHeight := 292;
    DBSet.iWidth := 100;                 // Position & Size
    DBSet.ProxyType := P_NONE;           // Proxy type
    DBSet.ProxyAuth := False;            // Proxy requires auth
    DBSet.ProxyHost := '';               // Proxy server
    DBSet.ProxyPass := '';               // Proxy passwd
    DBSet.ProxyUserID := '';             // Username
    DBSet.ProxyPort := 1080;             // Proxy port
    DBSet.ProxyResolve := False;         // Resolve hostnames through proxy
    DBSet.UIN := 0;                      // UIN
    DBSet.Password := '';                // Passwd
    DBSet.ICQServer := 'login.icq.com';  // ICQ login server
    DBSet.ICQPort := 5190;               // ICQ Port
    DBSet.KeepAlive := False;            // Keep connection alive
    DBSet.OnSaver := True;
    DBSet.OnWLock := True;               // AutoAway
    DBSet.OnMouse := True;
    DBSet.SetNA := True;
    DBSet.AwayTime := 5;
    DBSet.NATime := 20;
                                          // AutoAway msgs
    DBSet.MsgAway := 'I''ve been away since %time%';
    DBSet.MsgNA := 'Give it up, I''m not in!' + #13#10 + #13#10 +
                   'N/A since %time% %date%';
    DBSet.MsgDND :=  'Give a guy some peace, would ya?';
    DBSet.MsgOccupied := 'Not right now.';
    DBSet.MsgFFC :=  'Well, I would talk to you if eICQ supported chat';
  end;

  finally
    CloseFile(D);
  end;

  Result := DBSet;
end;

procedure TMainForm.SetCriticalSettings(Settings: _DBSETTINGS);
begin
  if not ICQClient1.LoggedIn then begin
    dwLastStatus := Settings.dwLastStatus;             // Last Status
    ICQClient1.ProxyType := Settings.ProxyType ;       // Proxy type
    ICQClient1.ProxyAuth := Settings.ProxyAuth ;       // Proxy requires auth
    ICQClient1.ProxyHost := Settings.ProxyHost ;       // Proxy server
    ICQClient1.ProxyPass := Settings.ProxyPass ;       // Proxy passwd
    ICQClient1.ProxyUserID := Settings.ProxyUserID ;   // Username
    ICQClient1.ProxyPort := Settings.ProxyPort ;       // Proxy port
    ICQClient1.ProxyResolve := Settings.ProxyResolve ; // Resolve hostnames through proxy

    ICQClient1.UIN := Settings.UIN ;                   // UIN
    ICQClient1.Password := Settings.Password ;         // Passwd
    ICQClient1.ICQServer := Settings.ICQServer ;       // ICQ login server
    ICQClient1.ICQPort := Settings.ICQPort ;           // ICQ Port
  end;
end;

procedure TMainForm.SetSettings(Settings: _DBSETTINGS);
var
  AStyle: Integer;
begin
  if Settings.bOnTop then                        // Window StayOnTop
   OnTop := HWND_TOPMOST
  else
   OnTop := HWND_NOTOPMOST;

  Caption := Settings.sTitleText;               // Titlebar Text
  bHide := Settings.bHide;                      // Hide or Close main window
  bTransparent := Settings.bTransparent;        // Window Transparency
  iBlendValue := Settings.iBlendValue;          // Transparecy level

  Self.Left := Settings.iLeft;
  Self.Top := Settings.iTop;
  Self.Height := Settings.iHeight;
  Self.Width := Settings.iWidth;                     // Position & Size

  KeepAliveTimer.Enabled := Settings.KeepAlive; // Keep connection alive
                                                 // AutoAway
  OnSaver := Settings.OnSaver;
  OnWLock := Settings.OnWLock;
  OnMouse := Settings.OnMouse;
  SetNA := Settings.SetNA;

  AwayTime := Settings.AwayTime;
  NATime := Settings.NATime;
                                                 // AutoAway msgs
  MsgAway := Settings.MsgAway;
  MsgNA := Settings.MsgNA;
  MsgDND := Settings.MsgDND;
  MsgOccupied := Settings.MsgOccupied;
  MsgFFC := Settings.MsgFFC;

  //System Tray
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

  AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
  if (@MySetLayeredWindowAttributes <> nil) and bTransparent then begin
    if (AStyle and MY_WS_EX_LAYERED) = 0 then
      SetWindowLong(Handle, GWL_EXSTYLE, AStyle or MY_WS_EX_LAYERED);
    MySetLayeredWindowAttributes(Handle, RGB(0,0,0), Round(iBlendValue * 255 div 100), MY_LWA_ALPHA);
  end
  else begin
      SetWindowLong(Handle, GWL_EXSTYLE, AStyle and not MY_WS_EX_LAYERED);
      RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
  end;

  // FormStyle
  SetWindowPos(Handle, OnTop, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
end;


procedure TMainForm.WriteSettings(Settings: _DBSETTINGS);
var
  FileName: String;
begin
  FileName := ExtractFilePath(ParamStr(0)) + 'settings.dat';
  try
    AssignFile(D, FileName);
    if FileExists(FileName) then
      Reset(D)
    else
      Rewrite(D);

    Settings.Password := CryptPassword(True, Settings.Password);
    Write(D, Settings);
  finally
    CloseFile(D);
  end;
end;

procedure TMainForm.WMNotifyIcon(var Message : TMessage);
var
  uMouseMsg : Integer;
  CursorPos: TPoint;
begin
  uMouseMsg := Message.lParam;
  inherited;
  case uMouseMsg of
    WM_LBUTTONDBLCLK:
      HideShow1.Click;
      
    WM_RBUTTONUP:
    begin
      SetForegroundWindow(Handle);
      GetCursorPos(CursorPos);
      Self.popupTray.Popup(CursorPos.X, CursorPos.Y);
      PostMessage(Handle, WM_NULL, 0, 0);
    end;
  end;
end;

//Specifies the current bias, in minutes, for local time translation on this
//computer. The bias is the difference, in minutes, between Coordinated
//Universal Time (UTC) and local time. All translations between UTC and local
//time are based on the following formula: UTC = local time + bias

function TMainForm.LocalTime(const DateTime: TDateTime): TDateTime;
var
  TimeZoneInfo: TTimeZoneInformation;
begin
  case GetTimeZoneInformation(TimeZoneInfo) of
    TIME_ZONE_ID_STANDARD:
      Result := DateTime - (TimeZoneInfo.Bias / 60 / 24); 
    TIME_ZONE_ID_DAYLIGHT: 
      Result := DateTime - ((TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / 60 / 24); 
    else 
      Result := 0; 
  end;
end;

procedure TMainForm.OpenURL(const sURL: String; IsEmail: Boolean);
begin
  if IsEmail then
    ShellExecute(Handle,'open',PChar('mailto:' + sURL),'','',sw_Normal)
  else
    ShellExecute(Handle,'open',PChar(sURL),'','',sw_Normal);
end;

{Convert datetime in format like 'Tue Mar 09 08:32:06 2004'}
function TMainForm.ConvertDateTime(DateTime: TDateTime): String;
var
  FormatSettings: TFormatSettings;
begin
  GetLocaleFormatSettings(LANG_ENGLISH, FormatSettings);
  Result := FormatDateTime('ddd mmm dd hh:nn:ss yyyy', DateTime, FormatSettings);
end;

procedure TMainForm.GetWindowsVersion;
var
  WinVerMajor: DWORD;
  WinVerMinor: DWORD;
begin
  WinVerMajor := (LoByte(LoWord(GetVersion)));
  WinVerMinor := (HiByte(LoWord(GetVersion)));

  // WinVerNT
  if GetVersion < $80000000 then IsWinVerNT := True;

  // WinVerNT4Plus
  if (WinVerMajor >= 5) or (WinVerMinor > 0) or IsWinVerNT
    then IsWinVerNT4Plus := True;

  // WinVer98Plus
  if LoWord(GetVersion) <> 4 then IsWinVer98Plus := True;

  // WinVerMEPlus
  if (WinVerMajor >= 5) or (WinVerMinor > 10) then IsWinVerMEPlus := True;

  // WinVer2000Plus
  if WinVerMajor >= 5 then IsWinVer2000Plus := True;

  // WinVerXPPlus
  if (WinVerMajor >= 5) and (LoWord(GetVersion) <> 5) then IsWinVerXPPlus := True;
end;

procedure TMainForm.RefreshRowHeight;
var
  wp: TWindowPos;
begin
  wp.hwnd := ListView1.Handle;
  wp.cx := ListView1.Width;
  wp.cy := ListView1.Height;
  wp.flags := SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or SWP_NOZORDER;
  SendMessage(ListView1.Handle, WM_WINDOWPOSCHANGED, 0, Longint(@wp));
end;

procedure TMainForm.ListViewWndProc(var Message: TMessage);
begin
  ShowScrollBar(ListView1.Handle, SB_HORZ, False); // cacher la barre horizontale
  FListViewWndProc(Message); // process message
end;

procedure TMainForm.WMMeasureItem(var Message: TWMMeasureItem);
begin
  inherited;
  if Message.MeasureItemStruct.CtlType = ODT_LISTVIEW then
  begin
    Message.MeasureItemStruct.itemHeight := LVItemHeight;
    Message.Result := 1;
  end;
end;

function DoLoadIcons(FileName: String): Boolean;
var
  dllHandle: HMODULE;

  procedure DoSingleEntry(Name: String);
  var
    Icon: TIcon;
  begin
    Icon := TIcon.Create;
    Icon.Handle := LoadIcon(dllHandle, PChar(Name));
    MainForm.IconList.AddIcon(Icon);
  end;

begin
  Result := False;
  dllHandle := LoadLibrary(PChar(FileName));
  if dllHandle <> 0 then
  begin
    DoSingleEntry('#104');  //Online      0
    DoSingleEntry('#128');  //Away        1
    DoSingleEntry('#158');  //DND         2
    DoSingleEntry('#131');  //N/A         3
    DoSingleEntry('#130');  //Invisible   4
    DoSingleEntry('#105');  //Offline     5
    DoSingleEntry('#159');  //Occupied    6
    DoSingleEntry('#129');  //FFC         7
    FreeLibrary(dllHandle);
    Result := True;
  end;
end;

//Deleting user from ContactList
procedure TMainForm.DeleteFromDB(dwUIN: DWORD);
var
  FileName: String;
  podm: Longint;
  EmptyDBD: _DBCONTACTSETTINGS;

  function ContactExists: LongInt;
  var
    Position: Longint;
  begin
    Position := -1;
    while not EOF(F) do
    begin
      Read(F, DBData);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -