Fiz uma aplicação servidora que chamando os métodos pelo browse, funciona tudo perfeito, mas pra testar meus métodos construí um cliente usando TdHTTP
o e chamo os métodos da seguinte forma:
procedure TF_CLIENTE.SBEnviar2Click(Sender: TObject);
var Url : String;
lJSO : String;
jsonToSend : TStringStream;
begin
Url := 'http://localhost:809...ecomandoPOST/';
lJSO := ('{"name":"TESTE"}');
jsonToSend := TStringStream.Create(lJSO,TEncoding.UTF8);
idHttp.ProxyParams.Clear;
idHttp.ProxyParams.BasicAuthentication := false;
idHttp.Request.BasicAuthentication := True;
idHttp.Request.Accept := 'text/javascript';
IdHTTP.Request.ContentType := 'application/json';
IdHTTP.Request.ContentEncoding := 'utf-8';
idHttp.Request.Method := 'POST';
IdHTTP.Request.BasicAuthentication := True;
IdHTTP.Request.Authentication := TIdBasicAuthentication.Create;
IdHttp.Request.Authentication.Username := 'USUARIO';
IdHttp.Request.Authentication.password := 'SENHA';
IdHttp.Request.ContentLength := Length(lJSO);
try
Memo1.Text := idHttp.Post(Url,jsonToSend);
except
on E : Exception do
begin
Memo1.Lines.Add('Exception class name = '+E.ClassName);
Memo1.Lines.Add('Exception message = '+E.Message);
end;
end;
end;
Já Liberei o Dispatch
:
procedure TF_WebModule.WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.SetCustomHeader('access-control-allow-origin','*');
Response.SetCustomHeader('access-control-allow-Methods','PUT, POST, GET, DELETE');
Response.SetCustomHeader('access-control-allow-Headers','accept, authorization, origin');
if FServerFunctionInvokerAction <> nil then
FServerFunctionInvokerAction.Enabled := AllowServerFunctionInvoker;
end;
Já validei o usuário e vem a autenticação certinho do Indy:
procedure TF_WebModule.DSAuthenticationManager1UserAuthenticate(Sender: TObject;
const Protocol, Context, User, Password: string; var valid: Boolean;
UserRoles: TStrings);
begin
if Request.Method = 'OPTIONS' then
valid := False
else
if ((User = 'USUARIO') and (Password = 'SENHA')) then
valid := True
else
valid := False;
end;
Ele apresenta um erro:
Exception class name = EIdHTTPProtocolException Exception message = HTTP/1.1 500 Internal Server Error