unit CACase; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, IdHTTP, OleCtrls, SHDocVw, WebBrowserWithUI; type TCACaseFrm = class(TForm) btn1: TButton; btn2: TBitBtn; btn3: TBitBtn; btn4: TBitBtn; wbrwsrwth1: TWebBrowserWithUI; procedure btn1Click(Sender: TObject); procedure btn2Click(Sender: TObject); procedure btn3Click(Sender: TObject); procedure btn4Click(Sender: TObject); procedure FormCreate(Sender: TObject); private function Authenticate(AAuthURL, AAppSecret: PChar): PChar; procedure OnRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod); function DecodeClientKey(AOpenKey, AAppSecret, AClientKey: string): string; function DecodeAdapter(AData, AKey: string): string; { Private declarations } public { Public declarations } 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 CACaseFrm: TCACaseFrm; function Authenticate1(AAuthURL, AAppSecret: PChar): PChar; stdcall; external 'AppCentrelib.dll' Name 'Authenticate'; implementation uses CAImport, InterfaceCA, superobject, XXTEA, IdURI; const /// /// CA请求报文 /// REQUEST_STR: string = '' + '1.0' + 'OriginalService' + '' + '' + '%s' + ''; /// /// 认证服务报文 /// AUTH_REQUEST_STR: string = '' + '1.0' + 'AuthenService' + '' + '' + '' + '%s' + '' + '%s' + '' + '' + '%s' + '%s' + '' + '' + 'false' + ''; {$R *.dfm} procedure TCACaseFrm.btn1Click(Sender: TObject); begin GetCAClient.Request; end; procedure TCACaseFrm.btn2Click(Sender: TObject); begin Authenticate(PCHar('http://oa.wswin.cn:8989/home/jump?appid=0B6AC133A3E1FC7F5A3109F8A81E0825&clientuin=31E65FD25C1D4D99A193CE5005B7813C&clientkey=CEABF7A66560F75F84347B3C2FE68BDC7B8B258942993F49&redirect_uri=&toappid=A0E0F1308C2111DF92D995795A3BCD40'), PChar('B0F0E1308c2111EF92E995795A3DED42')); end; function StrToHex(Const str: Ansistring): Ansistring; asm push ebx push esi push edi test eax,eax jz @@Exit mov esi,edx //保存edx值，用来产生新字符串的地址 mov edi,eax //保存原字符串 mov edx,[eax-4] //获得字符串长度 test edx,edx //检查长度 je @@Exit {Length(S) = 0} mov ecx,edx //保存长度 Push ecx shl 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 @@SetHex: xor edx,edx //清空edx mov dl, [edi] //Str字符串字符 mov ebx,edx //保存当前的字符 shr edx,4 //右移4字节，得到高8位 mov dl,byte ptr[edx+@@HexChar] //转换成字符 mov [eax],dl //将字符串输入到新建串中存放 and ebx,$0F //获得低8位 mov dl,byte ptr[ebx+@@HexChar] //转换成字符 inc eax //移动一个字节,存放低位 mov [eax],dl inc edi inc eax loop @@SetHex @@Exit: pop edi pop esi pop ebx ret @@HexChar: db '0123456789ABCDEF' 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; procedure TCACaseFrm.btn3Click(Sender: TObject); var d, k, d1, k2: string; begin k := 'asdf'; d := '32324sdfas'; // d1 := Encrypt(d, k); // ShowMessage(d1); ShowMessage(DecryptNoHex(HexToStr( '48BE536245C22280C1F1899C9C28D0E7646F267CA61C4DFBAD0107A7FF33E22A83A5D2394F8FD405C26FF401'), 'B0F0E1308c2111EF92E995795A3DED427AE31A14DEB647059A31073F1D641752')); // ShowMessage(Decrypt(d1, k)); end; procedure TCACaseFrm.btn4Click(Sender: TObject); begin Authenticate1(PChar('hellow'), PChar(111)); 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 TCACaseFrm.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 := 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 TCACaseFrm.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 := (Decrypt(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('错误：解密失败,找不到关键信息.'); 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 TCACaseFrm.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; function TCACaseFrm.DecodeClientKey(AOpenKey, AAppSecret, AClientKey: string): string; begin end; procedure TCACaseFrm.FormCreate(Sender: TObject); begin wbrwsrwth1.Navigate(ExtractFilePath(paramstr(0)) + '111.html'); end; end.