RealICQClient/AppCom/UAppCentreCom.pas

unit UAppCentreCom;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, AppCentreCom_TLB, StdVcl, SysUtils, IdURI;

type
  TLXTAppCentreCom = class(TTypedComObject, ILXTAppCentreCom)
  private
    procedure OnRedirect(Sender: TObject; var dest: string;
      var NumRedirect: Integer; var Handled: boolean; var VMethod: string);
    function DecodeAdapter(AData, AKey: string): string;
  protected
    function RegisterInstallationDirectory(AAppKey, ADir: PChar): SYSINT; stdcall;
    function GetInstallationDirectory(AAppKey: PChar): PChar; stdcall;
    function Authenticate(AAuthURL, AAppSecret: PChar): PChar; stdcall;
//    function ILXTAppCentreCom_Authenticate(AAuthURL, AAppSecret: PChar): PChar;
//      stdcall;
    {Declare ILXTAppCentreCom methods here}
  end;

implementation

uses ComServ, Registry, IdHTTP, StrUtils, Forms, Dialogs, superobject, XXTEA;

type
  TAuthIdHTTP = class(TIdHTTP)
  private
    FAccessToken: string;
    FClientKey: string;
  public
    property AccessToken: string read FAccessToken write FAccessToken;
    property ClientKey: string read FClientKey write FClientKey;
  end;
  
const
  APPCENTRE_REGISTRY: string = 'SOFTWARE\Winsoft\AppCentre\Directory';

function TLXTAppCentreCom.RegisterInstallationDirectory(AAppKey,
  ADir: PChar): SYSINT;
var
  ARegistry: TRegistry;
begin
  Result := 0;
  ARegistry := TRegistry.Create;
  try
    ARegistry.RootKey := HKEY_LOCAL_MACHINE;
    if ARegistry.OpenKey(APPCENTRE_REGISTRY, True) then
    begin
      ARegistry.WriteString(string(AAppKey), string(ADir));
      Result := 1;
    end;
  finally
    ARegistry.CloseKey;
    ARegistry.Free;
  end;
end;

function TLXTAppCentreCom.GetInstallationDirectory(AAppKey: PChar): PChar;
var
  ARegistry: TRegistry;
begin
  Result := nil;
  ARegistry := TRegistry.Create;
  try
    ARegistry.RootKey := HKEY_LOCAL_MACHINE;
    if ARegistry.OpenKey(APPCENTRE_REGISTRY, True) and ARegistry.ValueExists(string(AAppKey))  then
    begin
      Result := PChar(ARegistry.ReadString(AAppKey));
    end;
  finally
    ARegistry.CloseKey;
    ARegistry.Free;
  end;
end;

function SplitString(const Source,Ch:string):TStringList;
var
  Temp: string;
  iLoop: Integer;
begin
  Result := TStringList.Create;
  Temp := Source;
  iLoop := Pos(Ch, Source);
  while iLoop <> 0 do
  begin
    Result.Add(copy(temp, 0, iLoop-1));
    Delete(temp, 1, iLoop);
    iLoop := Pos(Ch, Temp);
  end;
  Result.Add(temp);
end;

procedure TLXTAppCentreCom.OnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
const
  TOKEN: string = 'access_token=';
  CLIENT_KEY: string = 'clientkey=';
var
  AParamsStr: string;
  AParams: TStrings;
  iStart, iEnd, iCount, i: Integer;
begin
//  ShowMessage(dest);
  if NumRedirect = 3 then
  begin
    AParamsStr := dest;
//    ShowMessage(AParamsStr);
    AParams := SplitString(AParamsStr, '&');
    try
      for i := 0 to AParams.Count - 1 do
      begin
        iStart := Pos(TOKEN, AParams[i]);
        if iStart > 0 then
        begin
          Inc(iStart, Length(TOKEN));
          (Sender as TAuthIdHTTP).FAccessToken := Copy(AParams[i], iStart);
          Break;
        end;
      end;
      for i := 0 to AParams.Count - 1 do
      begin
        iStart := Pos(CLIENT_KEY, AParams[i]);
        if iStart > 0 then
        begin
          Inc(iStart, Length(CLIENT_KEY));
          (Sender as TAuthIdHTTP).FClientKey := Copy(AParams[i], iStart);
          Break;
        end;
      end;
    finally
      AParams.Free;
    end;
  end;
end;

function TLXTAppCentreCom.DecodeAdapter(AData, AKey: string): string;
const
  TICKET_TAG: string = 'ticket=';
  EXTEND_TAG: string = 'extend=';
  ID_TAG: string = 'id=';
var
  AResults: TStrings;
  AResultStr, ATicket, AExtend, AID: string;
  iStart, iEnd, iCount, i: Integer;
  jo: ISuperObject;
begin
  AResultStr := (DecryptNoHex(HexToStr(AData), AKey));
  if AResultStr = '' then
  begin
    ShowMessage('错误：解密失败.');
    Exit;
  end;
  
  AResults := SplitString(AResultStr, '&');
  try
    for i := 0 to AResults.Count - 1 do
    begin
      iStart := Pos(TICKET_TAG, AResults[i]);
      if iStart > 0 then
      begin
        Inc(iStart, Length(TICKET_TAG));
        ATicket := Copy(AResults[i], iStart);
        Break;
      end;
    end;
    for i := 0 to AResults.Count - 1 do
    begin
      iStart := Pos(EXTEND_TAG, AResults[i]);
      if iStart > 0 then
      begin
        Inc(iStart, Length(EXTEND_TAG));
        AExtend := Copy(AResults[i], iStart);
        Break;
      end;
    end;
    for i := 0 to AResults.Count - 1 do
    begin
      iStart := Pos(ID_TAG, AResults[i]);
      if iStart > 0 then
      begin
        Inc(iStart, Length(ID_TAG));
        AID := Copy(AResults[i], iStart);
        Break;
      end;
    end;

    if (AID = '') or (ATicket = '') then
    begin
      ShowMessage('错误：解密失败,找不到关键信息. \n\r信息：' + AResultStr);
      Exit;
    end;

    jo := SO('{}');
    jo.I['ticket'] := StrToInt64(ATicket);
    jo.S['id'] := AID;
    jo.S['extend'] := AExtend;
    Result := jo.AsJSon();
  finally
    AResults.Free;
  end;
end;
//
function TLXTAppCentreCom.Authenticate(AAuthURL, AAppSecret: PChar): PChar;
const
  GET_OPENKEY: string = 'http://%s:%s/api/oauth/me?access_token=%s';
var
  AIdHttp: TAuthIdHTTP;
  AURL, AToken, AClientKey,
  ASecret,
  AOpenKey: string;
  AHost: string;
  joStr: string;
  jo: ISuperObject;
  AIDURL: TIdURI;
begin
//  ShowMessage(AURL);
  AURL := string(AAuthURL);
  ASecret := string(AAppSecret);
//  ShowMessage(AURL);
  AIdHttp := TAuthIdHTTP.Create(nil);
  AIDURL := TIdURI.Create(AURL);
  try
    AIdHttp.RedirectMaximum := 5;
    AIdHttp.HandleRedirects := True;
    AIdHttp.OnRedirect := OnRedirect;
    try
      AIdHttp.Get(AURL);
    except

    end;

    if (Length(AIdHttp.FAccessToken) = 0) or (Length(AIdHttp.FAccessToken) <> 32) then
    begin
      ShowMessage('错误：没有获取到通行证或不是有效的通行证,可能是因为认证链接已经过期.');
      Exit;
    end;
    if (Length(AIdHttp.FClientKey) = 0) then
    begin
      ShowMessage('错误：您还没有绑定该应用的账号，请联系管理员绑定.');
      Exit;
    end;

    AClientKey := AIdHttp.FClientKey;
    AToken := AIdHttp.FAccessToken;
    AURL := Format(GET_OPENKEY, [AIDURL.Host, AIDURL.Port, AToken]);
    joStr := Utf8ToAnsi(AIdHttp.Get(AURL));
    if joStr = '' then
    begin
      ShowMessage('错误：不能获取OpenKey.');
      Exit;
    end;

    jo := SO(joStr);
    if jo = nil then             
    begin
      ShowMessage('错误：OpenKey格式错误.');
      Exit;
    end;

    AOpenKey := jo.S['openkey'];
    if AOpenKey = '' then
    begin
      ShowMessage('错误：OpenKey为null.');
      Exit;
    end;
    try
      Result := PChar(DecodeAdapter(AClientKey, (string(ASecret) + AOpenKey)));
//      ShowMessage(string(Result));
    except
      on Ex: Exception do
      begin
        ShowMessage('错误：解密异常,' + Ex.Message + '.');
        Result := nil;
      end;
    end;
  except
    on Ex: Exception do
    begin
      ShowMessage('错误：解密异常,' + Ex.Message + '.');

      AIdHttp.Free;
      AIDURL.Free;
    end;
  end;
  AIdHttp.Free;
  AIDURL.Free;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TLXTAppCentreCom, Class_LXTAppCentreCom,
    ciSingleInstance, tmApartment);
end.