uses
synacode, synautil, httpsend, // for communication
ssl_openssl, // you need to include this one in your requirements
type
THTTPServerThread = class(TThread)
private
ListenerSocket: TTCPBlockSocket;
ConnectionSocket: TTCPBlockSocket;
public
Authorize_token: String;
procedure Execute; override;
procedure CancelThread(Sender: TObject; var CanClose: Boolean);
end;
procedure THTTPServerThread.CancelThread(Sender: TObject; var CanClose: Boolean);
begin
Terminate;
end;
procedure THTTPServerThread.Execute;
var
S: string;
method, uri, protocol: string;
OutputDataString: string;
begin
Authorize_token := '';
FreeOnTerminate := False;
ListenerSocket := TTCPBlockSocket.Create;
ConnectionSocket := TTCPBlockSocket.Create;
try
ListenerSocket.CreateSocket;
ListenerSocket.setLinger(True, 10);
ListenerSocket.Bind('localhost', '1500');
ListenerSocket.Listen;
while not terminated do
begin
Sleep(1000);
Application.ProcessMessages;
if ListenerSocket.CanRead(1000) and not Terminated then
begin
ConnectionSocket.Socket := ListenerSocket.Accept;
// read request line
S := string(ConnectionSocket.RecvString(1000));
method := fetch(S, ' ');
uri := fetch(S, ' ');
protocol := fetch(S, ' ');
// read request headers
repeat
S := string(ConnectionSocket.RecvString(1000));
until S = '';
// /?code=4/fegArZQDUJqFdoCw-1DU16ohYsoA5116feRuCW0LiuQ
// /?error=access_denied
Authorize_token := '';
if Pos('code=', uri) > 0 then
begin
Authorize_token := Copy(uri, Pos('code=', uri) + 5);
end;
OutputDataString := 'HTTP/1.0 200' + CRLF;
OutputDataString := OutputDataString + 'Content-type: Text/Html' + CRLF;
OutputDataString := OutputDataString + 'Content-length: ' + IntTostr(Length(OutputDataString)) + CRLF;
OutputDataString := OutputDataString + 'Connection: close' + CRLF;
OutputDataString := OutputDataString + 'Date: ' + Rfc822DateTime(now) + CRLF;
OutputDataString := OutputDataString + 'Server: Ciswin Synapse' + CRLF;
OutputDataString := OutputDataString + '' + CRLF;
ConnectionSocket.SendString(ansistring(OutputDataString));
// if ASocket.lasterror <> 0 then HandleError;
if Authorize_token = '' then
begin
OutputDataString :=
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"'
+ ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + CRLF
+ '<html><center><h1>Er is iets mis gegaan.<br><br>Cis heeft GEEN toegang.<br><br>U kunt deze pagina sluiten.</h1></center></html>' + CRLF;
end
else
begin
OutputDataString :=
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"'
+ ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + CRLF
+ '<html><center><h1>Cis heeft nu toegang.<br><br>U kunt deze pagina sluiten.</h1></center></html>' + CRLF;
end;
ConnectionSocket.SendString(ansistring(OutputDataString));
ConnectionSocket.CloseSocket;
Terminate;
end;
end;
finally
ConnectionSocket.Free;
ListenerSocket.Free;
end;
end;
procedure TGoogleOAuth2.GetAuthorize_token_interactive;
var
URL: string;
Params: string;
GoUrl: variant;
Scope: string;
ServerThread: THTTPServerThread;
dl: TForm;
function StartBrowser(const FileName: string): boolean;
begin
Result := Shellapi.ShellExecute(0, nil, pchar(FileName), nil, nil, 5 { SW_SHOW } ) > 32;
end;
begin
try
Scope := FScopes.DelimitedText;
if Scope = '' then
begin
LogLine('No scope specified in GetAccess');
end;
URL := AuthorizationUrl;
Params := '';
Params := Params + 'response_type=' + EncodeURLElement('code');
Params := Params + '&client_id=' + EncodeURLElement(FClient_id);
Params := Params + '&redirect_uri=' + EncodeURLElement(RedirectUri);
Params := Params + '&scope=' + EncodeURLElement(Scope);
LogLine('Authorizing...');
GoUrl := URL + '?' + Params;
ServerThread := THTTPServerThread.Create(False);
try
StartBrowser(GoUrl); // open website
dl := CreateMessageDialog('Wachten op toestemming', mtInformation, []);
try
dl.Height := Round(80 * (dl.PixelsPerInch / 96));
dl.OnCloseQuery := ServerThread.CancelThread;
dl.Top := 38;
dl.Left := 5;
dl.Show;
dl.Repaint;
while not ServerThread.Terminated do
begin
Sleep(1);
Application.ProcessMessages;
end;
ServerThread.WaitFor; // blocking met dialog
finally
dl.Free;
end;
Authorize_token := ServerThread.Authorize_token;
finally
ServerThread.Free;
end;
except
// on E: EOleSysError do ;
on E: Exception do
begin
DebugLine('Browser closed without confirmation.');
DebugLine('Exception: ' + E.Message);
end;
end;
end;
Bookmarks