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.
We have a problem calling websites assests from Indy TIdHTTPServer in Delphi. Some times, Indy can serve media files, some times not, but the problem is just when we are calling over the network. It is working very well when calling over localhost.
For example, if we call it over the network like https://192.168.1.113:5000/?page=index then Indy cannot serve some files, if we call like https://localhost:5000/?page=index it is working well.
procedure TFolsecPermissionManager.IdHTTPServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Command: TCommand;
sFileName: string;
begin
// IdHTTPServer.CreateSession(AContext, AResponseInfo, ARequestInfo);
AContext.Connection.Socket.ReadTimeout := 6000000;
if CommandRequestFileType(ARequestInfo.URI) = 'MEDIA' then
begin
//AResponseInfo.ContentStream := CommandGetMedia(ARequestInfo.URI);
sFileName := CommandGetMedia2(ARequestInfo.URI);
if sFileName <> '' then
begin
AResponseInfo.ContentType := GetContentType(ARequestInfo.URI);
AResponseInfo.ServeFile(AContext, sFileName); // --- here doesn't work to serve file
end else
AResponseInfo.WriteContent;
exit;
end else begin
Command:= TCommand.Create;
try
Command.AContext := AContext;
Command.ARequestInfo := ARequestInfo;
Command.AResponseInfo := AResponseInfo;
Command.Synchronize;
finally
Command.Free;
end;
end;
end;
I try to send mail with added attachment. Mail arrives to the addresse withouth an attachment. I use api access in delphi (indy). Can anyone help me ? My code:
try
IdHTTP1.Request.CharSet := 'utf-8';
IdHTTP1.Request.ContentType := 'multipart/form-data';
IdHTTP1.Request.BasicAuthentication := True;
IdHTTP1.Request.Username := 'api';
IdHTTP1.Request.Password := 'my pass';
Parametri := TIdMultiPartFormDataStream.Create;
Parametri.AddFormField('from', UTF8Encode('Excited user<excited#sandbox.mailgun.org>'), 'utf-8').ContentTransfer := '8bit';
Parametri.AddFormField('to','to#mail.com');
Parametri.AddFormField('subject', UTF8Encode('xy: sub...'), 'utf-8').ContentTransfer := '8bit';
Parametri.AddFormField('text', UTF8Encode('Here is my text...'), 'utf-8').ContentTransfer := '8bit';
Parametri.AddFile('ABC.pdf', 'c:\ABC.pdf', '');
Memo1.Text := IdHTTP1.Post( 'https://api.mailgun.net/v3/sandbox.mailgun.org/messages', Parametri);
finally
Parametri.Free;
end;
Thank you,
b.
Per the MailGun API documentation, each email attachment needs to be sent in a MIME field named 'attachment'. But when calling AddFile(), you are not naming the field 'attachment', you are naming it 'ABC.pdf' instead.
Change this line:
Parametri.AddFile('ABC.pdf', 'c:\ABC.pdf', '');
To this instead:
Parametri.AddFile('attachment', 'c:\ABC.pdf');
Alternatively, the documentation also states that MailGun supports SMTP, so you could use TIdSMTP and TIdMessage instead of using TIdHTTP and TIdMultipartFormDataStream, and let TIdMessage handle the MIME formatting for you, eg:
IdSMTP1.Host := 'smtp.mailgun.org';
IdSMTP.Username := 'api';
IdSMTP.Password := 'my pass';
IdMessage1.Clear;
IdMessage1.From.Name := 'Excited user';
IdMessage1.From.Address := 'excited#sandbox.mailgun.org';
IdMessage1.Recipients.EmailAddresses := 'to#mail.com';
IdMessage1.Subject := 'xy: sub...';
IdMessage1.ContentType := 'multipart/mixed';
with TIdText.Create(IdMessage1.MessageParts, nil) do
begin
Body.Text := 'Here is my text...';
ContentType := 'text/plain';
CharSet := 'utf-8';
ContentTransfer := '8-bit';
end;
TIdAttachmentFile.Create(IdMessage1.MessageParts, 'c:\ABC.pdf');
IdSMTP1.Connect;
try
IdSMTP1.Send(IdMessage1);
finally
IdSMTP1.Disconnect;
end;
Or:
IdSMTP1.Host := 'smtp.mailgun.org';
IdSMTP.Username := 'api';
IdSMTP.Password := 'my pass';
IdMessage1.Clear;
IdMessage1.From.Name := 'Excited user';
IdMessage1.From.Address := 'excited#sandbox.mailgun.org';
IdMessage1.Recipients.EmailAddresses := 'to#mail.com';
IdMessage1.Subject := 'xy: sub...';
with TIdMessageBuilderPlain.Create do
try
PlainText := 'Here is my text...';
PlainTextCharSet := 'utf-8';
PlainTextContentTransfer := '8-bit';
Attachments.Add('c:\ABC.pdf');
FillMessage(IdMessage1);
finally
Free;
end;
IdSMTP1.Connect;
try
IdSMTP1.Send(IdMessage1);
finally
IdSMTP1.Disconnect;
end;
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.
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;