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.