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

📄 main.pas

📁 ICQ客户端源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        ListItem.SubItems[LV_INDEX_STATUS] := IntToStr(S_OFFLINE);
        ListView1.Invalidate;
        Exit;
      end;
end;

procedure TMainForm.popupListMenuPopup(Sender: TObject);
var
  IsAwayStatus: Boolean;
  itemStatus: DWORD;
begin
  //If user not in Online or Invisible or Offline mode
  //then enable Read away message item in popup menu
  IsAwayStatus := True;
  itemStatus := StrToInt64(ListView1.Selected.SubItems[LV_INDEX_STATUS]);
  case StatusToInt(itemStatus) of
    S_AWAY       : ReadAwayMessage1.ImageIndex := 20;
    S_DND        : ReadAwayMessage1.ImageIndex := 23;
    S_NA         : ReadAwayMessage1.ImageIndex := 22;
    S_OCCUPIED   : ReadAwayMessage1.ImageIndex := 19;
    S_FFC        : ReadAwayMessage1.ImageIndex := 21;
  else  // !IsAwayStatus
    IsAwayStatus := False;
  end;

  if IsAwayStatus then begin
    ReadAwayMessage1.Enabled := True;
    ReadAwayMessage1.Visible := True;
  end
  else begin
    ReadAwayMessage1.Enabled := False;
    ReadAwayMessage1.Visible := False;
  end;
end;

function TMainForm.GetUserInfoIdx(Value: String): Integer;
var
  i: Integer;
begin
  Result := -1;
  if FInfoList.Count > 0 then
    for i := 0 to FInfoList.Count - 1 do
      if TUserInfoForm(FInfoList.Items[i]).FSource = Value then
      begin
        Result := i;
        Exit;
      end;
end;

procedure TMainForm.SetLabel(var lblLabel: TLabel; Enabled: Boolean; URL: Boolean; Text: String);
begin
  if Enabled then
  begin
    case URL of
      True: begin
              lblLabel.Visible := True;
              lblLabel.Enabled := True;
              lblLabel.Caption := Text;
              lblLabel.Enabled := True;
              lblLabel.Font.Color := $00CB8B64;
              lblLabel.Font.Style := [fsUnderline];
              //System HandPoint Cursor
              if IsWinVer2000Plus then
              begin
                Screen.Cursors[NIDC_HAND] := LoadCursor(0, IDC_HAND);
                lblLabel.Cursor := NIDC_HAND;
              end else lblLabel.Cursor := crHandPoint;
            end;

      False: begin
              lblLabel.Caption := Text;
              lblLabel.Enabled := True;
              lblLabel.Font.Color := clWindowText;
              lblLabel.Cursor := crDefault;
             end;
    end;
  end else
  begin
    lblLabel.Caption := '<not specified>';
    lblLabel.Enabled := False;
    lblLabel.Font.Color := clWindowText;
    lblLabel.Cursor := crDefault;
  end;
end;

procedure TMainForm.DoCreateInfoQuery(UIN: String);
var
  i: Integer;
  UIForm: TUserInfoForm;
  ListItem: TListItem;

  function GetICQClientName(Code: Cardinal; ProtoVer: Byte): String;
  var
    sICQName: String;
  begin
    case ProtoVer of
       4: sICQName := 'ICQ98';
       6: sICQName := 'ICQ99 / licq';
       7: sICQName := 'Icq2Go or ICQ2000';
       8: sICQName := 'ICQ2001-2003a';
       9: sICQName := 'ICQ Lite';
      10: sICQName := 'ICQ 2003b';
    else
      sICQName := 'Unknown';
    end;

    case Code of
      $ffffffff : sICQName := 'Miranda IM'; //ff ff ff ff - Miranda
      $7D800404 : sICQName := 'licq';       //7D 80 04 04- licq
                                            //7d xx xx xx - licq; reminder wxxy decimal is version w.x.y.
                                            //00 80 00 00 - licq SSL flag
      $ffffff8f : sICQName := 'StrICQ';     //ff ff ff 8f - StrICQ
      $ffffff42 : sICQName := 'mICQ';       //ff ff ff 42 - mICQ
      $ffffff7f : sICQName := '&&RQ';       //ff ff ff 7f - &RQ
      $ffffffbe : sICQName := 'alicq';      //ff ff ff be - alicq
      $ffffffab : sICQName := 'YSM';        //ff ff ff ab - YSM (does not send version)
    end;

    Result := Format('%d: %s', [ProtoVer, sICQName]);
  end;

  function MirandaVersionToString(Code, ICQVer: Cardinal): String;
  var
    sICQVersion: String;
    aa, bb, cc, dd: Cardinal;
    sAlpha: String;
  begin
    case ICQver of
      $ffffffbe:
        begin
          aa := (Code shr 24) and $FF;
          bb := (Code shr 16) and $FF;
          cc := (Code shr 8) and $FF;
          dd := Code and $FF;
          sICQVersion := Format('%u.%u.%u.%u', [aa, bb, cc, dd]);
        end;

      $ffffffff:
        begin
          if Code = $00000001 then sICQVersion := '0.1.2.0 alpha'
          else begin
            aa := (Code shr 24) and $7F;
            bb := (Code shr 16) and $FF;
            cc := (Code shr 8) and $FF;
            dd := Code and $FF;
            if (Code) and ($80000000) = $80000000 then
              sAlpha := ' alpha'
            else
              sAlpha := '';

            sICQVersion := Format('%u.%u.%u.%u%s', [aa, bb, cc, dd, sAlpha]);
          end;
        end;
    else
      sICQVersion := '';
    end;

    Result := sICQVersion;
  end;

begin
  i := GetUserInfoIdx(UIN);
  if i > -1 then
  begin
    TUserInfoForm(FInfoList.Items[i]).Show;
    Exit;
  end;
  UIForm := TUserInfoForm.Create(nil);
  FInfoList.Add(UIForm);
  with UIForm do
  begin
    if bMyDetails then begin
      SetLabel(lblMyDetailsURL ,True, True, 'Change my details using the ICQ website' );
      bMyDetails := False;
    end;
    UINLabel.Caption := UIN;
    stHandle := stPing.Handle;
    Caption := 'Info about ' + UIN;
    FSource := UIN;
    LocalTimer.Enabled := True;
    if UIN <> IntToStr(ICQClient1.UIN) then
    begin
      if ListView1.Items.Count > 0 then
        for i := 0 to ListView1.Items.Count - 1 do
          if ListView1.Items.Item[i].Caption = UIN then
          begin
            ListItem := ListView1.Items.Item[i];

            sExternalIP := ListItem.SubItems[LV_INDEX_EXTIP];
            sInternalIP := ListItem.SubItems[LV_INDEX_INTIP];
            wPort := StrToInt(ListItem.SubItems[LV_INDEX_PORT]);
            byProtoVer := StrToInt(ListItem.SubItems[LV_INDEX_PROTOVER]);
            byUserCaps := StrToInt(ListItem.SubItems[LV_INDEX_USERCAPS]);
            dwMirandaVer := StrToInt64(ListItem.SubItems[LV_INDEX_MIRANDAVER]);
            dwClient := StrToInt64(ListItem.SubItems[LV_INDEX_CLIENT]);
            dtOnlineTime := StrToFloat(ListItem.SubItems[LV_INDEX_ONLINETIME]);

            dwIdle := StrToInt(ListItem.SubItems[LV_INDEX_IDLE]);

            lbIdle.Caption := Format('%.02u:%.02u',[dwIdle div 60, dwIdle mod 60]);

            UINLabel.Caption := UIN;

            if sExternalIP = '' then SetLabel(ExtIPLabel, False, False, NA)
              else SetLabel(ExtIPLabel, True, False, sExternalIP);

            if sInternalIP = '' then SetLabel(IntIPLabel, False, False, NA)
              else SetLabel(IntIPLabel, True, False, sInternalIP);

            if wPort = 0 then SetLabel(PortLabel, False, False, NA)
              else SetLabel(PortLabel, True, False, IntToStr(wPort));

            if GetICQClientName(dwClient, byProtoVer) = '' then SetLabel(IcqVerLabel, False, False, NA)
              else SetLabel(IcqVerLabel, True, False, GetICQClientName(dwClient, byProtoVer));

            if MirandaVersionToString(dwMirandaVer, dwClient) = '' then SetLabel(MiraVerLabel, False, False, NA)
              else SetLabel(MiraVerLabel, True, False, MirandaVersionToString(dwMirandaVer, dwClient));

            if (dtOnlineTime = 0) or (not ICQClient1.LoggedIn) then SetLabel(OnlineSinceLabel, False, False, NA)
              else SetLabel(OnlineSinceLabel, True, False, ConvertDateTime(dtOnlineTime));

            dwUIN := StrToInt64(UIN);
            DBData.dwUIN := dwUIN;
            DBData.dwStatus := S_OFFLINE;
            DBData.sInternalIP := sInternalIP;
            DBData.sExternalIP := sExternalIP;
            DBData.wPort := wPort;
            DBData.byProtoVer := byProtoVer;
            DBData.byUserCaps := byUserCaps;
            DBData.dtOnlineTime := dtOnlineTime;
            DBData.dwClient := dwClient;
            DBData.dwMirandaVer := dwMirandaVer;
            DBData.sNick := ListItem.SubItems[LV_INDEX_NICK];   //Nick

            MainForm.WriteToDB(dwUIN, DBData);
          end;
        end;
    if Self.ICQClient1.LoggedIn then btnUpdate.Enabled := True
      else btnUpdate.Enabled := False;
    Show;
  end;
end;

procedure TMainForm.ICQClient1UserGeneralInfo(Sender: TObject; UIN,
  NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street,
  Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
var
  Form: TUserInfoForm;
  i: Integer;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  with Form do
  begin
    UINLabel.Caption := UIN;

    if NickName <> '' then   //Update Nick
      SetLabel(NickNameLabel, True, False, NickName)
    else
      SetLabel(NickNameLabel, False, False, NA);

    if FirstName = '' then SetLabel(FirstNameLabel, False, False, NA)
      else SetLabel(FirstNameLabel, True, False, FirstName);

    if LastName = '' then SetLabel(LastNameLabel, False, False, NA)
      else SetLabel(LastNameLabel, True, False, LastName);

    if PublishEmail then
    begin
      if Email = '' then SetLabel(EmailLabel, False, False, NA)
        else SetLabel(EmailLabel, True, True, Email);
    end
    else begin
      if Email = '' then SetLabel(EmailLabel, False, False, '<not published>')
        else SetLabel(EmailLabel, True, True, Email);
    end;

    if Street = '' then SetLabel(StreetLabel, False, False, NA)
      else SetLabel(StreetLabel, True, False, Street);

    if City = '' then SetLabel(CityLabel, False, False, NA)
      else SetLabel(CityLabel, True, False, City);

    if State = '' then SetLabel(StateLabel, False, False, NA)
      else SetLabel(StateLabel, True, False, State);

    if Country = '' then SetLabel(CountryLabel, False, False, NA)
      else SetLabel(CountryLabel, True, False, Country);

    if Zip = '' then SetLabel(ZipLabel, False, False, NA)
      else SetLabel(ZipLabel, True, False, Zip);

    //
    if TimeZone <> 0 then
    begin
      TimeZoneDiff := ShortInt(TimeZone);
      TimeZoneLabel.Caption := Format(IfThen(TimeZoneDiff > 0, 'GTM -%d:%.02d', 'GTM +%d:%.02d'),[Abs(TimeZoneDiff div 2), (TimeZoneDiff and 1)*30]);
      SetLabel(TimeZoneLabel, True, False, TimeZoneLabel.Caption);
    end else
      SetLabel(TimeZoneLabel, False, False, NA);

    if Cellular = '' then SetLabel(CellularLabel, False, False, NA)
      else SetLabel(CellularLabel, True, False, Cellular);
  end;

  Inc(UserInfoReader);
end;

procedure TMainForm.ICQClient1UserInfoMore(Sender: TObject; UIN: String;
  Age: Word; Gender: Byte; HomePage: String; BirthYear, BirthMonth,
  BirthDay: Word; Lang1, Lang2, Lang3: String);
var
  Form: TUserInfoForm;
  i: Integer;
  nMonth: String[11];
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  with Form do
  begin
    if Age = 0 then SetLabel(AgeLabel, False, False, NA)
      else SetLabel(AgeLabel, True, False, IntToStr(Age));

    case Gender of
      GEN_MALE: SetLabel(GenderLabel, True, False, 'Male');

      GEN_FEMALE: SetLabel(GenderLabel, True, False, 'Female');

      else SetLabel(GenderLabel, False, False, NA);
    end;

    if HomePage = '' then SetLabel(HomePageLabel, False, False, NA)
      else SetLabel(HomePageLabel, True, True, HomePage);

    case BirthMonth of
      1  : nMonth := 'January ';
      2  : nMonth := 'February ';
      3  : nMonth := 'March ';
      4  : nMonth := 'April ';
      5  : nMonth := 'May ';
      6  : nMonth := 'June ';
      7  : nMonth := 'July ';
      8  : nMonth := 'August ';
      9  : nMonth := 'September ';
      10 : nMonth := 'October ';
      11 : nMonth := 'November ';
      12 : nMonth := 'December ';
    else
      nMonth := '';
    end;

    if (BirthDay = 0) and (BirthMonth = 0) and (BirthYear = 0) then
      SetLabel(DayOfBirthLabel, False, False, NA)
    else
      SetLabel(DayOfBirthLabel, True, False, nMonth + IntToStr(BirthDay) + ', ' +  IntToStr(BirthYear));

    if Lang1 = '' then SetLabel(Language1Label, False, False, NA)
      else SetLabel(Language1Label, True, False, Lang1);

    if Lang2 = '' then SetLabel(Language2Label, False, False, NA)
      else SetLabel(Language2Label, True, False, Lang2);

    if Lang3 = '' then SetLabel(Language3Label, False, False, NA)
      else SetLabel(Language3Label, True, False, Lang3);
  end;
  Inc(UserInfoReader);  
end;

procedure TMainForm.ICQClient1UserInfoAbout(Sender: TObject; UIN,
  About: String);
var
  Form: TUserInfoForm;
  i: Integer;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  Form.AboutMemo.Text := About;
  Inc(UserInfoReader);  
end;

procedure TMainForm.ICQClient1UserWorkInfo(Sender: TObject; UIN, WCity,
  WState, WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment,
  WPosition, WOccupation, WHomePage: String);
var
  Form: TUserInfoForm;
  i: Integer;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  with Form do
  begin
    if WCity = '' then SetLabel(WCityLabel, False, False, NA)
      else SetLabel(WCityLabel, True, False, WCity);

    if WState = '' then SetLabel(WStateLabel, False, False, NA)
      else SetLabel(WStateLabel, True, False, WState);

    if WPhone = '' then SetLabel(WPhoneLabel, False, False, NA)
      else SetLabel(WPhoneLabel, True, False, WPhone);

    if WFax = '' then SetLabel(WFaxLabel, False, False, NA)

⌨️ 快捷键说明

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