Sorry, Forgive my poor english !!!
I found a piece of code in the method CreateFormFromStrings in the System.Net.HttpClient unit 1720 line .
procedure THTTPClient.CreateFormFromStrings(const ASource: TStrings; const AEncoding: TEncoding;
const AHeaders: TNetHeaders; var ASourceStream: TStream; var ASourceHeaders: TNetHeaders);
var
LParams: string;
LEncoding: TEncoding;
I: Integer;
Pos: Integer;
begin
// ******** Ignor some code
ASourceStream := TStringStream.Create(LParams, TEncoding.ASCII, False);
try
ASourceHeaders := [TNetHeader.Create(sContentType,
'application/x-www-form-urlencoded; charset=' + LEncoding.MIMEName)] + AHeaders; // do not translate
except
FreeAndNil(ASourceStream);
raise;
end;
end;
So I took it out and tested it separately. I don't know if the memory leaked. Use valgrind tools to test,you will find:
Related
Is it possible to get an output of an Exec'ed executable?
I want to show the user an info query page, but show the default value of MAC address in the input box. Is there any other way to achieve this?
Yes, use redirection of the standard output to a file:
[Code]
function NextButtonClick(CurPage: Integer): Boolean;
var
TmpFileName, ExecStdout: string;
ResultCode: integer;
begin
if CurPage = wpWelcome then begin
TmpFileName := ExpandConstant('{tmp}') + '\ipconfig_results.txt';
Exec('cmd.exe', '/C ipconfig /ALL > "' + TmpFileName + '"', '', SW_HIDE,
ewWaitUntilTerminated, ResultCode);
if LoadStringFromFile(TmpFileName, ExecStdout) then begin
MsgBox(ExecStdout, mbInformation, MB_OK);
{ do something with contents of file... }
end;
DeleteFile(TmpFileName);
end;
Result := True;
end;
Note that there may be more than one network adapter, and consequently several MAC addresses to choose from.
I had to do the same (execute command line calls and get the result) and came up with a more general solution.
It also fixes strange bugs if quoted paths are used in the actual calls by using the /S flag for cmd.exe.
// Exec with output stored in result.
// ResultString will only be altered if True is returned.
function ExecWithResult(
Filename, Params, WorkingDir: String; ShowCmd: Integer;
Wait: TExecWait; var ResultCode: Integer; var ResultString: String): Boolean;
var
TempFilename: String;
Command: String;
ResultStringAnsi: AnsiString;
begin
TempFilename := ExpandConstant('{tmp}\~execwithresult.txt');
// Exec via cmd and redirect output to file.
// Must use special string-behavior to work.
Command :=
Format('"%s" /S /C ""%s" %s > "%s""', [
ExpandConstant('{cmd}'), Filename, Params, TempFilename]);
Result :=
Exec(ExpandConstant('{cmd}'), Command, WorkingDir, ShowCmd, Wait, ResultCode);
if not Result then
Exit;
LoadStringFromFile(TempFilename, ResultStringAnsi); // Cannot fail
// See https://stackoverflow.com/q/20912510/850848
ResultString := ResultStringAnsi;
DeleteFile(TempFilename);
// Remove new-line at the end
if (Length(ResultString) >= 2) and
(ResultString[Length(ResultString) - 1] = #13) and
(ResultString[Length(ResultString)] = #10) then
Delete(ResultString, Length(ResultString) - 1, 2);
end;
Usage:
Success :=
ExecWithResult('ipconfig', '/all', '', SW_HIDE, ewWaitUntilTerminated,
ResultCode, ExecStdout) and
(ResultCode = 0);
The result can also be loaded into a TStringList object to get all lines:
Lines := TStringList.Create;
Lines.Text := ExecStdout;
// ... some code ...
Lines.Free;
I would like to know if it's possible to run a command and get its exit code. I have seen that it's possible to capture the stdout of the process, but I have not found anything about the exit code. Is it possible to do this on Linux?
Delphi version: 10.4
OS: Ubuntu 18.04
This is the unit I use to run the command and get its output:
unit TestRunCommand;
interface
uses
System.SysUtils,
Posix.Base,
Posix.Fcntl;
type
TStreamHandle = pointer;
function popen(const command: MarshaledAString; const _type: MarshaledAString): TStreamHandle; cdecl; external libc name _PU + 'popen';
function pclose(filehandle: TStreamHandle): int32; cdecl; external libc name _PU + 'pclose';
function fgets(buffer: pointer; size: int32; Stream: TStreamHandle): pointer; cdecl; external libc name _PU + 'fgets';
function RunCommand(const acommand: MarshaledAString): String; forward;
implementation
function RunCommand(const acommand: MarshaledAString): String;
// run a linux shell command and return output
var
handle: TStreamHandle;
data: array [0 .. 511] of uint8;
function bufferToString(buffer: pointer; maxSize: uint32): string;
var
cursor: ^uint8;
endOfBuffer: nativeuint;
begin
if not assigned(buffer) then
exit;
cursor := buffer;
endOfBuffer := nativeuint(cursor) + maxSize;
while (nativeuint(cursor) < endOfBuffer) and (cursor^ <> 0) do
begin
result := result + chr(cursor^);
cursor := pointer(succ(nativeuint(cursor)));
end;
end;
begin
result := '';
handle := popen(acommand, 'r');
try
while fgets(#data[0], sizeof(data), handle) <> nil do
begin
result := bufferToString(#data[0], sizeof(data));
end;
finally
pclose(handle);
end;
end;
end.
I have a software which requires the default browser installed on user computer.
Is there a way that I can get it?
Thanks
An solution that correctly works on modern versions of Windows cannot be based on association with http protocol, as that's no longer reliable. It should rather be based on a solution like the answer by #GregT to How to determine the Windows default browser (at the top of the start menu).
So something like:
function GetBrowserCommand: string;
var
UserChoiceKey: string;
HtmlProgId: string;
begin
UserChoiceKey :=
'Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.html\UserChoice';
if RegQueryStringValue(HKCU, UserChoiceKey, 'ProgId', HtmlProgId) then
begin
Log(Format('ProgID to registered for .html is [%s].', [HtmlProgId]));
if RegQueryStringValue(HKCR, HtmlProgId + '\shell\open\command', '', Result) then
begin
Log(Format('Command for ProgID [%s] is [%s].', [HtmlProgId, Result]));
end;
end;
{ Fallback for old version of Windows }
if Result = '' then
begin
if RegQueryStringValue(HKCR, 'http\shell\open\command', '', Result) then
begin
Log(Format('Command registered for http: [%s].', [Result]));
end;
end;
end;
If you want to extract browser path from the command, use a code like:
function ExtractProgramPath(Command: string): string;
var
P: Integer;
begin
if Copy(Command, 1, 1) = '"' then
begin
Delete(Command, 1, 1);
P := Pos('"', Command);
end
else P := 0;
if P = 0 then
begin
P := Pos(' ', Command);
end;
Result := Copy(Command, 1, P - 1);
end;
(based on Executing UninstallString in Inno Setup)
Take this:
function GetBrowser() : String;
var
RegistryEntry: String;
Browser: String;
Limit: Integer ;
begin
if RegQueryStringValue(HKEY_CLASSES_ROOT, 'http\shell\open\command', '', RegistryEntry) then
begin
Limit := Pos('.exe' ,RegistryEntry)+ Length('.exe');
Browser := Copy(RegistryEntry, 1, Limit );
MsgBox('Your browser: ' + Browser , mbInformation, MB_OK);
end;
end;
My Delphi 2010 app uploads stuff using multi-threading, uploaded data is POSTed to a PHP/web application which requires login, so I need to use a shared/global cookies manager (I'm using Indy10 Revision 4743) since TIdCookieManager is not thread-safe :(
Also, server side, session id is automatically re-generated every 5 minutes, so I must keep both the global & local cookie managers in sync.
My code looks like this:
TUploadThread = class(TThread)
// ...
var
GlobalCookieManager : TIdCookieManager;
procedure TUploadThread.Upload(FileName : String);
var
IdHTTP : TIdHTTP;
TheSSL : TIdSSLIOHandlerSocketOpenSSL;
TheCompressor : TIdCompressorZLib;
TheCookieManager : TIdCookieManager;
AStream : TIdMultipartFormDataStream;
begin
ACookieManager := TIdCookieManager.Create(IdHTTP);
// Automatically sync cookies between local & global Cookie managers
#TheCookieManager.OnNewCookie := pPointer(Cardinal(pPointer( procedure(ASender : TObject; ACookie : TIdCookie; var VAccept : Boolean)
begin
OmniLock.Acquire;
try
GlobalCookieManager.CookieCollection.AddCookie(ACookie, TIdHTTP(TIdCookieManager(ASender).Owner).URL{IdHTTP.URL});
finally
OmniLock.Release;
end; // try/finally
VAccept := True;
end )^ ) + $0C)^;
// ======================================== //
IdHTTP := TIdHTTP.Create(nil);
with IdHTTP do
begin
HTTPOptions := [hoForceEncodeParams, hoNoParseMetaHTTPEquiv];
AllowCookies := True;
HandleRedirects := True;
ProtocolVersion := pv1_1;
IOHandler := TheSSL;
Compressor := TheCompressor;
CookieManager := TheCookieManager;
end; // with
OmniLock.Acquire;
try
// Load login info/cookies
TheCookieManager.CookieCollection.AddCookies(GlobalCookieManager.CookieCollection);
finally
OmniLock.Release;
end; // try/finally
AStream := TIdMultipartFormDataStream.Create;
with Stream.AddFile('file_name', FileName, 'application/octet-stream') do
begin
HeaderCharset := 'utf-8';
HeaderEncoding := '8';
end; // with
IdHTTP.Post('https://www.domain.com/post.php', AStream);
AStream.Free;
end;
But it doesn't work! I'm getting this exception when calling AddCookies()
Project MyEXE.exe raised exception class EAccessViolation with message
'Access violation at address 00000000. Read of address 00000000'.
I also tried using assign(), ie.
TheCookieManager.CookieCollection.Assign(GlobalCookieManager.CookieCollection);
But I still get the same exception, usually here:
TIdCookieManager.GenerateClientCookies()
Anyone knows how to fix this?
Don't use an anonymous procedure for the OnNewCookie event. Use a normal class method instead:
procedure TUploadThread.NewCookie(ASender: TObject; ACookie : TIdCookie; var VAccept : Boolean);
var
LCookie: TIdCookie;
begin
LCookie := TIdCookieClass(ACookie.ClassType).Create;
LCookie.Assign(ACookie);
OmniLock.Acquire;
try
GlobalCookieManager.CookieCollection.AddCookie(LCookie, TIdHTTP(TIdCookieManager(ASender).Owner).URL);
finally
OmniLock.Release;
end;
VAccept := True;
end;
Or:
procedure TUploadThread.NewCookie(ASender: TObject; ACookie : TIdCookie; var VAccept : Boolean);
begin
OmniLock.Acquire;
try
GlobalCookieManager.CookieCollection.AddServerCookie(ACookie.ServerCookie, TIdHTTP(TIdCookieManager(ASender).Owner).URL);
finally
OmniLock.Release;
end;
VAccept := True;
end;
Then use it like this:
procedure TUploadThread.Upload(FileName : String);
var
IdHTTP : TIdHTTP;
TheSSL : TIdSSLIOHandlerSocketOpenSSL;
TheCompressor : TIdCompressorZLib;
TheCookieManager : TIdCookieManager;
TheStream : TIdMultipartFormDataStream;
begin
IdHTTP := TIdHTTP.Create(nil);
try
...
TheCookieManager := TIdCookieManager.Create(IdHTTP);
TheCookieManager.OnNewCookie := NewCookie;
with IdHTTP do
begin
HTTPOptions := [hoForceEncodeParams, hoNoParseMetaHTTPEquiv];
AllowCookies := True;
HandleRedirects := True;
ProtocolVersion := pv1_1;
IOHandler := TheSSL;
Compressor := TheCompressor;
CookieManager := TheCookieManager;
end; // with
OmniLock.Acquire;
try
// Load login info/cookies
TheCookieManager.CookieCollection.AddCookies(GlobalCookieManager.CookieCollection);
finally
OmniLock.Release;
end;
TheStream := TIdMultipartFormDataStream.Create;
try
with TheStream.AddFile('file_name', FileName, 'application/octet-stream') do
begin
HeaderCharset := 'utf-8';
HeaderEncoding := '8';
end;
IdHTTP.Post('https://www.domain.com/post.php', TheStream);
finally
TheStream.Free;
end;
finally
IdHTTP.Free;
end;
end;
If I had to guess, I'd say your problem is in here somewhere:
// Automatically sync cookies between local & global Cookie managers
#TheCookieManager.OnNewCookie := pPointer(Cardinal(pPointer( procedure(ASender : TObject; ACookie : TIdCookie; var VAccept : Boolean)
begin
OmniLock.Acquire;
try
GlobalCookieManager.CookieCollection.AddCookie(ACookie, TIdHTTP(TIdCookieManager(ASender).Owner).URL{IdHTTP.URL});
finally
OmniLock.Release;
end; // try/finally
VAccept := True;
end )^ ) + $0C)^;
I'm not sure what the $0C magic number is there for, but I bet all those casts are there because you had a heck of a time getting the compiler to accept this. It gave you type errors saying you couldn't assign the one thing to the other.
Those type errors are there for a reason! If you hack your way around the type system, things are very likely to break. Try turning that anonymous method into a normal method on TUploadThread and assign it that way, and see if it doesn't work better.
Responding to the comment:
Thank you guys, I converted to a normal method, but I'm still getting
exceptions in AddCookies(), last one happened in the line that reads
FRWLock.BeginWrite; in this procedure
TIdCookies.LockCookieList(AAccessType: TIdCookieAccess):
TIdCookieList;
If your error is an Access Violation with Read of address 00000000, that's got a very specific meaning. It means you're trying to do something with an object that's nil.
When you get that, break to the debugger. If the error's taking place on the line you said it's happening on, then it's almost certain that either Self or FRWLock is nil at this point. Check both variables and figure out which one hasn't been constructed yet, and that'll point you to the solution.
Is it possible to get an output of an Exec'ed executable?
I want to show the user an info query page, but show the default value of MAC address in the input box. Is there any other way to achieve this?
Yes, use redirection of the standard output to a file:
[Code]
function NextButtonClick(CurPage: Integer): Boolean;
var
TmpFileName, ExecStdout: string;
ResultCode: integer;
begin
if CurPage = wpWelcome then begin
TmpFileName := ExpandConstant('{tmp}') + '\ipconfig_results.txt';
Exec('cmd.exe', '/C ipconfig /ALL > "' + TmpFileName + '"', '', SW_HIDE,
ewWaitUntilTerminated, ResultCode);
if LoadStringFromFile(TmpFileName, ExecStdout) then begin
MsgBox(ExecStdout, mbInformation, MB_OK);
{ do something with contents of file... }
end;
DeleteFile(TmpFileName);
end;
Result := True;
end;
Note that there may be more than one network adapter, and consequently several MAC addresses to choose from.
I had to do the same (execute command line calls and get the result) and came up with a more general solution.
It also fixes strange bugs if quoted paths are used in the actual calls by using the /S flag for cmd.exe.
// Exec with output stored in result.
// ResultString will only be altered if True is returned.
function ExecWithResult(
Filename, Params, WorkingDir: String; ShowCmd: Integer;
Wait: TExecWait; var ResultCode: Integer; var ResultString: String): Boolean;
var
TempFilename: String;
Command: String;
ResultStringAnsi: AnsiString;
begin
TempFilename := ExpandConstant('{tmp}\~execwithresult.txt');
// Exec via cmd and redirect output to file.
// Must use special string-behavior to work.
Command :=
Format('"%s" /S /C ""%s" %s > "%s""', [
ExpandConstant('{cmd}'), Filename, Params, TempFilename]);
Result :=
Exec(ExpandConstant('{cmd}'), Command, WorkingDir, ShowCmd, Wait, ResultCode);
if not Result then
Exit;
LoadStringFromFile(TempFilename, ResultStringAnsi); // Cannot fail
// See https://stackoverflow.com/q/20912510/850848
ResultString := ResultStringAnsi;
DeleteFile(TempFilename);
// Remove new-line at the end
if (Length(ResultString) >= 2) and
(ResultString[Length(ResultString) - 1] = #13) and
(ResultString[Length(ResultString)] = #10) then
Delete(ResultString, Length(ResultString) - 1, 2);
end;
Usage:
Success :=
ExecWithResult('ipconfig', '/all', '', SW_HIDE, ewWaitUntilTerminated,
ResultCode, ExecStdout) and
(ResultCode = 0);
The result can also be loaded into a TStringList object to get all lines:
Lines := TStringList.Create;
Lines.Text := ExecStdout;
// ... some code ...
Lines.Free;