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.