// 阿里雲短信接口 （未測試 非原創 來自 qq 羣）

// 阿里雲短信接口
unit uAliyunSms;

{

Author: MarkWu
Q Q: 77910086

}

interface

uses Classes, SysUtils, uSMSIntf, IdHTTP, flcHash, EncdDecd;

type
  TAliYunSms = class(TInterfacedObject, ISMSIntf)
  private
    FHttp: TIdHTTP;
    FURL: string;
    FAppKey, FAppSercret, FAppCode: string;
    FSmsHost, FPath, FMethod: string;
    FQueryList: TStringList;

    function GetSmsURL: string;
    procedure SetSmsURL(value: string);
    function GetSign(APath, AMethod, ASecret: string; headers, querys, signHeader: TStringList): string;
    function BuildHeader(headers, signHeaderPrefixList: TStringList): string;
    function IsHeaderToSign(headerName: string; signHeaderPrefixList: TStringList): Boolean;
    function BuildStringToSign(APath, AMethod, ASecret: string; headers, querys, signHeader: TStringList): string;
    procedure InitHttpRequest(AHost, APath, AMethod, ASecret: string; headers, querys, signHeader: TStringList);
    function BuildResource(path: string; querys: TStringList): string;
    function InitialBasicHeader(path, appKey, appSecret, method: string;
      headers, querys, signHeaderPrefixList: TStringList): TStringList;


  public
    function GetSms(aList: TStringList): string;

    function SendSms(aHttp: TIdHttp): string;

    constructor Create(Ahttp: TIdHTTP);
    destructor Destroy; override;
  end;

  function HmacSHA256(data,key: string): string; stdcall; external 'hmac.dll';

implementation

uses
  uPublic;

const
  //請求Header Accept
  HTTP_HEADER_ACCEPT: string = 'Accept';
  //請求Body內容MD5 Header
  HTTP_HEADER_CONTENT_MD5: string = 'Content-MD5';
  //請求Header Content-Type
  HTTP_HEADER_CONTENT_TYPE: string = 'Content-Type';
  //請求Header UserAgent
  HTTP_HEADER_USER_AGENT: string = 'User-Agent';
  //請求Header Date
  HTTP_HEADER_DATE: string = 'Date';


  //簽名Header
  X_CA_SIGNATURE: string = 'X-Ca-Signature';
  //全部參與簽名的Header
  X_CA_SIGNATURE_HEADERS: string = 'X-Ca-Signature-Headers';
  //請求時間戳
  X_CA_TIMESTAMP: string = 'X-Ca-Timestamp';
  //請求放重放Nonce,15分鐘內保持惟一,建議使用UUID
  X_CA_NONCE: string = 'X-Ca-Nonce';
  //APP KEY
  X_CA_KEY: string = 'X-Ca-Key';
  //請求API所屬Stage
  X_CA_STAGE: string = 'X-Ca-Stage';

  //參與簽名的系統Header前綴,只有指定前綴的Header纔會參與到簽名中
  CA_HEADER_TO_SIGN_PREFIX_SYSTEM = 'X-Ca-';


  LF = #10;
  //分隔符1
  SPE1 = ',';
  //分隔符2
  SPE2 = ':';

  //鏈接符
  SPE3 = '&';

  //賦值符
  SPE4 = '=';

  //問號符
  SPE5 = '?';


  //默認請求超時時間,單位毫秒
  DEFAULT_TIMEOUT: Integer = 1000;

{ TAliyunSms }

constructor TAliYunSms.Create(Ahttp: TIdHTTP);
begin
  FHttp := Ahttp;      //FHttp.HTTPOptions := [];
  FHttp.HandleRedirects := true;
  FAppKey     := '23875185';
  FAppSercret := '7d379763c332be158ff253bcb61xxxxx';
  FAppCode    := '8592a9ec93fa47f59bd7661a5fdxxxxx';
  FSmsHost    := 'http://sms.market.alicloudapi.com';
  FPath       := '/singleSendSms';
  FMethod     := 'GET';

  FQueryList := TStringList.Create;
  FQueryList.Add('ParamString={"value":"MarkWu","couponno":"12345678"}');
  FQueryList.Add('RecNum=13760312656');
  FQueryList.Add('SignName=好好用軟件');
  FQueryList.Add('TemplateCode=SMS_69000458');
end;

destructor TAliYunSms.Destroy;
begin
  FQueryList.Free;
  
  inherited;
end;


function TAliYunSms.SendSms(aHttp: TIdHttp): string;
var
  aHeader_Accept, aHeader_Content_Type: string;
  headers,headers2, signHeader: TStringList;
  sha256Str, res: string;
begin
  //FParamsList.Sort;
  aHeader_Accept := 'application/text; charset=utf-8';
  aHeader_Content_Type := 'application/text; charset=utf-8'; //'application/x-www-form-urlencoded; charset=UTF-8';

  //aHttp.Request.ContentType := aHeader_Content_Type;//'application/text; charset=utf-8';
  //aHttp.Request.Accept := 'application/text; charset=utf-8';
  headers := TStringList.Create;
  signHeader := TStringList.Create;
  try
    
    headers.Add(HTTP_HEADER_CONTENT_TYPE + '=' + aHeader_Content_Type);
    headers.Add(HTTP_HEADER_ACCEPT + '=' + aHeader_Accept);
    {
    headers.Add('X-Ca-Request-Mode=debug');
    headers.Add('Accept=' + aHeader_Accept);
    headers.Add('X-Ca-Key=' + FAppKey);
    headers.Add('X-Ca-Timestamp=' + IntToStr(GetTimestamp(Now)) );
    headers.Add('X-Ca-Nonce=' + GetGUID(GetGUID));
    headers.Add('X-Ca-Signature=' + GetSign(FPath, FMethod, FAppSercret, headers, FQueryList, signHeader) );
    headers.Sort;
    }

    signHeader.Add(X_CA_TIMESTAMP);
    //signHeader.Add('a-header1');
    //signHeader.Add('a-header2');

    headers2 := InitialBasicHeader(FPath, FAppKey, FAppSercret, FMethod, headers, FQueryList, signHeader);

    InitHttpRequest(FSmsHost, FPath, FMethod, FAppSercret, headers2, FQueryList, signHeader);
    //res :=  FHttp.Get(FURL);

  finally
    FreeAndNil(headers);
   // if headers2 <> nil then
   // FreeAndNil(headers2);
    FreeAndNil(signHeader);
  end;
end;

function TAliYunSms.GetSms(aList: TStringList): string;
begin

end;

function TAliYunSms.GetSmsURL: string;
begin
  Result := FPath;
end;


procedure TAliYunSms.SetSmsURL(value: string);
begin
  FPath := Value;
end;

function TAliYunSms.InitialBasicHeader(path, appKey, appSecret, method: string; headers, querys, signHeaderPrefixList: TStringList): TStringList;

begin
  if (headers = nil) then
      headers := TStringList.Create;

    headers.Add('X-Ca-Request-Mode=debug');
    //headers.Add('Accept=' + aHeader_Accept);

    //headers.Add('X-Ca-Timestamp=1495990994649');// + IntToStr(GetTimestamp(StrToDateTime('2017-05-27 22:12:50.993') )) );
    headers.Add('X-Ca-Timestamp=' + IntToStr(GetTimestamp( Now )) );

    headers.Add('X-Ca-Nonce=' + GetGUID(GetGUID));
    headers.Add('X-Ca-Key=' + appKey);

    headers.Add('X-Ca-Signature=' + GetSign(FPath, FMethod, FAppSercret, headers, FQueryList, signHeaderPrefixList) );

  //headers.Add(X_CA_TIMESTAMP + '=' + get);
  //防重放，協議層不能進行重試，不然會報NONCE被使用；若是須要協議層重試，請註釋此行
  //headers.Add(SystemHeader.X_CA_NONCE, Guid.NewGuid().ToString());
  //headers.Add(SystemHeader.X_CA_KEY, appKey);
  //headers.Add(SystemHeader.X_CA_SIGNATURE, SignUtil.Sign(path, method, appSecret, headers, querys, bodys, signHeaderPrefixList));

  Result := headers;
end;


function UrlEncode(const ASrc: string): string;
const
  UnsafeChars = '*#%<>+ []{}"":,';  {do not localize}
var
  i: Integer;
begin
  Result := '';    {Do not Localize}
  for i := 1 to Length(ASrc) do begin
    if (AnsiPos(ASrc[i], UnsafeChars) > 0) or (ASrc[i]< #32) or (ASrc[i] > #127) then begin
      Result := Result + '%' + LowerCase(IntToHex(Ord(ASrc[i]), 2));  {do not localize}
    end else begin
      Result := Result + ASrc[i];
    end;
  end;
end;

procedure TAliYunSms.InitHttpRequest(AHost, APath, AMethod, ASecret: string; headers, querys, signHeader: TStringList);
var
  url: string;
  i: Integer;
  sbParams: string;
  sKey, sValue: string;
  res: string;
begin
  url := AHost;
  if APath <> '' then
    url := url + APath;

  sbParams := '';

  if (querys <> nil) and (0 < querys.Count) then
  begin
    for I := 0 to querys.Count - 1 do
    begin
      if sbParams <> '' then
      begin
        sbParams := sbParams + SPE3;
      end;

      sKey := querys.Names[I];
      sValue := querys.Values[sKey];
      if (sKey = '') and (sValue <> '') then
      begin
        sbParams := sbParams + UTF8Encode(sValue);
      end;

      if sKey <> '' then
      begin
        sbParams := sbParams + sKey + SPE4;
        if sValue <> '' then
        begin
          sbParams := sbParams + UrlEncode(UTF8Encode(sValue));
        end;
      end;
    end;
    if sbParams <> '' then
      url := url + SPE5 + sbParams;
  end;

  FURL := url;
  FHttp.ReadTimeout := DEFAULT_TIMEOUT;

  if ContainsKey(headers, 'Accept') then
    FHttp.Request.Accept := ListPop(headers, 'Accept');

  if ContainsKey(headers, 'Date') then
    FHttp.Request.Date := StrToDateTime(ListPop(headers, 'Date'));

  if ContainsKey(headers, HTTP_HEADER_CONTENT_TYPE) then
    FHttp.Request.ContentType := ListPop(headers, HTTP_HEADER_CONTENT_TYPE);
  headers.Sort;
  for I := 0 to headers.Count - 1 do
  begin
    FHttp.Request.CustomHeaders.Add(headers.Names[i] + ': ' + headers.Values[headers.Names[i]]);
  end;

  res := FHttp.Get(url);
end;

function TAliYunSms.GetSign(APath, AMethod, ASecret: string; headers, querys, signHeader: TStringList): string;
var
  sSign: WideString;
  abc: T256BitDigest;
  str, res: string;
  pt: PByteArray;
  I: Integer;
begin
  sSign := BuildStringToSign(APath, AMethod, ASecret, headers, querys, signHeader);
  //sSign := 'GET'#$A'application/text; charset=utf-8'#$A#$A'application/text; charset=utf-8'#$A#$A'X-Ca-Key:23875185'#$A'' + 'X-Ca-Nonce:12D01C4C-6501-4262-A236-9FC04B7F6740'#$A'X-Ca-Timestamp:1495894370993'#$A'/singleSendSms?ParamString={"value":"MarkWu","couponno":"12345678"}&RecNum=13760312656&SignName=好好用軟件&TemplateCode=SMS_69000458';
  abc := (CalcHMAC_SHA256(ASecret, AnsiToUtf8(sSign))) ;
  //Result := SHA256DigestToHexW(abc);

  SetLength(str, 32);
  pt := @(abc.Bytes);
  Move(pt[0], str[1], 32);

  Result := EncodeString(str);
end;

function TAliYunSms.BuildStringToSign(APath, AMethod, ASecret: string; headers, querys, signHeader: TStringList): string;
var
  I: Integer;
begin
  Result := UpperCase(AMethod) + LF;

  I := headers.IndexOfName(HTTP_HEADER_ACCEPT);
  if (I > -1) and (headers.Values[headers.Names[I]] <> '') then
    Result := Result + headers.Values[headers.Names[I]];
  Result := Result + LF;

  I := headers.IndexOfName(HTTP_HEADER_CONTENT_MD5);
  if (I > -1) and (headers.Values[headers.Names[I]] <> '') then
    Result := Result + headers.Values[headers.Names[I]];
  Result := Result + LF;

  I := headers.IndexOfName(HTTP_HEADER_CONTENT_TYPE);
  if (I > -1) and (headers.Values[headers.Names[I]] <> '') then
    Result := Result + headers.Values[headers.Names[I]];
  Result := Result + LF;

  I := headers.IndexOfName(HTTP_HEADER_DATE);
  if (I > -1) and (headers.Values[headers.Names[I]] <> '') then
    Result := Result + headers.Values[headers.Names[I]];
  Result := Result + LF;

  Result := Result + BuildHeader(headers, signHeader);
  Result := Result + BuildResource(aPath, querys);
end;


// 構建待簽名Http頭
//  headers              請求中全部的Http頭
//  signHeaderPrefixList 自定義參與簽名Header前綴
function TAliYunSms.BuildHeader(headers, signHeaderPrefixList: TStringList): string;
var
  I: Integer;
  sKey, sValue: string;
  sSignHeaders: string;
begin
  //剔除X-Ca-Signature/X-Ca-Signature-Headers/Accept/Content-MD5/Content-Type/Date
  if (signHeaderPrefixList <> nil) and (signHeaderPrefixList.Count > 0) then
  begin
    I := signHeaderPrefixList.IndexOfName(X_CA_SIGNATURE);
    if I > -1 then
    signHeaderPrefixList.Delete(I);

    I := signHeaderPrefixList.IndexOfName(X_CA_SIGNATURE_HEADERS);
    if I > -1 then
    signHeaderPrefixList.Delete(I);


    I := signHeaderPrefixList.IndexOfName('Accept');
    if I > -1 then
    signHeaderPrefixList.Delete(I);

    I := signHeaderPrefixList.IndexOfName(HTTP_HEADER_CONTENT_MD5);
    if I > -1 then
    signHeaderPrefixList.Delete(I);


    I := signHeaderPrefixList.IndexOfName(HTTP_HEADER_CONTENT_TYPE);
    if I > -1 then
      signHeaderPrefixList.Delete(I);

    I := signHeaderPrefixList.IndexOfName(HTTP_HEADER_DATE);
    if I > -1 then
      signHeaderPrefixList.Delete(I);

  end;


  Result := '';
  sSignHeaders := '';
  if (headers <> nil ) and (headers.Count > 0) then
  begin
    headers.Sort;
    for I := 0 to headers.Count - 1 do
    begin
      sKey := headers.Names[i];
      sValue := headers.Values[sKey];
      if IsHeaderToSign(sKey, signHeaderPrefixList) then
      begin
        Result := Result + sKey + SPE2;
        if sValue <> '' then
          Result := Result + sValue;
        Result := Result + LF;

        if Length(sSignHeaders) > 0 then
        begin
          sSignHeaders := sSignHeaders + SPE1;
        end;
        sSignHeaders := sSignHeaders + sKey;
      end;
    end;

    headers.Add(X_CA_SIGNATURE_HEADERS + '=' + sSignHeaders);
  end;

end;

//  Http頭是否參與簽名
function TAliYunSms.IsHeaderToSign(headerName: string; signHeaderPrefixList: TStringList): Boolean;
var
  I: Integer;
begin
  Result := False;
  if headerName = '' then Exit;

  if Pos(CA_HEADER_TO_SIGN_PREFIX_SYSTEM, headerName) > 0 then
  begin
    Result := True;
    Exit;
  end;

  if (signHeaderPrefixList <> nil) and (signHeaderPrefixList.Count > 0) then
  begin
    for I := 0 to signHeaderPrefixList.Count - 1 do
    begin
      Result := signHeaderPrefixList.IndexOfName(headerName) > -1;
    end;
  end;
end;


// 構建待簽名Path+Query+FormParams
function TAliYunSms.BuildResource(path: string; querys: TStringList): string;
var
  sKey, sValue: string;
  paramList: TStringList;
  I: Integer;
  sParams: string;
begin
  Result := '';
  if path <> '' then
    Result := Result + path;

  paramList := TStringList.Create;
  try
    //query參與簽名
    if (querys <> nil ) and (querys.Count > 0) then
    begin
      for I := 0 to querys.Count - 1 do
      begin
        sKey := querys.Names[I];
        sValue := querys.Values[sKey];
        if sKey <> '' then
        begin
          paramList.Add(sKey + '=' + sValue);
        end;
      end;
    end;
    paramList.Sort;

    //body參與簽名


    //參數Key
    for I := 0 to paramList.Count - 1 do
    begin
      sKey := querys.Names[I];

      if sKey <> '' then
      begin
        sValue := querys.Values[sKey];
        if Length(sParams) > 0 then
        begin
          sParams := sParams + SPE3;
        end;
        sParams := sParams + sKey;

        if sValue <> '' then
        begin
          sParams := sParams + SPE4 + sValue;
        end;
      end;
    end;

    if sParams <> '' then
    begin
      Result := Result + SPE5 + sParams;
    end;
    
  finally
    FreeAndNil(paramList);
  end;
end;



end.