I've written procedure to download file from google drive:
procedure DownloadfromDriveMyGolden2File;
begin
form2.RESTResponseDataSetAdapter1.AutoUpdate := false;
form2.RESTRequest1.Params.Clear;
form2.RESTRequest1.ClearBody;
form2.RESTRequest1.Method:=rmget;
Form2.RESTClient1.BaseURL:='https://www.googleapis.com/drive/v2/files/{FileId}?alt=media';
form2.RESTRequest1.Resource := '';
form2.RESTRequest1.Params.AddUrlSegment('FileId', form2.Edit4.Text);
try
form2.RESTRequest1.Execute;
except
on e: Exception do
begin
ShowMessage(e.Message);//Show Exception
end;
end;
end;
But i cant imagine where i can catch Tfilestream or Tmemorystream to get my file, is it possible or i should use idhttp to do this ?
I've found the answer:
procedure ServerResponseToFile;
var
SomeStream : tmemorystream;
local_filename : string;
begin
//в андроиде обратные слеши
{$IF DEFINED(MsWindows)}
local_filename := ExtractFilePath(ParamStr(0)) +'syncdownload/Northwindpers.sqlite3';
{$ENDIF}
SomeStream := tmemorystream.Create;
Somestream.WriteData(form2.RESTResponse1.RawBytes,Length(form2.RESTResponse1.Raw Bytes));
SomeStream.SaveToFile(local_filename);
SomeStream.free;
end;
Related
I am using Delphi 2007 with Indy 10. I have a gzip file. I have verified it can be decompressed with this Online Decompression Tool.
I am trying to use the TIdCompressorZlib component to decompress using Delphi. Here is my code:
procedure TForm2.Button9Click(Sender: TObject);
var
lCompressor : TIdCompressorZLib;
FileStream : TFileStream;
memorystream: TMemoryStream;
begin
lCompressor := TIdCompressorZLib.create(self);
FileStream := TFileStream.Create('c:\temp\test.gz', fmOpenRead);
filestream.position := 0;
memorystream:= TMemoryStream.create;
memorystream.position := 0;
lcompressor.DecompressGZipStream(FileStream,MemoryStream);
filestream.free;
showmessage('done');
end;
I cannot get it to work. If I pass fmOpenReadWrite in the constructor I get a zlib error (-5) when DecompressGZipStream is called.
If I pass fmOpenRead in the constructor I get a OS System Error Code 5 Access Denied when DecompressGZipStream is called.
Update David Hefferan suggested it is a file reading issue. So I am zeroing in on that. I am able to copy the file using this procedure:
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
showmessage('done');
End;
UPD Per David Heffernan, I have verified I can Read the data. I successfully ran the file through the following function. It returns the proper number of characters (bytes):
function GetTextFromFile(AFile: string; var Returnstring: string): Boolean;
var
FileStream: TFileStream;
begin
Result := False;
if not FileExists(AFile) then Exit;
FileStream := TFileStream.Create(AFile, fmOpenRead);
try
if FileStream.Size <> 0 then
begin
SetLength(Returnstring, FileStream.Size);
FileStream.Read(Returnstring[1], FileStream.Size);
Result := True;
end;
finally
FileStream.Free;
end;
end;
You can try to use Delphi zlib unit to decompress gzip.
Sample code:
procedure TForm2.Button9Click(Sender: TObject);
var
DecompressionStream : TDecompressionStream;
FileStream : TFileStream;
dest: TFileStream;
byteCount: Integer;
buffer: array [0..65535] of Byte;
begin
FileStream := TFileStream.Create('c:\temp\test.gz', fmOpenRead);
try
//no need to set FileStream position to 0, it's there already
DecompressionStream:=TDecompressionStream.Create(FileStream, 15+16);
//16 is flag that gzip stream used, not zlib.
//15 is maximum memory usage, to speed-up decompression.
try
dest:=TFileStream.Create('c:\temp\test.txt', fmCreate);
try
dest.CopyFrom(DecompressionStream,0);
finally
dest.free;
end;
finally
DecompressionStream.free;
end;
finally
filestream.free;
end;
showmessage('done');
end;
UPD: this code doesn't work for D2007 or earlier versions, no overloaded constructor with WindowBits argument...
I need to access binary image data using XMLHttpRequest in Delphi. I am using the following code but its not working, could someone please tell me what's wrong with this code, thanks in advance.
//I am using this function to get Image Binary data into Memory Stream.
procedure SendGETRequest(p_Url: string; p_resStream: TMemoryStream);
begin
FXmlHttpReq.open(METHOD_GET, p_Url, false, FUsername, FPassword);
FXmlHttpReq.setRequestHeader(HTTP_AUTHENTICATION, HTTP_BASIC + EncodeBase64(
FUsername + ':'+FPassword));
FXmlHttpReq.setRequestHeader(HTTP_CACHE_CONTROL, HTTP_NO_CACHE);
//FXmlHttpReq.setRequestHeader('Content-type','application/octet-stream');
FXmlHttpReq.send('');
if not VarIsEmpty(FXmlHttpReq.responseBody) then
begin
p_resStream:= OleVariantToMemoryStream(FXmlHttpReq.responseStream);
end;//if...
end;
function OleVariantToMemoryStream(OV: OleVariant): TMemoryStream;
var
Data: PByteArray;
Size: integer;
begin
Result := TMemoryStream.Create;
try
Size := VarArrayHighBound (OV, 1) - VarArrayLowBound(OV, 1) + 1;
Data := VarArrayLock(OV);
try
Result.Position := 0;
Result.WriteBuffer(Data^, Size);
finally
VarArrayUnlock(OV);
end;
except
Result.Free;
Result := nil;
end;
end;
responseStream is IStream. You need to convert it using TOleStream (AxCtrls):
uses AxCtrls, ComObj, ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
oXMLHTTP: OleVariant;
MemoryStream: TMemoryStream;
Stream: IStream;
OleStream: TOleStream;
begin
oXMLHTTP := CreateOleObject('MSXML2.XMLHTTP.3.0');
oXMLHTTP.open('GET', 'https://www.google.com/images/srpr/logo11w.png', False);
oXMLHTTP.send(EmptyParam);
Stream := IUnknown(oXMLHTTP.ResponseStream) as IStream;
OleStream := TOleStream.Create(Stream);
try
OleStream.Position := 0;
MemoryStream := TMemoryStream.Create;
try
MemoryStream.CopyFrom(OleStream, OleStream.Size);
MemoryStream.SaveToFile('logo11w.png');
finally
MemoryStream.Free;
end;
finally
OleStream.Free;
end;
end;
In Delphi XE:
function ReadConfig(TextReader: TTextReader): string;
begin
try
Result := TextReader.ReadToEnd;
finally
TextReader.Free;
end;
end.
Typical use:
var
s: string;
...
s := ReadConfig(TStreamReader.Create('MySetting.cf'));
Question:
What is the equivalent construct in Delphi 2007 downward.
Assuming you are asking about reading a file:
var
fils: TFileStream;
stri: TStringStream;
begin
fils := TFileStream.Create(sFileName, fmOpenRead or fmShareDenyNone);
stri := TStringStream.Create('');
try
stri.CopyFrom(fils, fils.Size);
Result := stri.DataString;
finally
fils.Free;
stri.Free;
end;
end;
I'm working on a component installer (only for Delphi XE2) and I would like to detect if the Delphi XE2 IDE is running. How would you detect it?
P.S. I know about the TAppBuilder window class name, but I need to detect also the IDE version.
These are the steps to determine if the Delphi XE2 is running
1) First Read the location of the the bds.exe file from the App entry in the \Software\Embarcadero\BDS\9.0 registry key which can be located in the HKEY_CURRENT_USER or HKEY_LOCAL_MACHINE Root key.
2) Then using the CreateToolhelp32Snapshot function you can check if exist a exe with the same name running.
3) Finally using the PID of the last processed entry you can resolve the full file path of the Exe (using the GetModuleFileNameEx function) and then compare the names again.
Check this sample code
{$APPTYPE CONSOLE}
{$R *.res}
uses
Registry,
PsAPI,
TlHelp32,
Windows,
SysUtils;
function ProcessFileName(dwProcessId: DWORD): string;
var
hModule: Cardinal;
begin
Result := '';
hModule := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, dwProcessId);
if hModule <> 0 then
try
SetLength(Result, MAX_PATH);
if GetModuleFileNameEx(hModule, 0, PChar(Result), MAX_PATH) > 0 then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '';
finally
CloseHandle(hModule);
end;
end;
function IsAppRunning(const FileName: string): boolean;
var
hSnapshot : Cardinal;
EntryParentProc: TProcessEntry32;
begin
Result := False;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot = INVALID_HANDLE_VALUE then
exit;
try
EntryParentProc.dwSize := SizeOf(EntryParentProc);
if Process32First(hSnapshot, EntryParentProc) then
repeat
if CompareText(ExtractFileName(FileName), EntryParentProc.szExeFile) = 0 then
if CompareText(ProcessFileName(EntryParentProc.th32ProcessID), FileName) = 0 then
begin
Result := True;
break;
end;
until not Process32Next(hSnapshot, EntryParentProc);
finally
CloseHandle(hSnapshot);
end;
end;
function RegReadStr(const RegPath, RegValue: string; var Str: string;
const RootKey: HKEY): boolean;
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
Result := Reg.OpenKey(RegPath, True);
if Result then
Str := Reg.ReadString(RegValue);
finally
Reg.Free;
end;
except
Result := False;
end;
end;
function RegKeyExists(const RegPath: string; const RootKey: HKEY): boolean;
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
Result := Reg.KeyExists(RegPath);
finally
Reg.Free;
end;
except
Result := False;
end;
end;
function GetDelphiXE2LocationExeName: string;
Const
Key = '\Software\Embarcadero\BDS\9.0';
begin
Result:='';
if RegKeyExists(Key, HKEY_CURRENT_USER) then
begin
RegReadStr(Key, 'App', Result, HKEY_CURRENT_USER);
exit;
end;
if RegKeyExists(Key, HKEY_LOCAL_MACHINE) then
RegReadStr(Key, 'App', Result, HKEY_LOCAL_MACHINE);
end;
Var
Bds : String;
begin
try
Bds:=GetDelphiXE2LocationExeName;
if Bds<>'' then
begin
if IsAppRunning(Bds) then
Writeln('The Delphi XE2 IDE Is running')
else
Writeln('The Delphi XE2 IDE Is not running')
end
else
Writeln('The Delphi XE2 IDE Is was not found');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
Addtional resources.
Detecting installed delphi versions
Check DebugHook <> 0.
The down side is that currently if your app is built with packages, DebugHook will return 0.
But normally this is would be a very elegant and simple test. Works great in D2009, I just noticed that it has the package dependency bug in XE2 (http://qc.embarcadero.com/wc/qcmain.aspx?d=105365).
i want to post data to the following url:
http://mehratin.heroku.com/personals/new
i write the following code but has problem:
procedure TForm1.Button3Click(Sender: TObject);
var
aStream: TMemoryStream;
Params: TStringList;
begin
aStream := TMemoryStream.Create;
Params := TStringList.Create;
try
with IdHTTP1 do
begin
Params.Add('fname=123');
Params.Add('lname=123');
Request.ContentType := 'application/x-www-form-urlencoded';
try
Response.KeepAlive := False;
Post('http://localhost:3000/personals/new', Params);
except
on E: Exception do
showmessage('Error encountered during POST: ' + E.Message);
end;
end;
how can i post data by TIDHtttp.post method in delphi 2010?
First things first, you'd need to read the http response code (it would have been useful to include that in your question).
In the absence of that I've used the Indy http object before as shown below. I included the parameters in my URL though. To troubleshoot, try running this with an http.Get to ensure the port is open, and you can actually connect to the server. Here's my example for completenes:
// parameters
params := format('export=1&format=%s&file=%s', [_exportType, destination]);
// First setup the http object
procedure TCrystalReportFrame.SetupHttpObject();
begin
try
IDHTTP1.HandleRedirects := TRUE;
IDHTTP1.AllowCookies := true;
IDHTTP1.Request.CacheControl := 'no-cache';
IdHTTP1.ReadTimeout := 60000;
_basePath:= GetBaseUrl;
except
on E: Exception do
begin
Global.LogError(E, 'SetupHttpObject');
end;
end;
end;
// Then have an onwork event
procedure TCrystalReportFrame.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
Http: TIdHTTP;
ContentLength: Int64;
Percent: Integer;
begin
Http := TIdHTTP(ASender);
ContentLength := Http.Response.ContentLength;
end;
// The actual process
procedure TCrystalReportFrame.ProcessHttpRequest(const parameters: string);
var
url : string;
begin
try
try
SetupHttpObject;
IdHTTP1.OnWork:= HttpWork;
url := format('%s&%s', [_basePath, parameters]);
url := IdHTTP1.Post(url);
except
on E: Exception do
begin
Global.LogError(E, 'ProcessHttpRequest');
end;
end;
finally
try
IdHTTP1.Disconnect;
except
begin
end;
end;
end;
end;