I´m using a Dahua Facial terminal and it has a API like (CGI style) and a SDK. i asked some questions about dll convertions, but now i´m trying to use de API too.
The API to monitoring the events handled by Facial is
http://192.168.1.201/cgi-bin/snapManager.cgi?action=attachFileProc&Flags[0]=Event&Events=[AccessControl]
Is a multipart/x-mixed-replace response how return a first bondary as text/plain with the event data and a bondary with a image/jpeg with the snapshot of the event.
Using the info online about Indy and some useful posts made by Lebeau i cad read the text data using idHttp.IoHanlder.ReadLn(IndyTextEncoding_UTF8)
I tryed to read the next bondary (image) with idHttp.IOHandler.ReadByte, ReadBytes, ReadStream but not sucess.
Here is the response using idHttp.IoHandler.ReadLn
--myboundary
Content-Type: text/plain
Content-Length: 1035
Events[0].Alive=100
Events[0].CardName=Joao Test
Events[0].CardNo=0B8748EB
Events[0].CardType=0
Events[0].CreateTime=1616297700
Events[0].Door=0
Events[0].ErrorCode=0
Events[0].Method=15
Events[0].ReaderID=1
Events[0].Similarity=99
Events[0].SnapPath=/var/tmp/partsnap96.jpg
Events[0].Status=1
Events[0].Type=Entry
Events[0].UTC=1616297700
Events[0].UserID=1
Events[0].UserType=0
--myboundary
Content-Type: image/jpeg
Content-Length: 54235
����
(1#%(:3=<9387#H\N#DWE78PmQW_bghg>Mqypdx\egc//cB8Bcccccccccccccccccccccccccccccccccccccccccccccccccc//cB8Bcccccccccccccccccccccccccccccccccccccccccccccccccc��
%&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz�������������������������������������������������������������������������
$4�%�&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz��������������������������������������������������������������������������
�XQz �?m�c$[J��5"�Hz�~5���m+��b{�����{��n��*p�p*�8�bx��
`3mjLQ��9CB���T���D���'ޥAY\ų���>�*��c�U���h�R�%��je�W��*]�m�p��m?��c6�?��b��R��1N�.(��.)إ�
u\,8�
)�ny�ڌү
#
#��
L�rɳ���B�Ns�� S�K��
�i�F��Z�af�
������ޭ�T�
/l�i]Q��l������
C�RS�
ʛO^�ҫ���
h�
P)#�
pN��
\S���0�1K�
f2N�⫑S�-�LF-�Y�8?0��.�?[�nE[��t[��s�w�h��_���y�[�R�*��=je ������4�M��,?�x��Ƣ�Sל�t8�F�
ZJZ
(��R�E
)h�bR�K#����
p�S����)تb���x1�O��(��i�1����5��r=i��i�B�A��J�{���ںT5s��_��
Q#-�
Z1J
x�i�i�S�NU��
�Kf=9=Pƺ�s�ٿ��N����uS�Tj��#��d��-N-����gw�W5�0*z0��=&m��=T��S�����
x�`JpJxZpZ"��i
p���#
<S7
P���R�a�wP"���� %!�Q�
��`�M�6��wⵍfjJb�I�������{�h/���ڞ�r�Q��Ta�ϫ�7E��o�����5%���X��C�
�v�G�rO���
��徸�(�O�T�4�4��ц��j8�
��3sM�X�'�G��ڪξ\�/L|��i����I?+|�Z�
�?��K[M��L7�^
K�#d�Hb��q߯�V�'|a��C�E�Z�+�
f�&����`'�ϑ��E�r>�Ƶ'Q�7~��<r}��XT�+������pHQۭ
I´m creating a class to implement the API and SDK, in this case (API) to manage the events i wrote a thread class to consume the Event API and syncronize the data when a event occur, the idHttp is owned by the thread class and it inside a TDispositivo class, so i run one thread class for each TDispositivo included on main class.
Here is the Execute code from the thread. (ignoring the image data because i do not now how to get it rigth.
procedure TMonitor.Execute;
var
Ret, URL, Chave, Valor : String;
I, isInteger : Integer;
Concluido : boolean;
Tentativas: Integer;
begin
Tentativas := 3;
fAtivo := True;
FContador := 0; //zerando contador
//executa enquanto fAtivo for True e terminated for False
while fAtivo and not self.Terminated do
begin
if fOwner.alive then
begin
//preparando URL
With fOwner.Config do
begin
Url := 'http://'+ IP + ifthen(PortaWeb>=0,':'+PortaWeb.ToString,'')+'/cgi-bin/snapManager.cgi?action=attachFileProc&Flags[0]=Event&Events=[AccessControl]';
end;
//Incrementando contado
Inc(fContador);
//Efetuando o GET dentro de um try except para evitar interrupcao na thread
Try
ret := fHttp.Get(Url);
except
End;
fOwner.doGet(fhttp.ResponseCode, fhttp.ResponseText);
//tratando erros http
if fHttp.ResponseCode <> 200 then
begin
case fHttp.ResponseCode of
400: Erro(740,'Chamada ao terminal mal formada');
401: Erro(741,'Chamada ao terminal não autorizada');
403: Erro(743,'Recurso do servidor proibido');
404: Erro(744,'Recurso do terminal não encontrado');
500: Erro(750,'Erro interno no processamento de chamadas do terminal');
501: Erro(751,'Recurso do terminal não implementado');
end;
if (fContador >= Tentativas) then
begin
Erro(700,'Falha ao conectar o dispositivo. Número de tentativas excedido');
fContador := 0;
//verificando se vai continuar tentando se reconectar
if fOwner.Config.Reconectar then
begin
Log('Aguardando para tentar reconectar o monitor ...');
Sleep(fOwner.Config.TempoEsperaReconectar);
end
else
begin
Log('Finalizando monitoramento por falha de comunicação');
Self.Stop;
end;
end;
end
else
begin
//zerando contador após uma conexão bem sucedida;
FContador := 0;
//para evitar final do chunk ou close gracefully
try
if IsHeaderMediaType(fHttp.Response.ContentType, 'multipart') then
begin
i := 0;
Concluido := False;
repeat
if (i >= 35) Or Concluido then
begin
//tirando snap antes de processar o evento para ver se diminui o delay
if FOwner.Config.SnapshotEvento then
fOwner.getSnapshot;
Synchronize(Evento);
Concluido := False;
i := 0;
end;
fLinha := fHttp.IOHandler.ReadLn(IndyTextEncoding_UTF8);
if Pos('Content-Length', fLinha) > 0 then
begin
i := 0;
Concluido := False;
fEvento.Limpar;
end
Else if Pos('Events[', fLinha) > 0 then
begin
if fOwner.Config.Depurar then
Log(fLinha);
Inc(I);
Chave := Trim(retPar(1,'=',retPar(2,'.',fLinha)));
Valor := Trim(retPar(2,'=',fLinha));
if Valor = '' then
Valor := '0';
With fEvento do
begin
if Chave = 'Alive' then
Alive := ifthen(Valor = '',0,Valor.ToInteger)
else if Chave = 'CardName' then
CardName := ifthen(Trim(Valor) = '0','Não identificado',trim(Valor))
else if Chave = 'CardNo' then
begin
if TryStrToInt(Valor, isInteger) then
CardNo := ifthen(Valor = '', '-1', Valor)
else
CardNo := WiegandHexToInt(Valor).ToString;
end
else if Chave = 'CardType' then
CardType := ifthen(Valor = '', -1, Valor.ToInteger)
else if Chave = 'CreateTime' then
CreateTime := UnixToDateTime(Valor.ToInt64, False)
else if Chave = 'Door' then
Door := ifThen(Valor = '',-1, Valor.ToInteger)
else if Chave = 'ErrorCode' then
ErrorCode := ifThen(Valor = '',-1, Valor.ToInteger)
else if Chave = 'EventBaseInfo.Action' then
EventBaseAction := Valor
else if Chave = 'EventBaseInfo.Code' then
EventBaseCode := Valor
else if Chave = 'EventBaseInfo.Index' then
EventBaseIndex := ifThen(Valor = '',-1, Valor.ToInteger)
else if Chave = 'Method' then
Metodo := ifThen(Valor = '',-1, Valor.ToInteger)
else if Chave = 'ReaderID' then
LeitorID := ifThen(Valor = '',-1, Valor.ToInteger)
else if Chave = 'Similarity' then
Similaridade := ifthen(Valor = '', 0, Valor.ToInteger)
else if Chave = 'SnapPath' then
snappath := Valor
else if Chave = 'Status' then
Status := ifthen(Valor = '', -1, Valor.ToInteger)
else if Chave = '.Type' then
TipoAcesso := Valor
else if Chave = 'UTC' then
DataHora := UnixToDateTime(Valor.ToInt64, False)
else if Chave = 'UserID' then
UserID := ifthen(Valor = '', -1, Valor.ToInteger)
else if Chave = 'UserType' then
begin
i := 34;
Concluido := True;
UserType := ifthen(Valor = '', -1, Valor.ToInteger);
end;
end;
end;
until fhttp.IOHandler.ClosedGracefully;
end;
except
end;
end;
inherited;
end
else
begin
//dispositivo não respondeu ao ping
//verificando se vai continuar tentando se reconectar
if fOwner.Config.Reconectar then
begin
Log('Aguardando para tentar reconectar o monitor ...');
Sleep(fOwner.Config.TempoEsperaReconectar);
end
else
begin
Log('Finalizando monitoramento por falha de comunicação');
Self.Stop;
end;
inherited;
end;
end;
//rotina de finalização da thread
if FHttp.Connected then
begin
try
Fhttp.Disconnect;
except
end;
end;
end;
First question, Can i do it ? Indy can do It ? Any suggestions ?
Second question, I observe the loop to retrive data when GET is running raise a Close gracefully when i try to readLn after the data is end. In Firefox the GET still running after the image and still working, in my case, the GET is finished and the threand.execute call GET again.
Is possible to keep the GET running avoiding premature interruption and processes the new data when present ?
EDIT: When this part of the code run, the line NewDecoder := TIdMessageDecoderMIME(Decoder).ReadBody(BodyStream, MsgEnd); raises a close gracefully, looking deeper on Indy code i found a TIOHandler.ReadLn how execute CheckForDisconnect(True,True) when LTerm = -1 and this break the execution without retrive the last bytes of data.
Thinking about this i´m suspect has a rellation with the Responde.KeepAlive is always False ans the Connection content is always close it´s explain why Decoder.Readybody raises a Close gracefully and break my execution.
But, if i run the api call on eg. Firefox, the connection still running after the FF get the image and only interrupts whenreachs a timeout.
Is it possible something on headers sended by terminal ? or the way how idHttp parse the headers data ?
//part of code after http.get
mcptAttachment: begin
BodyStream := TMemoryStream.Create;
try
BodyStream.Position := 0;
NewDecoder := TIdMessageDecoderMIME(Decoder).ReadBody(BodyStream, MsgEnd); //<-- here comes a close gracefully
jpg := TJPEGImage.Create;
try
BodyStream.Position := 0;
jpg.LoadFromStream(BodyStream);
jpg.SaveToFile('C:\Producao\API_SDK\Facial\teste.jpg');
finally
jpg.Free;
Decoder.Free;
Decoder := NewDecoder;
end;
finally
BodyStream.Free;
end;
end;
//part of the code of tIOHandler.ReadLn
// ReadFromSource blocks - do not call unless we need to
else if LTermPos = -1 then begin
// ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
CheckForDisconnect(True,True); //The execution stops here whiout return the last bytes and premature finishing the code above with a close gracefully
// Can only return -1 if timeout
FReadLnTimedOut := ReadFromSource(True, ATimeout, False) = -1;
if (not FReadLnTimedOut) and (ATimeout >= 0) then begin
if GetElapsedTicks(LReadLnStartTime) >= UInt32(ATimeout) then begin
FReadLnTimedOut := True;
end;
end;
if FReadLnTimedOut then begin
Result := '';
Exit;
end;
EDIT: Using the New TIdHTTP hoNoReadMultipartMIME flag sample, i wrote a test app to try get the image from the boundary
var
Boundary, Line: string;
TCPStream: TIdTCPStream;
NewDecoder, Decoder: TIdMessageDecoder;
MsgEnd: Boolean;
BodyStream: TStream;
Jpg: TJpegImage;
begin
{
The code below comes from Indy Project Blog by Remy Lebeau
This connection requires Digest Auth, so i set BasicAuth to False, put the flag hoInProcessAuth
And implement the OnAuthorization and OnSelectAuthorization, the select is needed to do something to the Authorization works,
do not know why.
}
HTTP.HTTPOptions := [hoInProcessAuth, hoForceEncodeParams, hoNoReadMultipartMIME];
HTTP.Get('http://192.168.1.205/cgi-bin/snapManager.cgi?action=attachFileProc&Flags[0]=Event&Events=[AccessControl]');
//Here the response always return HTTP.Response.KeepAlive FALSE, so i exclude it from test
if IsHeaderMediaType(HTTP.Response.ContentType, 'multipart') then //and HTTP.Response.KeepAlive
begin
Boundary := ExtractHeaderSubItem(HTTP.Response.ContentType, 'boundary', QuoteHTTP);
repeat
Line := HTTP.IOHandler.ReadLn;
until (Line = ('--' + Boundary)) or (Line = ('--' + Boundary + '--'));
TCPStream := TIdTCPStream.Create(HTTP);
try
Decoder := TIdMessageDecoderMIME.Create(nil);
try
TIdMessageDecoderMIME(Decoder).MIMEBoundary := Boundary;
MsgEnd := False;
repeat
TIdMessageDecoderMIME(Decoder).SourceStream := TCPStream;
TIdMessageDecoderMIME(Decoder).FreeSourceStream := False;
Decoder.ReadHeader;
case Decoder.PartType of
mcptText: begin
BodyStream := TMemoryStream.Create;
try
NewDecoder := TIdMessageDecoderMIME(Decoder).ReadBody(BodyStream, MsgEnd);
try
BodyStream.Position := 0;
mLog.Lines.LoadFromStream(BodyStream); //<-- OK i got the text data from body and showing in a memo
finally
Decoder.Free;
Decoder := NewDecoder;
end;
finally
BodyStream.Free;
end;
end;
mcptAttachment: begin
BodyStream := TMemoryStream.Create;
try
BodyStream.Position := 0;
NewDecoder := TIdMessageDecoderMIME(Decoder).ReadBody(BodyStream, MsgEnd); //<-- here comes a close gracefully,
//so i debug the ReadBody and found a exception on line 438 of idMessadeCoderMime
// LLine := ReadLnRFC(VMsgEnd, LF, '.', LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); {do not localize}
//When it try to read a exception occurs and the connection closes gracefully
//but it read a lot of data befora except, so i thinking is something about a end of msg missing or misformed
jpg := TJPEGImage.Create;
try
BodyStream.Position := 0;
jpg.LoadFromStream(BodyStream);
jpg.SaveToFile('C:\Producao\API_SDK\Facial\teste.jpg');
finally
jpg.Free;
Decoder.Free;
Decoder := NewDecoder;
end;
finally
BodyStream.Free;
end;
end;
mcptIgnore: begin
FreeAndNil(Decoder);
Decoder := TIdMessageDecoderMIME.Create(nil);
TIdMessageDecoderMIME(Decoder).MIMEBoundary := Boundary;
end;
mcptEOF: begin
FreeAndNil(Decoder);
MsgEnd := True;
end;
end;
until (Decoder = nil) or MsgEnd;
finally
Decoder.Free;
end;
finally
TCPStream.Free;
end;
end;
end;
The part of the code mcptAttachment when NewDecoder := Decoder.ReadBody(BodyStream, MsgEnd); is called, the readbody funtion run, reading the bytes until it crashes before reach the 'Content-Length' size.
I´m trying to isolate when it crashes, but one thing is for sure, the error occurs when it try to read the next data. but i can´t find the trigger for the exception on indy source yet
EDIT: Got a imagem but can´t keep reading until server close connection cause the response alredy comes closed.
Workin Code
var
Boundary, Line: string;
TCPStream: TIdTCPStream;
NewDecoder, Decoder: TIdMessageDecoder;
MsgEnd: Boolean;
BodyStream: TStream;
Jpg: TJpegImage;
begin
HTTP.HTTPOptions := [hoInProcessAuth, hoForceEncodeParams, hoNoReadMultipartMIME];
HTTP.Get('http://192.168.1.205/cgi-bin/snapManager.cgi?action=attachFileProc&Flags[0]=Event&Events=[AccessControl]');
if IsHeaderMediaType(HTTP.Response.ContentType, 'multipart') then
begin
Boundary := ExtractHeaderSubItem(HTTP.Response.ContentType, 'boundary', QuoteHTTP);
repeat
Line := HTTP.IOHandler.ReadLn;
until (Line = ('--' + Boundary)) or (Line = ('--' + Boundary + '--'));
TCPStream := TIdTCPStream.Create(HTTP);
try
Decoder := TIdMessageDecoderMIME.Create(nil);
try
TIdMessageDecoderMIME(Decoder).MIMEBoundary := Boundary;
MsgEnd := False;
repeat
TIdMessageDecoderMIME(Decoder).SourceStream := TCPStream;
TIdMessageDecoderMIME(Decoder).FreeSourceStream := False;
if not http.IOHandler.InputBufferIsEmpty then
begin
Decoder.ReadHeader;
case Decoder.PartType of
mcptText: begin
BodyStream := TMemoryStream.Create;
try
NewDecoder := TIdMessageDecoderMIME(Decoder).ReadBody(BodyStream, MsgEnd);
try
BodyStream.Position := 0;
mEvent.Lines.LoadFromStream(BodyStream);
finally
Decoder.Free;
Decoder := NewDecoder;
end;
finally
BodyStream.Free;
end;
end;
mcptAttachment: begin
BodyStream := TMemoryStream.Create;
http.IOHandler.InputBuffer.ExtractToStream(BodyStream);
try
BodyStream.Position := 0;
jpg := TJPEGImage.Create;
try
jpg.LoadFromStream(BodyStream);
JvImage1.Picture.Assign(jpg);
jpg.SaveToFile('C:\Producao\API-SDK\Facial\teste.jpg');
finally
jpg.Free;
FreeAndNil(Decoder);
Decoder := TIdMessageDecoderMIME.Create(nil);
TIdMessageDecoderMIME(Decoder).MIMEBoundary := Boundary;
end;
finally
BodyStream.Free;
end;
end;
mcptIgnore: begin
mLog.Lines.Add('Ignore');
FreeAndNil(Decoder);
Decoder := TIdMessageDecoderMIME.Create(nil);
TIdMessageDecoderMIME(Decoder).MIMEBoundary := Boundary;
end;
mcptEOF: begin
mLog.Lines.Add('Fim');
FreeAndNil(Decoder);
MsgEnd := True;
end;
end;
end
else
begin
http.IOHandler.CheckForDisconnect(False,True);
msgend := True
end;
until (Decoder = nil) or MsgEnd;
finally
Decoder.Free;
end;
finally
TCPStream.Free;
end;
end;
end;
What you are asking for can be done with TIdHTTP, but it takes some extra work. Details are in the following blog article on Indy's website:
https://www.indyproject.org/2014/03/05/new-tidhttp-honoreadmultipartmime-flag/
In a nutshell, you need to enable the hoNoReadMultipartMIME flag in the TIdHTTP.HTTPOptions property, so that TIdHTTP.Get() won't try to read the MIME data from the TIdHTTP.IOHandler after receiving the HTTP headers. That will allow you to read the MIME data yourself. You can use Indy's TIdMessageDecoderMIME class to help with that reading. There is a code example provided in the blog article.
I have some script in some file "MyScript.sql"
On the form I have my TProgressBar.
I want to read script with TFDScript and move progressbar according to the script.
My code is
Var
Lista: TStringList; // SQL DDL list for creating table and populate table
I: Integer;
Begin
With FDConn Do //FDConn is my FaireDac connection
Begin
LoginPrompt := False;
With Params Do
Begin
Clear;
DriverID := 'SQLite';
Database := 'MyDatabase.sdb';
LoginPrompt := False;
End;
Lista := TStringList.Create;
Lista.Clear;
Try
FDScript.ValidateAll; //FDScript is TFDScript and prgBar is TProgressBar
prgBar.Max := FDScript.TotalJobSize - 1;
prgBar.Update;
Lista.Clear;
Lista.LoadFromFile('MyScript.sql');
// Now how I can read script 1 line by 1 line and move progress bar with
prgBar.StepIt;
prgBar.Update;`
You can handle the OnProgress event and read there e.g. TotalJobSize property to determine the number of bytes to proceed and TotalJobDone to get number of bytes processed. For example:
procedure TForm1.FDScript1Progress(Sender: TObject);
begin
ProgressBar1.Max := TFDScript(Sender).TotalJobSize;
ProgressBar1.Position := TFDScript(Sender).TotalJobDone;
end;
If you were having progress bar control with progress value setup by percentage, you'd better read the TotalPct10Done property.
I am trying to create video streaming server using Indy Http server. I am using ranged requests to send large files. One chunk of data is 10 Mb long. If video file which requests client is smaller than 10 Mb then it is all ok and vido is played. But if file size is longer than 10 Mb I return first chunk of data. Then client asks me for another chunk of data from the end of file and then my client says that it is unrecognizable video format. Can someone tell me where is problem in my code.
my server code
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := 'Running';
FServer := TIdHTTPServer.Create(Self);
FServer.DefaultPort := 7070;
FServer.OnCommandGet:=#External_Get;
FServer.Active := True;
end;
procedure TForm1.External_Get(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
FS: TFileStream;
Ranges: TIdEntityRanges;
Range: TIdEntityRange;
begin
Ranges := ARequestInfo.Ranges;
Range := Ranges.Ranges[0];
FS := TFileStream.Create('/home/user/Desktop/large_file.mp4', fmOpenRead or fmShareDenyWrite);
AResponseInfo.ContentType := 'video/mp4';
AResponseInfo.AcceptRanges := 'bytes';
AResponseInfo.ContentStream := TIdHTTPRangeStream.Create(
FS,
Range.StartPos,
Range.StartPos + 1024*1024*10,
True
);
AResponseInfo.FreeContentStream := True;
AResponseInfo.ContentRangeStart := TIdHTTPRangeStream(AResponseInfo.ContentStream).RangeStart;
AResponseInfo.ContentRangeEnd := TIdHTTPRangeStream(AResponseInfo.ContentStream).RangeEnd;
AResponseInfo.ContentRangeInstanceLength := AResponseInfo.ContentRangeEnd - Range.StartPos + 1;
AResponseInfo.ContentLength := FS.Size;
AResponseInfo.ResponseNo := 206;
end;
And here is my client code (I use firefox):
<!DOCTYPE html>
<html>
<head>
<meta content="text/html;charset=utf-8" http-equiv="Content-Type">
<meta content="utf-8" http-equiv="encoding">
</head>
<body>
<video width="400" controls>
<source src="http://localhost:7070/test38.mp4" type="video/mp4">
Your browser does not support HTML5 video.
</video>
</body>
</html>
There are several errors in your server code.
You are not validating that a range is actually being requested, or even respecting an end range if one is present.
You are setting the AResponseInfo.ContentLength property to the full size of the file, even when you are not sending the full file at one time. That value belongs in the AResponseInfo.ContentRangeInstanceLength property instead when sending a ranged response. You must set ContentLength to the size of the data actually being sent in the response, which in this case is your current range chunk. It is best not to set the ContentLength at all, you can let the server calculate it for you based on the assigned ContentStream.
You are setting the AResponseInfo.ResponseNo property to 206 unconditionally, even if a range is not requested at all, or if the requested range cannot be satisfied. TIdHTTPRangeStream performs validations in its constructor and sets its ResponseCode property accordingly. That is the value you should be assigning to ResponseNo.
Try something more like this instead:
procedure TForm1.External_Get(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
FS: TFileStream;
Range: TIdEntityRange;
StartPos, EndPos: Int64;
begin
if not FileExists('/home/user/Desktop/large_file.mp4') then
begin
AResponseInfo.ResponseNo := 404;
Exit;
end;
try
FS := TFileStream.Create('/home/user/Desktop/large_file.mp4', fmOpenRead or fmShareDenyWrite);
except
AResponseInfo.ResponseNo := 500;
Exit;
end;
AResponseInfo.ContentType := 'video/mp4';
AResponseInfo.AcceptRanges := 'bytes';
if ARequestInfo.Ranges.Count = 1 then
begin
Range := ARequestInfo.Ranges.Ranges[0];
StartPos := Range.StartPos;
EndPos := Range.EndPos;
if StartPos >= 0 then
begin
// requesting prefix range from BOF
if EndPos >= 0 then
EndPos := IndyMin(EndPos, StartPos + (1024*1024*10) - 1)
else
EndPos := StartPos + (1024*1024*10) - 1;
end else
begin
// requesting suffix range from EOF
if EndPos >= 0 then
EndPos := IndyMin(EndPos, 1024*1024*10)
else
EndPos := (1024*1024*10);
end;
AResponseInfo.ContentStream := TIdHTTPRangeStream.Create(FS, StartPos, EndPos);
AResponseInfo.ResponseNo := TIdHTTPRangeStream(AResponseInfo.ContentStream).ResponseCode;
if AResponseInfo.ResponseNo = 206 then
begin
AResponseInfo.ContentRangeStart := TIdHTTPRangeStream(AResponseInfo.ContentStream).RangeStart;
AResponseInfo.ContentRangeEnd := TIdHTTPRangeStream(AResponseInfo.ContentStream).RangeEnd;
AResponseInfo.ContentRangeInstanceLength := FS.Size;
end;
end else
begin
AResponseInfo.ContentStream := FS;
AResponseInfo.ResponseNo := 200;
end;
end;
What is the correct way to write a stringstream using TIdHTTP.Put() in Delphi FireMonkey?
I have a PHP API (slim) like this:
// Update user
$app->put('/api/user/update/{id}', function(Request $request, Response $response){
$id = $request->getAttribute('id');
$username = $request->getParam('username');
$password = $request->getParam('password');
$nama = $request->getParam('nama');
$alamat = $request->getParam('alamat');
$jenis_kelamin = $request->getParam('jenis_kelamin');
$foto = $request->getParam('foto');
$sql = "UPDATE user SET
username = :username,
password = :password,
nama = :nama,
alamat = :alamat,
jenis_kelamin = :jenis_kelamin,
foto = :foto
WHERE id = $id";
try{
// Get DB Object
$db = new db();
// Connect
$db = $db->connect();
$stmt = $db->prepare($sql);
$stmt->bindParam(':username', $username);
$stmt->bindParam(':password', $password);
$stmt->bindParam(':nama', $nama);
$stmt->bindParam(':alamat', $alamat);
$stmt->bindParam(':jenis_kelamin', $jenis_kelamin);
$stmt->bindParam(':foto', $foto);
$stmt->execute();
echo '{"notice": {"text": "Customer Updated"}';
} catch(PDOException $e){
echo '{"error": {"text": '.$e->getMessage().'}';
}
});
The procedure in Delphi for posting data via HTTP is like this:
procedure TForm3.updateexample;
var
lHTTP: TIdHTTP;
lParamList: TStringList;
stream : TStringStream;
mydata,json: string;
begin
json := 'username='+edtusername.Text+
'password='+edtpassword.Text+
'nama='+edtnama.Text+
'alamat='+edtalamat.Text+
'jenis_kelamin='+cbbjkel.Selected.Text+
'foto="'+edtalamat.text;
stream := TStringStream.Create(json,Tencoding.UTF8);
//create
lHTTP := TIdHTTP.Create(nil);
try
mydata := lHTTP.put
('http://myweblablalbalbala/api/user/update/'+id,stream);
if Pos('Customer Updated', mydata) > 0 then
begin
ShowMessage('Update Succes');
end
else
ShowMessage('update fail');
finally
lHTTP.Free;
lParamList.Free;
end;
end;
The code works, but after sending an update, the data changes from this (before the update):
{"id":"1","username":"iboy","password":"123456","nama":"ishak","alamat":"cikupa","jenis_kelamin":"l","foto":"iboy.jpg"}
to this (after the update):
{"id":"1","username":"","password":"","nama":"","alamat":"","jenis_kelamin":"","foto":""}
Can you help me? What is the correct way to post a stringstream via HTTP I Delphi?
You are not formatting your TStringstream data correctly. It is not even close to being JSON (despite your variable name). And you are also not setting the TIdHTTP.Request.ContentType property so the server knows what kind of data you are actually sending.
If you read the Slim documentation, Slim supports the following media types out of the box:
application/x-www-form-urlencoded
application/json
application/xml & text/xml
The data you are trying to send is closest to application/x-www-form-urlencoded. That is normally sent using TIdHTTP.Post() instead of TIdHTTP.Put(), by giving it a TStrings object of name=value pairs. Post() will format the values in the application/x-www-form-urlencoded format for you, and set the Request.ContentType property to match.
Your PHP is expecting a PUT request instead of a POST request. Per the Slim documentation, you can actually send a POST request and make it act like a PUT request, by either:
including a _METHOD=PUT value in your data (application/x-www-form-urlencoded only)
including an X-HTTP-Method-Override: PUT HTTP request header (works with any media type).
Try something more like this:
procedure TForm3.UpdateExample;
var
lHTTP: TIdHTTP;
lParamList: TStringList;
lReply: string;
begin
lParamList := TStringList.Create;
try
lParamList.Add('username='+edtusername.Text);
lParamList.Add('password='+edtpassword.Text);
lParamList.Add('nama='+edtnama.Text);
lParamList.Add('alamat='+edtalamat.Text);
lParamList.Add('jenis_kelamin='+cbbjkel.Selected.Text);
lParamList.Add('foto='+edtalamat.Text);
lHTTP := TIdHTTP.Create(nil);
try
// use one of these, not both!
lParamList.Add('_METHOD=PUT');
lHTTP.Request.MethodOverride := 'PUT';
lReply := lHTTP.Post('http://myweblablalbalbala/api/user/update/'+id, lParamList);
if Pos('Customer Updated', lReply) > 0 then
ShowMessage('Update Success')
else
ShowMessage('Update Fail');
finally
lHTTP.Free;
end;
finally
lParamList.Free;
end;
end;
Another Way (without Indy), multiplatform, better than with Indy:
function Upload(const aFilePath: string): boolean;
var
vData: TMultipartFormData; // uses System.Net.Mime
vHTTP: THTTPClient; // uses System.Net.HttpClient
vCRC: cardinal;
vURL: string;
vResp: TStringStream;
begin
vURL := 'PHP url';
vResp := TStringStream.Create('');
vData := TMultipartFormData.Create();
vHTTP := THTTPClient.Create;
try
try
vData.AddField('version', MyVerField.ToString);
vData.AddField('crc', MyCRC.ToString);
vData.AddFile('db_file', aFilePath);
Result := vHTTP.Post(vURL, vData, vResp).StatusCode = 200;
if Result then
Result := vResp.DataString.ContentAsString().Contains('"result":true');
except
Result := false;
end;
finally
vHTTP.Free;
vData.Free;
vResp.Free;
end;
end;
I need to program an application with Delphi that goes into this site and uses the form to get an .exe file (in fact, the site sends a .ex_ file that you have to manually rename).
http://www.bmf.com.br/arquivos1/arquivos_ipn.asp?idioma=pt-BR&status=ativo
Via browser I just click on the checkbox on the left of "Cenários de Margem - CORE" then click on the Download button and get the file automatically.
I managed to work with .dat files from other site, now I don't know what might be wrong.
I think the problem should be with the content type or how i'm saving the file.
This is what I got so far:
procedure DownloadViaPost;
var
objHttp: TIdHttp;
sUrl: String;
sGetRequest: String;
objParametrosPost: TStringList;
objRespostaPost: TStringStream;
sViewState: String;
sEventValidation: String;
begin
sUrl := 'http://www.bmf.com.br/arquivos1/arquivos_ipn.asp';
objHttp := TIdHTTP.Create(nil);
objParametrosPost := TStringList.Create;
objRespostaPost := TStringStream.Create;
try
objHttp.HandleRedirects := true;
objHttp.AllowCookies := true;
objParametrosPost.Add('hdnStatus=ativo');
objParametrosPost.Add('chkArquivoDownload_ativo=36');
objParametrosPost.Add('txtDataDownload_ativo=21/08/2014');
objParametrosPost.Add('imgSubmeter.x=31');
objParametrosPost.Add('imgSubmeter.y=9');
objParametrosPost.Add('imgSubmeter=ativo');
objHttp.Request.ContentType := 'application/octet-stream exe';
objHttp.Post(sUrl, objParametrosPost, objRespostaPost);
objRespostaPost.SaveToFile('C:\Download.ex_');
finally
FreeAndNil(objHttp);
FreeAndNil(objParametrosPost);
FreeAndNil(objRespostaPost);
end;
end;
Just like a browser would, you need to first retreive the download page to get the server's cookies, then post the download request so the cookies can be sent back to the server.
Try this:
procedure DownloadViaPost;
var
objHttp: TIdHttp;
objRespostaPost: TMemoryStream;
objParametrosPost: TStringList;
begin
objHttp := TIdHTTP.Create(nil);
try
objHttp.HandleRedirects := true;
objHttp.AllowCookies := true;
objHttp.Get('http://www.bmf.com.br/arquivos1/arquivos_ipn.asp?idioma=pt-BR&status=ativo');
objRespostaPost := TMemoryStream.Create;
try
objParametrosPost := TStringList.Create;
try
objParametrosPost.Add('hdnStatus=ativo');
objParametrosPost.Add('chkArquivoDownload_ativo=36');
objParametrosPost.Add('txtDataDownload_ativo=22/08/2014');
objParametrosPost.Add('imgSubmeter.x=37');
objParametrosPost.Add('imgSubmeter.y=6');
objHttp.Request.Referer := 'http://www.bmf.com.br/arquivos1/arquivos_ipn.asp?idioma=pt-BR&status=ativo';
objHttp.HTTPOptions := objHttp.HTTPOptions + [hoKeepOrigProtocol, hoTreat302Like303];
objHttp.Post('http://www.bmf.com.br/arquivos1/download_ipn.asp', objParametrosPost, objRespostaPost);
finally
FreeAndNil(objParametrosPost);
end;
objRespostaPost.SaveToFile('C:\Download.exe');
finally
FreeAndNil(objRespostaPost);
end;
finally
FreeAndNil(objHttp);
end;
end;