unitmain.pas

Delphi版飞信源代码 用Delphi实现飞信功能

  SetLength(byteBuf, Length(SALT) + Sizeof(SHA1Digest));
  CopyMemory(@byteBuf[0], @SALT[0], Sizeof(SALT));
  CopyMemory(@byteBuf[Length(SALT)], @SHA1Digest[0], Sizeof(SHA1Digest));

  SHA1Init(SHA1Context);
  SHA1Update(SHA1Context, @byteBuf[0], Length(byteBuf));
  SHA1Final(SHA1Context, SHA1Digest);

  SetLength(byteBuf, Length(SALT) + Sizeof(SHA1Digest));
  CopyMemory(@byteBuf[0], @SALT[0], Sizeof(SALT));
  CopyMemory(@byteBuf[Length(SALT)], @SHA1Digest[0], Sizeof(SHA1Digest));

  BinToHex(PAnsiChar(@byteBuf[0]), PAnsiChar(@r[0]), Length(byteBuf));
  Result := UpperCase(PAnsiChar(@r[0]));
end;

procedure TFormMain.InitConfigFromFetion;
var FetionConfigPath: array[0..MAX_PATH] of Char;
  sr: TSearchRec;
  aFileName, DecodedStr, tmpStr: string;
  PhoneNum: string;
  decodeNode, aNode: IXMLNode;
  aStr: TStringList;

  function DecodeFile(aFile, NodeName: string): string;
  var Base64Result: RawByteString;
    tmpStream, newStream, outStream: TMemoryStream;
    res: Pointer;
    comp: TIdZLibCompressorBase;
  begin
    Result := '';
    try
      XmlReader.LoadFromFile(aFileName);
      XmlReader.Active := True;
      aNode := XmlReader.ChildNodes.FindNode(NodeName);
      if aNode <> nil then
      begin
        Base64Result := aNode.Text;
        tmpStream := TMemoryStream.Create;
        newStream := TMemoryStream.Create;
        outStream := TMemoryStream.Create;
        res := @Base64Result[1];
        tmpStream.WriteBuffer(res^, Length(Base64Result));
        tmpStream.Position := 0;
        DecodeStream(tmpStream, newStream);
        newStream.Position := 0;
{$IFDEF UNICODE}
        comp := TIdCompressorZLib.Create;
{$ELSE}
        comp := TIdCompressorZLibEx.Create;
{$ENDIF}
        comp.DecompressGZipStream(newStream, outStream);
        comp.Free;

        outStream.Position := 0;
        SetLength(Base64Result, outStream.Size);
        res := @Base64Result[1];
        outStream.Read(res^, outStream.Size);

        Result := Base64Result;
      end;
    except
    end;
  end;
begin //   SHGetSpecialFolderPath
  SHGetFolderPath(0, CSIDL_APPDATA, 0, 0, FetionConfigPath);

  aFileName := string(FetionConfigPath) + '\Fetion\*.*';
  if FindFirst(aFileName, faanyfile, sr) = 0 then
  begin
    repeat
      if sr.Attr and fadirectory <> fadirectory then
        continue;

      if StrToIntDef(sr.Name, 0) <> 0 then
      begin
        // 获取用户手机号码
        DecodedStr := '';
        PhoneNum := '';
        aFileName := string(FetionConfigPath) + '\Fetion\' + sr.Name + '\userinfo.dat';
        if FileExists(aFileName) then
          DecodedStr := DecodeFile(aFileName, 'UserInfo');
        if DecodedStr <> '' then
        begin
          PhoneNum := GetSubStringBetween(DecodedStr, 'mobile-no="', '"');
        end;

        // 获取用户IP信息
        DecodedStr := '';
        aFileName := string(FetionConfigPath) + '\Fetion\' + sr.Name + '/configuration.dat';
        if FileExists(aFileName) then
          DecodedStr := DecodeFile(aFileName, 'ImpsConfiguration');
        if DecodedStr <> '' then
        begin
          tmpStr := GetSubStringBetween(DecodedStr, '<sipc-proxy>', '</sipc-proxy>');
          if Pos(':', tmpStr) <= 0 then
          begin
            FSIPCServer := tmpStr;
          end else
          begin
            FSIPCServer := Copy(tmpStr, 1, Pos(':', tmpStr) - 1);
            FSIPCPort := StrToIntDef(Copy(tmpStr, Pos(tmpStr, ':') + 1, Length(tmpStr)), 8080);
          end;

          FSSISignInURL := GetSubStringBetween(DecodedStr, '<ssi-app-sign-in>', '</ssi-app-sign-in>');
          FGetUriURL := GetSubStringBetween(DecodedStr, '<get-uri>', '</get-uri>');
        end;

        if PhoneNum <> '' then
          WriteUserConfig(PhoneNum, False);
      end;
    until FindNext(sr) <> 0;
  end;
  FindClose(sr);
end;

procedure TFormMain.Label2Click(Sender: TObject);
begin
  FormAbout.ShowModal;
end;

function TFormMain.Login(PhoneNum, Password: string): Boolean;
var
  deliPos, I: Integer;
  FResult: WideString;
  IEHttp1: TIEHTTP;
  Request: TStringList;
  RequestArg, ResponseMsg: string;
  procedure ExploreNode(aNode: IXMLNode);
  var I, J: Integer;
  begin
    if aNode.NodeName = 'sipc-proxy' then
      if aNode.IsTextElement then
      begin
        if Pos(':', aNode.Text) <= 0 then
        begin
          FSIPCServer := aNode.Text;
        end else
        begin
          FSIPCServer := Copy(aNode.Text, 1, Pos(':', aNode.Text) - 1);
          FSIPCPort := StrToIntDef(Copy(aNode.Text, Pos(aNode.Text, ':') + 1, Length(aNode.Text)), 8080);
        end;
      end;

    if aNode.NodeName = 'ssi-app-sign-in' then
      if aNode.IsTextElement then
        FSSISignInURL := aNode.Text;

    if aNode.NodeName = 'get-uri' then
      if aNode.IsTextElement then
        FGetUriURL := aNode.Text;

    for I := 0 to aNode.ChildNodes.Count - 1 do
    begin
      ExploreNode(aNode.ChildNodes[I]);
    end;
  end;
begin
  Result := False;
  if PhoneNum = '' then
    Exit;
  if Password = '' then
    Exit;
  FPassWord := AnsiToUtf8(Password);

  // 从Ini文件中读取登录服务器IP
  ReadUserConfig(PhoneNum);

  // 获取登录服务器和通信服务器地址
  Request := TStringList.Create;
  try
    try
      IdHTTP1.ReadTimeout := 5000;
      IdHTTP1.ConnectTimeout := 5000;
      Request.Text := '<config><user mobile-no="' + PhoneNum + '" /><client type="PC" version="3.3.0370" platform="W5.1" /><servers version="0" /><service-no version="37" /></config>';
      XMLReader.LoadFromXML(IdHTTP1.Post('http://nav.fetion.com.cn/nav/getsystemconfig.aspx', Request));
      XMLReader.Active := True;
      ExploreNode(XMLReader.Node);

      // 保存登录服务器IP到Ini文件中
      WriteUserConfig(PhoneNum);

    except
    end;
  finally
    Request.Free;
  end;

  // 开始登录过程
  // 第一步： 连接SSIPortal服务器，获取SSI及用户飞信号
  IEHttp1 := TIEHTTP.Create(Self);
  try
    try
      IEHTTP1.ExecuteURL(FSSISignInURL + '?mobileno='
        + PhoneNum + '&domains=&digest=' + hash_password(FPassWord));
      FResult := IEHTTP1.sl.Text;
      deliPos := Pos('; ', string(IEHTTP1.cookies.Values['ssic']));
      FSSIC := IEHTTP1.cookies.Values['ssic'];
      if deliPos > 0 then
        SetLength(FSSIC, deliPos - 1);
    except
      Exit;
    end;
  finally
    IEHttp1.Free;
  end;


  FUserURI := GetSubStringBetween(FResult, 'uri="', '"');
  FUserSid := GetSubStringBetween(FUserURI, 'sip:', '@');
  FDomain := GetSubStringBetween(FUserURI, '@', ';');

  // 第二步： 使用SIP协议登录通信服务器
  try
    IdTCPClient1.Host := FSIPCServer;
    IdTCPClient1.Port := FSIPCPort;
    IdTCPClient1.Connect;

    // 先获取nonce
    SocketWrite(BuildSIPRequest('R', [], LOGON_REQUEST_ARG, GetNextRegisterCount()));
    GetSIPResponse('R', ResponseMsg);

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

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

    // 获取联系人列表
    RefreshContactList;

    // 获取离线时的消息
    SocketWrite(BuildSIPRequest('S', ['N: GetOfflineMessages'], ''));
    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;
    try
      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'];
    except
    end;
    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.LoadFromXML(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
      begin
        nickName := aNode.Attributes['nickname'];
        FNickName := nickName;
        Caption := FORM_CAPTION + '   当前用户：' + FNickName;
      end;
      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.LoadFromXML(ResponseMsg);
    XMLReader.Active := True;
    ExploreNode(XMLReader.Node);
  except
  end;
end;

function TFormMain.RetriveUserInfo(aURI: string): TUserInfo;
var ResponseMsg: string;
var CmdLine: string;
  // 读取一个完整的SIP响应，并返回SIP响应对应的命令
  function ReadASIPResponse(var SIPMsg: string): string;
  var NewLine, SIPCmd, SubCmd: string;
    tmpIndex: Integer;
    MsgLength: Integer;
  begin
    Result := '';
    MsgLength := 0;
    CmdLine := SocketReadLn(); // SIP 响应头
    if Length(CmdLine) <= 0 then
      Exit;
    repeat
      NewLine := SocketReadLn();
      if Length(NewLine) <= 0 then
        Break;
      if UpperCase(NewLine[1]) = 'Q' then
      begin
          // 提取SIP命令
        tmpIndex := Pos(' ', NewLine);
        tmpIndex := PosIdx(' ', NewLine, tmpIndex + 1);
        Result := Copy(NewLine, tmpIndex + 1, MaxInt);
      end;
      if UpperCase(NewLine[1]) = 'N' then
      begin
          // 提取SIP子命令
        tmpIndex := Pos(' ', NewLine);
        tmpIndex := PosIdx(' ', NewLine, tmpIndex + 1);
        SubCmd := Copy(NewLine, tmpIndex + 1, MaxInt);
      end;
      if UpperCase(NewLine[1]) = 'L' then
      begin
          // 获取SIP消息长度
        tmpIndex := Pos(' ', NewLine);
        MsgLength := StrToIntDef(Copy(NewLine, tmpIndex + 1, MaxInt), 0);
      end;
    until False;

    if MsgLength <= 0 then
      Exit;

    // 读取SIP消息
    SIPMsg := SocketReadString(MsgLength);
  end;
  procedure ExploreNode(aNode: IXMLNode);
  var I, J: Integer;
  begin
    // 联系人信息
    if aNode.NodeName = 'personal' then
    begin
      if aNode.HasAttribute('name') then
        Result.Name := aNode.Attributes['name'];
      if aNode.HasAttribute('nickname') then
        Result.nickName := aNode.Attributes['nickname'];
      if aNode.HasAttribute('mobile-no') then
        Result.mobileNum := aNode.Attributes['mobile-no'];
      if aNode.HasAttribute('nation') then
        Result.Nation := aNode.Attributes['nation'];
      if aNode.HasAttribute('province') then
        Result.Province := aNode.Attributes['province'];
      if aNode.HasAttribute('city') then
        Result.City := aNode.Attributes['city'];
    end;

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

    for I := 0 to aNode.ChildNodes.Count - 1 do
    begin
      ExploreNode(aNode.ChildNodes[I]);
    end;
  end;
begin
  FillMemory(@Result, sizeof(Result), 0);
  ResponseMsg := '';
  if not IdTcpClient1.Connected then
    exit;