unitmain.pas.~45~

Delphi实现的飞信源码

unit UnitMain;

interface

uses
  UnitSHA1,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, IEHTTP3, IdHashMessageDigest, IdGlobal, IdHash, xmldom,
  XMLIntf, msxmldom, XMLDoc, Buttons, ExtCtrls, ComCtrls, jpeg, IdBaseComponent,
  IdComponent, ImgList,MTreeView;

const
  LOGON_REQUEST_INVITE = 'fetion.com.cn SIP-C/2.0';
  LOGON_REQUEST_ARG = '<args><device type="PC" version="33" client-version="3.3.0370" />' +
    '<caps value="simple-im;im-session;temp-group;personal-group" /><events value="contact;permission;system-message;personal-group" /><user-info attributes="all" /><presence><basic value="400" desc="" /></presence></args>';
  LOGON_GETCONTACTLIST_ARG = '<args><contacts><buddy-lists /><buddies attributes="all" /><mobile-buddies attributes="all" /><chat-friends /><blacklist /></contacts></args>';
  LOGON_GETCONTACTINFO_ARG = '<args><contacts attributes="provisioning;impresa;mobile-no;nickname;name;gender;portrait-crc;ivr-enabled" extended-attributes="score-level">'; //<contact uri="sip:[e-mail];p=9805" version="12" /></contacts></args>';

 // SALT = #$77+#$7A+#$6D+#$03;
  SALT = #$FD + #$A5 + #$E5 + #$01;

const
  MSG_FONT_SIZE = 10;
  MSG_FONT_COLOR = clBlack;
  SYSMSG_FONT_SIZE = 8;
  SYSMSG_FONT_COLOR = clGreen;

type
  // 用户信息
  TUserInfo = record
    Sid: string; // 飞信标识
    IsFetionUser: Boolean;
    Name, NickName, LocalName, MobileNum: string;
    Group: Integer;
    //
  end;

  // 联系人列表管理
  TContactList = class
  private
    FUserList: array of TUserInfo;

    function GetCount: Integer;
    function GetItem(itemIndex: Integer): TUserInfo;
    function GetUserName(itemIndex: Integer): string;
  public
    procedure Clear;
    procedure AddUser(aSid, aLocalName: string; IsFetionUser: Boolean; aGroup: Integer; aMobileNum: string = ''; aNickName: string = ''; aName: string = '');
    procedure UpdateUserNickName(aSid, aNickName, aName, aMobileNum: string);
    function  GetUserSidByName(aName: string): string;
  public
    property Count: Integer read GetCount;
    property Items[itemIndex: Integer]: TUserInfo read GetItem;
    property UserName[itemIndex: Integer]: string read GetUserName;
  end;

  TFormMain = class(TForm)
    IdTCPClient1: TIdTCPClient;
    XMLReader: TXMLDocument;
    tmRegister: TTimer;
    IdHTTP1: TIdHTTP;
    UserTv: TTreeView;
    Panel1: TPanel;
    reLogMsg: TRichEdit;
    Panel2: TPanel;
    mmMsg: TMemo;
    btSendMsg: TBitBtn;
    Panel3: TPanel;
    Label1: TLabel;
    cbContactList: TComboBox;
    ImageList1: TImageList;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure btSendMsgClick(Sender: TObject);
    procedure tmRegisterTimer(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure UserTvDblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure IdTCPClient1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
  private
    { Private declarations }
    FPhoneNum: string;
    FPassWord: string;
    FSSIC: string;
    FUserURI: string; // 用户飞信标识
    FUserSid: string; // 飞信号
    FDomain: string; // 飞信标识中的域名
    FSalt: string;
    FNonce: string;
    FCNonce: string;

    FSIPCServer: string;
    FSIPCPort: Integer;
    FSSISignInURL: string;

    FContactList: TContactList;

    FCall,tempindex: Integer;
    FRegisterCount: Integer;
    Groups:array[1..200] of string;
    function GetNextCall: Integer;
    function GetNextRegisterCount: Integer;
    function BuildSIPRequest(Cmd: string; fields: array of string;
      arg: string; CmdTryCount: Integer = 1): string;
    function GetSIPResponse(Cmd: string; var ResponseMsg: string): Boolean;

    function hash_password(pwd: string): string;
    function calc_salt(pwd: string): string;
    function calc_cnonce: string;
    function calc_response(sid, domain, pwd, nonce, cnonce: string): string;
    function build_reponse_A: string;

    function  SendMessage(uri, msg: string): Boolean;
    procedure RetrivePersonalInfo; // 获取自己的信息
    procedure RetriveContractInfo(aSubscribeResponse: string); // 从预定信息回复中获取某联系人信息
    procedure RetriveContractList;
    procedure AddLogMsg(msg: string; FontColor: TColor);
    procedure AddSysMsg(msg: string; FontColor: TColor);
  public
    { Public declarations }

    function Login(PhoneNum, Password: string): Boolean;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses UnitLogin, About;

function GetSubStringBetween(aString, beginstr, endstr: string): string;
var Len, index, beginPos: Integer;
begin
  Len := 0;
  if Pos(beginstr, aString)<=0 then
    Exit;
  if Pos(endstr, aString)<=0 then
    Exit;

  beginPos := Pos(beginstr, aString) + Length(beginstr);
  index := beginPos;
  while aString[index] <> endstr[1] do
  begin
    Inc(index);
    Inc(Len);
  end;
  Result := Copy(aString, beginPos, Len);
end;

procedure TFormMain.AddLogMsg(msg: string; FontColor: TColor);
var
  P: Integer;
begin
  P := Length(reLogMsg.Text); //Keep Append Position
  with reLogMsg do
  begin
    Lines.Add(msg);
    Lines.Add('--------------------');
    SelStart := P;
    SelLength := Length(reLogMsg.Text) - P;
    SelAttributes.Color := FontColor;
    SelAttributes.Size := MSG_FONT_SIZE;
  end;
  Windows.SendMessage(reLogMsg.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;

procedure TFormMain.AddSysMsg(msg: string; FontColor: TColor);
var
  P: Integer;
begin
  P := Length(reLogMsg.Text); //Keep Append Position
  with reLogMsg do
  begin
    Lines.Add('【系统提示】:' + msg);
    SelStart := P;
    SelLength := Length(reLogMsg.Text) - P;
    SelAttributes.Color := FontColor;
    SelAttributes.Size := SYSMSG_FONT_SIZE;
  end;
  Windows.SendMessage(reLogMsg.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;

procedure TFormMain.btSendMsgClick(Sender: TObject);
var
  I: Integer;
begin
  if mmMsg.Text = '' then
    Exit;
    AddLogMsg(mmMsg.Text, clBlack);

 for I := 0 to UserTv.Items.Count- 1 do
    begin
    if userTv.Items[i].ImageIndex=2 then
     begin
       // Items[cbContactList.ItemIndex].Sid
  if SendMessage(FContactList.GetUserSidByName(userTv.Items[i].Text), mmMsg.Text) then
     AddSysMsg('短信发送完毕！' + #$0D + #$0A, clGreen)
  else
    AddSysMsg('短信发送失败！' + #$0D + #$0A, clRed);
     end;

    end;




  mmMsg.Clear;

end;

function TFormMain.BuildSIPRequest(Cmd: string; fields: array of string;
  arg: string; CmdTryCount: Integer = 1): string;
var I: Integer;
begin
  Result := Cmd + ' ' + LOGON_REQUEST_INVITE;
  Result := Result + #$D + #$A + 'F: ' + FUserSid;

  if Cmd = 'R' then
  begin
    Result := Result + #$D + #$A + 'I: 1';
  end
  else
  begin
    if CmdTryCount = 1 then
      Result := Result + #$D + #$A + 'I: ' + IntToStr(GetNextCall())
    else
      Result := Result + #$D + #$A + 'I: ' + IntToStr(FCall);
  end;


  Result := Result + #$D + #$A + 'Q: ' + IntToStr(CmdTryCount) + ' ' + Cmd;

  for I := 0 to Length(fields) - 1 do
    Result := Result + #$D + #$A + fields[I];

  if Length(arg) > 0 then
  begin
    Result := Result + #$D + #$A + 'L: ' + IntToStr(Length(arg))
      + #$D + #$A + #$D + #$A
      + arg;
  end
  else
  begin
    Result := Result + #$D + #$A + #$D + #$A;
  end;

end;


function TFormMain.GetSIPResponse(Cmd: string; var ResponseMsg: string): Boolean;
var CmdLine: string;
  // 读取一个完整的SIP响应，并返回SIP响应对应的命令
  function ReadASIPResponse(var SIPMsg: string): string;
  var NewLine, SIPCmd: string;
    tmpIndex: Integer;
    MsgLength: Integer;
  begin
    Result := '';
    MsgLength := 0;

    CmdLine := IdTCPClient1.Socket.ReadLn; // SIP 响应头
    if Length(CmdLine) <= 0 then
      Exit;
    repeat
      NewLine := IdTCPClient1.Socket.ReadLn;
      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]) = 'L' then
      begin
          // 获取SIP消息长度
        tmpIndex := Pos(' ', NewLine);
        MsgLength := StrToIntDef(Copy(NewLine, tmpIndex + 1, MaxInt), 0);
       // relogmsg.Lines.Add(NewLine);
      end;

      if UpperCase(NewLine[1]) = 'W' then
      begin
          // 获取登录认证时服务器提供的Nonce
        FNonce := GetSubStringBetween(NewLine, 'nonce="', '"');
      end;

    until False;



    if MsgLength <= 0 then
      Exit;

    // 读取SIP消息
    SIPMsg := IdTCPClient1.Socket.ReadString(MsgLength);
    try
    if length(SIPMsg)<100 then
    relogmsg.Lines.Add(AnsiToUtf8(SIPMsg));
   except;
    end;
    // 获取联系人信息
    if Result = 'BN' then
     begin
      RetriveContractInfo(SIPMsg);
     end;

     //if CMd='R' then



  end;
begin
  Result := False;
  ResponseMsg := '';
  try
    // 读取与命令无关的响应
    while ReadASIPResponse(ResponseMsg) <> Cmd do ;

    if Pos('200 OK', CmdLine) > 0 then
      Result := True
    else
      if Pos('280 Send SMS OK', CmdLine) > 0 then
        Result := True;
  except
  end;
end;


function TFormMain.build_reponse_A: string;
begin
  FSalt := calc_salt(FPassWord);
  FCNonce := calc_cnonce;
//  Result := 'Digest algorithm="SHA1-sess",response="'
  Result := 'Digest '
//    + 'algorithm="MD5-sess",'
  + 'algorithm="SHA1-sess",'
    + 'response="' + calc_response(FUserSid, FDomain, FPassWord, FNonce, FCNonce)
    + '",cnonce="' + FCNonce
    + '",salt="' + FSalt
    + '",ssic="' + FSSIC
    + '"';
end;

function TFormMain.hash_password(pwd: string): string;
var
  SHA1Context: TSHA1Context;
  SHA1Digest: TSHA1Digest;
  tmpStr: string;
  p, r: array[0..256] of char;
begin
  FillMemory(@p[0], 257, 0);
  FillMemory(@r[0], 257, 0);

  SHA1Init(SHA1Context);
  SHA1Update(SHA1Context, PChar(pwd), Length(pwd));
  SHA1Final(SHA1Context, SHA1Digest);
  tmpStr := SALT + PChar(@SHA1Digest);
  StrCopy(p, PChar(tmpStr));

  SHA1Init(SHA1Context);
  SHA1Update(SHA1Context, @p[0], StrLen(p));
  SHA1Final(SHA1Context, SHA1Digest);

  tmpStr := SALT + PChar(@SHA1Digest);
  BinToHex(PChar(tmpStr), r, Length(tmpStr));
  Result := UpperCase(r);
end;

procedure TFormMain.IdTCPClient1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
ReLogmsg.Lines.Add('Rec'); 
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;

    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);

  // 获取登录服务器和通信服务器地址
  Request := TStringList.Create;
  try
    try
      IdHTTP1.ReadTimeout := 3000;
      IdHTTP1.ConnectTimeout := 3000;
      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.XML.Text := IdHTTP1.Post('http://nav.fetion.com.cn/nav/getsystemconfig.aspx', Request);
      XMLReader.Active := True;
      ExploreNode(XMLReader.Node);
    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('; ', 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
    IdTCPClient1.Socket.Write(BuildSIPRequest('R', [], LOGON_REQUEST_ARG, GetNextRegisterCount()));
    GetSIPResponse('R', ResponseMsg);

    // 使用nonce构造response，再次发送登录请求
    IdTCPClient1.Socket.Write(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);
    // 获取用户自己的信息