unitmain.pas

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

  try
    SocketWrite(BuildSIPRequest('S', ['N: GetContactsInfo'],
      '<args><contacts attributes="all"><contact uri="'
      + aURI + '" /></contacts></args>'));

    // 读取与命令无关的响应
    while ReadASIPResponse(ResponseMsg) <> 'S' do ;

    if Length(ResponseMsg) > 0 then
    begin
      try
        XMLReader.LoadFromXML(ResponseMsg);
        XMLReader.Active := True;
        ExploreNode(XMLReader.Node);
      except
      end;
    end;

    while IdTcpClient1.Socket.Readable(100) do
    begin
      ReadASIPResponse(ResponseMsg);

      if Length(ResponseMsg) > 0 then
      begin
        try
          XMLReader.LoadFromXML(ResponseMsg);
          XMLReader.Active := True;
          ExploreNode(XMLReader.Node);
        except
        end;
      end;
    end;

  except
    exit;
  end;
end;

function TFormMain.RetriveURIFromUID(aUid: string): string;
var Msg: TStringList;
  Response: string;
begin
  Result := '';
  try
    Msg := TStringList.Create;
    Msg.Add('Sid=' + aUid);
    IdHttp1.Disconnect;
    IdHttp1.CookieManager := TIdCookieManager.Create(nil);
    try
      IdHttp1.CookieManager.AddCookie('ssic=' + FSSIC, GetSubStringBetween(FGetUriURL, '://', '/'));
      Response := IdHttp1.Post(FGetUriURL, Msg);
      if Pos('value="', Response) > 0 then
        Result := GetSubStringBetween(Response, 'value="', '"');
    finally
      IdHttp1.CookieManager.Free;
      IdHttp1.CookieManager := nil;
    end;
  except
  end;
end;

function TFormMain.ReadUserConfig(aUserPhoneNum: string): boolean;
var ConfigFile: TIniFile;
begin
  ConfigFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');
  try
    FSSISignInURL := ConfigFile.ReadString(aUserPhoneNum, 'SSISignInURL', 'https://uid.fetion.com.cn/ssiportal/SSIAppSignIn.aspx');
    FGetUriURL := ConfigFile.ReadString(aUserPhoneNum, 'GetUriURL', 'HTTP://221.130.45.205/hds/geturi.aspx');
    FSIPCServer := ConfigFile.ReadString(aUserPhoneNum, 'SIPCServer', '221.130.46.144');
    FSIPCPort := StrToIntDef(ConfigFile.ReadString(aUserPhoneNum, 'SIPCPort', '8080'), 8080);
  finally
    ConfigFile.Free;
  end;
end;

procedure TFormMain.RefreshContactList;
var I: integer;
  aUserInfo: TUserInfo;
begin
  if not IdTcpClient1.Connected then
    exit;

  FContactList.Clear;

  // 把自己添加到联系人列表
  FContactList.AddUser(FUserURI, '自己', True, 0, FPhoneNum);
  RetrivePersonalInfo;

  RetriveContractList;

  for I := 0 to FContactList.Count - 1 do
  begin
    if FContactList.Items[I].Sid <> FUserURI then
    begin
      aUserInfo := Self.RetriveUserInfo(FContactList.Items[I].Sid);
      if aUserInfo.Sid <> '' then
        FContactList.UpdateUserNickName(FContactList.Items[I].Sid,
          aUserInfo.NickName, aUserInfo.Name, aUserInfo.MobileNum);
    end;
    if I > 50 then
      Break;
  end;

  cbContactList.Clear;
  for I := 0 to FContactList.Count - 1 do
    cbContactList.Items.Add(FContactList.UserName[I]);
  cbContactList.ItemIndex := 0;

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.LoadFromXML(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'], 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.WriteUserConfig(aUserPhoneNum: string; Update: Boolean = True): boolean;
var ConfigFile: TIniFile;
begin
  ConfigFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');
  try
    if not Update then
      if ConfigFile.ReadString(aUserPhoneNum, 'SSISignInURL', '') <> '' then
        Exit;

    ConfigFile.WriteString(aUserPhoneNum, 'SSISignInURL', FSSISignInURL);
    ConfigFile.WriteString(aUserPhoneNum, 'GetUriURL', FGetUriURL);
    ConfigFile.WriteString(aUserPhoneNum, 'SIPCServer', FSIPCServer);
    ConfigFile.WriteString(aUserPhoneNum, 'SIPCPort', IntToStr(FSIPCPort));
  finally
    ConfigFile.Free;
  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 hashedPwd: string;
  tmpStr: RawByteString;
  h1, h2: string;
  pwdBin: array[0..256] of AnsiChar;
  pwdLen: Integer;
var
  SHA1Context: TSHA1Context;
  SHA1Digest: TSHA1Digest;
var
  MyMD5: TIdHashMessageDigest5;
  Digest: TBytes;
begin
  hashedPwd := hash_password(pwd);
  hashedPwd := Copy(hashedPwd, 9, Length(hashedPwd) - 8);
  FillMemory(@pwdBin[0], 257, 0);
  pwdLen := HexToBin(PChar(hashedPwd), pwdBin, 256);
  tmpStr := sid + ':' + domain + ':';
  SetLength(Digest, Length(tmpStr) + pwdLen);
  CopyMemory(@Digest[0], @tmpStr[1], Length(tmpStr));
  CopyMemory(@Digest[Length(tmpStr)], @pwdBin[0], pwdLen);
  SHA1Init(SHA1Context);
  SHA1Update(SHA1Context, @Digest[0], Length(Digest));
  SHA1Final(SHA1Context, SHA1Digest);

  MyMD5 := TIdHashMessageDigest5.Create;

  tmpStr := ':' + nonce + ':' + cnonce;
  SetLength(Digest, Sizeof(SHA1Digest) + Length(tmpStr));
  CopyMemory(@Digest[0], @SHA1Digest, Sizeof(SHA1Digest));
  CopyMemory(@Digest[Sizeof(SHA1Digest)], @tmpStr[1], Length(tmpStr));
{$IFDEF UNICODE}
  h1 := MyMD5.HashBytesAsHex(Digest);
  h2 := UpperCase(MyMD5.HashStringAsHex('REGISTER:' + sid));
  Result := UpperCase(MyMD5.HashStringAsHex(h1 + ':' + nonce + ':' + h2));
{$ELSE}
  h1 := MyMD5.AsHex(MyMD5.HashValue(string(Digest)));
  h2 := MyMD5.AsHex(MyMD5.HashValue('REGISTER:' + sid));
  Result := UpperCase(MyMD5.AsHex(MyMD5.HashValue(h1 + ':' + nonce + ':' + h2)));
{$ENDIF}

  MyMd5.Free;
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);
var ConfigFile: TIniFile;
begin
  XMLReader.Free;
  FContactList.Free;
  if IdTCPClient1.Connected then
    IdTCPClient1.Disconnect;

end;

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

  Randomize;

  InitConfigFromFetion;

  FContactList := TContactList.Create;
  FContactList.Clear;

  FCall := 0;
  FRegisterCount := 0;

  LoginForm := TFormLogin.Create(Application);
  if LoginForm.ShowModal = mrCancel then
  begin
    Application.ShowMainForm := False;
    Application.Terminate;
  end;
  LoginForm.Free;
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;
  if Result = '' then
    Result := FUserList[itemIndex].Sid;
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
{$IFDEF UNICODE}
  Result := IdTCPClient1.Socket.ReadLn(enUTF8);
{$ELSE}
  Result := IdTCPClient1.Socket.ReadLn;
{$ENDIF}
end;

function TFormMain.SocketReadString(aStrLen: integer): string;
begin
{$IFDEF UNICODE}
  Result := IdTCPClient1.Socket.ReadString(aStrLen, enUTF8);
{$ELSE}
  Result := IdTCPClient1.Socket.ReadString(aStrLen);
{$ENDIF}
end;

procedure TFormMain.SocketWrite(aStr: string);
var tmp: RawByteString;
  byteBuf: TBytes;
begin
  tmp := Utf8Encode(aStr);
  SetLength(byteBuf, Length(tmp));
  CopyMemory(@byteBuf[0], @tmp[1], Length(tmp));
  IdTCPClient1.Socket.Write(byteBuf);
end;

end.