function TDigital.EnviarPost(Url, Post: AnsiString; out Reply: TStrings): Boolean;
//***********************************************************************************
function ReadFromStream(Buffer: PAnsiChar; Size, Count: Integer;
Stream: TStream): Integer; cdecl;
begin
Result:= Stream.Read(Buffer^,Size*Count) div Size;
end;
function SaveToStream(Buffer: PAnsiChar; Size, Count: Integer;
Stream: TStream): Integer; cdecl;
begin
Result:= Stream.Write(Buffer^,Size*Count) div Size;
end;
function MemoryStreamToString(M:TMemoryStream): AnsiString;
begin
SetString(Result, PChar(M.Memory), M.Size);
end;
//***********************************************************************************
procedure ErrorCurl(const mensaje: string);
begin
raise Exception.Create(mensaje);
exit;
end;
begin
Result:= false;
Curl:= curl_easy_init;
if Curl <> nil then
try
if curl_easy_setopt(Curl, CURLOPT_VERBOSE, TRUE) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_VERBOSE.');
if curl_easy_setopt(Curl, CURLOPT_USE_SSL, CURLUSESSL_ALL) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_USE_SSL.');
if curl_easy_setopt(Curl, CURLOPT_SSL_VERIFYPEER, FALSE) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_SSL_VERIFYPEER.');
if curl_easy_setopt(Curl, CURLOPT_URL, PAnsiChar(URL)) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_URL.');
if curl_easy_setopt(Curl, CURLOPT_POST, 1) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_POST.');
if curl_easy_setopt(Curl, CURLOPT_READFUNCTION, @ReadFromStream) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_READFUNCTION.');
if curl_easy_setopt(Curl, CURLOPT_WRITEFUNCTION, @SaveToStream) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_WRITEFUNCTION.');
if curl_easy_setopt(Curl, CURLOPT_WRITEFUNCTION, @SaveToStream) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_WRITEFUNCTION.');
if curl_easy_setopt(Curl, CURLOPT_CONNECTTIMEOUT, 30) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_CONNECTTIMEOUT.');
if curl_easy_setopt(Curl, CURLOPT_TIMEOUT, 180) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_TIMEOUT.');
// if FproxyCurl.proxyIP <> '' then
// begin
// if curl_easy_setopt(Curl, CURLOPT_HTTPPROXYTUNNEL, 1) <> CURLE_OK then
// ErrorCurl('No se pudo asignar CURLOPT_HTTPPROXYTUNNEL.');
// if curl_easy_setopt(Curl, CURLOPT_PROXY, FproxyCurl.proxyIP + ':' + FproxyCurl.proxyPort ) <> CURLE_OK then
// ErrorCurl('No se pudo asignar CURLOPT_PROXY.');
//
// if FproxyCurl.proxyUsr <> '' then
// begin
// if curl_easy_setopt(Curl, CURLOPT_PROXYUSERPWD, FproxyCurl.proxyUsr + ':' + FproxyCurl.proxyPwd ) <> CURLE_OK then
// ErrorCurl('No se pudo asignar CURLOPT_PROXYUSERPWD.');
// end;
// end;
Stream := TMemoryStream.Create;
StreamOut := TMemoryStream.Create;
try
with TStringList.Create do
try
Add(Post);
SaveToStream(Stream);
finally
Free;
end;
Stream.Position:= 0;
if curl_easy_setopt(Curl, CURLOPT_INFILE, Stream) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_INFILE.');
if curl_easy_setopt(Curl, CURLOPT_POSTFIELDSIZE, Stream.Size) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_POSTFIELDSIZE.');
Header := nil;
Header := curl_slist_append(Header,PAnsiChar('Expect:'));
Header := curl_slist_append(Header,PAnsiChar('Content-Type: text/xml;charset=UTF-8'));
Header := curl_slist_append(Header,PAnsiChar('SOAPAction: "urn:'+FsoapAction+'"'));
Header := curl_slist_append(Header,PAnsiChar('Accept: text/xml'));
Header := curl_slist_append(Header,PAnsiChar('Accept-Encoding: gzip,deflate,identity'));
Header := curl_slist_append(Header,PAnsiChar('User-Agent: Jakarta Commons-HttpClient/3.1'));
try
if curl_easy_setopt(Curl, CURLOPT_FILE, StreamOut) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_FILE.');
if curl_easy_setopt(Curl, CURLOPT_HTTPHEADER, Header) <> CURLE_OK then
ErrorCurl('No se pudo asignar CURLOPT_HTTPHEADER.');
curlResult := curl_easy_perform(Curl);
if curlResult = CURLE_OK then
begin
Reply.Text := MemoryStreamToString(StreamOut);
curlError := '';
result := true;
end
else begin
curlError := curl_easy_strerror(curlResult);
Reply.Text := curlError;
result := false;
end;
finally
curl_slist_free_all(Header);
end;
finally
Stream.Free;
StreamOut.Free;
end;
finally
curl_easy_cleanup(Curl);
end;
end;
