unitmain.pas

Delphi7版飞信GreenFetion源码

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;

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;
    reLogMsg: TRichEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    mmMsg: TMemo;
    btSendMsg: TBitBtn;
    Label1: TLabel;
    cbContactList: TComboBox;
    tmRegister: TTimer;
    IdHTTP1: TIdHTTP;
    Panel3: TPanel;
    Image1: TImage;
    Label2: TLabel;
    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);
  private
    { Private declarations }
    XMLReader: TXMLDocument;

    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: Integer;
    FRegisterCount: Integer;
    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);

    function SocketReadLn: String;
    procedure SocketWrite(aStr: String);
  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);
begin
  if mmMsg.Text = '' then
    Exit;
  AddLogMsg(mmMsg.Text, clBlack);
  if SendMessage(FContactList.Items[cbContactList.ItemIndex].Sid, mmMsg.Text) then
    AddSysMsg('短信发送完毕！' + #$0D + #$0A, clGreen)
  else
    AddSysMsg('短信发送失败！' + #$0D + #$0A, clRed);
  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 := 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]) = 'L' then
      begin
          // 获取SIP消息长度
        tmpIndex := Pos(' ', NewLine);
        MsgLength := StrToIntDef(Copy(NewLine, tmpIndex + 1, MaxInt), 0);
      end;
      if UpperCase(NewLine[1]) = 'W' then
      begin
          // 获取登录认证时服务器提供的Nonce
        FNonce := GetSubStringBetween(NewLine, 'nonce="', '"');
      end;
    until False;

    if MsgLength <= 0 then
      Exit;

    // 读取SIP消息
    SIPMsg := IdTCPClient1.ReadString(MsgLength);

    // 获取联系人信息
    if Result = 'BN' then
      RetriveContractInfo(SIPMsg);
  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.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
    SocketWrite(BuildSIPRequest('R', [], LOGON_REQUEST_ARG, GetNextRegisterCount()));
    GetSIPResponse('R', ResponseMsg);