delphi 使用oauth的控件
unit OAuth;
interface
uses
Classes, SysUtils, IdURI, Windows;
type
EOAuthException = class(Exception);
TOAuthConsumer = class;
TOAuthToken = class;
TOAuthRequest = class;
TOAuthSignatureMethod = class;
TOAuthSignatureMethod_HMAC_SHA1 = class;
TOAuthSignatureMethod_PLAINTEXT = class;
TOAuthConsumer = class
private
FKey: string;
FSecret: string;
FCallback_URL: string;
procedure SetKey(const Value: string);
procedure SetSecret(const Value: string);
procedure SetCallback_URL(const Value: string);
public
constructor Create(Key, Secret: string); overload;
constructor Create(Key, Secret: string; Callback_URL: string); overload;
property Key: string read FKey write SetKey;
property Secret: string read FSecret write SetSecret;
property Callback_URL: string read Fcallback_URL write SetCallback_URL;
end;
TOAuthToken = class
private
FKey: string;
FSecret: string;
procedure SetKey(const Value: string);
procedure SetSecret(const Value: string);
public
constructor Create(Key, Secret: string);
function AsString: string; virtual;
property Key: string read FKey write SetKey;
property Secret: string read FSecret write SetSecret;
end;
TOAuthRequest = class
private
FParameters: TStringList;
FHTTPURL: string;
FScheme: string;
FHost: string;
FPath: string;
FFields: string;
FVersion: string;
FBaseString: string;
FGetString: string;
procedure SetHTTPURL(const Value: string);
procedure SetBaseString(const Value: string);
procedure SetVersion(const Value: string);
function GenerateNonce: string;
function GenerateTimeStamp: string;
function GetSignableParameters: string;
public
constructor Create(HTTPURL: string);
function FromConsumerAndToken(Consumer: TOAuthConsumer; Token: TOAuthToken;
HTTPURL: string): TOAuthRequest;
procedure Sign_Request(Signature_Method: TOAuthSignatureMethod; Consumer: TOAuthConsumer;
Token: TOAuthToken);
function Build_Signature(Signature_Method: TOAuthSignatureMethod; Consumer: TOAuthConsumer;
Token: TOAuthToken): string;
property BaseString: string read FBaseString write SetBaseString;
property Version: string read FVersion write SetVersion;
property Parameters: TStringList read FParameters;
property HTTPURL: string read FHTTPURL write SetHTTPURL;
property Scheme: string read FScheme;
property Host: string read FHost;
property Path: string read FPath;
property Fields: string read FFields;
property GetString: string read FGetString;
end;
TOAuthSignatureMethod = class
public
function check_signature(Request: TOAuthRequest; Consumer: TOAuthConsumer;
Token: TOAuthToken; Signature: string): boolean;
function get_name(): string; virtual; abstract;
function build_signature(Request: TOAuthRequest; Consumer: TOAuthConsumer;
Token: TOAuthToken): string; virtual; abstract;
end;
TOAuthSignatureMethod_HMAC_SHA1 = class(TOAuthSignatureMethod)
public
function get_name(): string; override;
function build_signature(Request: TOAuthRequest; Consumer: TOAuthConsumer;
Token: TOAuthToken): string; override;
end;
TOAuthSignatureMethod_PLAINTEXT = class(TOAuthSignatureMethod)
public
function get_name(): string; override;
function build_signature(Request: TOAuthRequest; Consumer: TOAuthConsumer;
Token: TOAuthToken): string; override;
end;
TOAuthUtil = class
public
class function urlEncodeRFC3986(URL: string):string;
class function urlDecodeRFC3986(URL: string):string;
end;
const
UnixStartDate : TDateTime = ;
implementation
uses
IdGlobal, IdHash, IdHashMessageDigest, IdHMACSHA1, IdCoderMIME;
function DateTimeToUnix(ConvDate: TDateTime): Longint;
var
x: double;
lTimeZone: TTimeZoneInformation;
begin
GetTimeZoneInformation(lTimeZone);
ConvDate := ConvDate + (lTimeZone.Bias / );
x := (ConvDate - UnixStartDate) * ;
Result := Trunc(x);
end;
function _IntToHex(Value: Integer; Digits: Integer): String;
begin
Result := SysUtils.IntToHex(Value, Digits);
end;
function XDigit(Ch : Char) : Integer;
begin
if (Ch >= '') and (Ch <= '') then
Result := Ord(Ch) - Ord('')
else
Result := (Ord(Ch) and ) + ;
end;
function IsXDigit(Ch : Char) : Boolean;
begin
Result := ((Ch >= '') and (Ch <= '')) or
((Ch >= 'a') and (Ch <= 'f')) or
((Ch >= 'A') and (Ch <= 'F'));
end;
function htoin(Value : PChar; Len : Integer) : Integer;
var
I : Integer;
begin
Result := ;
I := ;
while (I < Len) and (Value[I] = ' ') do
I := I + ;
while (I < len) and (IsXDigit(Value[I])) do begin
Result := Result * + XDigit(Value[I]);
I := I + ;
end;
end;
function htoi2(Value : PChar) : Integer;
begin
Result := htoin(Value, );
end;
function UrlEncode(const S : String) : String;
var
I : Integer;
Ch : Char;
begin
Result := '';
for I := to Length(S) do begin
Ch := S[I];
if ((Ch >= '') and (Ch <= '')) or
((Ch >= 'a') and (Ch <= 'z')) or
((Ch >= 'A') and (Ch <= 'Z')) or
(Ch = '.') or (Ch = '-') or (Ch = '_') or (Ch = '~')then
Result := Result + Ch
else
Result := Result + '%' + _IntToHex(Ord(Ch), );
end;
end;
function UrlDecode(const Url : String) : String;
var
I, J, K, L : Integer;
begin
Result := Url;
L := Length(Result);
I := ;
K := ;
while TRUE do begin
J := I;
while (J <= Length(Result)) and (Result[J] <> '%') do begin
if J <> K then
Result[K] := Result[J];
Inc(J);
Inc(K);
end;
if J > Length(Result) then
break; { End of string }
if J > (Length(Result) - ) then begin
while J <= Length(Result) do begin
Result[K] := Result[J];
Inc(J);
Inc(K);
end;
break;
end;
Result[K] := Char(htoi2(@Result[J + ]));
Inc(K);
I := J + ;
Dec(L, );
end;
SetLength(Result, L);
end;
{ TOAuthConsumer }
constructor TOAuthConsumer.Create(Key, Secret: string);
begin
FKey := Key;
FSecret := Secret;
FCallBack_URL := '';
end;
constructor TOAuthConsumer.Create(Key, Secret, Callback_URL: string);
begin
FKey := Key;
FSecret := Secret;
FCallBack_URL := Callback_URL;
end;
procedure TOAuthConsumer.SetCallback_URL(const Value: string);
begin
FCallback_URL := Value;
end;
procedure TOAuthConsumer.SetKey(const Value: string);
begin
FKey := Value;
end;
procedure TOAuthConsumer.SetSecret(const Value: string);
begin
FSecret := Value;
end;
{ TOAuthToken }
function TOAuthToken.AsString: string;
begin
result := 'oauth_token=' + Self.Key + '&oauth_token_secret=' + Self.Secret;
end;
constructor TOAuthToken.Create(Key, Secret: string);
begin
FKey := Key;
FSecret := Secret;
end;
procedure TOAuthToken.SetKey(const Value: string);
begin
FKey := Value;
end;
procedure TOAuthToken.SetSecret(const Value: string);
begin
FSecret := Value;
end;
{ TOAuthRequest }
function TOAuthRequest.Build_Signature(Signature_Method: TOAuthSignatureMethod;
Consumer: TOAuthConsumer; Token: TOAuthToken): string;
begin
Result := Signature_Method.build_signature(Self, Consumer, Token);
end;
constructor TOAuthRequest.Create(HTTPURL: string);
var
x,y: integer;
begin
FHTTPURL := HTTPURL;
FScheme := Copy(FHTTPURL, , );
x := AnsiPos('.com', FHTTPURL);
y := AnsiPos('?', FHTTPURL);
FHost := Copy(FHTTPURL, , x-);
FPath := Copy(FHTTPURL, x + , Length(HTTPURL) - y - );
if y > then
FFields := Copy(FHTTPURL, y + , Length(HTTPURL));
FVersion := '1.0';
FParameters := TStringList.Create;
end;
function TOAuthRequest.FromConsumerAndToken(Consumer: TOAuthConsumer;
Token: TOAuthToken; HTTPURL: string): TOAuthRequest;
begin
Self.FParameters.Clear;
Self.FParameters.Add('oauth_consumer_key=' + Consumer.Key);
Self.FParameters.Add('oauth_nonce=' + Self.GenerateNonce);
Self.FParameters.Add('oauth_timestamp=' + Self.GenerateTimeStamp);
if Token <> nil then
FParameters.Add('oauth_token=' + Token.Key);
Self.FParameters.Add('oauth_version=' + Self.Version);
Result := Self;
end;
function TOAuthRequest.GenerateNonce: string;
var
md5: TIdHashMessageDigest;
begin
md5 := TIdHashMessageDigest5.Create;
Result := md5.HashStringAsHex(GenerateTimeStamp);
md5.Free;
end;
function TOAuthRequest.GenerateTimeStamp: string;
begin
Result := IntToStr(DateTimeToUnix(Now));
end;
function TOAuthRequest.GetSignableParameters: string;
var
x: integer;
parm: string;
begin
parm := '';
x := FParameters.IndexOfName('oauth_signature');
if x <> - then
FParameters.Delete(x);
for x := to FParameters.Count - do
begin
if x = then
begin
FParameters.ValueFromIndex[x] := TOAuthUtil.urlEncodeRFC3986(FParameters.ValueFromIndex[x]);
parm := FParameters.Names[x] + TOAuthUtil.urlEncodeRFC3986('=') + TIdURI.PathEncode(FParameters.ValueFromIndex[x]);
end
else
parm := parm + TOAuthUtil.urlEncodeRFC3986('&') +
FParameters.Names[x] + TOAuthUtil.urlEncodeRFC3986('=' + FParameters.ValueFromIndex[x])
end;
Result := parm;
end;
procedure TOAuthRequest.SetBaseString(const Value: string);
begin
FBaseString := Value;
end;
procedure TOAuthRequest.SetHTTPURL(const Value: string);
var
x,y: integer;
begin
FHTTPURL := Value;
FScheme := Copy(FHTTPURL, , );
x := AnsiPos('.com', FHTTPURL);
y := AnsiPos('?', FHTTPURL);
FHost := Copy(FHTTPURL, , x-);
if y > then
FPath := Copy(FHTTPURL, x + , y - (x + ))
else
FPath := Copy(FHTTPURL, x + , Length(HTTPURL) - y - );
if y > then
FFields := Copy(FHTTPURL, y + , Length(HTTPURL));
end;
procedure TOAuthRequest.SetVersion(const Value: string);
begin
FVersion := Value;
end;
procedure TOAuthRequest.Sign_Request(Signature_Method: TOAuthSignatureMethod;
Consumer: TOAuthConsumer; Token: TOAuthToken);
var
signature: string;
x: integer;
begin
FParameters.Insert( ,'oauth_signature_method=' + Signature_Method.get_name);
//FParameters.Sort;
signature := Self.Build_Signature(Signature_Method, Consumer, Token);
signature := TOAuthUtil.urlEncodeRFC3986(signature);
FParameters.Insert(, 'oauth_signature=' + signature);
for x := to FParameters.Count - do
begin
if x = then
FGetString := FParameters.Names[X] + '=' + FParameters.ValueFromIndex[x]
else
FGetString := FGetString + '&' + FParameters.Names[X] + '=' + FParameters.ValueFromIndex[x];
end;
end;
{ TOAuthUtil }
class function TOAuthUtil.urlDecodeRFC3986(URL: string): string;
begin
result := TIdURI.URLDecode(URL);
end;
class function TOAuthUtil.urlEncodeRFC3986(URL: string): string;
var
URL1: string;
begin
URL1 := URLEncode(URL);
URL1 := StringReplace(URL1, '+', ' ', [rfReplaceAll, rfIgnoreCase]);
result := URL1;
end;
{ TOAuthSignatureMethod }
function TOAuthSignatureMethod.check_signature(Request:TOAuthRequest;
Consumer: TOAuthConsumer; Token: TOAuthToken; Signature: string): boolean;
var
newsig: string;
begin
newsig:= Self.build_signature(Request, Consumer, Token);
if (newsig = Signature) then
Result := True
else
Result := False;
end;
{ TOAuthSignatureMethod_HMAC_SHA1 }
function TOAuthSignatureMethod_HMAC_SHA1.build_signature(Request: TOAuthRequest;
Consumer: TOAuthConsumer; Token: TOAuthToken): string;
function Base64Encode(const Input: TIdBytes): string;
begin
Result := TIdEncoderMIME.EncodeBytes(Input);
end;
function EncryptHMACSha1(Input, AKey: string): TIdBytes;
begin
with TIdHMACSHA1.Create do
try
Key := ToBytes(AKey);
Result := HashValue(ToBytes(Input));
finally
Free;
end;
end;
var
parm1, parm: string;
consec, toksec: string;
begin
parm1 := Request.GetSignableParameters;
parm := TOAuthUtil.urlEncodeRFC3986(Request.Scheme) +
TOAuthUtil.urlEncodeRFC3986(Request.Host) +
TOAuthUtil.urlEncodeRFC3986(Request.Path);
if Request.Fields <> '' then
begin
parm := parm + '&' + TOAuthUtil.urlEncodeRFC3986(Request.Fields);
parm := parm + TOAuthUtil.urlEncodeRFC3986('&') + parm1;
end
else
parm := parm + '&' + parm1;
Request.BaseString := 'GET&' + parm;
if Token <> nil then
begin
consec := TOAuthUtil.urlEncodeRFC3986(Consumer.Secret);
toksec := TOAuthUtil.urlEncodeRFC3986(Token.Secret);
consec := consec + '&' + toksec;
Result := Base64Encode(EncryptHMACSha1(Request.BaseString, consec))
end
else
begin
consec := TOAuthUtil.urlEncodeRFC3986(Consumer.Secret);
consec := consec + '&';
Result := Base64Encode(EncryptHMACSha1(Request.BaseString, consec));
end;
end;
function TOAuthSignatureMethod_HMAC_SHA1.get_name: string;
begin
result := 'HMAC-SHA1';
end;
{ TOAuthSignatureMethod_PLAINTEXT }
function TOAuthSignatureMethod_PLAINTEXT.build_signature(Request: TOAuthRequest;
Consumer: TOAuthConsumer; Token: TOAuthToken): string;
begin
if Token <> nil then
Result := TOAuthUtil.urlEncodeRFC3986((Consumer.Secret + '&' + Token.Secret))
else
Result := TOAuthUtil.urlEncodeRFC3986((Consumer.Secret));
end;
function TOAuthSignatureMethod_PLAINTEXT.get_name: string;
begin
Result := 'PLAINTEXT';
end;
end.
delphi 使用oauth的控件的更多相关文章
- JS调用Delphi编写的OCX控件
原文:http://www.mamicode.com/info-detail-471283.html 一.使用Delphi XE2编写OCX控件 生成OCX工程: 1.File-New-Other,在 ...
- Delphi中使用TXMLDocument控件应注意的问题 转
Delphi中使用TXMLDocument控件应注意的问题 delphiconstructorxmlclass今天写了一个类,其中用到了TXMLDocument控件.这个控件我是要动态生成的. 但是却 ...
- Delphi中的DBGrid控件
在Delphi中,DBGrid控件是一个开发数据库软件不能不使用的控件,其功能非常强大,可以配合SQL语句实现几乎所有数据报表的显示,操作也非常简单,属性.过程.事件等都非常直观,但是使用中,有时侯还 ...
- Delphi中,indy控件实现收发邮件的几点学习记录( 可以考虑加入多线程,用多个邮箱做一个邮箱群发器) 转
关于用Delphi中的Indy控件实现收发邮件的几点学习记录 这几天心里颇不宁静,不是因为项目延期,而是因为自己几个月前做的邮件发送程序至今无任何进展,虽然一向谦虚的人在网上发 ...
- 获取Delphi焦点所在的控件及通过控件名称访问控件
方法一: Var I: Integer; Begin For I := To ComponentCount - Do //获取组件数量 Begin If Components[I] Is TWinCo ...
- delphi安装 Tclientsocket, Tserversocket控件
菜单component->Install Packets按Add按钮,选择delphi目录里的bin目录下的dclsockets70.bpl(delphi2010是 dclsockets140. ...
- Delphi 7学习开发控件
我们知道使用Delphi快速开发,很大的一方面就是其强大的VCL控件,另外丰富的第三方控件也使得Delphi程序员更加快速的开发出所需要的程序.在此不特别介绍一些概念,只记录自己学习开发控件的步骤.假 ...
- Delphi对象变成Windows控件的前世今生(关键是设置句柄和回调函数)goodx
----------------------------------------------------------------------第一步,准备工作:预定义一个全局Win控件变量,以及一个精简 ...
- Delphi中代替WebBrowser控件的第三方控件
这几天,接触到在delphi中内嵌网页,用delphi7自带的TWebBrowser控件,显示的内容与本机IE8显示的不一样,但是跟装IE8之前的IE6显示一个效果.现在赶脚是下面两个原因中的一个: ...
随机推荐
- java script btoa与atob的
javascript原生的api本来就支持,Base64,但是由于之前的javascript局限性,导致Base64基本中看不中用.当前html5标准正式化之际,Base64将有较大的转型空间,对于H ...
- ORACLE 对一个表进行循环查数,再根据MO供给数量写入另一个新表
一. 加工处理后要变成如下效果 create table test1 (sonum varchar2(10),lineid varchar2(10),qty int ,qty2 int ,remark ...
- [poj1269]Intersecting Lines
题目大意:求两条直线的交点坐标. 解题关键:叉积的运用. 证明: 直线的一般方程为$F(x) = ax + by + c = 0$.既然我们已经知道直线的两个点,假设为$(x_0,y_0), (x_1 ...
- raptor
raptor - 必应词典 美['ræptər]英['ræptə(r)] n.猛禽:攫禽 网络迅猛龙:雷电威龙:决战侏罗纪
- ECMAScript6新特性之Array API
一 填充数组 var arr = new Array(5); arr.fill('abc',2,4); console.log('Array.prototype.fill',arr); // [und ...
- 中文路径读取乱码,json乱码
strPath = 'E:\新建文件夹' #含有中文的路径,使用unicode函数转换. strPath = unicode(strPath , "utf8") 参考:http:/ ...
- JavaScript对象继续总结
1.字符串对象 18_1.查看字符串的长度 var a = "hello world" alert(a.length) 18_2.遍历整个字符串的,这里的是索引 for (var ...
- 27-x的y次方的后三位数
题目内容: 输入描述 数据分n组,对于每组数据有两个正整数x和y(x的y次方必须大于100) 输出描述 对于每组输出,输出一个值,即x的y次方结果的最后三位数 提示:13的13次方为:30287510 ...
- mockito使用
mockito学习资料: http://docs.mockito.googlecode.com/hg/org/mockito/Mockito.html http://blog.csdn.net/sdy ...
- struts框架问题六之从值栈中获取值
6. 问题六: 在JSP中获取值栈的数据 * 总结几个小问题: > 访问root中数据 不需要# > 访问context其它对象数据 加 # > 如果向root中存入对象的话,优先使 ...