290 lines
8.1 KiB
Plaintext
290 lines
8.1 KiB
Plaintext
unit uTWAuth;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer, IdHTTPServer,
|
|
IdComponent, winapi.ShellAPI, System.Threading, winapi.Windows;
|
|
|
|
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
|
|
|
|
{ TTTWAuth }
|
|
|
|
constructor TTTWAuth.Create;
|
|
begin
|
|
inherited Create;
|
|
FHTTPServer := TIdHTTPServer.Create(nil);
|
|
FHTTPServer.OnCommandGet := HandleRequest;
|
|
FHTTPServer.OnStatus := OnStatus;
|
|
// Íå âêëþ÷àåì Active çäåñü
|
|
end;
|
|
|
|
destructor TTTWAuth.Destroy;
|
|
begin
|
|
try
|
|
if Assigned(FHTTPServer) then
|
|
begin
|
|
try
|
|
if FHTTPServer.Active then
|
|
FHTTPServer.Active := False;
|
|
except
|
|
end;
|
|
FreeAndNil(FHTTPServer);
|
|
end;
|
|
except
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTTWAuth.StartServer(aURL: string);
|
|
begin
|
|
// Çàùèòà îò ïîâòîðíîãî çàïóñêà
|
|
if Assigned(FHTTPServer) and FHTTPServer.Active then
|
|
Exit;
|
|
|
|
// Î÷èñòèì ñòàðûå áèíäèíãè, ÷òîáû íå íàêàïëèâàòü èõ
|
|
FHTTPServer.Bindings.Clear;
|
|
|
|
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, SW_SHOWNORMAL);
|
|
end;
|
|
|
|
procedure TTTWAuth.StopServer;
|
|
begin
|
|
if Assigned(FHTTPServer) then
|
|
begin
|
|
try
|
|
FHTTPServer.Active := False;
|
|
except
|
|
end;
|
|
try
|
|
FHTTPServer.Bindings.Clear;
|
|
except
|
|
end;
|
|
end;
|
|
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 := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
|
sLineBreak + '<head>' + sLineBreak +
|
|
' <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
|
|
'<body>' + sLineBreak + ' <p>ïîëó÷àþ òîêåí:</p>' + sLineBreak + '<script>' +
|
|
sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
|
|
'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' +
|
|
sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
|
|
'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
|
|
sLineBreak + ' </script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
|
|
end;
|
|
|
|
procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
|
|
const AStatusText: string);
|
|
begin
|
|
// Ìîæíî ëîãèðîâàòü ñòàòóñ, íî íå îáÿçàòåëüíî
|
|
end;
|
|
|
|
procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
|
|
AResponseInfo: TIdHTTPResponseInfo);
|
|
begin
|
|
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
|
sLineBreak + '<head>' + sLineBreak +
|
|
' <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
|
|
'<body>' + sLineBreak + ' <p>ïîëó÷àþ êîä</p>' + sLineBreak + '<script>' +
|
|
sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
|
|
'var urrl = paragraph.replace(''localhost/da'',''localhost/redirect'');' +
|
|
sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
|
|
'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
|
|
sLineBreak + ' </script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
|
|
end;
|
|
|
|
procedure TTTWAuth.HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
|
|
AResponseInfo: TIdHTTPResponseInfo);
|
|
var
|
|
i: Integer;
|
|
AccessToken: string;
|
|
LTokenCopy: string;
|
|
begin
|
|
// Åñëè ïîëó÷åí access_token
|
|
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 := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
|
sLineBreak + '<head>' + sLineBreak +
|
|
' <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
|
|
'<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
|
|
'</body>' + sLineBreak + '</html>';
|
|
AResponseInfo.WriteContent;
|
|
|
|
// Êîïèðóåì òîêåí, ÷òîáû êîððåêòíî ïåðåäàòü â main thread
|
|
LTokenCopy := AccessToken;
|
|
// Âûçûâàåì OnToken â main thread
|
|
if Assigned(FmyEvent) then
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
try
|
|
FmyEvent(LTokenCopy);
|
|
except
|
|
end;
|
|
end);
|
|
|
|
// Îñòàíîâèì ñåðâåð è çàïëàíèðóåì î÷èñòêó îáúåêòà â main thread
|
|
try
|
|
StopServer;
|
|
except
|
|
end;
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
try
|
|
Free;
|
|
except
|
|
end;
|
|
end);
|
|
Exit;
|
|
end;
|
|
|
|
// Åñëè åñòü error_description
|
|
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 := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
|
sLineBreak + '<head>' + sLineBreak +
|
|
' <title>ERROR...</title>' + sLineBreak + '</head>' + sLineBreak +
|
|
'<body>' + sLineBreak + AccessToken + sLineBreak + '</body>' + sLineBreak + '</html>';
|
|
AResponseInfo.WriteContent;
|
|
|
|
LTokenCopy := AccessToken;
|
|
if Assigned(FmyEvent) then
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
try
|
|
FmyEvent(LTokenCopy);
|
|
except
|
|
end;
|
|
end);
|
|
|
|
try
|
|
StopServer;
|
|
except
|
|
end;
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
try
|
|
Free;
|
|
except
|
|
end;
|
|
end);
|
|
Exit;
|
|
end;
|
|
|
|
// Åñëè ïîëó÷åí code=
|
|
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 := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
|
sLineBreak + '<head>' + sLineBreak +
|
|
' <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
|
|
'<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
|
|
'</body>' + sLineBreak + '</html>';
|
|
AResponseInfo.WriteContent;
|
|
|
|
LTokenCopy := AccessToken;
|
|
if Assigned(FmyEvent) then
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
try
|
|
FmyEvent(LTokenCopy);
|
|
except
|
|
end;
|
|
end);
|
|
|
|
try
|
|
StopServer;
|
|
except
|
|
end;
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
try
|
|
Free;
|
|
except
|
|
end;
|
|
end);
|
|
Exit;
|
|
end;
|
|
|
|
// Ïî óìîë÷àíèþ — 404
|
|
AResponseInfo.ResponseNo := 404;
|
|
AResponseInfo.ContentText := 'Not Found';
|
|
AResponseInfo.WriteContent;
|
|
end;
|
|
|
|
end.
|
|
|