unitmain.pas

Delphi7版飞信GreenFetion源码

    // 使用nonce构造response，再次发送登录请求
    SocketWrite(BuildSIPRequest('R', ['A: ' + build_reponse_A()], LOGON_REQUEST_ARG, GetNextRegisterCount()));
    if not GetSIPResponse('R', ResponseMsg) then
    begin
      // 登录不成功
      IdTCPClient1.Disconnect;
      Exit;
    end;

    FContactList.AddUser(FUserURI, '自己', True, 0, PhoneNum);

    // 获取用户自己的信息
    RetrivePersonalInfo;

    // 获取组列表
    SocketWrite(BuildSIPRequest('S', ['N: PGGetGroupList'], '<args><group-list version="0" attributes="name;identity" /></args>'));
    GetSIPResponse('S', ResponseMsg);

    // 获取联系人列表
    RetriveContractList;

    // 预定联系人状态及详细信息
    RequestArg := '<args>';
    for I := 0 to FContactList.Count - 1 do
      if FContactList.Items[I].Sid <> FUserURI then
        if FContactList.Items[I].IsFetionUser then
          RequestArg := RequestArg + '<subscription><contacts><contact uri="' + FContactList.Items[I].Sid + '" /></contacts><presence><basic attributes="all" /><personal attributes="all" /><extended types="sms;location;listening;ring-back-tone;feike" /></presence></subscription>';
    RequestArg := RequestArg + '<subscription><contacts><contact uri="' + FContactList.Items[I].Sid + '" /></contacts><presence><extended types="sms;location;listening;ring-back-tone;feike" /></presence></subscription>';
    RequestArg := RequestArg + '</args>';
    SocketWrite(BuildSIPRequest('SUB', ['N: presence'], RequestArg));
    GetSIPResponse('SUB', ResponseMsg);

    // 获取联系人状态及详细信息
    RequestArg := '<args><contacts attributes="provisioning;impresa;mobile-no;nickname;name;gender;portrait-crc;ivr-enabled" extended-attributes="score-level">';
    for I := 0 to FContactList.Count - 1 do
      if FContactList.Items[I].Sid <> FUserURI then
        if FContactList.Items[I].IsFetionUser then
          RequestArg := RequestArg + '<contact uri="' + FContactList.Items[I].Sid + '" version="12" />';
    RequestArg := RequestArg + '</contacts></args>';
    SocketWrite(BuildSIPRequest('S', ['N: GetContactsInfo'], RequestArg));
    GetSIPResponse('S', ResponseMsg);

    // 获取离线时的消息
    SocketWrite(BuildSIPRequest('S', ['N: GetOfflineMessages'], ''));
    GetSIPResponse('S', ResponseMsg);

    // 获取分数
    SocketWrite(BuildSIPRequest('S', ['N: GetScore'], ''));
    GetSIPResponse('S', ResponseMsg);

    // 开始发送心跳包
    tmRegister.Enabled := True;
  except
    Exit;
  end;

  Result := True;
end;

procedure TFormMain.RetriveContractList;
var ResponseMsg: string;

  procedure ShowNodeInfo(aNode: IXMLNode; IsFetionUser: boolean);
  var uri, localName: string;
    group: Integer;
  begin
    if aNode = nil then
      Exit;
    uri := '';
    localName := '';
    group := 0;
    if aNode.HasAttribute('uri') then
      uri := aNode.Attributes['uri'];
    if aNode.HasAttribute('local-name') then
      localName := aNode.Attributes['local-name'];
    if aNode.HasAttribute('buddy-lists') then
      group := aNode.Attributes['buddy-lists'];
    if uri <> '' then
      FContactList.AddUser(uri, localName, IsFetionUser, group);
  end;
  procedure ExploreNode(aNode: IXMLNode);
  var I, J: Integer;
  begin
    if aNode.NodeName = 'buddy' then
      ShowNodeInfo(aNode, True);
    if aNode.NodeName = 'mobile-buddy' then
      ShowNodeInfo(aNode, False);

    for I := 0 to aNode.ChildNodes.Count - 1 do
    begin
      ExploreNode(aNode.ChildNodes[I]);
    end;
  end;
begin
  if not IdTCPClient1.Connected then
    Exit;

  SocketWrite(BuildSIPRequest('S', ['N: GetContactList'], LOGON_GETCONTACTLIST_ARG));
  if not GetSIPResponse('S', ResponseMsg) then
    Exit;

  try
    XMLReader.XML.Text := ResponseMsg;
    XMLReader.Active := True;
    ExploreNode(XMLReader.Node);
  except

  end;
end;

procedure TFormMain.RetrivePersonalInfo;
var ResponseMsg: string;

  procedure ExploreNode(aNode: IXMLNode);
  var I, J: Integer;
    name, nickName, mobileNum: string;
  begin
    if aNode.NodeName = 'personal' then
    begin
      if aNode.HasAttribute('name') then
        name := aNode.Attributes['name'];
      if aNode.HasAttribute('nickname') then
        nickName := aNode.Attributes['nickname'];
      if aNode.HasAttribute('mobile-no') then
        mobileNum := aNode.Attributes['mobile-no'];
      FContactList.UpdateUserNickName(FUserURI, nickName, name, mobileNum);
    end;

    for I := 0 to aNode.ChildNodes.Count - 1 do
    begin
      ExploreNode(aNode.ChildNodes[I]);
    end;
  end;
begin
  if not IdTCPClient1.Connected then
    Exit;

  SocketWrite(BuildSIPRequest('S', ['N: GetPersonalInfo'],
    '<args><personal attributes="all" /></args>'));
  if not GetSIPResponse('S', ResponseMsg) then
    Exit;

  try
    XMLReader.XML.Text := ResponseMsg;
    XMLReader.Active := True;
    ExploreNode(XMLReader.Node);
  except
  end;
end;

procedure TFormMain.RetriveContractInfo(aSubscribeResponse: string); // 从预定信息回复中获取某联系人信息
var aSid: string;
  name, nickName, mobileNum: string;

  procedure ExploreNode(aNode: IXMLNode);
  var I, J: Integer;
  begin
    // 联系人信息
    if aNode.NodeName = 'personal' then
    begin
      if aNode.HasAttribute('name') then
        name := aNode.Attributes['name'];
      if aNode.HasAttribute('nickname') then
        nickName := aNode.Attributes['nickname'];
      if aNode.HasAttribute('mobile-no') then
        mobileNum := aNode.Attributes['mobile-no'];
    end;

    // 联系人URI
    if ((aNode.NodeName = 'presence') or (aNode.NodeName = 'contact')) then
      if aNode.HasAttribute('uri') then
        aSid := aNode.Attributes['uri'];

    for I := 0 to aNode.ChildNodes.Count - 1 do
    begin
      ExploreNode(aNode.ChildNodes[I]);
    end;
  end;
begin
  aSid := '';
  try
    //XMLReader.XML.Text := Utf8ToAnsi(aSubscribeResponse);
    XMLReader.XML.Text := aSubscribeResponse;
    XMLReader.Active := True;
    ExploreNode(XMLReader.Node);

    if aSid <> '' then
      FContactList.UpdateUserNickName(aSid, nickName, name, mobileNum);
  except
  end;
end;

function TFormMain.SendMessage(uri, msg: string): Boolean;
var ResponseMsg: string;
begin
  Result := False;
  if uri = '' then
    Exit;
  if msg = '' then
    Exit;
  if not IdTCPClient1.Connected then
    Exit;
  try
    SocketWrite(BuildSIPRequest('M', ['T: ' + uri, 'N: SendSMS'], AnsiToUtf8(msg)));
    Result := GetSIPResponse('M', ResponseMsg);
  except
  end;
end;

procedure TFormMain.tmRegisterTimer(Sender: TObject);
var ResponseMsg: string;
begin
  if not IdTCPClient1.Connected then
    Exit;
  try
    SocketWrite(BuildSIPRequest('R', [], '', GetNextRegisterCount()));
    GetSIPResponse('R', ResponseMsg);
  except
  end;
end;

function TFormMain.calc_cnonce: string;
var I: Integer;
  Num: Integer;
begin
  Result := '';
  for I := 0 to 4 - 1 do
  begin
    Num := Random(MaxInt);
    if Num shr $18 < $10 then
      Num := Num + $10000000;
    Result := Result + IntToHex(Num, 8);
  end;
end;

function TFormMain.calc_response(sid, domain, pwd, nonce, cnonce: string): string;
var tmpStr, hashedPwd: string;
  key, h1, h2: string;
  pwdBin: array[0..256] of Char;
var
  SHA1Context: TSHA1Context;
  SHA1Digest: TSHA1Digest;
var
  MyMD5: TIdHashMessageDigest5;
  Digest: T4x4LongWordRecord;
begin
  hashedPwd := hash_password(pwd);
  hashedPwd := Copy(hashedPwd, 9, Length(hashedPwd) - 8);
  FillMemory(@pwdBin[0], 257, 0);
  HexToBin(PChar(hashedPwd), pwdBin, 256);
  tmpStr := AnsiToUtf8(sid + ':' + domain + ':') + pwdBin;
  SHA1Init(SHA1Context);
  SHA1Update(SHA1Context, PChar(tmpStr), Length(tmpStr));
  SHA1Final(SHA1Context, SHA1Digest);
  key := PChar(@SHA1Digest);

  MyMD5 := TIdHashMessageDigest5.Create;

//  Digest := MyMD5.HashValue(sid + ':' + domain + ':' + hash_password(FPassword));
//  key := UpperCase(MyMD5.AsHex(Digest));

  Digest := MyMD5.HashValue(key + ':' + nonce + ':' + cnonce);
  h1 := UpperCase(MyMD5.AsHex(Digest));
  Digest := MyMD5.HashValue('REGISTER:' + sid);
  h2 := UpperCase(MyMD5.AsHex(Digest));
  Digest := MyMD5.HashValue(h1 + ':' + nonce + ':' + h2);
  Result := UpperCase(MyMD5.AsHex(Digest));
end;

function TFormMain.calc_salt(pwd: string): string;
var r: array[0..256] of char;
  tmpStr: string;
begin
  tmpStr := hash_password(pwd);
 // BinToHex(PChar(tmpStr), r, Length(tmpStr));
  Result := Copy(UpperCase(tmpStr), 1, 8);
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  XMLReader.Free;
  FContactList.Free;
  if IdTCPClient1.Connected then
    IdTCPClient1.Disconnect;
end;

procedure TFormMain.FormCreate(Sender: TObject);
var LoginForm: TFormLogin;
begin
  XMLReader := TXMLDocument.Create(Self);

  Randomize;

  FCall := 0;
  FRegisterCount := 0;
  FSSISignInURL := 'https://uid.fetion.com.cn/ssiportal/SSIAppSignIn.aspx';
  FSIPCServer := '221.176.31.36';
  FSIPCPort := 8080;

  FContactList := TContactList.Create;
  FContactList.Clear;

  LoginForm := TFormLogin.Create(Application);
  if LoginForm.ShowModal = mrCancel then
  begin
    Application.ShowMainForm := False;
    Application.Terminate;
  end;
  LoginForm.Free;
end;

procedure TFormMain.FormShow(Sender: TObject);
var I: Integer;
begin
  for I := 0 to FContactList.Count - 1 do
    cbContactList.Items.Add(FContactList.UserName[I]);
  cbContactList.ItemIndex := 0;
end;

function TFormMain.GetNextCall: Integer;
begin
  Inc(FCall);
  Result := FCall;
end;


function TFormMain.GetNextRegisterCount: Integer;
begin
  Inc(FRegisterCount);
  Result := FRegisterCount;
end;

{ TContactList }

procedure TContactList.AddUser(aSid, aLocalName: string; IsFetionUser: Boolean; aGroup: Integer; aMobileNum: string; aNickName, aName: string);
var Len: Integer;
begin
  Len := Length(FUserList);
  SetLength(FUserList, Len + 1);
  FUserList[Len].Sid := aSid;
  FUserList[Len].IsFetionUser := IsFetionUser;
  FUserList[Len].Name := aName;
  FUserList[Len].NickName := aNickName;
  FUserList[Len].LocalName := aLocalName;
  FUserList[Len].MobileNum := aMobileNum;
  FUserList[Len].Group := aGroup;
end;

procedure TContactList.Clear;
begin
  SetLength(FUserList, 0);
end;

function TContactList.GetCount: Integer;
begin
  Result := Length(FUserList);
end;

function TContactList.GetItem(itemIndex: Integer): TUserInfo;
begin
  Result.Sid := '';
  if itemIndex >= Count then
    Exit;
  if itemIndex < 0 then
    Exit;
  Result := FUserList[itemIndex];
end;

function TContactList.GetUserName(itemIndex: Integer): string;
begin
  Result := '';
  if itemIndex >= Count then
    Exit;
  if itemIndex < 0 then
    Exit;
  Result := FUserList[itemIndex].LocalName;
  if Result = '' then
    Result := FUserList[itemIndex].NickName;
  if Result = '' then
    Result := FUserList[itemIndex].Name;
end;

function TContactList.GetUserSidByName(aName: string): string;
var I: Integer;
begin
  Result := '';
  for I := 0 to Length(FUserList) - 1 do
  begin
    if ((FUserList[I].Name = aName)
      or (FUserList[I].NickName = aName)
      or (FUserList[I].LocalName = aName)) then
    begin
      Result := FUserList[I].Sid;
      Break;
    end;
  end;
end;

procedure TContactList.UpdateUserNickName(aSid, aNickName, aName, aMobileNum: string);
var I: Integer;
begin
  for I := 0 to Length(FUserList) - 1 do
    if (FUserList[I].Sid = aSid) then
    begin
      if aNickName <> '' then
        FUserList[I].NickName := aNickName;
      if aName <> '' then
        FUserList[I].Name := aName;
      if aMobileNum <> '' then
        FUserList[I].MobileNum := aMobileNum;
      Break;
    end;
end;

function TFormMain.SocketReadLn: String;
begin
  Result := IdTCPClient1.ReadLn;
end;

procedure TFormMain.SocketWrite(aStr: String);
begin
  IdTCPClient1.Write(aStr);
end;

end.