How to send a HTTP POST Request in Delphi using WinInet api - delphi

I am trying to make HTTP Requests from Delphi using the WinInet functions.
So far I have:
function request:string;
var
hNet,hURL,hRequest: HINTERNET;
begin
hNet := InternetOpen(PChar('User Agent'),INTERNET_OPEN_TYPE_PRECONFIG or INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hNet) then
begin
try
hURL := InternetConnect(hNet,PChar('http://example.com'),INTERNET_DEFAULT_HTTP_PORT,nil,nil,INTERNET_SERVICE_HTTP,0,DWORD(0));
if(hURL<>nil) then
hRequest := HttpOpenRequest(hURL, 'POST', PChar('param=value'),'HTTP/1.0',PChar(''), nil, INTERNET_FLAG_RELOAD or INTERNET_FLAG_PRAGMA_NOCACHE,0);
if(hRequest<>nil) then
HttpSendRequest(hRequest, nil, 0, nil, 0);
InternetCloseHandle(hNet);
except
on E : Exception do
ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
end;
end
end;
But this doesn't do anything (I am sniffing network http traffic to see if it works).
I have successfully used InternetOpenURL but I also need to send POST request and that function doesn't do that.
Could someone show me a simple example? The result I want is to get the http response page in a var as string.

I got all the url/filename part messed up with the previous code. I'm using this from Jeff DeVore now and it's working fine:
function request(const AUrl, AData: AnsiString; blnSSL: Boolean = True): AnsiString;
var
aBuffer : Array[0..4096] of Char;
Header : TStringStream;
BufStream : TMemoryStream;
sMethod : AnsiString;
BytesRead : Cardinal;
pSession : HINTERNET;
pConnection : HINTERNET;
pRequest : HINTERNET;
parsedURL : TStringArray;
port : Integer;
flags : DWord;
begin
ParsedUrl := ParseUrl(AUrl);
Result := '';
pSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(pSession) then
try
if blnSSL then
Port := INTERNET_DEFAULT_HTTPS_PORT
else
Port := INTERNET_DEFAULT_HTTP_PORT;
pConnection := InternetConnect(pSession, PChar(ParsedUrl[0]), port, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if Assigned(pConnection) then
try
if (AData = '') then
sMethod := 'GET'
else
sMethod := 'POST';
if blnSSL then
flags := INTERNET_FLAG_SECURE or INTERNET_FLAG_KEEP_CONNECTION
else
flags := INTERNET_SERVICE_HTTP;
pRequest := HTTPOpenRequest(pConnection, PChar(sMethod), PChar(ParsedUrl[1]), nil, nil, nil, flags, 0);
if Assigned(pRequest) then
try
Header := TStringStream.Create('');
try
with Header do
begin
WriteString('Host: ' + ParsedUrl[0] + sLineBreak);
WriteString('User-Agent: Custom program 1.0'+SLineBreak);
WriteString('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'+SLineBreak);
WriteString('Accept-Language: en-us,en;q=0.5' + SLineBreak);
WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7'+SLineBreak);
WriteString('Keep-Alive: 300'+ SLineBreak);
WriteString('Connection: keep-alive'+ SlineBreak+SLineBreak);
end;
HttpAddRequestHeaders(pRequest, PChar(Header.DataString), Length(Header.DataString), HTTP_ADDREQ_FLAG_ADD);
if HTTPSendRequest(pRequest, nil, 0, Pointer(AData), Length(AData)) then
begin
BufStream := TMemoryStream.Create;
try
while InternetReadFile(pRequest, #aBuffer, SizeOf(aBuffer), BytesRead) do
begin
if (BytesRead = 0) then Break;
BufStream.Write(aBuffer, BytesRead);
end;
aBuffer[0] := #0;
BufStream.Write(aBuffer, 1);
Result := PChar(BufStream.Memory);
finally
BufStream.Free;
end;
end;
finally
Header.Free;
end;
finally
InternetCloseHandle(pRequest);
end;
finally
InternetCloseHandle(pConnection);
end;
finally
InternetCloseHandle(pSession);
end;
end;
ParseUrl is a function that splits a URL in "hostname / filename" and TStringArray is an array of strings. I still have to review the code tomorrow but it looks fine and in my sniffer I saw the post data and headers being sent.

Personally I prefer to use the synapse library for all of my TCP/IP work. For example, a simple HTTP post can be coded as:
uses
httpsend;
function testpost;
begin
stm := tStringstream.create('param=value');
try
HttpPostBinary('http://example.com',Stm);
finally
stm.free;
end;
end;
The library is well written and very easy to modify to suit your specific requirements. The latest subversion release works without any problems for both Delphi 2009 and Delphi 2010. This framework is not component based, but rather is a series of classes and procedures which well in a multi-threaded environment.

The third parameter (lpszObjectName) to HttpOpenRequest should be the URL you wish to request. That's why the documentation describes the fifth parameter (lpszReferer) as "a pointer to a null-terminated string that specifies the URL of the document from which the URL in the request (lpszObjectName) was obtained."
The posted data gets sent with HttpSendRequest; the lpOptional parameter is described like this:
Pointer to a buffer containing any optional data to be sent immediately after the request headers. This parameter is generally used for POST and PUT operations. The optional data can be the resource or information being posted to the server. This parameter can be NULL if there is no optional data to send.
The second parameter to InternetOpen should be just the server name; it should not include the protocol. The protocol you specify with the sixth parameter.
After you've sent the request, you can read the response with InternetReadFile and InternetQueryDataAvailable.
Don't just check whether the API functions return zero and then proceed on the next line. If they fail, call GetLastError to find out why. The code you've posted will not raise exceptions, so it's futile to catch any. (And it's foolish to "handle" them the way you're doing so anyway. Don't catch an exception that you don't already know how to fix. Let everything else go up to the caller, or the caller's caller, etc.)

Related

How to determine the size of a buffer for a DLL call when the result comes from the DLL

Using both Delphi 10.2 Tokyo and Delphi XE2.
I have a DLL that posts XML data to a site. The DLL is built with Delphi 10 in order to use TLS 1.2, which is not available with Delphi XE2.
The call to the DLL comes from a Delphi XE2 EXE, but I don't believe that is relevant, but I am noting it nonetheless.
The call to post data to a site will often return text data. Sometimes very large amounts of text data. Greater than 150K characters.
My original DLL convention was basically not correct, as I returned the contents of the returned text data as a PChar. In my readings here and elsewhere, that's a big no-no.
That "bad" methodology worked well until I started to get very large amounts of data returned. I tested it, and it failed on anything greater than 132,365 characters.
I restructured my DLL and calling code to pass in a buffer as a PChar to fill in, but I get an error trying to fill the output value!
Secondly, since I never know how big the returned data will be, how to I specify how big a buffer to fill from my calling method?
My DLL code where I get the error:
library TestDLL;
uses
SysUtils,
Classes,
Windows,
Messages,
vcl.Dialogs,
IdSSLOpenSSL, IdHTTP, IdIOHandlerStack, IdURI,
IdCompressorZLib;
{$R *.res}
function PostAdminDataViaDll(body, method, url: PChar; OutData : PChar; OutLen : integer): integer; stdcall
var HTTPReq : TIdHTTP;
var Response: TStringStream;
var SendStream : TStringStream;
var IdSSLIOHandler : TIdSSLIOHandlerSocketOpenSSL;
var Uri : TIdURI;
var s : string;
begin
Result := -1;
try
HTTPReq := TIdHTTP.Create(nil);
IdSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
IdSSLIOHandler.SSLOptions.Mode := sslmClient;
IdSSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2, sslvTLSv1_1];
if Assigned(HTTPReq) then begin
HTTPReq.Compressor := TIdCompressorZLib.Create(HTTPReq);
HTTPReq.IOHandler := IdSSLIOHandler;
HTTPReq.ReadTimeout := 180000;//set read timeout to 3 minutes
HTTPReq.Request.ContentType := 'text/xml;charset=UTF-8';
HTTPReq.Request.Accept := 'text/xml';
HTTPReq.Request.CustomHeaders.AddValue('SOAPAction', 'http://tempuri.org/Administration/' + method);
HTTPReq.HTTPOptions := [];
end;
SendStream := TStringStream.Create(Body);
Response := TStringStream.Create(EmptyStr);
try
HTTPReq.Request.ContentLength := Length(Body);
Uri := TiDUri.Create(url);
try
HTTPReq.Request.Host := Uri.Host;
finally
Uri.Free;
end;
HTTPReq.Post(url + 'admin.asmx', SendStream,Response);
if Response.Size > 0 then begin
if assigned(OutData) then begin
s := Response.DataString;// Redundant? Probably can just use Response.DataString?
StrPLCopy(OutData, s, OutLen);// <- ACCESS VIOLATION HERE
//StrPLCopy(OutData, s, Response.Size);// <- ACCESS VIOLATION HERE
Result := 0;
end;
end
else begin
Result := -2;
end;
finally
Response.Free;
SendStream.Free;
IdSSLIOHandler.Free;
HTTPReq.Free;
end;
except
on E:Exception do begin
ShowMessage(E.Message);
Result := 1;
end;
end;
end;
exports
PostAdminDataViaDll;
begin
end.
My Calling method code:
function PostAdminData(body, method, url : string): IXMLDOMDocument;
type
TMyPost = function (body, method, url: PChar; OutData : PChar; OutLen : integer): integer; stdcall;
var Handle : THandle;
var MyPost : TMyPost;
var dataString : string;
var returnData : string;
begin
if not (FileExists(ExtractFilePath(Application.ExeName) + 'TestDLL.DLL')) then begin
Application.MessageBox(pchar('Unable to find TestDLL.DLL.'), pchar('Error posting'),MB_ICONERROR + MB_OK);
Exit;
end;
dataString := EmptyStr;
returnData := '';
Handle := LoadLibrary(PChar(ExtractFilePath(Application.ExeName) + 'TestDLL.DLL'));
if Handle <> 0 then begin
try
try
MyPost := GetProcAddress(Handle, 'PostAdminDataViaDll');
if #MyPost <> nil then begin
// NOTE 32767 is not big enough for the returned data! Help!
if MyPost(PChar(body), PChar(method), PChar(url), PChar(returnData), 32767) = 0 then begin
dataString := returnData;
end;
end;
except
end;
finally
FreeLibrary(Handle);
end;
end
else begin
Application.MessageBox(pchar('Unable to find TestDLL.DLL.'), pchar('Error posting'),MB_ICONERROR + MB_OK);
end;
if not sametext(dataString, EmptyStr) then begin
try
Result := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
Result.async := False;
Result.loadXML(dataString);
except
end;
end;
end;
I have a DLL that posts XML data to a site. The DLL is built with Delphi 10 in order to use TLS 1.2, which is not available with Delphi XE2.
Why not simply update Indy in XE2 to a newer version that supports TLS 1.2? Then you don't need the DLL at all.
My original DLL convention was basically not correct, as I returned the contents of the returned text data as a PChar. In my readings here and elsewhere, that's a big no-no.
It is not a "big no-no", especially if the response data is dynamic in nature. Returning a pointer to dynamically allocated data is perfectly fine. You would simply have to export an extra function to free the data when the caller is done using it, that's all. The "big no-no" is that this does introduce a potential memory leak, if the caller forgets to call the 2nd function. But that is what try..finally is good for.
That "bad" methodology worked well until I started to get very large amounts of data returned. I tested it, and it failed on anything greater than 132,365 characters.
That is not a lot of memory. Any failure you were getting with it was likely due to you simply misusing the memory.
I restructured my DLL and calling code to pass in a buffer as a PChar to fill in, but I get an error trying to fill the output value!
That is because you are not filling in the memory correctly.
Secondly, since I never know how big the returned data will be, how to I specify how big a buffer to fill from my calling method?
You can't, when using POST. You would have to cache the response data somewhere off to the side, and then expose ways to let the caller query that cache for its size and data afterwards.
My DLL code where I get the error:
My Calling method code:
I see a number of logic mistakes in that code.
But, the most important reason for the Access Violation error is that your EXE is simply not allocating any memory for its returnData variable.
Casting a string to a PChar never produces a nil pointer. If the input string is not empty, a pointer to the string's first Char is returned. Otherwise, a pointer to a static #0 Char is returned instead. This ensures that a string casted to PChar always results in a non-nil, null-terminated, C style character string.
Your EXE is telling the DLL that returnData can hold up to 32767 chars, but in reality it can't hold any chars at all! In the DLL, OutData is not nil, and OutLen is wrong.
Also, StrPLCopy() always null-terminates the output, but the MaxLen parameter does not include the null-terminator, so the caller must allocate room for MaxLen+1 characters. This is stated in the StrPLCopy() documentation.
With all of this said, try something more like this:
library TestDLL;
uses
SysUtils,
Classes,
Windows,
Messages,
Vcl.Dialogs,
IdIOHandlerStack, IdSSLOpenSSL, IdHTTP, IdCompressorZLib;
{$R *.res}
function PostAdminDataViaDll(body, method, url: PChar;
var OutData : PChar): integer; stdcall;
var
HTTPReq : TIdHTTP;
SendStream : TStringStream;
IdSSLIOHandler : TIdSSLIOHandlerSocketOpenSSL;
s : string;
begin
OutData := nil;
try
HTTPReq := TIdHTTP.Create(nil);
try
IdSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTPReq);
IdSSLIOHandler.SSLOptions.Mode := sslmClient;
IdSSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
HTTPReq.IOHandler := IdSSLIOHandler;
HTTPReq.Compressor := TIdCompressorZLib.Create(HTTPReq);
HTTPReq.ReadTimeout := 180000;//set read timeout to 3 minutes
HTTPReq.HTTPOptions := [];
HTTPReq.Request.ContentType := 'text/xml';
HTTPReq.Request.Charset := 'UTF-8';
HTTPReq.Request.Accept := 'text/xml';
HTTPReq.Request.CustomHeaders.AddValue('SOAPAction', 'http://tempuri.org/Administration/' + method);
SendStream := TStringStream.Create(Body, TEncoding.UTF8);
try
s := HTTPReq.Post(string(url) + 'admin.asmx', SendStream);
finally
SendStream.Free;
end;
Result := Length(s);
if Result > 0 then begin
GetMem(OutData, (Result + 1) * Sizeof(Char));
Move(PChar(s)^, OutData^, (Result + 1) * Sizeof(Char));
end;
finally
HTTPReq.Free;
end;
except
on E: Exception do begin
ShowMessage(E.Message);
Result := -1;
end;
end;
end;
function FreeDataViaDll(Data : Pointer): integer; stdcall;
begin
try
FreeMem(Data);
Result := 0;
except
on E: Exception do begin
ShowMessage(E.Message);
Result := -1;
end;
end;
end;
exports
PostAdminDataToCenPosViaDll,
FreeDataViaDll;
begin
end.
function PostAdminData(body, method, url : string): IXMLDOMDocument;
type
TMyPost = function (body, method, url: PChar; var OutData : PChar): integer; stdcall;
TMyFree = function (Data Pointer): integer; stdcall;
var
hDll : THandle;
MyPost : TMyPost;
MyFree : TMyFree;
dataString : string;
returnData : PChar;
returnLen : Integer;
begin
hDll := LoadLibrary(PChar(ExtractFilePath(Application.ExeName) + 'TestDLL.DLL'));
if hDll = 0 then begin
Application.MessageBox('Unable to load TestDLL.DLL.', 'Error posting', MB_ICONERROR or MB_OK);
Exit;
end;
try
try
MyPost := GetProcAddress(hDll, 'PostAdminDataViaDll');
MyFree := GetProcAddress(hDll, 'FreeDataViaDll');
if Assigned(MyPost) and Assigned(MyFree) then begin
returnLen := MyPost(PChar(body), PChar(method), PChar(url), returnData);
if returnLen > 0 then begin
try
SetString(dataString, returnData, returnLen);
finally
MyFree(returnData);
end;
end;
end;
finally
FreeLibrary(hDll);
end;
except
end;
if dataString <> '' then begin
try
Result := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
Result.async := False;
Result.loadXML(dataString);
except
end;
end;
end;

Is there way to get the final URL after redirects using WinHTTP in Delphi?

I can use the following code to easily get the HTML source from the URL, but how can I get the actual URL itself? Because sometimes the initial URL goes through some redirects and the actual URL is not the same and I would like to capture it for usage. I cannot seem to find any good documentation on the usage of methods or properties for winHTTP in Delphi. Thanks!
var http: variant;
begin
http:=createoleobject('WinHttp.WinHttpRequest.5.1');
http.open('GET', 'http://URLtoWebsite.com', false);
http.send;
showmessage(http.responsetext);
end;
You can use something like this
function GetFinalURL(const AMainURL: string): string;
var
http: Variant;
begin
Result := '';
http := CreateOleObject('WinHttp.WinHttpRequest.5.1');
http.Option(6) := False;
http.open('GET', AMainURL, false);
http.send;
if http.Status = 302 then
Result := http.getResponseHeader('Location')
else
Result := AMainURL;
end;
Another way using Indy
function GetFinalURL(const AMainURL: string): string;
var
idHTTP: TIdHTTP;
begin
Result := '';
idHTTP := TIdHTTP.Create(nil);
try
idHTTP.HandleRedirects := True;
try
idHTTP.Get(AMainURL);
Result := idHTTP.Request.URL;
except
end;
finally
idHTTP.Free;
end;
end;
You can set WinHttpSetStatusCallback with WINHTTP_CALLBACK_FLAG_REDIRECT parameter to receive notifications about every redirect occurred during request.

How to get all raw request headers?

I am trying to get all the raw request headers from Asynchronous Pluggable Protocol I've implemented. But I can only get a few basic headers using IHttpNegotiate. Such as Accept-Language, Referer. With a tool called HTTP Analyzer these things can be viewed in more detail.
function RetrieveRequestHeaders(const szUrl: PWideChar; const OIProtSink: IInternetProtocolSink): String;
var
pHttpNeg: IHttpNegotiate;
Headers: PWideChar;
HR: HResult;
begin
Result := '';
HR := IUnknown_QueryService(OIProtSink, IID_IHttpNegotiate, IID_IHttpNegotiate, pHttpNeg);
if Succeeded(HR) then
begin
Headers := nil;
HR := pHttpNeg.BeginningTransaction(szUrl, nil, 0, Headers);
if Succeeded(HR) then
begin
Result := Headers;
CoTaskMemFree(Headers);
end;
end;
end;
IHTTPNegotiate.BeginningTransaction will give you the (additional) headers the browser wants to add to the outgoing request. As the protocol handler you're responsible to create the full outgoing HTTP request header, like you can see with a HTTP analyzer tool.

Reading web pages / unicode

I have this function in Delphi 2009 /2010
It returns garbage, now if I change the char,pchar types to Ansichar,Pansichar it returns the text but all foreign unicode text is garbage. it drive me banana
I have been trying all kind of stuff for 2 days now
I thought I understoff this unicode crap but I guess I do not
Help please
thanks
Philippe Watel
function GetInetFileAsString(const fileURL: string): string;
const
C_BufferSize = 1024;
var
sAppName: string;
hSession,
hURL: HInternet;
Buffer: array[0..C_BufferSize] of Char;
BufferLen: DWORD;
strPageContent: string;
strTemp: string;
begin
Result := '';
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil,
nil, 0);
try
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
try
strPageContent := '';
repeat
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen);
SetString(strTemp, PChar(#buffer), BufferLen div SizeOf(Char));
strPageContent := strPageContent + strTemp;
until BufferLen = 0;
Result := strPageContent;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end
end;
Starting in Delphi 2009, String is an alias for UnicodeString, which holds UTF-16 data. An HTML page, on the other hand, is typically encoded using a multi-byte Ansi encoding instead (usually UTF-8 nowadays, but not always). Your current code will only work if the HTML is encoded as UTF-16, which is very rare. You should not be reading the raw HTML bytes into a UnicodeString directly. You need to first download the entire data into a TBytes, RawByteString, TMemoryStream, or other suitable byte container of your choosing, and then perform an Ansi->Unicode conversion afterwards, based on the charset that is specified in the HTTP "Content-Type" response header. You can use the Accept-charset request header to tell the server which charset you prefer the data be sent as, and if the server is not able to use that charset then it should send a 406 Not Acceptable response (though it MIGHT still send a successful response in an unacceptable charset if it chooses to ignore your request header, so you should account for that).
Try something like this:
function GetInetFileAsString(const fileURL: string): string;
const
C_BufferSize = 1024;
var
sAppName: string;
hSession, hURL: HInternet;
Buffer: array of Byte;
BufferLen: DWORD;
strHeader: String;
strPageContent: TStringStream;
begin
Result := '';
SetLength(Buffer, C_BufferSize);
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
strHeader := 'Accept-Charset: utf-8'#13#10;
hURL := InternetOpenURL(hSession, PChar(fileURL), PChar(strHeader), Length(strHeader), 0, 0);
try
strPageContent := TStringStream.Create('', TEncoding.UTF8);
try
repeat
if not InternetReadFile(hURL, PByte(Buffer), Length(Buffer), BufferLen) then
Exit;
if BufferLen = 0 then
Break;
strPageContent.WriteBuffer(PByte(Buffer)^, BufferLen);
until False;
Result := strPageContent.DataString;
// or, use HttpQueryInfo(HTTP_QUERY_CONTENT_TYPE) to get
// the Content-Type header, parse out its "charset" attribute,
// and convert strPageContent.Memory to UTF-16 accordingly...
finally
strPageContent.Free;
end;
finally
InternetCloseHandle(hURL);
end
finally
InternetCloseHandle(hSession);
end;
end;
My first thought is to add the correct AcceptEncoding/CharSet header to the request:
e.g:
Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7

How in Delphi 2009 redirect console (stin, sterr)?

I try several samples in the internet and none of them work - the scripts are not executed- (maybe because are for pre Delphi 2009 unicode?).
I need to run some python scripts and pass arguments to them, like:
python "..\Plugins\RunPlugin.py" -a login -u Test -p test
And capture the output to a string & the errors to other.
This is what I have now:
procedure RunDosInMemo(DosApp:String; var OutData: String);
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of Char;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
OutData := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES or CREATE_UNICODE_ENVIRONMENT;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := 'C:\';
Handle := CreateProcess(nil, PChar(DosApp),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
begin
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
OutData := OutData + String(Buffer);
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
end else begin
raise Exception.Create('Failed to load python plugin');
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
Create_Unicode_Environment is a process creation flag, meant for use in the dwCreationFlags parameter of CreateFile. It is not a flag for use in the TStartupInfo record. API functions are liable to fail if you give them flag values they don't understand, and they're liable to do strange things if you give them flag values that mean something other than what you expected.
You declare a buffer of 256 Chars; recall that Char in Delphi 2009 is a 2-byte Unicode type. You then call ReadFile and tell it that the buffer is 255 bytes long instead of the real value, 512. When the documentation says that a value is the number of bytes, take that as your cue to use the SizeOf function.
Since ReadFile reads bytes, it would be a good idea to declare your buffer array to be an array of byte-sized elements, such as AnsiChar. That way, when you set Buffer[BytesRead], you won't include twice the data you actually read.
The Unicode version of CreateProcess may modify its command-line argument. You must ensure that the string you pass to that parameter has a reference count of 1. Call UniqueString(DosApp) before you call CreateProcess.
When an API function fails, you will of course want to know why. Don't just make up a reason. Use the functions provided, such as Win32Check and RaiseLastOSError. At the very least, call GetLastError, like MSDN tells you to. Don't throw a generic exception type when a more specific one is readily available.
I'm not certain the WaitForSingleObject is the way to go... I think its better to loop with GetExitCodeProcess(pi.hProcess,iExitCode) until iExitCode <> STILL_ACTIVE and then check for data on each pass through the loop.
The code as written does not operate under Delphi 2007 either, so its not a Delphi 2009 unicode issue.
Changing your inner loop to the following works:
if Handle then
begin
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
for ix := 0 to BytesRead-1 do
begin
OutData := OutData + AnsiChar(Buffer[ix]);
end;
GetExitCodeProcess(pi.hProcess,iExit);
until (iExit <> STILL_ACTIVE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
I made the following corrections/additions to the local variables:
Buffer: array[0..255] of byte;
iExit : Cardinal;
IX : integer;
I also moved the CloseHandle(StdOutPipeWrite) just before the close of the StdOutPipeRead.

Resources