home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / ICQ.ZIP / ICQ / Example / Main.pas < prev    next >
Pascal/Delphi Source File  |  2002-08-16  |  24KB  |  766 lines
  1. unit Main;
  2. {(C) Alex Demchenko(alex@ritlabs.com)}
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, Classes, Graphics, Controls, Forms,
  8.   ComCtrls, ImgList, Menus, ICQClient, ICQWorks, RecvMsg,
  9.   SendMsg, UserInfo, StdCtrls, UserSearch, AutoAway, PktDump, RIchEdit;
  10.  
  11. type
  12.   TMainForm = class(TForm)
  13.     ListView1: TListView;
  14.     IconList: TImageList;
  15.     MainMenu1: TMainMenu;
  16.     Main1: TMenuItem;
  17.     Status1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     Online1: TMenuItem;
  20.     Away1: TMenuItem;
  21.     DND1: TMenuItem;
  22.     Invisible1: TMenuItem;
  23.     Offline1: TMenuItem;
  24.     NA1: TMenuItem;
  25.     StatusBar1: TStatusBar;
  26.     ICQClient1: TICQClient;
  27.     PopupMenu1: TPopupMenu;
  28.     UserInfo1: TMenuItem;
  29.     Search1: TMenuItem;
  30.     Search2: TMenuItem;
  31.     PacketDumps1: TMenuItem;
  32.     RemoveContact1: TMenuItem;
  33.     LoadContactList1: TMenuItem;
  34.     ReadAwayMessage1: TMenuItem;
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure FormShow(Sender: TObject);
  37.     procedure Exit1Click(Sender: TObject);
  38.     procedure Online1Click(Sender: TObject);
  39.     procedure Away1Click(Sender: TObject);
  40.     procedure DND1Click(Sender: TObject);
  41.     procedure NA1Click(Sender: TObject);
  42.     procedure Invisible1Click(Sender: TObject);
  43.     procedure Offline1Click(Sender: TObject);
  44.     procedure ICQClient1Login(Sender: TObject);
  45.     procedure ICQClient1ConnectionFailed(Sender: TObject);
  46.     procedure ICQClient1StatusChange(Sender: TObject; UIN: String;
  47.       Status: Cardinal);
  48.     procedure ICQClient1UserOffline(Sender: TObject; UIN: String);
  49.     procedure ListView1DblClick(Sender: TObject);
  50.     procedure PopupMenu1Popup(Sender: TObject);
  51.     procedure FormDestroy(Sender: TObject);
  52.     procedure UserInfo1Click(Sender: TObject);
  53.     procedure ICQClient1UserInfoMore(Sender: TObject; UIN: String;
  54.       Age: Word; Gender: Byte; HomePage: String; BirthYear, BirthMonth,
  55.       BirthDay: Word; Lang1, Lang2, Lang3: String);
  56.     procedure ICQClient1UserInfoAbout(Sender: TObject; UIN, About: String);
  57.     procedure ICQClient1UserWorkInfo(Sender: TObject; UIN, WCity, WState,
  58.       WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment,
  59.       WPosition, WOccupation, WHomePage: String);
  60.     procedure ICQClient1UserInfoInterests(Sender: TObject; UIN: String;
  61.       Interests: TStringList);
  62.     procedure Search1Click(Sender: TObject);
  63.     procedure ICQClient1UserFound(Sender: TObject; UIN, Nick, FirstName,
  64.       LastName, Email: String; Status: Word; Gender, Age: Byte;
  65.       SearchComplete: Boolean; Authorize: Boolean);
  66.     procedure ICQClient1UserNotFound(Sender: TObject);
  67.     procedure ICQClient1PktParse(Sender: TObject; Buffer: Pointer;
  68.       BufLen: Cardinal; Incoming: Boolean);
  69.     procedure PacketDumps1Click(Sender: TObject);
  70.     procedure ICQClient1UserInfoBackground(Sender: TObject; UIN: String;
  71.       Pasts, Affiliations: TStringList);
  72.     procedure ICQClient1UserGeneralInfo(Sender: TObject; UIN, NickName,
  73.       FirstName, LastName, Email, City, State, Phone, Fax, Street,
  74.       Cellular, Zip, Country: String; TimeZone: Byte;
  75.       PublishEmail: Boolean);
  76.     procedure RemoveContact1Click(Sender: TObject);
  77.     procedure LoadContactList1Click(Sender: TObject);
  78.     procedure ICQClient1ServerListRecv(Sender: TObject;
  79.       SrvContactList: TList);
  80.     procedure ReadAwayMessage1Click(Sender: TObject);
  81.     procedure ICQClient1AutoMsgResponse(Sender: TObject; UIN: String;
  82.       ID: Word; RespStatus: Byte; Msg: String);
  83.     procedure ICQClient1PktDirectParse(Sender: TObject; Buffer: Pointer;
  84.       BufLen: Cardinal; Incoming: Boolean);
  85.     procedure ICQClient1URLRecv(Sender: TObject; Description, URL,
  86.       UIN: String);
  87.     procedure ICQClient1MessageRecv(Sender: TObject; Msg, UIN: String);
  88.     procedure ICQClient1OfflineMsgRecv(Sender: TObject; Msg, UIN: String);
  89.     procedure ICQClient1OfflineURLRecv(Sender: TObject; Description, URL,
  90.       UIN: String);
  91.     procedure ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
  92.       ErrorMsg: String);
  93.   private
  94.     procedure ReCreateContactList;
  95.     procedure DoStatusChange(NewStatus: LongWord);
  96.   public
  97.     FInfoList: TList;
  98.     function GetUserInfoIdx(Value: String): Integer;
  99.     procedure DoCreateInfoQuery(UIN: String);
  100.   end;
  101.  
  102. var
  103.   MainForm: TMainForm;
  104.  
  105. implementation
  106.  
  107. {$R *.dfm}
  108.  
  109. function DoLoadIcons(FileName: String): Boolean;
  110. var
  111.   dllHandle: HMODULE;
  112.   procedure DoSingleEntry(Name: String);
  113.   var
  114.     Icon: TIcon;
  115.   begin
  116.     Icon := TIcon.Create;
  117.     Icon.Handle := LoadIcon(dllHandle, PChar(Name));
  118.     MainForm.IconList.AddIcon(Icon);
  119.   end;
  120. begin
  121.   Result := False;
  122.   dllHandle := LoadLibrary(PChar(FileName));
  123.   if dllHandle <> 0 then
  124.   begin
  125.     DoSingleEntry('#104');  //Online      0
  126.     DoSingleEntry('#128');  //Away        1
  127.     DoSingleEntry('#159');  //DND         2
  128.     DoSingleEntry('#131');  //N/A         3
  129.     DoSingleEntry('#130');  //Invisible   4
  130.     DoSingleEntry('#105');  //Offline     5
  131.     DoSingleEntry('#159');  //Occupied    6
  132.     DoSingleEntry('#129');  //FFC         7
  133.     FreeLibrary(dllHandle);
  134.     Result := True;
  135.   end;
  136. end;
  137.  
  138. procedure TMainForm.ReCreateContactList;
  139. var
  140.   i: Integer;
  141.   ListItem: TListItem;
  142. begin
  143.   ListView1.Items.Clear;
  144.   if ICQClient1.ContactList.Count > 0 then
  145.     for i := 0 to ICQClient1.ContactList.Count - 1 do
  146.     begin
  147.       ListItem := ListView1.Items.Add;
  148.       ListItem.ImageIndex := 5;
  149.       ListItem.Caption := ICQClient1.ContactList.Strings[i];
  150.     end;
  151. end;
  152.  
  153. procedure TMainForm.FormCreate(Sender: TObject);
  154. begin
  155.   if not DoLoadIcons('icons.dll') then //Load icons
  156.     MessageBox(0, 'Could not load icons!', 'Error', MB_ICONERROR);
  157.   ReCreateContactList; //Add users from contactlist to listview in offline mode
  158.   FInfoList := TList.Create; //List of avaible info query forms
  159.  
  160.   if FileExists('ContactList.txt') then
  161.     ICQClient1.ContactList.LoadFromFile('ContactList.txt');
  162. end;
  163.  
  164. procedure TMainForm.FormDestroy(Sender: TObject);
  165. begin
  166.   ICQClient1.ContactList.SaveToFile('ContactList.txt');
  167.   FInfoList.Free;
  168. end;
  169.  
  170. procedure TMainForm.FormShow(Sender: TObject);
  171. begin
  172.   StatusBar1.Panels[0].Text := 'Offline';
  173.   ReCreateContactList;
  174. end;
  175.  
  176. procedure TMainForm.Exit1Click(Sender: TObject);
  177. begin
  178.   Close;
  179. end;
  180.  
  181. procedure TMainForm.DoStatusChange(NewStatus: LongWord);
  182. begin
  183.   if not ICQClient1.LoggedIn then
  184.   begin
  185.     if (ICQClient1.Password = '') and (ICQClient1.UIN = 0) then
  186.     begin
  187.       MessageBox(MainForm.Handle, 'Please set UIN & Password in TICQClient component!', 'Error!', MB_ICONERROR);
  188.       Exit;
  189.     end;
  190.     StatusBar1.Panels[0].Text := 'Connecting...';
  191.     ICQClient1.Login(NewStatus);
  192.   end
  193.   else
  194.   begin
  195.     ICQClient1.Status := NewStatus;
  196.     StatusBar1.Panels[0].Text := StatusToStr(ICQClient1.Status);
  197.   end;
  198. end;
  199.  
  200. procedure TMainForm.Online1Click(Sender: TObject);
  201. begin
  202.   DoStatusChange(S_ONLINE);
  203. end;
  204.  
  205. procedure TMainForm.Away1Click(Sender: TObject);
  206. begin
  207.   DoStatusChange(S_AWAY);
  208. end;
  209.  
  210. procedure TMainForm.DND1Click(Sender: TObject);
  211. begin
  212.   DoStatusChange(S_DND);
  213. end;
  214.  
  215. procedure TMainForm.NA1Click(Sender: TObject);
  216. begin
  217.   DoStatusChange(S_NA);
  218. end;
  219.  
  220. procedure TMainForm.Invisible1Click(Sender: TObject);
  221. begin
  222.   DoStatusChange(S_INVISIBLE);
  223. end;
  224.  
  225. procedure TMainForm.Offline1Click(Sender: TObject);
  226. begin
  227.   ICQClient1.Disconnect;
  228.   StatusBar1.Panels[0].Text := 'Offline';
  229.   ReCreateContactList;
  230. end;
  231.  
  232. procedure TMainForm.ICQClient1Login(Sender: TObject);
  233. begin
  234.   StatusBar1.Panels[0].Text := StatusToStr(ICQClient1.Status);
  235. end;
  236.  
  237. procedure TMainForm.ICQClient1ConnectionFailed(Sender: TObject);
  238. begin
  239.   StatusBar1.Panels[0].Text := 'Connection failed';
  240.   ReCreateContactList;
  241. end;
  242.  
  243. procedure TMainForm.ICQClient1StatusChange(Sender: TObject; UIN: String;
  244.   Status: Cardinal);
  245. var
  246.   i, img: Integer;
  247.   S: String;
  248. begin
  249.   if ListView1.Items.Count > 0 then
  250.     for i := 0 to ListView1.Items.Count - 1 do
  251.       if ListView1.Items.Item[i].Caption = UIN then
  252.       begin
  253.         S := StatusToStr(Status);
  254.         if S = 'Online' then img := 0 else
  255.         if S = 'Away' then img := 1 else
  256.         if S = 'DND' then img := 2 else
  257.         if S = 'N/A' then img := 3 else
  258.         if S = 'Invisible' then img := 4 else
  259.         if S = 'Occupied' then img := 6 else
  260.         if S = 'FFC' then img := 7 else
  261.           img := 0;
  262.         ListView1.Items.Item[i].ImageIndex := img;
  263.         Exit;
  264.       end;
  265. end;
  266.  
  267. procedure TMainForm.ICQClient1UserOffline(Sender: TObject; UIN: String);
  268. var
  269.   i: Integer;
  270. begin
  271.   if ListView1.Items.Count > 0 then
  272.     for i := 0 to ListView1.Items.Count - 1 do
  273.       if ListView1.Items.Item[i].Caption = UIN then
  274.       begin
  275.         ListView1.Items.Item[i].ImageIndex := 5;
  276.         Exit;
  277.       end;
  278. end;
  279.  
  280. procedure TMainForm.ListView1DblClick(Sender: TObject);
  281. begin
  282.   if ListView1.Selected = nil then Exit;
  283.   with TSendMsgForm.Create(Self) do
  284.   begin
  285.     Caption := 'Send message to: ' + ListView1.Selected.Caption;
  286.     FDest := ListView1.Selected.Caption;
  287.     Show;
  288.   end;
  289. end;
  290.  
  291. procedure TMainForm.PopupMenu1Popup(Sender: TObject);
  292. begin
  293.   if ListView1.Selected = nil then
  294.   begin
  295.     PopUpMenu1.Items[0].Enabled := False;
  296.     PopUpMenu1.Items[2].Enabled := False;
  297.     PopUpMenu1.Items[3].Enabled := False
  298.   end
  299.   else
  300.   begin
  301.     PopUpMenu1.Items[0].Enabled := True;
  302.     PopUpMenu1.Items[2].Enabled := True;
  303.     //If user not in Online or Invisible or Offline mode then enable Read away message item in popup menu
  304.  
  305.     if (ListView1.Selected.ImageIndex <> -1) and
  306.        (ListView1.Selected.ImageIndex <> 0) and
  307.        (ListView1.Selected.ImageIndex <> 4) and
  308.        (ListView1.Selected.ImageIndex <> 5) then
  309.          PopUpMenu1.Items[3].Enabled := True
  310.     else
  311.       PopUpMenu1.Items[3].Enabled := False;    
  312.   end;
  313. end;
  314.  
  315. function TMainForm.GetUserInfoIdx(Value: String): Integer;
  316. var
  317.   i: Integer;
  318. begin
  319.   Result := -1;
  320.   if FInfoList.Count > 0 then
  321.     for i := 0 to FInfoList.Count - 1 do
  322.       if TUserInfoForm(FInfoList.Items[i]).FSource = Value then
  323.       begin
  324.         Result := i;
  325.         Exit;
  326.       end;
  327. end;
  328.  
  329. procedure TMainForm.DoCreateInfoQuery(UIN: String);
  330. var
  331.   i: Integer;
  332.   UIForm: TUserInfoForm;
  333. begin
  334.   i := GetUserInfoIdx(UIN);
  335.   if i > -1 then
  336.   begin
  337.     TUserInfoForm(FInfoList.Items[i]).Show;
  338.     Exit;
  339.   end;
  340.   UIForm := TUserInfoForm.Create(nil);
  341.   FInfoList.Add(UIForm);
  342.   with UIForm do
  343.   begin
  344.     Caption := 'Info about ' + UIN;
  345.     FSource := UIN;
  346.     Show;
  347.   end;
  348.   if ICQClient1.LoggedIn then
  349.     ICQClient1.RequestInfo(StrToInt(UIN));
  350. end;
  351.  
  352. procedure TMainForm.ICQClient1UserGeneralInfo(Sender: TObject; UIN,
  353.   NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street,
  354.   Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
  355. var
  356.   Form: TUserInfoForm;
  357.   i: Integer;
  358. begin
  359.   i := GetUserInfoIdx(UIN);
  360.   if i < 0 then Exit;
  361.   Form := FInfoList.Items[i];
  362.   with Form do
  363.   begin
  364.     UINLabel.Caption := UIN;
  365.     NickNameLabel.Caption := NickName;
  366.     FirstNameLabel.Caption := FirstName;
  367.     LastNameLabel.Caption := LastName;
  368.     EmailLabel.Caption := Email;
  369.     {}
  370.     StreetLabel.Caption := Street;
  371.     CityLabel.Caption := City;
  372.     CountryLabel.Caption := Country;
  373.     ZipLabel.Caption := Zip;
  374.     TimeZoneLabel.Caption := IntToStr(- ShortInt(TimeZone) div 2) + ':' + IntToStr(Abs(ShortInt(TimeZone) mod 2 * 30));
  375.     if - ShortInt(TimeZone) > 0 then
  376.       TimeZoneLabel.Caption := '+' + TimeZoneLabel.Caption;    
  377.     CellularLabel.Caption := Cellular;
  378.   end;
  379. end;
  380.  
  381. procedure TMainForm.ICQClient1UserInfoMore(Sender: TObject; UIN: String;
  382.   Age: Word; Gender: Byte; HomePage: String; BirthYear, BirthMonth,
  383.   BirthDay: Word; Lang1, Lang2, Lang3: String);
  384. var
  385.   Form: TUserInfoForm;
  386.   i: Integer;
  387. begin
  388.   i := GetUserInfoIdx(UIN);
  389.   if i < 0 then Exit;
  390.   Form := FInfoList.Items[i];
  391.   with Form do
  392.   begin
  393.     AgeLabel.Caption := IntToStr(Age);
  394.     if Gender = GEN_MALE then
  395.       GenderLabel.Caption := 'Male'
  396.     else if Gender = GEN_FEMALE then
  397.       GenderLabel.Caption := 'Female'
  398.     else
  399.       GenderLabel.Caption := 'Not specified';
  400.     HomePageLabel.Caption := HomePage;
  401.     DayOfBirthLabel.Caption := IntToStr(BirthYear) + '/' + IntToStr(BirthMonth) + '/' + IntToStr(BirthDay);
  402.     Language1Label.Caption := Lang1;
  403.     Language2Label.Caption := Lang2;
  404.     Language3Label.Caption := Lang3;
  405.   end;
  406. end;
  407.  
  408. procedure TMainForm.ICQClient1UserInfoAbout(Sender: TObject; UIN,
  409.   About: String);
  410. var
  411.   Form: TUserInfoForm;
  412.   i: Integer;
  413. begin
  414.   i := GetUserInfoIdx(UIN);
  415.   if i < 0 then Exit;
  416.   Form := FInfoList.Items[i];
  417.   Form.AboutMemo.Text := About;
  418. end;
  419.  
  420. procedure TMainForm.ICQClient1UserWorkInfo(Sender: TObject; UIN, WCity,
  421.   WState, WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment,
  422.   WPosition, WOccupation, WHomePage: String);
  423. var
  424.   Form: TUserInfoForm;
  425.   i: Integer;
  426. begin
  427.   i := GetUserInfoIdx(UIN);
  428.   if i < 0 then Exit;
  429.   Form := FInfoList.Items[i];
  430.   with Form do
  431.   begin
  432.     WCityLabel.Caption := WCity;
  433.     WStateLabel.Caption := WState;
  434.     WPhoneLabel.Caption := WPhone;
  435.     WFaxLabel.Caption := WFax;
  436.     WAddressLabel.Caption := FAddress;
  437.     WZipLabel.Caption := WZip;
  438.     WCountryLabel.Caption := WCountry;
  439.     WCompanyLabel.Caption := WCompany;
  440.     WDepartmentLabel.Caption := WDepartment;
  441.     WPositionLabel.Caption := WPosition;
  442.     WOccupationLabel.Caption := WOccupation;
  443.     WHomePageLabel.Caption := WHomePage;
  444.   end;
  445. end;
  446.  
  447. procedure TMainForm.ICQClient1UserInfoInterests(Sender: TObject; UIN: String;
  448.   Interests: TStringList);
  449. var
  450.   Form: TUserInfoForm;
  451.   i: Integer;
  452.   ListItem: TListItem;
  453. begin
  454.   i := GetUserInfoIdx(UIN);
  455.   if i < 0 then Exit;
  456.   Form := FInfoList.Items[i];
  457.   Form.InterestsView.Items.Clear;
  458.   if Interests.Count > 0 then
  459.     for i := 0 to Interests.Count - 1 do
  460.     begin
  461.       if (ExtractName(Interests.Strings[i]) <> '') and (ExtractValue(Interests.Strings[i]) <> '') then
  462.       begin
  463.         ListItem := Form.InterestsView.Items.Add;
  464.         ListItem.Caption := ExtractName(Interests.Strings[i]);
  465.         ListItem.SubItems.Add(ExtractValue(Interests.Strings[i]));
  466.       end;
  467.     end;
  468.   Interests.Free;
  469. end;
  470.  
  471. procedure TMainForm.UserInfo1Click(Sender: TObject);
  472. begin
  473.   if ListView1.Selected = nil then Exit;
  474.   DoCreateInfoQuery(ListView1.Selected.Caption);
  475. end;
  476.  
  477.  
  478. procedure TMainForm.Search1Click(Sender: TObject);
  479. begin
  480.   UserSearchForm.Show;
  481. end;
  482.  
  483. procedure TMainForm.RemoveContact1Click(Sender: TObject);
  484. begin
  485.   if ListView1.Selected = nil then Exit;
  486.   ICQClient1.RemoveContact(StrToInt(ListView1.Selected.Caption));
  487.   ListView1.Items.Delete(ListView1.Selected.Index);
  488. end;
  489.  
  490. procedure TMainForm.ICQClient1UserFound(Sender: TObject; UIN, Nick, FirstName,
  491.   LastName, Email: String; Status: Word; Gender, Age: Byte;
  492.   SearchComplete, Authorize: Boolean);
  493. var
  494.   ListItem: TListItem;
  495. begin
  496.   if UserSearchForm <> nil then
  497.   begin
  498.     ListItem := UserSearchForm.ListView1.Items.Add;
  499.     if Status = 1 then {Online}
  500.       ListItem.ImageIndex := 0
  501.     else
  502.       ListItem.ImageIndex := 5;    
  503.     ListItem.Caption := Nick;
  504.     ListItem.SubItems.Add(FirstName);
  505.     ListItem.SubItems.Add(LastName);
  506.     ListItem.SubItems.Add(Email);
  507.     ListItem.SubItems.Add(UIN);
  508.     if SearchComplete then
  509.     begin
  510.       UserSearchForm.Button1.Caption := 'Search';
  511.       UserSearchForm.StatusBar1.Panels[0].Text := 'Search complete';
  512.     end;
  513.   end;
  514. end;
  515.  
  516. procedure TMainForm.ICQClient1UserNotFound(Sender: TObject);
  517. begin
  518.   if UserSearchForm <> nil then
  519.   begin
  520.     UserSearchForm.Button1.Caption := 'Search';
  521.     UserSearchForm.StatusBar1.Panels[0].Text := 'User not found';
  522.   end;
  523. end;
  524.  
  525. {Needed for debug only! It's not required implementing this event in your developments.}
  526. procedure TMainForm.ICQClient1PktParse(Sender: TObject; Buffer: Pointer;
  527.   BufLen: Cardinal; Incoming: Boolean);
  528. var
  529.   p: PRawPkt;
  530.   ListItem: TListItem;
  531.   ad: String;
  532.   f, s: Word;
  533. begin
  534.   GetMem(p, SizeOf(TRawPkt));
  535.   Move(Buffer^, p^, BufLen);
  536.   p^.Len := 0;
  537.   PktDumpForm.FPktList.Add(p);
  538.   {ListItem}
  539.   ListItem := PktDumpForm.ListView1.Items.Add;
  540.   if Incoming then
  541.     ListItem.ImageIndex := 5
  542.   else
  543.     ListItem.ImageIndex := 0;
  544.   ListItem.SubItems.Add(IntToStr(PFlapHdr(Buffer)^.ChID));
  545.   ListItem.SubItems.Add(IntToStr(Swap16(PFlapHdr(Buffer)^.DataLen)));
  546.   ListItem.SubItems.Add('0x' + IntToHex(Swap16(PFlapHdr(Buffer)^.Seq), 4));
  547.  
  548.   if PFlapHdr(Buffer)^.ChID <> 2 then
  549.   begin
  550.     ListItem.SubItems.Add('');
  551.     if (PFlapHdr(Buffer)^.ChID = 1) and (Swap16(PFlapHdr(Buffer)^.DataLen) > 35) then
  552.     begin
  553.       if PChar(LongWord(Buffer) + BufLen - 2)^ + PChar(LongWord(Buffer) + BufLen - 1)^ = 'us' then
  554.         ListItem.SubItems.Add('CLI_IDENT')
  555.       else if Swap16(PFlapHdr(Buffer)^.DataLen) = 264 then
  556.           ListItem.SubItems.Add('CLI_COOKIE')
  557.     end else
  558.     if (PFlapHdr(Buffer)^.ChID = 4) and (Swap16(PFlapHdr(Buffer)^.DataLen) = 0) then
  559.     begin
  560.       if Incoming then
  561.         ListItem.SubItems.Add('SRV_GOODBYE')
  562.       else
  563.         ListItem.SubItems.Add('CLI_GOODBYE');
  564.     end else if (PFlapHdr(Buffer)^.ChID = 4) and Incoming then
  565.     begin
  566.       if (Swap16(PFlapHdr(Buffer)^.DataLen) > 270) then
  567.         ListItem.SubItems.Add('SRV_COOKIE')
  568.       else
  569.         ListItem.SubItems.Add('SRV_GOODBYE')
  570.     end
  571.     else if Swap16(PFlapHdr(Buffer)^.DataLen) = 4 then
  572.     begin
  573.       if Incoming then
  574.         ListItem.SubItems.Add('SRV_HELLO')
  575.       else
  576.         ListItem.SubItems.Add('CLI_HELLO');
  577.     end else
  578.       ListItem.SubItems.Add('none');
  579.   end else
  580.   begin
  581.     ad := '';
  582.     f := Swap16(PSnacHdr(LongWord(Buffer) + TFLAPSZ)^.Family);
  583.     s := Swap16(PSnacHdr(LongWord(Buffer) + TFLAPSZ)^.SubType);
  584.     if (f = $15) and ((s = $03) or (s = $02)) then
  585.       ad := ' [' + SrvMetaToStr(PWord(LongWord(Buffer) + TFLAPSZ + TSNACSZ + 10)^, PWord(LongWord(Buffer) + TFLAPSZ + TSNACSZ + 14)^) + ']';
  586.     ListItem.SubItems.Add('SNAC(' + IntToHex(f, 2) + ',' + IntToHex(s, 2) + ')' + ad);
  587.     ListItem.SubItems.Add(SnacToStr(f, s));
  588.   end;
  589. end;
  590.  
  591. procedure TMainForm.PacketDumps1Click(Sender: TObject);
  592. begin
  593.   PktDumpForm.Show;
  594. end;
  595.  
  596. procedure TMainForm.ICQClient1UserInfoBackground(Sender: TObject;
  597.   UIN: String; Pasts, Affiliations: TStringList);
  598. var
  599.   Form: TUserInfoForm;
  600.   i: Integer;
  601.   ListItem: TListItem;
  602. begin
  603.   i := GetUserInfoIdx(UIN);
  604.   if i < 0 then Exit;
  605.   Form := FInfoList.Items[i];
  606.   Form.PastsListView.Items.Clear;
  607.   Form.AffiliationsListView.Items.Clear;
  608.   if Pasts.Count > 0 then
  609.     for i := 0 to Pasts.Count - 1 do
  610.     begin
  611.       if (ExtractName(Pasts.Strings[i]) <> '') and (ExtractName(Pasts.Strings[i]) <> '') then
  612.       begin
  613.         ListItem := Form.PastsListView.Items.Add;
  614.         ListItem.Caption := ExtractName(Pasts.Strings[i]);
  615.         ListItem.SubItems.Add(ExtractValue(Pasts.Strings[i]));
  616.       end;
  617.     end;
  618.   if Affiliations.Count > 0 then
  619.     for i := 0 to Affiliations.Count - 1 do
  620.     begin
  621.       if (ExtractName(Pasts.Strings[i]) <> '') and (ExtractValue(Affiliations.Strings[i]) <> '') then
  622.       begin
  623.         ListItem := Form.AffiliationsListView.Items.Add;
  624.         ListItem.Caption := ExtractName(Affiliations.Strings[i]);
  625.         ListItem.SubItems.Add(ExtractValue(Affiliations.Strings[i]));
  626.       end;
  627.     end;
  628.   Pasts.Free;
  629.   Affiliations.Free;
  630. end;
  631.  
  632. procedure TMainForm.LoadContactList1Click(Sender: TObject);
  633. begin
  634.   ICQClient1.RequestContactList;
  635. end;
  636.  
  637. procedure TMainForm.ICQClient1ServerListRecv(Sender: TObject;
  638.   SrvContactList: TList);
  639. var
  640.   i: Word;
  641.   UserInfo: TUINEntry;
  642.   ListItem: TListItem;
  643. begin
  644.   if SrvContactList.Count > 0 then
  645.     for i := 0 to SrvContactList.Count - 1 do
  646.     begin
  647.       UserInfo := PUINEntry(SrvContactList.Items[i])^;
  648.       if UserInfo.CType = U_VISIBLE_LIST then
  649.         ICQClient1.VisibleList.Add(IntToStr(UserInfo.UIN))
  650.       else if UserInfo.CType = U_VISIBLE_LIST then
  651.         ICQClient1.InvisibleList.Add(IntToStr(UserInfo.UIN))
  652.       else if UserInfo.CType = U_NORMAL then
  653.       begin
  654.         if ICQClient1.AddContact(UserInfo.UIN) then
  655.         begin
  656.           ListItem := ListView1.Items.Add;
  657.           ListItem.ImageIndex := 5;
  658.           ListItem.Caption := IntToStr(UserInfo.UIN);
  659.         end;
  660.       end;
  661.     end;
  662.   ICQClient1.DestroyUINList(SrvContactList);
  663. end;
  664.  
  665. procedure TMainForm.ReadAwayMessage1Click(Sender: TObject);
  666. var
  667.   ReqStatus: Byte;
  668. begin
  669.   if ListView1.Selected = nil then Exit;
  670.   case ListView1.Selected.ImageIndex of
  671.     1: ReqStatus := GET_AWAY;
  672.     2: ReqStatus := GET_DND;
  673.     3: ReqStatus := GET_NA;
  674.     6: ReqStatus := GET_OCCUPIED;
  675.     7: ReqStatus := GET_FFC;
  676.   else  //Unknown status
  677.     Exit;
  678.   end;
  679.  
  680.   ICQClient1.RequestAwayMsg(StrToInt(ListView1.Selected.Caption), 0, ReqStatus);
  681. end;
  682.  
  683. procedure TMainForm.ICQClient1AutoMsgResponse(Sender: TObject; UIN: String;
  684.   ID: Word; RespStatus: Byte; Msg: String);
  685. begin
  686.   with TAutoAwayForm.Create(Self) do
  687.   begin
  688.     Caption := UIN + ': away-message';
  689.     AwayMemo.Lines.Text := Msg;
  690.     Show;
  691.   end;
  692. end;
  693.  
  694. {Needed for debug only! It's not required implementing this event in your developments.}
  695. procedure TMainForm.ICQClient1PktDirectParse(Sender: TObject;
  696.   Buffer: Pointer; BufLen: Cardinal; Incoming: Boolean);
  697. var
  698.   p: PRawPkt;
  699.   ListItem: TListItem;
  700. begin
  701.   GetMem(p, SizeOf(TRawPkt));
  702.   Move(Buffer^, p^, BufLen);
  703.   p^.Len := BufLen;
  704.   PktDumpForm.FPktList.Add(p);
  705.   {ListItem}
  706.   ListItem := PktDumpForm.ListView1.Items.Add;
  707.   if Incoming then
  708.     ListItem.ImageIndex := 5
  709.   else
  710.     ListItem.ImageIndex := 0;
  711.   ListItem.SubItems.Add('DIRECT');
  712.   ListItem.SubItems.Add(IntToStr(BufLen));
  713.   ListItem.SubItems.Add('');
  714.   ListItem.SubItems.Add('0x' + IntToHex(PByte(LongWord(Buffer) + 2)^, 2));
  715.   ListItem.SubItems.Add(PeerCmdToStr(PByte(LongWord(Buffer) + 2)^));
  716.   {//Save incoming dumps to a file
  717.   if Incoming then
  718.     LogText('dc.txt', 'Incoming packet! Command: ' + PeerCmdToStr(PByte(LongWord(Buffer) + 2)^) + ', length: ' + IntToStr(BufLen - 2) + #13#10 + DumpPacket(Buffer, BufLen) + #13#10#13#10)
  719.   else
  720.     LogText('dc.txt', 'Outgoing packet! Command: ' + PeerCmdToStr(PByte(LongWord(Buffer) + 2)^) + ', length: ' + IntToStr(BufLen - 2) + #13#10 + DumpPacket(Buffer, BufLen) + #13#10#13#10);}
  721. end;
  722.  
  723. procedure TMainForm.ICQClient1URLRecv(Sender: TObject; Description, URL,
  724.   UIN: String);
  725. begin
  726.   with TRecvMsgForm.Create(nil) do
  727.   begin
  728.     Caption := 'URL from: ' + UIN;
  729.     RichEdit1.Text := Description + ':'#13#10 + URL;
  730.     FSource := UIN;
  731.     Show;
  732.   end;
  733. end;
  734.  
  735. procedure TMainForm.ICQClient1MessageRecv(Sender: TObject; Msg,
  736.   UIN: String);
  737. begin
  738.   with TRecvMsgForm.Create(nil) do
  739.   begin
  740.     Caption := 'Message from: ' + UIN;
  741.     RichEdit1.Text := Msg;
  742.     FSource := UIN;
  743.     Show;
  744.   end;
  745. end;
  746.  
  747. procedure TMainForm.ICQClient1OfflineMsgRecv(Sender: TObject; Msg,
  748.   UIN: String);
  749. begin
  750.   ICQClient1MessageRecv(Self, Msg, UIN);
  751. end;
  752.  
  753. procedure TMainForm.ICQClient1OfflineURLRecv(Sender: TObject; Description,
  754.   URL, UIN: String);
  755. begin
  756.   ICQClient1URLRecv(Self, Description, URL, UIN);
  757. end;
  758.  
  759. procedure TMainForm.ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
  760.   ErrorMsg: String);
  761. begin
  762.   ShowMessage('Error: ' + ErrorMsg); {Handle error as you need}
  763. end;
  764.  
  765. end.
  766.