unit uTWAuth;
interface
uses
System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer, IdHTTPServer,
IdComponent, ShellAPI;
type
TmyEvent = procedure(txt: string) of object;
type
TTTWAuth = class
FmyEvent: TmyEvent;
FURL: string;
private
FHTTPServer: TIdHTTPServer;
procedure HandleRequest(ASender: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
public
constructor Create;
destructor Destroy; override;
procedure StartServer(aURL: string);
procedure StopServer;
property OnToken: TmyEvent read FmyEvent write FmyEvent;
property OnError: TmyEvent read FmyEvent write FmyEvent;
end;
implementation
constructor TTTWAuth.Create;
begin
FHTTPServer := TIdHTTPServer.Create(nil);
FHTTPServer.OnCommandGet := HandleRequest;
FHTTPServer.OnStatus := OnStatus;
end;
destructor TTTWAuth.Destroy;
begin
FHTTPServer.Free;
inherited;
end;
procedure TTTWAuth.StartServer(aURL: string);
begin
FHTTPServer.DefaultPort := 80;
FHTTPServer.Bindings.Add.SetBinding('127.0.0.1', 80);
FURL := aURL;
FHTTPServer.Active := True;
if FURL <> '' then
ShellExecute(0, 'open', pwidechar(FURL), nil, nil, 1);
end;
procedure TTTWAuth.StopServer;
begin
FHTTPServer.Active := False;
end;
procedure TTTWAuth.HandleRequest(ASender: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
HandleRootRequest(ARequestInfo, AResponseInfo)
else if ARequestInfo.Document = '/redirect' then
HandleRedirectRequest(ARequestInfo, AResponseInfo)
else if ARequestInfo.Document = '/da' then
HandleDARequest(ARequestInfo, AResponseInfo)
else
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'Not Found';
end;
end;
procedure TTTWAuth.HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := '' + #13 + '' + #13 +
'' + #13 + ' Redirecting...' + #13 + '' + #13 +
'' + #13 + ' получаю токен:
' + #13 + '' + #13 + '' + #13 +
'';
end;
procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
end;
procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := '' + #13 + '' + #13 +
'' + #13 + ' Redirecting...' + #13 + '' + #13 +
'' + #13 + ' получаю код
' + #13 + '' + #13 + '' + #13
+ '';
end;
procedure TTTWAuth.HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
i: integer;
AccessToken: string;
begin
if Pos('access_token=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('access_token', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'access_token=', '',
[rfReplaceAll]);
AResponseInfo.ContentText := '' + #13 + '' + #13 +
'' + #13 + ' Done...' + #13 + '' + #13 +
'' + #13 + 'Эту страницу можно закрыть' + #13 + '' + #13 +
'';
AResponseInfo.WriteContent;
OnToken(AccessToken);
Destroy;
end;
if Pos('error_description=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('error_description', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'error_description=', '',
[rfReplaceAll]);
AResponseInfo.ContentText := '' + #13 + '' + #13 +
'' + #13 + ' ERROR...' + #13 + '' + #13 +
'' + #13 + AccessToken + #13 + '' + #13 +
'';
AResponseInfo.WriteContent;
OnError(AccessToken);
Destroy;
end;
if Pos('code=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('code', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'code=', '', [rfReplaceAll]);
AResponseInfo.ContentText := '' + #13 + '' + #13 +
'' + #13 + ' Done...' + #13 + '' + #13 +
'' + #13 + 'Эту страницу можно закрыть' + #13 + '' + #13 +
'';
AResponseInfo.WriteContent;
OnToken(AccessToken);
Destroy;
end;
end;
end.