umsnmsgr.pas

msn控件 可验证 可接受信息 可发送信息 msn8协议 win32

// =============================================================================
//  TMsnConnection
// =============================================================================
constructor TMsnConnection.Create;
begin
   inherited;
   CreateSocket;
   FUser           := TMsnUser.Create;
   FMembersCount   := 0;
   FMembers        := TMsnMemberList.Create;
   FReverseMembers := TMsnMemberList.Create;
   FAllowMembers   := TMsnMemberList.Create;
   FBlockMembers   := TMsnMemberList.Create;
   FGroupsCount := 0;
   FGroups      := TMSNGroupList.Create;
   
   FPingTimer := TTimer.Create(nil);
   FPingTimer.OnTimer := PingTimerProc;
   FPingTimer.Enabled := False;
   
   FHost := MSN_DEFAULTHOST;
   FPort := MSN_DEFAULTPORT;
   FSignInStage := ssUnConnect;
   FUser.Status := usFLN;
end;

destructor TMsnConnection.Destroy;
begin
   FPingTimer.Free;
   FUser.Free;
   FMembers.Free;
   FReverseMembers.Free;
   FAllowMembers.Free;
   FBlockMembers.Free;
   FGroups.Free;
   DestroySocket;
   inherited;
end;

// 僐儅儞僪憲怣
procedure TMsnConnection.SendCommand(Str: UTF8String);
begin
   FSocket.SendText(Str);
   DoLog('C', Str);
end;

procedure TMsnConnection.DoMemberInit(ListKind: TListKind; Member: TMsnMember);
begin
  if Assigned(FOnMemberInit) then
    FOnMemberInit(Self, ListKind, Member);
end;

procedure TMsnConnection.DoMemberAddition(ListKind: TListKind; Member: TMsnMember);
begin
  if Assigned(FOnMemberAddition) then
    FOnMemberAddition(Self, ListKind, Member);
end;

procedure TMsnConnection.DoMemberDeletion(ListKind: TListKind; Member: TMsnMember);
begin
  if Assigned(FOnMemberDeletion) then
    FOnMemberDeletion(Self, ListKind, Member);
end;

procedure TMsnConnection.DoMemberListChange(ListKind: TListKind);
begin
  if Assigned(FOnMemberListChange) then
    FOnMemberListChange(Self, ListKind);
end;

procedure TMsnConnection.DoMemberStatusChange(Member: TMsnMemberBase; OldStatus: TMsnMemberStatus; InitList: Boolean);
begin
  if Assigned(FOnMemberStatusChange) then
    FOnMemberStatusChange(Self, Member, OldStatus, InitList);
end;

procedure TMsnConnection.DoMemberNameChange(Member: TMsnMemberBase);
begin
  if Assigned(FOnMemberNameChange) then
    FOnMemberNameChange(Self, Member);
end;

procedure TMsnConnection.DoMemberGroupChange(Member: TMsnMemberBase);
begin
  if Assigned(FOnMemberGroupChange) then
    FOnMemberGroupChange(Self, Member);
end;

procedure TMsnConnection.DoMemberOnline(Member: TMsnMemberBase);
begin
  if Assigned(FOnMemberOnline) then
    FOnMemberOnline(Self, Member);
end;

procedure TMsnConnection.DoMemberOffline(Member: TMsnMemberBase);
begin
  if Assigned(FOnMemberOffline) then
    FOnMemberOffline(Self, Member);
end;

procedure TMsnConnection.DoGroupAddition(Group: TMsnGroup);
begin
  if Assigned(FOnGroupAddition) then
    FOnGroupAddition(Self, Group);
end;

procedure TMsnConnection.DoGroupDeletion(Group: TMsnGroup);
begin
  if Assigned(FOnGroupDeletion) then
    FOnGroupDeletion(Self, Group);
end;

procedure TMsnConnection.DoGroupListChange;
begin
  if Assigned(FOnGroupListChange) then
    FOnGroupListChange(Self);
end;

procedure TMsnConnection.DoGroupNameChange(Group: TMsnGroup);
begin
  if Assigned(FOnGroupNameChange) then
    FOnGroupNameChange(Self, Group);
end;

procedure TMsnConnection.DoSignIn;
begin
  if Assigned(FOnSignIn) then
    FOnSignIn(Self);
end;

procedure TMsnConnection.DoSignOut(SignOutType: TSignOutType);
begin
  if Assigned(FOnSignOut) then
    FOnSignOut(Self, SignOutType);
end;

procedure TMsnConnection.DoMemberListUpdated(ListKind: TListKind);
begin
  if Assigned(FOnMemberListUpdated) then
    FOnMemberListUpdated(Self, ListKind);
end;

procedure TMsnConnection.DoLog(Hdr: String; Msg: UTF8String);
var
  LogInfo: TMsnLogInfo;
begin
   if Assigned(FOnLog) then
   begin
      with LogInfo do
      begin
         cbSize := SizeOf(TMsnLogInfo);
         nType := MSN_EVENT_COMLOG_HANDLE_CONNECTION;
         lpHandle := FNsmHandle;
         lpHeader := PChar(Hdr);
         lpMessage := PChar(Msg);
      end;
      FOnLog(LogInfo);
   end;
end;

procedure TMsnConnection.DoError(ErrorKind: TErrorKind; ErrorCode: Integer; ErrorMsg: WideString);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorKind, ErrorCode, ErrorMsg);
end;

procedure TMsnConnection.DoSwitchBoard(TrID: Integer; SBAddress, Cookie: String);
begin
  if Assigned(FOnSwitchBoard) then
    FOnSwitchBoard(Self, TrID, SBAddress, Cookie);
end;

procedure TMsnConnection.DoCalled(SessionID, SBAddress, Cookie, CallingUserAccount: String;
  CallingUserName: WideString);
begin
  if Assigned(FOnCalled) then
    FOnCalled(Self, SessionID, SBAddress, Cookie, CallingUserAccount, CallingUserName);
end;

procedure TMsnConnection.DoUrl(rru, passport: String; id: Integer);
begin
  if Assigned(FOnUrl) then
    FOnUrl(Self, rru, passport, id);
end;

procedure TMsnConnection.DoNewMail(Inbox: Boolean; FromName: WideString; FromAddr: String);
begin
  if Assigned(FOnNewMail) then
    FOnNewMail(Self, Inbox, FromName, FromAddr);
end;

procedure TMsnConnection.DoUnreadMailChange(Init: Boolean);
begin
  if Assigned(FOnUnreadMailChange) then
    FOnUnreadMailChange(Self, Init);
end;

procedure TMsnConnection.DoSystemMessage(Arg1: String);
begin
   If Assigned(FOnSystemMessage) then
      FOnSystemMessage(Self, Arg1);
end;

// 僒僀儞僀儞
procedure TMsnConnection.SignIn(Account, Password: String; Name: WideString;
                                Status: TMsnMemberStatus);
begin
   FSignOutType := otUnKnown;
   FSignInStage := ssTryConnectServer;
   // 儊儞僶儕僗僩傪弶婜壔
   FMembers.Clear;
   FReverseMembers.Clear;
   FAllowMembers.Clear;
   FBlockMembers.Clear;
   FGroups.Clear;
   FMembers.Updated := False;
   FReverseMembers.Updated := False;
   FAllowMembers.Updated := False;
   FBlockMembers.Updated := False;
   // 儐乕僓傪弶婜壔
   FUser.Account := Account;
   FUser.Password := Password;
   FUser.Status := Status;
   FUser.Name := Name;
   
   If FSocket.Handle > 0 then
   begin
      // 僜働僢僩傪弶婜壔
      FSocket.Close;
      FSocket.Address := '';
      FSocket.Host := FHost;
      FSocket.Port := FPort;
      FSocket.Open;
   end
   else
   begin
      // 枹愙懕忬懺
      FSignInStage := ssUnConnect;
      DoLog('-', 'Disconnect');
      // 僒僀儞傾僂僩僀儀儞僩
      DoSignOut(FSignOutType);
   end;
end;

// 僒僀儞傾僂僩
procedure TMsnConnection.SignOut;
begin
   SendCommand('OUT'#13#10);
end;

// 儐乕僓偺忬懺傪曄峏
function TMsnConnection.ChangeUserStatus(Status: TMsnMemberStatus): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('CHG %d %s %d'#13#10,
                      [FTrID, MemberStatusToStr(Status), MSNMSGR_CHG]));
   Result := FTrID;
end;

// 儐乕僓柤仌儊儞僶柤傪曄峏
function TMsnConnection.RenameMember(Account: String; NewName: WideString): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('REA %d %s %s'#13#10,
                      [FTrID, Account, EncodeParam(NewName)]));
   Result := FTrID;
end;

// 儊儞僶傪儕僗僩偵捛壛
function TMsnConnection.AddMember(List: TListKind; Account: String;
                                  GroupId: Integer = -1): Integer;
var
  Name: UTF8String;
begin
   if Account = RS_DUMMY_ALL_USER_ACCOUNT then
   begin
      if (List = lkAL) and (FBLP <> bpAL) then
         BLP := bpAL
      else if (List = lkBL) and (FBLP <> bpBL) then
         BLP := bpBL;
      Result := 1;
      Exit;
  end;
  
   if FMembers.Contains(Account) then
       Name := EncodeParam(FMembers.Find(Account).Name)
   else
      Name := Account;
   
   Inc(FTrID);
   if GroupId <> -1 then
      SendCommand(Format('ADD %d %s %s %s %d'#13#10,
                         [FTrID, ListKindToStr(List), Account, Name, GroupId]))
   else if List = lkFL then
      SendCommand(Format('ADD %d %s %s %s 0'#13#10,
                         [FTrID, ListKindToStr(List), Account, Name]))
   else
      SendCommand(Format('ADD %d %s %s %s'#13#10,
                         [FTrID, ListKindToStr(List), Account, Name]));
   Result := FTrID;
end;

// 儊儞僶傪儕僗僩偐傜嶍彍
function TMsnConnection.RemoveMember(List: TListKind; Account: String;
                                     GroupId: Integer = -1): Integer;
begin
   if Account = RS_DUMMY_ALL_USER_ACCOUNT then
   begin
      if (List = lkAL) and (FBLP <> bpBL) then
         BLP := bpBL
      else if (List = lkBL) and (FBLP <> bpAL) then
         BLP := bpAL;
      Result := 1;
      Exit;
   end;

   Inc(FTrID);
   if GroupId = -1 then
      SendCommand(Format('REM %d %s %s'#13#10,
                         [FTrID, ListKindToStr(List), Account]))
   else
      SendCommand(Format('REM %d %s %s %d'#13#10,
                         [FTrID, ListKindToStr(List), Account, GroupId]));
   Result := FTrID;
end;

// 僌儖乕僾傪捛壛
function TMsnConnection.AddGroup(Name: WideString): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('ADG %d %s 0'#13#10, [FTrID, EncodeParam(Name)]));
   Result := FTrID;
end;

// 僌儖乕僾傪嶍彍
function TMsnConnection.RemoveGroup(GroupId: Integer): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('RMG %d %d'#13#10, [FTrID, GroupId]));
   Result := FTrID;
end;

// 僌儖乕僾柤傪曄峏
function TMsnConnection.RenameGroup(GroupId: Integer; NewName: WideString): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('REG %d %d %s 0'#13#10, [FTrID, GroupId, EncodeParam(NewName)]));
   Result := FTrID;
end;

// SwitchBoard Server 徯夘梫媮傪憲怣
function TMsnConnection.SwitchBoardRequest: Integer;
begin
   Inc(FTrID);
   SendCommand(Format('XFR %d SB'#13#10, [FTrID]));
   Result := FTrID;
end;

// URL 傪栤偄崌傢偣
function TMsnConnection.QueryUrl(Param: String): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('URL %d %s'#13#10, [FTrID, Param]));
   Result := FTrID;
end;

// Ping 憲怣
procedure TMsnConnection.Ping;
begin
   SendCommand('PNG'#13#10);
end;

// GTC 愝掕
procedure TMsnConnection.SetGTC(Value: Boolean);
begin
   Inc(FTrID);
   if Value then
      SendCommand(Format('GTC %d A'#13#10, [FTrID]))
   else
      SendCommand(Format('GTC %d N'#13#10, [FTrID]));
end;