We need to save cookies between urls, save the cookie depend on domain name that cookie related to it, that need a good manage to parse the url and cookie that not exists in fphttpclient, i did that trick not good but work fine in my code bellow, the idea to save NID value that come with cookies responds to the client (here our code) on google.com domain, then you need pass it again in the next redirect, also AUTO cookie needs to pass to the next googleusercontent.com
uses
SysUtils, Classes, StrUtils,
fphttpclient, URIParser, opensslsockets, fgl;
type
//https://serverfault.com/questions/153409/can-subdomain-example-com-set-a-cookie-that-can-be-read-by-example-com
{ TSessionCookies }
TSessionCookies = class(TStringList)
private
FHost: String;
public
property Host: String read FHost;
end;
{ TSessionsCookies }
TSessionsCookies = class(specialize TFPGObjectList<TSessionCookies>)
private
function Find(AHost: String): TSessionCookies;
function GetSessions(Index: String): TSessionCookies;
public
property Sessions[Index: String]: TSessionCookies read GetSessions; default;
end;
{ TMyHTTPClient }
TMyHTTPClient = class(TFPHTTPClient)
public
Count: Integer;
Referer: String; //refere only set to first request
Sessions: TSessionsCookies;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean; override;
procedure HTTPMethod(const AMethod, AURL: String; Stream: TStream; const AllowedResponseCodes: array of Integer); override;
procedure DoNormalRequest(const AURI: TURI; const AMethod: String; AStream: TStream; const AAllowedResponseCodes: array of Integer; AHeadersOnly, AIsHttps: Boolean); override;
procedure DoRedirect(Sender: TObject; const ASrc: String; var ADest: String);
end;
procedure DownloadFromGDrive(const URL, FileName: String);
function GetDomain(Host: string): string;
implementation
function GetDomain(Host: string): string;
var
p: Integer;
begin
Result := Host;
if RightStr(Result, 1) = '/' then
Result := LeftStr(Result, Length(Result) - 1);
p := pos('.', Result);
if p >0 then
begin
Result := MidBStr(Result, p + 1, MaxInt);
end;
end;
{ TSessionsCookies }
function TSessionsCookies.Find(AHost: String): TSessionCookies;
var
i: Integer;
begin
Result := nil;
for i := 0 to Count - 1 do
begin
if SameText(Items[i].Host, AHost) then
begin
Result := Items[i];
break;
end;
end;
end;
function TSessionsCookies.GetSessions(Index: String): TSessionCookies;
begin
Result := Find(Index);
if Result = nil then
begin
Result := TSessionCookies.Create;
Result.FHost := Index;
Add(Result);
end;
end;
{ TMyHTTPClient }
constructor TMyHTTPClient.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Sessions := TSessionsCookies.Create(True);
end;
function TMyHTTPClient.CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean;
begin
Result := inherited CheckResponseCode(ACode, AllowedResponseCodes);
if ACode = 302 then
Result := True;
end;
destructor TMyHTTPClient.Destroy;
begin
FreeAndNil(Sessions);
inherited Destroy;
end;
procedure TMyHTTPClient.HTTPMethod(const AMethod, AURL: String; Stream: TStream; const AllowedResponseCodes: array of Integer);
var
aHost: string;
URI: TURI;
begin
inherited;
{$ifdef GDDownload_LOG}
WriteLn('to ' + AURL);
{$endif}
Referer := AURL;
URI := ParseURI(AURL);
aHost := URI.Host;
aHost := GetDomain(aHost);
Sessions[aHost].Assign(Cookies);
Count := 0;
end;
procedure TMyHTTPClient.DoNormalRequest(const AURI: TURI; const AMethod: String; AStream: TStream; const AAllowedResponseCodes: array of Integer; AHeadersOnly, AIsHttps: Boolean);
var
aHost: String;
begin
aHost := GetDomain(AURI.Host);
Cookies.Assign(Sessions[aHost]);
if Referer <> '' then
AddHeader('referer', Referer);
AddHeader('User-Agent', 'Wget/1.13.4 (linux-gnu)');
AddHeader('Connection', 'Keep-Alive');
{$ifdef GDDownload_LOG}
WriteLn('##### ' + aHost + ' Count: ', Count, ' #####');
WriteLn;
WriteLn('-----------------Request Headers---------------------');
WriteLn(RequestHeaders.Text);
WriteLn('-----------------Sending Cookies---------------------');
WriteLn(Cookies.Text);
{$endif}
inherited;
{$ifdef GDDownload_LOG}
WriteLn('-----------------Response Headers---------------------');
WriteLn(ResponseHeaders.Text);
WriteLn('-----------------Response Cookies---------------------');
WriteLn(Cookies.Text);
{$endif}
if Trim(Cookies.Text) <> '' then
Sessions[aHost].Assign(Cookies);
Count := Count + 1;
end;
procedure TMyHTTPClient.DoRedirect(Sender: TObject; const ASrc: String; var ADest: String);
begin
// Referer := ASrc; //nop
{$ifdef GDDownload_LOG}
WriteLn;
WriteLn('---------------------- Redirect -----------------------');
WriteLn('Redirect to ' + ADest);
{$endif}
end;
procedure DownloadFromGDrive(const URL, FileName: String);
var
FileID, Token: String;
HttpClient: TMyHTTPClient;
function GetDownloadId(const URL: String): String;
var
p, i: Word;
R: String;
begin
Result := '';
p := 0;
p := pos('?id=', URL);
if p <> 0 then p := p + 4
else
begin
p := pos('/d/', URL);
if p <> 0 then p := p + 3;
end;
i := p;
while URL[i] in ['a'..'z', 'A'..'Z', '0'..'9'] do
begin
Result := Result + URL[i];
if i < length(URL) then Inc(i);
end;
end;
function GetConfirmToken(const Html: String): String;
var
p1, p2: Word;
begin
p1 := pos('confirm=', Html);
if p1 <> 0 then
begin
p2 := PosEx('&', Html, p1);
if p2 <> 0 then
Result := copy(HTML, p1 + 8, p2 - p1 - 8);
end;
end;
var
DownloadUrl: String;
HtmlResult: TStringList;
begin
HttpClient := TMyHTTPClient.Create(nil);
HtmlResult := TStringList.Create;
with HttpClient do
try
MaxRedirects := 5;
OnRedirect := @DoRedirect;
AddHeader('User-Agent', 'Wget/1.13.4 (linux-gnu)');
FileID := GetDownloadID(URL);
DownloadUrl := 'https://drive.google.com/uc?export=download&id=' + FileID;
{$ifdef GDDownload_LOG}
WriteLn('attempting to get ' + DownloadUrl);
{$endif}
HtmlResult.Text := Get(DownloadUrl);
Token := GetConfirmToken(HtmlResult.Text);
{$ifdef GDDownload_LOG}
Writeln('Download ID: ', FileID);
writeln('Confirm Token: ' + Token);
Writeln;
Writeln('==============================================');
{$endif}
try
AllowRedirect := True;
DownloadUrl := 'https://drive.google.com/uc?export=download&confirm=' + Token + '&id=' + FileID;
Get(DownloadUrl, FileName);
except
on E: Exception do
begin
{$ifdef GDDownload_LOG}
writeln(E.Message);
{$endif}
raise;
end;
end;
{$ifdef GDDownload_LOG}
writeln('got codes ' + IntToStr(ResponseStatusCode));
{$endif}
finally
HtmlResult.Free;
Free;
end;
end;