RealICQClient/Log/AppCentreCase.pas

unit AppCentreCase;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AppsLayout, AppBtn, InterfaceAppCentre, AppCentreImport,
  LoggerImport, pngimage, DataProviderImport, cefvcl, IdHTTP, superobject,
  IdURI;

type
  TAppCentreTestCase = class(TForm, IHotAppView)
    btnLogin: TButton;
    btnOpenAppCentre: TButton;
    btnLogout: TButton;
    btnIdHttp: TButton;
    dlgFind1: TFindDialog;
    btn1: TButton;
    dlgOpen1: TOpenDialog;
    btn2: TButton;
    edt1: TEdit;
    btnCanlian: TButton;
    edt2: TEdit;
    lbl1: TLabel;
    Label1: TLabel;
    btn3: TButton;
    procedure btnLoginClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnOpenAppCentreClick(Sender: TObject);
    procedure btnLogoutClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnIdHttpClick(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btnCanlianClick(Sender: TObject);
    procedure btn3Click(Sender: TObject);
  private
    FAppsLayout: TAppsLayout;
    FDotPic: TGraphic;

    function CreateAppBtn(AHotApp: IHotApp): TAppBtn;
    procedure DestroyHotApps;
    procedure InitHttpHeader(AIdHttp: TIdHTTP);
    procedure SSO(Sender: TObject);
    function Authenticate(AAuthURL, AAppSecret: PChar): PChar;
    function DecodeAdapter(AData, AKey: string): string;
    procedure OnRedirect(Sender: TObject; var dest: string;
      var NumRedirect: Integer; var Handled: boolean;
      var VMethod: TIdHTTPMethod);
    function GetDefaultBrowser: string;

  public
    function AddHotApp(AHotApp: IHotApp): Boolean; stdcall;
    function RemoveHotApp(AHotApp: IHotApp): Boolean; stdcall;
    procedure OnASyncAppIconDownloaded(AAppKey: AnsiString; const ABuffer; const ACount: Integer); stdcall;
    procedure InitHotApps;
  end;

  TAuthIdHTTP = class(TIdHTTP)
  private
    FAccessToken: string;
    FClientKey: string;
  public
    property AccessToken: string read FAccessToken write FAccessToken;
    property ClientKey: string read FClientKey write FClientKey;
  end;

var
  AppCentreTestCase: TAppCentreTestCase;

implementation

uses
  StrUtils, XXTEA, System.Win.Registry, Winapi.ShellAPI;

{$R *.dfm}

function TAppCentreTestCase.AddHotApp(AHotApp: IHotApp): Boolean;
var
  AAppBtn: TAppBtn;
begin
  AAppBtn := CreateAppBtn(AHotApp);
  FAppsLayout.AddAppBtn(AAppBtn);
  FAppsLayout.Layout;
end;

procedure TAppCentreTestCase.InitHttpHeader(AIdHttp: TIdHTTP);
var
  openIDEx: string;
begin
//  openIDEx := 'Basic '+ EncodeString('12312');
//  AIdHttp.Request.Accept := '';
//  AIdHttp.Request.CustomHeaders.Values['Authorization'] := openIDEx;
//  AIdHttp.Request.CustomHeaders.Values['Content-Type']  := 'application/x-www-form-urlencoded';
end;

procedure TAppCentreTestCase.btn1Click(Sender: TObject);
begin
  if dlgOpen1.Execute(Handle) then
  begin
    ShowMessage(dlgOpen1.FileName);

  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 TAppCentreTestCase.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
  if NumRedirect = 3 then
  begin
    AParamsStr := dest;
    AParams := AppCentreCase.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 HexToStr(const Str: AnsiString): AnsiString;
asm
  push ebx
  push edi
  push esi
  test eax,eax //为空串
  jz   @@Exit
  mov  edi,eax
  mov  esi,edx
  mov  edx,[eax-4]
  test edx,edx
  je   @@Exit
  mov  ecx,edx
  push ecx
  shr  edx,1
  mov  eax,esi //开始构造字符串
  {$IFDEF VER210}
  movzx ecx, word ptr [edi-12] {需要设置CodePage}
  {$ENDIF}
  call System.@LStrSetLength //设置新串长度
  mov  eax,esi       //新字符串地址
  Call UniqueString  //产生一个唯一的新字符串，串位置在eax中
  Pop   ecx
  xor  ebx,ebx
  xor  esi,esi
@@CharFromHex:
  xor  edx,edx
  mov  dl, [edi]     //Str字符串字符
  cmp  dl, '0'  //查看是否在0到f之间的字符
  JB   @@Exit   //小于0，退出
  cmp  dl,'9'   //小于=9
  ja  @@DoChar//CompOkNum
  sub  dl,'0'
  jmp  @@DoConvert
@@DoChar:
  //先转成大写字符
  and  dl,$DF
  cmp  dl,'F'
  ja   @@Exit  //大于F退出
  add  dl,10
  sub  dl,'A'
@@DoConvert: //转化
  inc  ebx
  cmp  ebx,2
  je   @@Num1
  xor  esi,esi
  shl  edx,4
  mov  esi,edx
  jmp  @@Num2
@@Num1:
  add  esi,edx
  mov  edx,esi
  mov  [eax],dl
  xor  ebx,ebx
  inc  eax
@@Num2:
  dec  ecx
  inc  edi
  test ecx,ecx
  jnz  @@CharFromHex
@@Exit:
  pop  esi
  pop  edi
  pop  ebx
end;

function TAppCentreTestCase.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));
  AResultStr := UTF8Encode(AResultStr);
  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('错误：解密失败,找不到关键信息.');
      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 TAppCentreTestCase.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
  AURL := string(AAuthURL);
  ASecret := string(AAppSecret);

  AIdHttp := TAuthIdHTTP.Create(nil);
  AIDURL := TIdURI.Create(AURL);
  try
    AIdHttp.RedirectMaximum := 5;
    AIdHttp.HandleRedirects := True;
    AIdHttp.OnRedirect := OnRedirect;
    AIdHttp.Get(AURL);

    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)));
    except
      on Ex: Exception do
      begin
        ShowMessage('错误：解密异常,' + Ex.Message + '.');
        Result := nil;
      end;
    end;
  finally
    AIdHttp.Free;
    AIDURL.Free;
  end;
end;

procedure TAppCentreTestCase.btnIdHttpClick(Sender: TObject);
var
  AIdHttp:TIdHTTP;
  ResponeStr: String;
begin
  AIdHttp   := TIdHTTP.Create(nil);
  InitHttpHeader(AIdHttp);
  try
    ResponeStr:=AIdHttp.Get('http://www.baidu.com');
    ResponeStr := UTF8Decode(ResponeStr);
//    FHotApps :=  ProcessHotAppJsonStr(ResponeStr);
//    Result := FHotApps;
  except
    on E: Exception do
    begin
//      FHotApps := nil;
//      Result := nil;
      Freeandnil(AIdHttp);
    end;
  end;
  Freeandnil(AIdHttp);
end;

procedure TAppCentreTestCase.btnLoginClick(Sender: TObject);
begin
  GetDataModule.Install('lqq', ExtractFilePath(ParamStr(0)) + 'Users\Data\');
  GetAppCentre.Login('lqq', Self);
  InitHotApps;
end;

procedure TAppCentreTestCase.btnLogoutClick(Sender: TObject);
begin
  DestroyHotApps;
  GetAppCentre.Logout;
  GetDataModule.Uninstall;
end;

procedure TAppCentreTestCase.btnOpenAppCentreClick(Sender: TObject);
begin
  GetAppCentre.OpenAppCentreFrom;
  GetAppCentre.OpenWebDebuggerTool;
end;

function TAppCentreTestCase.CreateAppBtn(AHotApp: IHotApp): TAppBtn;
var
  AStream: TMemoryStream;
  pngObj: TPNGObject;
  ABuffer: TBytes;
begin
  Result := TAppBtn.Create(Self);
  with Result do
  begin
    Parent := Self;
    BtnStyle := absSmall;
    AppModel := AHotApp;
    DotPicture.Assign(FDotPic);
    Caption := (AHotApp.GetUserApp.GetTitle);
    ShowHint := True;
  end;
  Result.OnClick := SSO;
  DataProviderImport.GetAppIconProvider.FindIcon(AHotApp.GetUserApp.GetAppKey, ABuffer);
  if Length(ABuffer) = 0 then
    Result.AppIcon.LoadFromFile('Images\DefaultApp.png')
  else
  begin
    Debug('获取到ICON'+AHotApp.GetUserApp.GetAppKey, 'TMainFrmFooter.CreateAppBtn');
    AStream := TMemoryStream.Create;
    AStream.Write(ABuffer[0], Length(ABuffer));
    pngObj := TPNGObject.Create;
    AStream.Position := 0;
    pngObj.LoadFromStream(AStream);
    Result.AppIcon.Assign(pngObj);
    FreeAndNil(pngObj);
    FreeAndNil(AStream);
  end;
end;

procedure TAppCentreTestCase.FormCreate(Sender: TObject);
begin
  FAppsLayout := TAppsLayout.Create;
  FAppsLayout.Col := 8;
  FAppsLayout.Row := 1;
  FAppsLayout.ClientRect := Rect(30, 2, 238, 32);
  FDotPic := TPNGObject.Create;
  FDotPic.LoadFromFile('Images\Dot.png');
end;

procedure TAppCentreTestCase.FormDestroy(Sender: TObject);
var
  AAppBtn: TAppBtn;
begin
  FreeAndNil(FAppsLayout);
  FreeAndNil(FDotPic);
end;

procedure TAppCentreTestCase.InitHotApps;
var
  AAppBtn: TAppBtn;
  AList: IInterfaceList;
  iLoop: Integer;
begin
  AList := GetAppCentre.GetHotApps;
  if AList = nil then
    Exit;
  for iLoop := 0 to AList.Count - 1 do
  begin
    AAppBtn := CreateAppBtn((AList[iLoop] as IHotApp));
    FAppsLayout.AddAppBtn(AAppBtn);
  end;
  FAppsLayout.Layout;
end;

procedure TAppCentreTestCase.DestroyHotApps;
var
  AAppBtn: TAppBtn;
  AList: TStringList;
  iLoop: Integer;
begin
  AList := FAppsLayout.Apps;
  if AList = nil then
    Exit;
  while AList.Count > 0 do
  begin
    AAppBtn := AList.Objects[0] as TAppBtn;
    AList.Delete(0);
    FreeAndNil(AAppBtn);
  end;
  FAppsLayout.Layout;
end;

procedure TAppCentreTestCase.OnASyncAppIconDownloaded(AAppKey: AnsiString;
  const ABuffer; const ACount: Integer);
var
  iLoop: Integer;
  AAppBtn: TAppBtn;
  AHotApp: IHotApp;
  pngObj: TPNGObject;
  AStream: TStream;
begin
  for iLoop := 0 to FAppsLayout.Apps.Count - 1 do
  begin
    AAppBtn := FAppsLayout.Apps.Objects[iLoop] as TAppBtn;
    AHotApp := AAppBtn.AppModel as IHotApp;
    if SameText(AHotApp.GetUserApp.GetAppKey, AAppKey) then
    begin
      AStream := TMemoryStream.Create;
      try
        pngObj := TPNGObject.Create;
        AStream.Position := 0;
        AStream.Write(TBytes(ABuffer)[0], ACount);
        AStream.Position := 0;
        pngObj.LoadFromStream(AStream);
        AAppBtn.AppIcon.Assign(pngObj);
        AAppBtn.Invalidate;
        FreeAndNil(pngObj);
      finally
        AStream.Free;
      end;
      Exit;
    end;
  end;
end;

function TAppCentreTestCase.RemoveHotApp(AHotApp: IHotApp): Boolean;
var
  iLoop: Integer;
  AAppBtn: TAppBtn;
  AOldHotApp: IHotApp;
begin
  for iLoop := 0 to FAppsLayout.Apps.Count - 1 do
  begin
    AAppBtn := FAppsLayout.Apps.Objects[iLoop] as TAppBtn;
    AOldHotApp := AAppBtn.AppModel as IHotApp;
    if SameText(AOldHotApp.GetUserApp.GetAppKey, AHotApp.GetUserApp.GetAppKey) then
    begin
      FAppsLayout.RemoveAppBtn(AAppBtn);
      FreeAndNil(AAppBtn);
      Exit;
    end;
  end; 
end;

procedure TAppCentreTestCase.SSO(Sender: TObject);
var
  AHotApp: IHotApp;
begin
  if (Sender = nil) or not (Sender is TAppBtn) then
    Exit;

  AHotApp := (Sender as TAppBtn).AppModel as IHotApp;
  GetAppCentre.SSO(AHotApp.GetUserApp.GetAppKey);
end;

procedure TAppCentreTestCase.btn2Click(Sender: TObject);
begin
//  Authenticate(PChar(edt1.Text), PChar('B0F0E1308C2111EF92E995795A3DED42'))
  ShowMessage(DecryptNoHex(HexToStr(
  '48BE536245C22280C1F1899C9C28D0E7646F267CA61C4DFBAD0107A7FF33E22A83A5D2394F8FD405C26FF401'),
  'B0F0E1308c2111EF92E995795A3DED427AE31A14DEB647059A31073F1D641752'));
end;

procedure TAppCentreTestCase.btn3Click(Sender: TObject);
var
  AHandle: Cardinal;
  ShExecInfo: SHELLEXECUTEINFO;
  ADir: PAnsiChar;
  ADlgOpen: TOpenDialog;
  ADirStr: string;
begin
  ShExecInfo.cbSize := SizeOf(SHELLEXECUTEINFO);
  ShExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
  ShExecInfo.Wnd := 0;
  ShExecInfo.lpVerb := nil;
  ShExecInfo.lpFile := PChar(GetDefaultBrowser);
  ShExecInfo.lpParameters := PChar('http://www.baidu.com');
//  ShExecInfo.lpDirectory := PChar(ExtractFilePath(string(ADir)));
  ShExecInfo.nShow := SW_SHOW;
  ShExecInfo.hInstApp := 0;
  ShellExecuteEx(@ShExecInfo);
end;

function TAppCentreTestCase.GetDefaultBrowser: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    reg.OpenKey('http\\shell\\open\\command',false);
    result:=reg.ReadString('');
    result:=Copy(result,Pos('"',result)+1,Length(result)-1);
    result:=Copy(result,1,Pos('"',result)-1);
    reg.CloseKey;
  finally
    if (result='') then result:='IEXPLORE.EXE';
    reg.Free;
  end;
end;

procedure TAppCentreTestCase.btnCanlianClick(Sender: TObject);
begin
  if GetAppCentre.AuthFromCanlian(edt1.Text, edt2.Text) then
    ShowMessage('login sucessfully!')
  else
    ShowMessage('Password error!');
end;

end.