lqq
/
RealICQClient


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438
							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
  /// <remarks>
  ///   CA请求报文
  /// </remarks>
  REQUEST_STR: string =
  '<head>' +
    '<version>1.0</version>' +
    '<servicetype>OriginalService</servicetype>' +
  '</head>' +
  '<body>' +
    '<appid>%s</appid>' +
  '</body>';

  /// <remarks>
  ///  认证服务报文
  /// </remarks>
  AUTH_REQUEST_STR: string =
  '<head>' +
    '<version>1.0</version>' +
    '<servicetype>AuthenService</servicetype>' +
  '</head>' +
  '<body>' +
      '<clientInfo>' +
        '<clientIP>%s</clientIP>' +
    '</clientInfo>' +
    '<appId>%s</appId>' +
    '<authen>' +
      '<authCredential authMode="cert">' +
        '<detach>%s</detach>' +
        '<original>%s</original>' +
      '</authCredential>' +
    '</authen>' +
    '<accessControl>false</accessControl>' +
  '</body>';

{$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.