main.pas

ICQ客户端源代码

      else SetLabel(WFaxLabel, True, False, WFax);

    if FAddress = '' then SetLabel(WAddressLabel, False, False, NA)
      else SetLabel(WAddressLabel, True, False, FAddress);

    if WZip = '' then SetLabel(WZipLabel, False, False, NA)
      else SetLabel(WZipLabel, True, False, WZip);

    if WCountry = '' then SetLabel(WCountryLabel, False, False, NA)
      else SetLabel(WCountryLabel, True, False, WCountry);

    if WCompany = '' then SetLabel(WCompanyLabel, False, False, NA)
      else SetLabel(WCompanyLabel, True, False, WCompany);

    if WDepartment = '' then SetLabel(WDepartmentLabel, False, False, NA)
      else SetLabel(WDepartmentLabel, True, False, WDepartment);

    if WPosition = '' then SetLabel(WPositionLabel, False, False, NA)
      else SetLabel(WPositionLabel, True, False, WPosition);

    if WOccupation = '' then SetLabel(WOccupationLabel, False, False, NA)
      else SetLabel(WOccupationLabel, True, False, WOccupation);

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

procedure TMainForm.ICQClient1UserInfoInterests(Sender: TObject; UIN: String;
  Interests: TStringList);
var
  Form: TUserInfoForm;
  i: Integer;
  ListItem: TListItem;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  Form.InterestsView.Items.Clear;
  if Interests.Count > 0 then
    for i := 0 to Interests.Count - 1 do
    begin
      if (ExtractName(Interests.Strings[i]) <> '') and (ExtractValue(Interests.Strings[i]) <> '') then
      begin
        ListItem := Form.InterestsView.Items.Add;
        ListItem.Caption := ExtractName(Interests.Strings[i]);
        ListItem.SubItems.Add(ExtractValue(Interests.Strings[i]));
      end;
    end;
  Interests.Free;
  Inc(UserInfoReader);  
end;

procedure TMainForm.UserInfo1Click(Sender: TObject);
begin
  SetCapture(ListView1.Handle);

  if ListView1.Selected <> nil then
    DoCreateInfoQuery(ListView1.Selected.Caption);
end;


procedure TMainForm.RemoveContact1Click(Sender: TObject);
var
  dwUIN: DWORD;
begin
  SetCapture(ListView1.Handle);
  if ListView1.Selected <> nil then
  begin
    dwUIN := StrToInt64(ListView1.Selected.Caption);
    ICQClient1.RemoveContact(dwUIN);
    ListView1.Items.Delete(ListView1.Selected.Index);

    DeleteFromDB(dwUIN);
  end;
end;

procedure TMainForm.ICQClient1UserFound(Sender: TObject; UIN, Nick, FirstName,
  LastName, Email: String; Status: Word; Gender, Age: Byte;
  SearchComplete, Authorize: Boolean);
var
  ListItem: TListItem;
  S: String;
begin
  if UserSearchForm <> nil then
  begin
    ListItem := UserSearchForm.ListView1.Items.Add;
    if Status = 1 then {Online}
      ListItem.ImageIndex := ICON_ONLINE
    else
      ListItem.ImageIndex := ICON_OFFLINE;
    ListItem.Caption := Nick;
    ListItem.SubItems.Add(FirstName);
    ListItem.SubItems.Add(LastName);
    ListItem.SubItems.Add(Email);
    ListItem.SubItems.Add(UIN);
    S := '';
    if Gender <> 0 then
      if Gender = GEN_FEMALE then
        S := 'F'
      else if Gender = GEN_MALE then
        S := 'M';
    if Age <> 0 then
      if S = '' then
        S := IntToStr(Age)
      else
        S := S + '-' + IntToStr(Age);
    ListItem.SubItems.Add(S);
    if Authorize then ListItem.SubItems.Add('Yes')
      else ListItem.SubItems.Add('No');

    if SearchComplete then
    begin
      UserSearchForm.Button1.Caption := 'Search';
      UserSearchForm.StatusBar1.Panels[0].Text := 'Search complete';
    end;
  end;
end;

procedure TMainForm.ICQClient1UserNotFound(Sender: TObject);
begin
  if UserSearchForm <> nil then
  begin
    UserSearchForm.Button1.Caption := 'Search';
    UserSearchForm.StatusBar1.Panels[0].Text := 'User not found';
  end;
end;

{Needed for debug only! It's not required implementing this event in your developments.}
procedure TMainForm.ICQClient1PktParse(Sender: TObject; Buffer: Pointer;
  BufLen: Cardinal; Incoming: Boolean);
var
  p: PRawPkt;
  ListItem: TListItem;
  ad: String;
  f, s: Word;
begin
  GetMem(p, SizeOf(TRawPkt));
  Move(Buffer^, p^, BufLen);
  p^.Len := 0;
  PktDumpForm.FPktList.Add(p);
  {ListItem}
  ListItem := PktDumpForm.ListView1.Items.Add;
  if Incoming then
    ListItem.ImageIndex := 5
  else
    ListItem.ImageIndex := 0;
  ListItem.SubItems.Add(IntToStr(PFlapHdr(Buffer)^.ChID));
  ListItem.SubItems.Add(IntToStr(Swap16(PFlapHdr(Buffer)^.DataLen)));
  ListItem.SubItems.Add('0x' + IntToHex(Swap16(PFlapHdr(Buffer)^.Seq), 4));

  if PFlapHdr(Buffer)^.ChID <> 2 then
  begin
    ListItem.SubItems.Add('');
    if (PFlapHdr(Buffer)^.ChID = 1) and (Swap16(PFlapHdr(Buffer)^.DataLen) > 35) then
    begin
      if PChar(LongWord(Buffer) + BufLen - 2)^ + PChar(LongWord(Buffer) + BufLen - 1)^ = 'us' then
        ListItem.SubItems.Add('CLI_IDENT')
      else if Swap16(PFlapHdr(Buffer)^.DataLen) = 264 then
          ListItem.SubItems.Add('CLI_COOKIE')
    end else
    if (PFlapHdr(Buffer)^.ChID = 4) and (Swap16(PFlapHdr(Buffer)^.DataLen) = 0) then
    begin
      if Incoming then
        ListItem.SubItems.Add('SRV_GOODBYE')
      else
        ListItem.SubItems.Add('CLI_GOODBYE');
    end else if (PFlapHdr(Buffer)^.ChID = 4) and Incoming then
    begin
      if (Swap16(PFlapHdr(Buffer)^.DataLen) > 270) then
        ListItem.SubItems.Add('SRV_COOKIE')
      else
        ListItem.SubItems.Add('SRV_GOODBYE')
    end
    else if Swap16(PFlapHdr(Buffer)^.DataLen) = 4 then
    begin
      if Incoming then
        ListItem.SubItems.Add('SRV_HELLO')
      else
        ListItem.SubItems.Add('CLI_HELLO');
    end else
      ListItem.SubItems.Add('none');
  end else
  begin
    ad := '';
    f := Swap16(PSnacHdr(LongWord(Buffer) + TFLAPSZ)^.Family);
    s := Swap16(PSnacHdr(LongWord(Buffer) + TFLAPSZ)^.SubType);
    if (f = $15) and ((s = $03) or (s = $02)) then
      ad := ' [' + SrvMetaToStr(PWord(LongWord(Buffer) + TFLAPSZ + TSNACSZ + 10)^, PWord(LongWord(Buffer) + TFLAPSZ + TSNACSZ + 14)^) + ']';
    ListItem.SubItems.Add('SNAC(' + IntToHex(f, 2) + ',' + IntToHex(s, 2) + ')' + ad);
    ListItem.SubItems.Add(SnacToStr(f, s));
  end;
end;

procedure TMainForm.ICQClient1UserInfoBackground(Sender: TObject;
  UIN: String; Pasts, Affiliations: TStringList);
var
  Form: TUserInfoForm;
  i: Integer;
  ListItem: TListItem;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  if Form = nil then Exit;
  Form.PastsListView.Items.Clear;
  Form.AffiliationsListView.Items.Clear;
  if Pasts.Count > 0 then
    for i := 0 to Pasts.Count - 1 do
    begin
      if (ExtractName(Pasts.Strings[i]) <> '') and (ExtractName(Pasts.Strings[i]) <> '') then
      begin
        ListItem := Form.PastsListView.Items.Add;
        ListItem.Caption := ExtractName(Pasts.Strings[i]);
        ListItem.SubItems.Add(ExtractValue(Pasts.Strings[i]));
      end;
    end;
  Pasts.Free;
  if Affiliations.Count > 0 then
    for i := 0 to Affiliations.Count - 1 do
    begin
      if (ExtractName(Affiliations.Strings[i]) <> '') and (ExtractValue(Affiliations.Strings[i]) <> '') then
      begin
        ListItem := Form.AffiliationsListView.Items.Add;
        ListItem.Caption := ExtractName(Affiliations.Strings[i]);
        ListItem.SubItems.Add(ExtractValue(Affiliations.Strings[i]));
      end;
    end;
  Affiliations.Free;
  Inc(UserInfoReader);  
end;

procedure TMainForm.ICQClient1ServerListRecv(Sender: TObject;
  SrvContactList: TList);
var
  i: Word;
  UserInfo: TUINEntry;
  ListItem: TListItem;
begin
  if SrvContactList.Count > 0 then
    for i := 0 to SrvContactList.Count - 1 do
    begin
      UserInfo := PUINEntry(SrvContactList.Items[i])^;
      if UserInfo.CType = U_VISIBLE_LIST then
        ICQClient1.VisibleList.Add(IntToStr(UserInfo.UIN))
      else if UserInfo.CType = U_INVISIBLE_LIST then
        ICQClient1.InvisibleList.Add(IntToStr(UserInfo.UIN))
      else if UserInfo.CType = U_NORMAL then
      begin
        if ICQClient1.AddContact(UserInfo.UIN) then
        begin
          ListItem := ListView1.Items.Add;
          ListItem.ImageIndex := ICON_OFFLINE;
          ListItem.Caption := IntToStr(UserInfo.UIN);
        end;
      end;
    end;
  ICQClient1.DestroyUINList(SrvContactList);
end;

procedure TMainForm.ReadAwayMessage1Click(Sender: TObject);
var
  ReqStatus: Byte;
  itemStatus: DWORD;
begin
  SetCapture(ListView1.Handle);
  if ListView1.Selected = nil then Exit;

  itemStatus := StrToInt64(ListView1.Selected.SubItems[LV_INDEX_STATUS]);
  case StatusToInt(itemStatus) of
    S_AWAY       : ReqStatus := GET_AWAY;
    S_DND        : ReqStatus := GET_DND;
    S_NA         : ReqStatus := GET_NA;
    S_OCCUPIED   : ReqStatus := GET_OCCUPIED;
    S_FFC        : ReqStatus := GET_FFC;
  else  //Unknown status
    Exit;
  end;

  Randomize;
  ICQClient1.RequestAwayMsg(StrToInt64(ListView1.Selected.Caption), Random($FFFF), ReqStatus);
end;

procedure TMainForm.ICQClient1AutoMsgResponse(Sender: TObject; UIN: String;
  ID: Word; RespStatus: Byte; Msg: String);
begin
  with TAutoAwayForm.Create(Self) do
  begin
    Caption := UIN + ': away-message';
    AwayMemo.Lines.Text := Msg;
    Show;
  end;
end;

procedure TMainForm.ICQClient1AdvancedMsgAck(Sender: TObject; UIN: String;
  ID: Word; AcceptType: Byte; AcceptMsg: String);
begin
  with TAutoAwayForm.Create(Self) do
  begin
    Caption := UIN + ': adv-away-message';
    AwayMemo.Lines.Text := AcceptMsg;
    Show;
  end;
end;

{Needed for debug only! It's not required implementing this event in your developments.}
procedure TMainForm.ICQClient1PktDirectParse(Sender: TObject;
  Buffer: Pointer; BufLen: Cardinal; Incoming: Boolean);
var
  p: PRawPkt;
  ListItem: TListItem;
begin
  GetMem(p, SizeOf(TRawPkt));
  Move(Buffer^, p^, BufLen);
  p^.Len := BufLen;
  PktDumpForm.FPktList.Add(p);
  {ListItem}
  ListItem := PktDumpForm.ListView1.Items.Add;
  if Incoming then
    ListItem.ImageIndex := 5
  else
    ListItem.ImageIndex := 0;
  ListItem.SubItems.Add('DIRECT');
  ListItem.SubItems.Add(IntToStr(BufLen));
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('0x' + IntToHex(PByte(LongWord(Buffer) + 2)^, 2));
  ListItem.SubItems.Add(PeerCmdToStr(PByte(LongWord(Buffer) + 2)^));
  //Save incoming dumps to a file
  {if Incoming then LogText('dc.txt', 'Incoming packet! Command: ' + PeerCmdToStr(PByte(LongWord(Buffer) + 2)^) + ', length: ' + IntToStr(BufLen - 2) + #13#10 + DumpPacket(Buffer, BufLen) + #13#10#13#10)
  else LogText('dc.txt', 'Outgoing packet! Command: ' + PeerCmdToStr(PByte(LongWord(Buffer) + 2)^) + ', length: ' + IntToStr(BufLen - 2) + #13#10 + DumpPacket(Buffer, BufLen) + #13#10#13#10);}
end;

procedure TMainForm.ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
  ErrorMsg: String);
begin
//  ShowMessage(ErrorMsg); {Handle as you need}
end;

procedure TMainForm.ICQClient1NewUINRefused(Sender: TObject);
begin
  with TUserRegForm.Create(Self) do
  begin
    Memo1.Lines.Text := 'Sorry, server cannot give you a new UIN, possible'
      + ' you are trying to register numbers too often.';
    Show;
  end;
end;

procedure TMainForm.ICQClient1NewUINRegistered(Sender: TObject;
  UIN: String);
begin
  with TUserRegForm.Create(Self) do
  begin
    Memo1.Lines.Text := 'Success! New UIN was granted: ' + #13#10 + UIN;
    Show;
  end;
end;

procedure TMainForm.ICQClient1UnregisterBadPassword(Sender: TObject);
begin
  with TUserRegForm.Create(Self) do
  begin
    Memo1.Lines.Text := 'Sorry, server can''t unregister UIN, possible'
      + ' you''ve entered a bad password.';
    Show;
  end;
end;

procedure TMainForm.ICQClient1UnregisterOk(Sender: TObject);
begin
  with TUserRegForm.Create(Self) do
  begin
    Memo1.Lines.Text := Format('Your UIN: %u was successfully unregistred!', [ICQClient1.UIN]);
    Show;
  end;
end;

procedure TMainForm.ICQClient1InfoChanged(Sender: TObject;
  InfoType: TInfoType; ChangedOk: Boolean);
begin
  with TUserRegForm.Create(Self) do
  begin
    if InfoType = INFO_PASSWORD then
    begin
      case ChangedOk of
        True: Memo1.Lines.Text := 'Your password was successfully changed!';
        False: Memo1.Lines.Text := 'Sorry, server can''t change your password.';
      end;
    end;
    Show;
  end;
end;

procedure TMainForm.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  StatusBar1.Canvas.FillRect(Rect);
  StatusBar1.Canvas.Draw(Rect.Left, Rect.Top, Icon);
  StatusBar1.Canvas.TextOut(20, 5, StatusBar1.Panels[0].Text);
end;

procedure TMainForm