main.pas

ICQ客户端源代码

      if DBData.dwUIN = dwUIN then
      begin
        Position := FilePos(F)-1;
        Break;
      end;
    end;
    Result := Position;
  end;

begin
  FileName := ExtractFilePath(ParamStr(0)) + 'contacts.dat';
  try
    AssignFile(F, FileName);
    if FileExists(FileName) then
      Reset(F)
    else
      Rewrite(F);

    podm := ContactExists;

    if podm <> -1 then
    begin
      Seek(F, podm);         //Edit existing contact

      EmptyDBD.dwUIN := 0;
      EmptyDBD.dwStatus := S_OFFLINE;
      EmptyDBD.sInternalIP := '';
      EmptyDBD.sExternalIP := '';
      EmptyDBD.wPort := 0;
      EmptyDBD.byProtoVer := 0;
      EmptyDBD.byUserCaps := 0;
      EmptyDBD.dtOnlineTime := 0;
      EmptyDBD.dwClient := 0;
      EmptyDBD.dwMirandaVer := 0;
      EmptyDBD.sNick := '';

      Write(F, EmptyDBD);
    end;
  finally
    CloseFile(F);
  end;
end;

//Adding new user, UserInfo, Nick change
procedure TMainForm.WriteToDB(dwUIN: DWORD; DBD: _DBCONTACTSETTINGS);
var
  FileName: String;
  podm: Longint;

  function ContactExists: LongInt;
  var
    Position: Longint;
  begin
    Position := -1;
    while not EOF(F) do
    begin
      Read(F, DBData);
      if DBData.dwUIN = dwUIN then
      begin
        Position := FilePos(F)-1;
        Break;
      end;
    end;
    Result := Position;
  end;

begin
  FileName := ExtractFilePath(ParamStr(0)) + 'contacts.dat';
  try
    AssignFile(F, FileName);
    if FileExists(FileName) then
      Reset(F)
    else
      Rewrite(F);

    podm := ContactExists;

    if podm = -1 then
      Seek(F, FileSize(F))   //Add new contact
    else
      Seek(F, podm);         //Edit existing contact

    Write(F, DBD);
  finally
    CloseFile(F);
  end;
end;

procedure TMainForm.ReadFromDB(DBD: _DBCONTACTSETTINGS);
var
  FileName: String;
  ListItem: TListItem;
begin
  FileName := ExtractFilePath(ParamStr(0)) + 'contacts.dat';
  try
    AssignFile(F, FileName);
    if FileExists(FileName) then
      Reset(F)
    else
      Rewrite(F);

    while not EOF(F) do
    begin
      Read(F, DBD);

      if DBD.dwUIN <> 0 then
      begin

        ListItem := ListView1.Items.Add;

        ListItem.ImageIndex := ICON_OFFLINE;
        //UIN
        ListItem.Caption := IntToStr(DBD.dwUIN);
        ICQClient1.AddContact(DBD.dwUIN);
        //STATUS
        ListItem.SubItems.Add(IntToStr(DBD.dwStatus));
        //Internal IP
        ListItem.SubItems.Add(DBD.sInternalIP);
        //External IP
        ListItem.SubItems.Add(DBD.sExternalIP);
        //Port
        ListItem.SubItems.Add(IntToStr(DBD.wPort));
        //ProtoVer
        ListItem.SubItems.Add(IntToStr(DBD.byProtoVer));
        //UserCaps
        ListItem.SubItems.Add(IntToStr(DBD.byUserCaps));
        //Online since
        ListItem.SubItems.Add(FloatToStr(DBD.dtOnlineTime));
        //ICQ Client
        ListItem.SubItems.Add(IntToStr(DBD.dwClient));
        //Miranda version
        ListItem.SubItems.Add(IntToStr(DBD.dwMirandaVer));
        //Nick
        ListItem.SubItems.Add(DBD.sNick);
        //Idle
        ListItem.SubItems.Add('0');
      end;
    end;
  finally
    CloseFile(F);
  end;
end;

procedure TMainForm.RepaintOfflineCL;
var
  i: Integer;
begin
  if ListView1.Items.Count > 0 then
    for i := 0 to ListView1.Items.Count - 1 do
      ListView1.Items.Item[i].ImageIndex := ICON_OFFLINE;
  ListView1.Invalidate;
end;

procedure TMainForm.ReCreateContactList;
begin
  //ListView Filling
  ListView1.Items.Clear;
  ReadFromDB(DBData);
  ListView1.Invalidate;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  UserInfoReader := 0;

  bEditAble := False;

  FListViewWndProc := ListView1.WindowProc;
  ListView1.WindowProc := ListViewWndProc;

  //Load icons
  if not DoLoadIcons(ExtractFilePath(ParamStr(0)) + 'Icons/icons.dll') then
  begin
    MessageBox(Self.Handle,'Could not load icons! Application will be terminated.','Error',MB_OK);
    Application.Terminate;
  end;  

  GetWindowsVersion;


  if IsWinVer2000Plus then begin
    @MyGetLastInputInfo := GetProcAddress(GetModuleHandle('user32'), 'GetLastInputInfo');

    @MySetLayeredWindowAttributes := GetProcAddress(GetModuleHandle('user32.dll'), 'SetLayeredWindowAttributes');
  end;

  //Icons
  if IsWinVerXPPlus then  // IsWinVerXPPlus need 32-bit icons on XP for alpha channels
    hImlMenuIcons  := ImageList_Create(GetSystemMetrics(SM_CXSMICON),
      GetSystemMetrics(SM_CYSMICON), ILC_COLOR32 or ILC_MASK, IconList.Count, 20)
  else
  //Win2k won't blend icons with imagelist_drawex when color-depth>16-bit.
  //Don't know about WinME, but it certainly doesn't support alpha channels
		hImlMenuIcons := ImageList_Create(GetSystemMetrics(SM_CXSMICON),
      GetSystemMetrics(SM_CYSMICON), ILC_COLOR16 or ILC_MASK, IconList.Count, 20);

  for i := 0 to IconList.Count - 1 do
  begin
    IconList.GetIcon(i, Icon);
    ImageList_AddIcon(hImlMenuIcons, Icon.Handle);
  end;

  //Icon
  IconList.GetIcon(ICON_OFFLINE, Icon);
  StatusBar1.Panels[0].Text := 'Offline';

  tnid.cbSize:= sizeof(tnid);
  tnid.Wnd:= Handle;
  tnid.uID:= Application.Icon.Handle;
  tnid.uFlags:= NIF_MESSAGE or NIF_ICON or NIF_TIP;
  tnid.uCallbackMessage:= WM_NOTIFYICON;
  tnid.hIcon := Icon.Handle;
  StrPCopy(tnid.szTip, Format('ICQ - %s ', ['Offline']));
  Shell_NotifyIconA(NIM_ADD, @tnid);

  SetCriticalSettings(ReadSettings());
  SetSettings(ReadSettings());

  //List of avaible info query forms
  FInfoList := TList.Create;

  //Add users from contactlist to listview in offline mode
  ReCreateContactList;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if bHide then begin
    Action := caNone;
    Self.Hide;
  end
  else
    Application.Terminate;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
var
  DBSet: _DBSETTINGS;
begin
  TestHit := nil;

  DBSet := ReadSettings();
  DBSet.iHeight := Height;
  DBSet.iWidth := Width;
  WriteSettings(DBSet);

  DBSet := ReadSettings();
  DBSet.iLeft := Left;
  DBSet.iTop := Top;
  WriteSettings(DBSet);
  
  ListView1.WindowProc := FListViewWndProc;
  FListViewWndProc := nil;
  ImageList_Destroy(hImlMenuIcons);
  Shell_NotifyIconA(NIM_DELETE, @tnid);
  FInfoList.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  RefreshRowHeight;
  if dwLastStatus <> S_OFFLINE then DoStatusChange(dwLastStatus or fDCFlag);
end;

procedure TMainForm.DoStatusChange(NewStatus: LongWord);
var
  img: Byte;

  function SetAutoAwayMsg(AnyMsg: String): String;
  begin
    while Pos('%time%', AnyMsg) <> 0 do
    begin
      Insert(TimeToStr(Now), AnyMsg, Pos('%time%', AnyMsg));
      Delete(AnyMsg, Pos('%time%', AnyMsg), Length('%time%'));
    end;
    while Pos('%date%', AnyMsg) <> 0 do
    begin
      Insert(DateToStr(Now), AnyMsg, Pos('%date%', AnyMsg));
      Delete(AnyMsg, Pos('%date%', AnyMsg), Length('%date%'));
    end;
    Result := AnyMsg;
  end;

begin
  if not ICQClient1.LoggedIn then
  begin
    if (ICQClient1.Password = '') or (ICQClient1.UIN = 0) then
    begin
      MessageBox(MainForm.Handle, 'Please set UIN & Password in Options dialog!', 'Error!', MB_OK);
      options.Click;
      Exit;
    end;
    StatusBar1.Panels[0].Text := 'Connecting...';
    ICQClient1.Login(NewStatus);
  end else
  begin
    ICQClient1.Status := NewStatus;
    StatusBar1.Panels[0].Text := StatusToStr(ICQClient1.Status);
  end;

  case StatusToInt(NewStatus) of
    S_ONLINE : begin
                 img := ICON_ONLINE;
               end;
    S_AWAY   : begin
                 img := ICON_AWAY;
                 ICQClient1.AutoAwayMessage := SetAutoAwayMsg(MsgAway);
               end;
    S_DND    : begin
                 img := ICON_DND;
                 ICQClient1.AutoAwayMessage := SetAutoAwayMsg(MsgDND);
               end;
    S_NA     : begin
                 img := ICON_NA;
                 ICQClient1.AutoAwayMessage := SetAutoAwayMsg(MsgNA);
               end;
    S_INVISIBLE : begin
                    img := ICON_INVISIBLE;
                  end;
    S_OCCUPIED : begin
                   img := ICON_OCCUPIED;
                   ICQClient1.AutoAwayMessage := SetAutoAwayMsg(MsgOccupied);
               end;
    S_FFC     : begin
                 img := ICON_FFC;
                 ICQClient1.AutoAwayMessage := SetAutoAwayMsg(MsgFFC);
               end;
  else
    img := ICON_OFFLINE;
  end;
  
  IconList.GetIcon(img, Icon);
  StatusBar1.Invalidate;

  tnid.hIcon := Icon.Handle;
  StrPCopy(tnid.szTip, Format('ICQ - %s ', [StatusToStr(NewStatus)]));
  Shell_NotifyIconA(NIM_MODIFY, @tnid);
end;

procedure TMainForm.ICQClient1Login(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := StatusToStr(ICQClient1.Status);
  ICQClient1.RequestOfflineMessages;
  AutoAwayTimer.Enabled := True;
end;

procedure TMainForm.ICQClient1ConnectionFailed(Sender: TObject);
begin
  IconList.GetIcon(ICON_OFFLINE, Icon);
  StatusBar1.Panels[0].Text := 'Connection failed';
  //ReCreateContactList;
  RepaintOfflineCL;

  if AutoAwayTimer.Enabled then AutoAwayTimer.Enabled := False;

  SetCriticalSettings(ReadSettings());
  AutoAwayTimer.Enabled := False;
  
  tnid.hIcon := Icon.Handle;
  StrPCopy(tnid.szTip, Format('ICQ - %s ', ['Connection failed']));
  Shell_NotifyIconA(NIM_MODIFY, @tnid);
end;

procedure TMainForm.ICQClient1StatusChange(Sender: TObject; UIN: String;
  Status: Cardinal);
var
  i, img: Integer;
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
        case StatusToInt(Status) of
          S_ONLINE     : img := ICON_ONLINE;
          S_AWAY       : img := ICON_AWAY;
          S_DND        : img := ICON_DND;
          S_NA         : img := ICON_NA;
          S_INVISIBLE  : img := ICON_INVISIBLE;
          S_OCCUPIED   : img := ICON_OCCUPIED;
          S_FFC        : img := ICON_FFC;
        else
          img := ICON_OFFLINE;
        end;
        ListView1.Items.Item[i].ImageIndex := img;
        ListView1.Items.Item[i].SubItems[LV_INDEX_STATUS] := IntToStr(Status); //StatusToStr(Status);
        ListView1.Invalidate;
        Exit;
      end;
end;

procedure TMainForm.ICQClient1UserOffline(Sender: TObject; UIN: String);
var
  i: Integer;
  ListItem: TListItem;
begin
  //ListView Filling
  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];;
        ListItem.ImageIndex := ICON_OFFLINE;
        //STATUS