main.pas

本程序是转载的

    DayOfBirthLabel.Caption := IntToStr(BirthYear) + '/' + IntToStr(BirthMonth) + '/' + IntToStr(BirthDay);
    Language1Label.Caption := Lang1;
    Language2Label.Caption := Lang2;
    Language3Label.Caption := Lang3;
  end;
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;
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
    WCityLabel.Caption := WCity;
    WStateLabel.Caption := WState;
    WPhoneLabel.Caption := WPhone;
    WFaxLabel.Caption := WFax;
    WAddressLabel.Caption := FAddress;
    WZipLabel.Caption := WZip;
    WCountryLabel.Caption := WCountry;
    WCompanyLabel.Caption := WCompany;
    WDepartmentLabel.Caption := WDepartment;
    WPositionLabel.Caption := WPosition;
    WOccupationLabel.Caption := WOccupation;
    WHomePageLabel.Caption := WHomePage;
  end;
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;
end;

procedure TMainForm.UserInfo1Click(Sender: TObject);
begin
  if ListView1.Selected = nil then Exit;
  DoCreateInfoQuery(ListView1.Selected.Caption);
end;


procedure TMainForm.Search1Click(Sender: TObject);
begin
  UserSearchForm.Show;
end;

procedure TMainForm.RemoveContact1Click(Sender: TObject);
begin
  if ListView1.Selected = nil then Exit;
  ICQClient1.RemoveContact(StrToInt(ListView1.Selected.Caption));
  ListView1.Items.Delete(ListView1.Selected.Index);
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 := 0
    else
      ListItem.ImageIndex := 5;
    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 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.PacketDumps1Click(Sender: TObject);
begin
  PktDumpForm.Show;
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;
end;

procedure TMainForm.LoadContactList1Click(Sender: TObject);
begin
  ICQClient1.RequestContactList;
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 := 5;
          ListItem.Caption := IntToStr(UserInfo.UIN);
        end;
      end;
    end;
  ICQClient1.DestroyUINList(SrvContactList);
end;

procedure TMainForm.ReadAwayMessage1Click(Sender: TObject);
var
  ReqStatus: Byte;
begin
  if ListView1.Selected = nil then Exit;
  case ListView1.Selected.ImageIndex of
    1: ReqStatus := GET_AWAY;
    2: ReqStatus := GET_DND;
    3: ReqStatus := GET_NA;
    6: ReqStatus := GET_OCCUPIED;
    7: ReqStatus := GET_FFC;
  else  //Unknown status
    Exit;
  end;

  ICQClient1.RequestAwayMsg(StrToInt(ListView1.Selected.Caption), 0, 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;

{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.ICQClient1URLRecv(Sender: TObject; Description, URL,
  UIN: String);
begin
  with TRecvMsgForm.Create(nil) do
  begin
    Caption := 'URL from: ' + UIN;
    RichEdit1.Text := Description + ':'#13#10 + URL;
    FSource := UIN;
    Show;
  end;
end;

procedure TMainForm.ICQClient1MessageRecv(Sender: TObject; Msg,
  UIN: String);
begin
  with TRecvMsgForm.Create(nil) do
  begin
    Caption := 'Message from: ' + UIN;
    RichEdit1.Text := Msg;
    FSource := UIN;
    Show;
  end;
end;

procedure TMainForm.ICQClient1OfflineMsgRecv(Sender: TObject; Msg,
  UIN: String);
begin
  ICQClient1MessageRecv(Self, Msg, UIN);
end;

procedure TMainForm.ICQClient1OfflineURLRecv(Sender: TObject; Description,
  URL, UIN: String);
begin
  ICQClient1URLRecv(Self, Description, URL, UIN);
end;

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

procedure TMainForm.RegisterNewUIN1Click(Sender: TObject);
begin
  with TUserRegNewForm.Create(Self) do
    Show;
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;

end.