• R/O
  • SSH
  • HTTPS

mantisbtmonitor: Commit


Commit MetaInfo

Revision45 (tree)
Time2019-08-02 02:56:31
Authorderekwildstar

Log Message

- Implementada a mudança de status

Change Summary

Incremental Difference

--- trunk/testes/Unit9.pas (revision 44)
+++ trunk/testes/Unit9.pas (revision 45)
@@ -38,6 +38,7 @@
3838 StatusColor: TColor;
3939 Priority: String;
4040 Project: String;
41+ Summary: String;
4142 Description: String;
4243 Category: String;
4344 LastUpdate: TDateTime;
@@ -46,7 +47,7 @@
4647 PossibleStatusChanges: TPossibleStatusChanges;
4748 end;
4849
49- TAssignedTasks = array of TTask;
50+ TTasks = array of TTask;
5051
5152 TStatusColor = record
5253 Id: Byte;
@@ -74,6 +75,7 @@
7475 procedure ColorListBox1GetColors(Sender: TCustomColorListBox;
7576 Items: TStrings);
7677 procedure Button5Click(Sender: TObject);
78+ procedure Button6Click(Sender: TObject);
7779 private
7880 { Private declarations }
7981 FUserInfo: TUserInfo;
@@ -95,61 +97,6 @@
9597 const
9698 BASE_URL = 'https://desenvolvimento.tjpe.gov.br';
9799
98-//function GetCookies: boolean;
99-//var
100-// h:THandle;
101-// dwEntrySize:DWORD;
102-// LPCacheEntry:^TInternetCacheEntryInfoA;
103-// MAX_CACHE_ENTRY_INFO_SIZE:DWORD;
104-// flag:boolean;
105-// s:LPSTR;
106-// aStr:String;
107-// Size:DWORD;
108-// lpszData:LPSTR;
109-// Res:boolean;
110-//begin
111-// MAX_CACHE_ENTRY_INFO_SIZE := 4096;
112-// dwEntrySize := MAX_CACHE_ENTRY_INFO_SIZE;
113-//
114-// GetMem(lpCacheEntry,8 * dwEntrySize);
115-//
116-// lpCacheEntry.dwStructSize := dwEntrySize;
117-//
118-// h := FindFirstUrlCacheEntryA('cookie:',lpCacheEntry^,dwEntrySize);
119-//
120-// if h=0 then
121-// begin
122-// FreeMem(lpCacheEntry);
123-// Result := false;
124-// Exit;
125-// end;
126-//
127-// flag := true;
128-//
129-// while flag do
130-// begin
131-// if (lpCacheEntry.CacheEntryType and COOKIE_CACHE_ENTRY) <> 0 then
132-// begin
133-// s:=lpCacheEntry.lpszSourceUrlName;
134-// lpszData:=nil;
135-// Size:=0;
136-// Res := InternetGetCookieA(s,nil,lpszData,Size);// this line don't work :
137-// //Size== 0,lpszData == nil
138-// //Res==false
139-// end;
140-//
141-// FreeMem(lpCacheEntry);
142-//
143-// dwEntrySize:=MAX_CACHE_ENTRY_INFO_SIZE;
144-// GetMem(lpCacheEntry,8*dwEntrySize);
145-// lpCacheEntry.dwStructSize:=dwEntrySize;
146-// flag:=FindNextUrlCacheEntryA(h,lpCacheEntry^,dwEntrySize);
147-// end;
148-// FreeMem(lpCacheEntry);
149-// FindCloseUrlCache(h);
150-//
151-//end;
152-
153100 function FixEncoding(AText: OleVariant): String;
154101 var
155102 RBS: RawByteString;
@@ -372,7 +319,14 @@
372319 end;
373320 end;
374321
375-function DecodeStatusColor(AStatusColors: TStatusColors; AClassName: String): TColor;
322+function ExtractStatusCode(AClassName: String): String;
323+begin
324+ // Usa um negative lookahead na expressão regular para achar a última
325+ // ocorrência de uma classe que define a cor do status
326+ RegExMatch(AClassName,'status-(\d{2})-color(?!.*status-\d{2}-color)',1,1,False,[],Result);
327+end;
328+
329+function ExtractStatusColor(AStatusColors: TStatusColors; AClassName: String): TColor;
376330 var
377331 StatusCode: String;
378332 i: Byte;
@@ -379,9 +333,13 @@
379333 begin
380334 Result := clNone;
381335
382- // Usa um negative lookahead na expressão regular para achar a última
383- // ocorrência de uma classe que define a cor do status
384- if RegExMatch(AClassName,'status-(\d{2})-color(?!.*status-\d{2}-color)',1,1,False,[],StatusCode) then
336+ if Length(AStatusColors) = 0 then
337+ raise Exception.Create('As cores dos status não foram obtidas');
338+
339+
340+ StatusCode := ExtractStatusCode(AClassName);
341+
342+ if StatusCode <> '' then
385343 for i := 0 to High(AStatusColors) do
386344 if AStatusColors[i].id = StatusCode.ToInteger then
387345 begin
@@ -400,15 +358,114 @@
400358 Result := StrToDateTime(DateTime);
401359 end;
402360
403-function AssignedTasks(AHandle: Cardinal; AStatusColors: TStatusColors; out AAssignedTasks: TAssignedTasks): Boolean;
361+function ExtractSummary(ASummary: OleVariant): String;
362+begin
363+ RegExMatch(FixEncoding(ASummary),'\d{7}:\s(.*)',1,1,False,[],Result);
364+end;
365+
366+function ParseTaskDetails(ADocument: String; AStatusColors: TStatusColors; var ATask: TTask): Boolean;
404367 var
405- Req: TRequestOptions;
406- Res: TResponse;
407368 HTMLDocument: OleVariant;
408- AssignedTasks: OleVariant;
369+ Aux: OleVariant;
409370 i: Word;
410371 begin
411372 Result := False;
373+
374+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
375+
376+ // Habilita o modo de design, o qual desabilita scripts e permite a
377+ // leitura do código da página exatamente como ele é. Scripts podem
378+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
379+ // ser diferente daquilo que ele seria ao não usar esta propriedade
380+ HTMLDocument.DesignMode := 'On';
381+ HTMLDocument.Write(ADocument);
382+ HTMLDocument.Close;
383+
384+ try
385+ Result := FixEncoding(HTMLDocument.getElementsByTagName('h4').Item(0).InnerText) = 'Ver Detalhes da Tarefa';
386+ except
387+ { É um mudinho de propósito. A idéia aqui é verificar se há o tag com o
388+ texto correto, mas pdoe ser que haja um access violation e por isso, o
389+ result tem que permanecer false. Usando o mudinho, mantemos o result
390+ como false, mas não levantamos qualquer exceção }
391+ end;
392+
393+ if Result then
394+ begin
395+ // Retorna em Aux todos os elementos <td>
396+ Aux := HTMLDocument.GetElementsByTagName('td');
397+
398+ // Varre todos os <td> buscando por aqueles que tem classes específicas
399+ // específicas que os identificam
400+ for i := 0 to Aux.Length - 1 do
401+ begin
402+ if Aux.Item(i).ClassName = 'bug-status' then
403+ begin
404+ ATask.Status := FixEncoding(Aux.Item(i).InnerText);
405+ ATask.StatusColor := ExtractStatusColor(AStatusColors, Aux.Item(i).ChildNodes[0].ClassName);
406+ end
407+ else if Aux.Item(i).ClassName = 'bug-priority' then
408+ ATask.Priority := FixEncoding(Aux.Item(i).InnerText)
409+ else if Aux.Item(i).ClassName = 'bug-project' then
410+ ATask.Project := FixEncoding(Aux.Item(i).InnerText)
411+ else if Aux.Item(i).ClassName = 'bug-category' then
412+ ATask.Category := FixEncoding(Aux.Item(i).InnerText)
413+ else if Aux.Item(i).ClassName = 'bug-last-modified' then
414+ ATask.LastUpdate := ExtractDateTime(Aux.Item(i).InnerText)
415+ else if Aux.Item(i).ClassName = 'bug-summary' then
416+ ATask.Summary := ExtractSummary(Aux.Item(i).InnerText)
417+ else if Aux.Item(i).ClassName = 'bug-description' then
418+ ATask.Description := FixEncoding(Aux.Item(i).InnerHtml);
419+ end;
420+
421+ // Retorna em Aux todos os elementos <input>
422+ Aux := HTMLDocument.GetElementById('bugnoteadd').GetElementsByTagName('input');
423+
424+ // Varre todos os <input> buscando por aqueles que tem nomes específicos
425+ // e obtendo seus valores
426+ for i := 0 to Aux.Length - 1 do
427+ begin
428+ if Aux.Item(i).Name = 'bugnote_add_token' then
429+ ATask.AddCommentToken := Aux.Item(i).Value
430+ else if Aux.Item(i).Name = 'max_file_size' then
431+ ATask.MaxFileSize := Aux.Item(i).Value;
432+ end;
433+
434+ // Retorna em Aux todos os elementos <select>
435+ Aux := HTMLDocument.GetElementsByTagName('select');
436+
437+ // Varre todos os <select> buscando por aquele que contém a lista
438+ // suspensa de possíveis mudanças de status
439+ for i := 0 to Aux.Length - 1 do
440+ if Aux.Item(i).Name = 'new_status' then
441+ Break;
442+
443+ // Ao encontrar o <select> correto, o loop anterior foi encerrado
444+ // prematuramente, logo, continua o fluxo
445+ if i < Aux.Length then
446+ begin
447+ // Obtém os nós filhos do <select>, os elementos <option>
448+ Aux := Aux.Item(i).ChildNodes;
449+
450+ // Configura o array de possíveis mudanças de status com a quantidade
451+ // correta de elementos possíveis
452+ SetLength(ATask.PossibleStatusChanges,Word(Aux.Length));
453+
454+ // Varre todos os <option>, adicionando suas informações no array
455+ for i := 0 to Aux.Length - 1 do
456+ begin
457+ ATask.PossibleStatusChanges[i].Id := Aux.Item(i).value;
458+ ATask.PossibleStatusChanges[i].Description := FixEncoding(Aux.Item(i).InnerText);
459+ end;
460+ end;
461+ end;
462+end;
463+
464+function TaskDetails(AHandle: Cardinal; AStatusColors: TStatusColors; var ATask: TTask): Boolean;
465+var
466+ Req: TRequestOptions;
467+ Res: TResponse;
468+begin
412469 ZeroMemory(@Req,SizeOf(Req));
413470 ZeroMemory(@Res,SizeOf(Res));
414471
@@ -416,7 +473,7 @@
416473
417474 Req.InternetOpenParams.Agent := 'Mantis Monitor';
418475 Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
419- Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/my_view_page.php';
476+ Req.InternetConnectParams.ServerName := PChar(BASE_URL + '/mantis/view.php?id=' + IntToStr(ATask.Id));
420477 Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
421478 Req.InternetConnectParams.Context := AHandle;
422479
@@ -432,50 +489,101 @@
432489 Res.Content := TStringStream.Create('');
433490 try
434491 Request(Req,Res);
492+ Result := ParseTaskDetails(TStringStream(Res.Content).DataString,AStatusColors,ATask);
493+ finally
494+ Res.Content.Free;
495+ end;
496+ finally
497+ Req.HttpOpenRequestParams.AcceptTypes.Free;
498+ end;
499+end;
435500
436- HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
501+function ParseAssignedTasks(ADocument: String; AStatusColors: TStatusColors; out ATasks: TTasks; AFullInfo: Boolean = False): Boolean;
502+var
503+ HTMLDocument: OleVariant;
504+ Aux: OleVariant;
505+ i: Word;
506+begin
507+ Result := False;
508+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
437509
438- // Habilita o modo de design, o qual desabilita scripts e permite a
439- // leitura do código da página exatamente como ele é. Scripts podem
440- // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
441- // ser diferente daquilo que ele seria ao não usar esta propriedade
442- HTMLDocument.DesignMode := 'On';
443- HTMLDocument.Write(TStringStream(Res.Content).DataString);
444- HTMLDocument.Close;
510+ // Habilita o modo de design, o qual desabilita scripts e permite a
511+ // leitura do código da página exatamente como ele é. Scripts podem
512+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
513+ // ser diferente daquilo que ele seria ao não usar esta propriedade
514+ HTMLDocument.DesignMode := 'On';
515+ HTMLDocument.Write(ADocument);
516+ HTMLDocument.Close;
445517
446- try
447- Result := UTF8ToString(RawByteString(HTMLDocument.getElementsByTagName('h4').Item(0).ChildNodes[1].InnerText)) = 'Atribuídos a Mim (não resolvidos)';
448- except
449- { É um mudinho de propósito. A idéia aqui é verificar se há o tag com o
450- texto correto, mas pdoe ser que haja um access violation e por isso, o
451- result tem que permanecer false. Usando o mudinho, mantemos o result
452- como false, mas não levantamos qualquer exceção }
453- end;
518+ try
519+ Result := UTF8ToString(RawByteString(HTMLDocument.getElementsByTagName('h4').Item(0).ChildNodes[1].InnerText)) = 'Atribuídos a Mim (não resolvidos)';
520+ except
521+ { É um mudinho de propósito. A idéia aqui é verificar se há o tag com o
522+ texto correto, mas pdoe ser que haja um access violation e por isso, o
523+ result tem que permanecer false. Usando o mudinho, mantemos o result
524+ como false, mas não levantamos qualquer exceção }
525+ end;
454526
455- if Result then
527+ if Result then
528+ begin
529+ // A atribuição a uma variável ajuda a reduzir o tamanho da expressão,
530+ // no etanto se perde a capacidade de usar [] para acessar itens de
531+ // coleções. Mais adiante, dentro do for, usa-se Aux.Item(i),
532+ // ao invés de Aux[i], porque não é possível ou não consegui
533+ // achar um modo de realizar um cast
534+ Aux := HTMLDocument.getElementsByTagName('tbody').Item(0).ChildNodes;
535+
536+ SetLength(ATasks,Integer(Aux.Length));
537+
538+ for i := 0 to Aux.Length - 1 do
539+ begin
540+ ATasks[i].Id := Aux.Item(i).ChildNodes[0].ChildNodes[0].InnerText;
541+
542+ if AFullInfo then
543+ TaskDetails(0,AStatusColors,ATasks[i])
544+ else
456545 begin
457- // A atribuição a uma variável ajuda a reduzir o tamanho da expressão,
458- // no etanto se perde a capacidade de usar [] para acessar itens de
459- // coleções. Mais adiante, dentro do for, usa-se AssignedTasks.Item(i),
460- // ao invés de AssignedTasks[i], porque não é possível ou não consegui
461- // achar um modo de realizar um cast
462- AssignedTasks := HTMLDocument.getElementsByTagName('tbody').Item(0).ChildNodes;
546+ ATasks[i].Status := FixEncoding(Aux.Item(i).ChildNodes[0].ChildNodes[2].Title);
547+ ATasks[i].StatusColor := ExtractStatusColor(AStatusColors,Aux.Item(i).ChildNodes[0].ChildNodes[2].ClassName);
548+ ATasks[i].Priority := FixEncoding(Aux.Item(i).ChildNodes[0].ChildNodes[4].Title);
549+ ATasks[i].Project := FixEncoding(ExtractProjectName(Aux.Item(i).ChildNodes[1].ChildNodes[0].InnerText));
550+ ATasks[i].Summary := FixEncoding(Aux.Item(i).ChildNodes[1].ChildNodes[1].ChildNodes[0].InnerText);
551+ ATasks[i].Category := FixEncoding(Aux.Item(i).ChildNodes[1].ChildNodes[3].InnerText);
552+ ATasks[i].LastUpdate := ExtractDateTime(Aux.Item(i).ChildNodes[1].ChildNodes[4].InnerText);
553+ end;
554+ end;
555+ end;
556+end;
463557
464- SetLength(AAssignedTasks,Integer(AssignedTasks.Length));
558+function AssignedTasks(AHandle: Cardinal; AStatusColors: TStatusColors; out ATasks: TTasks; AFullInfo: Boolean = False): Boolean;
559+var
560+ Req: TRequestOptions;
561+ Res: TResponse;
562+begin
563+ ZeroMemory(@Req,SizeOf(Req));
564+ ZeroMemory(@Res,SizeOf(Res));
465565
466- for i := 0 to AssignedTasks.Length - 1 do
467- begin
468- AAssignedTasks[i].Id := AssignedTasks.Item(i).ChildNodes[0].ChildNodes[0].InnerText;
469- AAssignedTasks[i].Status := FixEncoding(AssignedTasks.Item(i).ChildNodes[0].ChildNodes[2].Title);
470- AAssignedTasks[i].StatusColor := DecodeStatusColor(AStatusColors,AssignedTasks.Item(i).ChildNodes[0].ChildNodes[2].ClassName);
471- AAssignedTasks[i].Priority := FixEncoding(AssignedTasks.Item(i).ChildNodes[0].ChildNodes[4].Title);
472- AAssignedTasks[i].Project := FixEncoding(ExtractProjectName(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[0].InnerText));
473- AAssignedTasks[i].Description := FixEncoding(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[1].ChildNodes[0].InnerText);
474- AAssignedTasks[i].Category := FixEncoding(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[3].InnerText);
475- AAssignedTasks[i].LastUpdate := ExtractDateTime(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[4].InnerText);
476- end;
566+ Req.AutoClearSSLState := True;
477567
478- end;
568+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
569+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
570+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/my_view_page.php';
571+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
572+ Req.InternetConnectParams.Context := AHandle;
573+
574+ Req.HttpOpenRequestParams.Verb := 'GET';
575+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
576+ try
577+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
578+ Req.HttpOpenRequestParams.Context := AHandle;
579+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
580+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
581+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
582+
583+ Res.Content := TStringStream.Create('');
584+ try
585+ Request(Req,Res);
586+ Result := ParseAssignedTasks(TStringStream(Res.Content).DataString,AStatusColors,ATasks,AFullInfo);
479587 finally
480588 Res.Content.Free;
481589 end;
@@ -543,78 +651,6 @@
543651 end;
544652 end;
545653
546-function TaskDetails(AHandle: Cardinal; var ATask: TTask): Boolean;
547-var
548- Req: TRequestOptions;
549- Res: TResponse;
550- HTMLDocument: OleVariant;
551- Inputs: OleVariant;
552- i: Word;
553-begin
554- Result := False;
555- ZeroMemory(@Req,SizeOf(Req));
556- ZeroMemory(@Res,SizeOf(Res));
557-
558- Req.AutoClearSSLState := True;
559-
560- Req.InternetOpenParams.Agent := 'Mantis Monitor';
561- Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
562- Req.InternetConnectParams.ServerName := PChar(BASE_URL + '/mantis/view.php?id=' + IntToStr(ATask.Id));
563- Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
564- Req.InternetConnectParams.Context := AHandle;
565-
566- Req.HttpOpenRequestParams.Verb := 'GET';
567- Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
568- try
569- Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
570- Req.HttpOpenRequestParams.Context := AHandle;
571- Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
572- Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
573- Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
574-
575- Res.Content := TStringStream.Create('');
576- try
577- Request(Req,Res);
578-
579- HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
580-
581- // Habilita o modo de design, o qual desabilita scripts e permite a
582- // leitura do código da página exatamente como ele é. Scripts podem
583- // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
584- // ser diferente daquilo que ele seria ao não usar esta propriedade
585- HTMLDocument.DesignMode := 'On';
586- HTMLDocument.Write(TStringStream(Res.Content).DataString);
587- HTMLDocument.Close;
588-
589- try
590- Result := FixEncoding(HTMLDocument.getElementsByTagName('h4').Item(0).InnerText) = 'Ver Detalhes da Tarefa';
591- except
592- { É um mudinho de propósito. A idéia aqui é verificar se há o tag com o
593- texto correto, mas pdoe ser que haja um access violation e por isso, o
594- result tem que permanecer false. Usando o mudinho, mantemos o result
595- como false, mas não levantamos qualquer exceção }
596- end;
597-
598- if Result then
599- begin
600- Inputs := HTMLDocument.GetElementById('bugnoteadd').GetElementsByTagName('input');
601-
602- for i := 0 to Inputs.Length - 1 do
603- begin
604- if Inputs.Item(i).Name = 'bugnote_add_token' then
605- ATask.AddCommentToken := Inputs.Item(i).Value
606- else if Inputs.Item(i).Name = 'max_file_size' then
607- ATask.MaxFileSize := Inputs.Item(i).Value;
608- end;
609- end;
610- finally
611- Res.Content.Free;
612- end;
613- finally
614- Req.HttpOpenRequestParams.AcceptTypes.Free;
615- end;
616-end;
617-
618654 procedure WriteStream(AStream: TStream; AValue: RawByteString);
619655 var
620656 i: Cardinal;
@@ -680,18 +716,77 @@
680716 end;
681717 end;
682718
683-function AddComment(AHandle: Cardinal; AAddCommentToken: UTF8String; AMaxFileSize: Cardinal; ATaskId: Cardinal; AComment: UTF8String; AAttachments: array of String; out ACommentId: Cardinal; out AError: String): Boolean;
719+function ParseAddComment(ADocument: String; out ACommentId: Cardinal; out AError: String): Boolean;
684720 var
685- Req: TRequestOptions;
686- Res: TResponse;
687- Boundary: UTF8String;
688- i: Word;
689721 HTMLDocument: OleVariant;
690722 Aux: OleVariant;
723+ i: Word;
691724 CommentingUser: String;
692725 LastCommentId: Cardinal;
693726 CurrentCommentId: Cardinal;
694727 begin
728+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
729+
730+ // Habilita o modo de design, o qual desabilita scripts e permite a
731+ // leitura do código da página exatamente como ele é. Scripts podem
732+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
733+ // ser diferente daquilo que ele seria ao não usar esta propriedade
734+ HTMLDocument.DesignMode := 'On';
735+ HTMLDocument.Write(ADocument);
736+ HTMLDocument.Close;
737+
738+ Aux := HTMLDocument.GetElementsByTagName('div');
739+
740+ for i := 0 to Aux.Length - 1 do
741+ begin
742+ if Aux.Item(i).ClassName = 'alert alert-danger' then
743+ begin
744+ AError := FixEncoding(RawByteString(Aux.Item(i).ChildNodes[0].InnerText + '|' + Aux.Item(i).ChildNodes[1].InnerText));
745+ Break;
746+ end;
747+ end;
748+
749+ // Caso tenha saído do loop anterior prematuramente, significa que
750+ // houve um erro
751+ Result := i = Aux.Length;
752+
753+ if Result then
754+ begin
755+ RegExMatch(ADocument
756+ ,'<a href="\/mantis\/account_page\.php">\s*([a-z]+)\s*\(\s*([^ ][\w\W ]+[^ ])\s*\)\s*<\/a>'
757+ ,2
758+ ,0
759+ ,False
760+ ,[]
761+ ,CommentingUser);
762+
763+ Aux := HTMLDocument.GetElementsByTagName('tr');
764+
765+ LastCommentId := 0;
766+
767+ for i := 0 to Aux.Length - 1 do
768+ begin
769+ if (Aux.Item(i).ClassName = 'bugnote') and (FixEncoding(Aux.Item(i).ChildNodes[0].ChildNodes[1].ChildNodes[0].ChildNodes[1].InnerText) = CommentingUser) then
770+ begin
771+ CurrentCommentId := StrToInt(StringReplace(Aux.Item(i).Id,'c','',[]));
772+
773+ if CurrentCommentId > LastCommentId then
774+ LastCommentId := CurrentCommentId;
775+ end;
776+ end;
777+
778+ ACommentId := LastCommentId;
779+ end;
780+
781+end;
782+
783+function AddComment(AHandle: Cardinal; AAddCommentToken: UTF8String; AMaxFileSize: Cardinal; ATaskId: Cardinal; AComment: UTF8String; AAttachments: array of String; out ACommentId: Cardinal; out AError: String): Boolean;
784+var
785+ Req: TRequestOptions;
786+ Res: TResponse;
787+ Boundary: UTF8String;
788+ i: Word;
789+begin
695790 AError := '';
696791 ACommentId := 0;
697792 ZeroMemory(@Req,SizeOf(Req));
@@ -739,59 +834,86 @@
739834 Res.Content := TStringStream.Create('');
740835 try
741836 Request(Req,Res);
837+ Result := ParseAddComment(TStringStream(Res.Content).DataString,ACommentId,AError);
838+ finally
839+ Res.Content.Free;
840+ end;
841+ finally
842+ Req.HttpOpenRequestParams.Headers.Free;
843+ end;
844+ finally
845+ Req.HttpOpenRequestParams.AcceptTypes.Free;
846+ end;
847+ finally
848+ Req.Content.Free;
849+ end;
850+end;
742851
743- HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
852+function ChangeStatus(AHandle: Cardinal; ATaskId: Cardinal; ANewStatus: TStatus; AComment: UTF8String; AHandlerId: Cardinal): Boolean;
853+var
854+ BugUpdateToken: String;
855+ LastUpdated: String;
856+//-/////////////////////////////////////////////////////////////////////////////
857+function ParseChangeStatusPageResponse(ADocument: String): Boolean;
858+var
859+ HTMLDocument: OleVariant;
860+ Aux: OleVariant;
861+ i: Word;
862+begin
863+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
744864
745- // Habilita o modo de design, o qual desabilita scripts e permite a
746- // leitura do código da página exatamente como ele é. Scripts podem
747- // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
748- // ser diferente daquilo que ele seria ao não usar esta propriedade
749- HTMLDocument.DesignMode := 'On';
750- HTMLDocument.Write(TStringStream(Res.Content).DataString);
751- HTMLDocument.Close;
865+ HTMLDocument.DesignMode := 'On';
866+ HTMLDocument.Write(ADocument);
867+ HTMLDocument.Close;
752868
753- Aux := HTMLDocument.GetElementsByTagName('div');
869+ Aux := HTMLDocument.GetElementsByTagName('input');
754870
755- for i := 0 to Aux.Length - 1 do
756- begin
757- if Aux.Item(i).ClassName = 'alert alert-danger' then
758- begin
759- AError := FixEncoding(RawByteString(Aux.Item(i).ChildNodes[0].InnerText + '|' + Aux.Item(i).ChildNodes[1].InnerText));
760- Break;
761- end;
762- end;
871+ BugUpdateToken := '';
872+ LastUpdated := '';
763873
764- // Caso tenha saído do loop anterior prematuramente, significa que
765- // houve um erro
766- Result := i = Aux.Length;
874+ for i := 0 to Aux.Length - 1 do
875+ if Aux.Item(i).Name = 'bug_update_token' then
876+ BugUpdateToken := Aux.Item(i).Value
877+ else if Aux.Item(i).Name = 'last_updated' then
878+ LastUpdated := Aux.Item(i).Value;
767879
768- if Result then
769- begin
770- RegExMatch(TStringStream(Res.Content).DataString
771- ,'<a href="\/mantis\/account_page\.php">\s*([a-z]+)\s*\(\s*([^ ][\w\W ]+[^ ])\s*\)\s*<\/a>'
772- ,2
773- ,0
774- ,False
775- ,[]
776- ,CommentingUser);
880+ Result := (BugUpdateToken <> '') and (LastUpdated <> '');
881+end;
777882
778- Aux := HTMLDocument.GetElementsByTagName('tr');
883+function OpenChangeStatusPage: Boolean;
884+var
885+ Req: TRequestOptions;
886+ Res: TResponse;
887+begin
888+ ZeroMemory(@Req,SizeOf(Req));
889+ ZeroMemory(@Res,SizeOf(Res));
779890
780- LastCommentId := 0;
891+ Req.AutoClearSSLState := True;
781892
782- for i := 0 to Aux.Length - 1 do
783- begin
784- if (Aux.Item(i).ClassName = 'bugnote') and (FixEncoding(Aux.Item(i).ChildNodes[0].ChildNodes[1].ChildNodes[0].ChildNodes[1].InnerText) = CommentingUser) then
785- begin
786- CurrentCommentId := StrToInt(StringReplace(Aux.Item(i).Id,'c','',[]));
893+ Req.Content := TStringStream.Create(Format('new_status=%u&id=%u&change_type=change_status',[ANewStatus.Id,ATaskId]));
894+ try
895+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
896+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
897+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/bug_change_status_page.php';
898+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
899+ Req.InternetConnectParams.Context := AHandle;
787900
788- if CurrentCommentId > LastCommentId then
789- LastCommentId := CurrentCommentId;
790- end;
791- end;
901+ Req.HttpOpenRequestParams.Verb := 'POST';
902+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
903+ try
904+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
905+ Req.HttpOpenRequestParams.Context := AHandle;
906+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
907+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
908+ Req.HttpOpenRequestParams.Headers := TStringList.Create;
909+ try
910+ Req.HttpOpenRequestParams.Headers.Add('Content-Type: application/x-www-form-urlencoded');
911+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
792912
793- ACommentId := LastCommentId;
794- end;
913+ Res.Content := TStringStream.Create('');
914+ try
915+ Request(Req,Res);
916+ Result := ParseChangeStatusPageResponse(TStringStream(Res.Content).DataString);
795917 finally
796918 Res.Content.Free;
797919 end;
@@ -805,188 +927,83 @@
805927 Req.Content.Free;
806928 end;
807929 end;
808-(*
809- ZeroMemory(@RO,SizeOf(RO));
810- ZeroMemory(@RE,SizeOf(RE));
930+//-/////////////////////////////////////////////////////////////////////////////
931+var
932+ Req: TRequestOptions;
933+ Res: TResponse;
934+//-/////////////////////////////////////////////////////////////////////////////
935+function ParseChangeStatusResponse: Boolean;
936+var
937+ HTMLDocument: OleVariant;
938+ Aux: OleVariant;
939+ i: Word;
940+begin
941+ Result := False;
942+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
811943
812- MEMOResponse.Clear;
944+ HTMLDocument.DesignMode := 'On';
945+ HTMLDocument.Write(TStringStream(Res.Content).DataString);
946+ HTMLDocument.Close;
813947
814- RO.AutoClearSSLState := True;
948+ Aux := HTMLDocument.GetElementsByTagName('td');
815949
816- RO.Content := nil;
817- if CHBXUseRequestContent.Checked then
818- begin
819- if CHBXFileUpload.Checked then
950+ for i := 0 to Aux.Length - 1 do
951+ if Aux.Item(i).ClassName = 'bug-status' then
820952 begin
821- with TStringList.Create do
822- try
823- LoadFromFile('D:\35180401158586000180570010000016131000016137-cte.xml');
824- RO.Content := TStringStream.Create(Trim(Text));
825- finally
826- Free;
827- end;
828- end
829- else
830- RO.Content := TStringStream.Create(Trim(MEMORequest.Text));
831- end;
953+ Result := StrToInt(ExtractStatusCode(Aux.Item(i).ChildNodes[0].ClassName)) = ANewStatus.Id;
954+ Break;
955+ end;
956+end;
957+//-/////////////////////////////////////////////////////////////////////////////
958+begin
959+ ZeroMemory(@Req,SizeOf(Req));
960+ ZeroMemory(@Res,SizeOf(Res));
832961
833- RO.MaximumSingleRequestContentSize := StrToInt(LAEDMaximumSingleRequestContentSize.Text); // Ao usar zero, na verdade será usado o valor padrão = High(SmallInt)
834- { InternetOpen }
835- RO.InternetOpenParams.Agent := 'Anak Krakatoa Delphi Library';
836- RO.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
837- RO.InternetOpenParams.ProxyName := nil;
838- RO.InternetOpenParams.ProxyBypass := nil;
839- RO.InternetOpenParams.Flags := 0;
840- { InternetConnect }
841- RO.InternetConnectParams.ServerName := PChar(CBBXURL.Text);
962+ Req.AutoClearSSLState := True;
842963
843- RO.InternetConnectParams.UserName := nil;
844- if LAEDUserName.Text <> '' then
845- RO.InternetConnectParams.UserName := PChar(LAEDUserName.Text);
964+ // Obtém alguns parâmetros necessários
965+ OpenChangeStatusPage;
846966
847- RO.InternetConnectParams.Password := nil;
848- if LAEDPassword.Text <> '' then
849- RO.InternetConnectParams.Password := PChar(LAEDPassword.Text);
967+ Req.Content := TStringStream.Create(UTF8String(Format('bug_update_token=%s&bug_id=%u&status=%u&last_updated=%s&handler_id=%u&bugnote_text=%s&action_type=change_status',[BugUpdateToken,ATaskId,ANewStatus.Id,LastUpdated,AHandlerId,AComment])));
968+ try
969+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
970+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
971+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/bug_update.php';
972+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
973+ Req.InternetConnectParams.Context := AHandle;
850974
851- RO.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
852- RO.InternetConnectParams.Flags := 0;
853- RO.InternetConnectParams.Context := Self.Handle;
854- { HttpOpenRequest }
855- RO.HttpOpenRequestParams.Verb := PChar(CBBXVerb.Text);
856- RO.HttpOpenRequestParams.ObjectName := nil;
857- RO.HttpOpenRequestParams.Version := nil;
858- RO.HttpOpenRequestParams.Referrer := nil;
859- RO.HttpOpenRequestParams.ConnectTimeout := StrToInt(LAEDConnectTimeOut.Text);
860- RO.HttpOpenRequestParams.SendTimeout := StrToInt(LAEDSendTimeOut.Text);
861- RO.HttpOpenRequestParams.ReceiveTimeout := StrToInt(LAEDReceiveTimeOut.Text);
975+ Req.HttpOpenRequestParams.Verb := 'POST';
976+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
977+ try
978+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
979+ Req.HttpOpenRequestParams.Context := AHandle;
980+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
981+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
982+ Req.HttpOpenRequestParams.Headers := TStringList.Create;
983+ try
984+ Req.HttpOpenRequestParams.Headers.Add('Content-Type: application/x-www-form-urlencoded');
985+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
862986
863- RO.HttpOpenRequestParams.AcceptTypes := nil;
864- if CHBXUseAcceptTypes.Checked then
865- begin
866- RO.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
867- RO.HttpOpenRequestParams.AcceptTypes.Text := Trim(MEMOAcceptTypes.Text);
868- end;
869-
870- RO.HttpOpenRequestParams.Flags := 0;
871- RO.HttpOpenRequestParams.Context := Self.Handle;
872- { HttpOpenRequest (extras) }
873- RO.HttpOpenRequestParams.AutoDetectHTTPS := CHBXHTTPSAutoDetect.Checked; // adiciona automaticamente INTERNET_FLAG_SECURE para conexões com https
874- RO.HttpOpenRequestParams.IgnoreInvalidCertificates := CHBXIgnoreInvalidCertificates.Checked; // Adiciona automaticamente INTERNET_FLAG_IGNORE_CERT_CN_INVALID + INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
875-
876- RO.HttpOpenRequestParams.Headers := nil; // Executa HttpAddRequestHeaders para cada header da lista
877- if CHBXUseOpenRequestHeaders.Checked then
878- begin
879- RO.HttpOpenRequestParams.Headers := TStringList.Create;
880- RO.HttpOpenRequestParams.Headers.Text := Trim(MEMOOpenRequestHeaders.Text);
881- end;
882-
883- { HttpSendRequest }
884- RO.HttpSendRequestParams.Headers := nil; // Substitui cada quebra de linha da lista por \r\n e atribui o texto resultante no parâmetro Headers de HttpSendRequest
885- if CHBXUseSendRequestHeaders.Checked then
886- begin
887- RO.HttpSendRequestParams.Headers := TStringList.Create;
888- RO.HttpSendRequestParams.Headers.Text := Trim(MEMOSendRequestHeaders.Text);
889- end;
890-
891- RO.HttpSendRequestParams.Optional := nil;
892- RO.HttpSendRequestParams.OptionalLength := 0;
893- { HttpSendRequest (extras) }
894- RO.HttpSendRequestParams.IgnoreInvalidCertificateCA := CHBXIgnoreInvalidCertsCA.Checked;
895- RO.HttpSendRequestParams.UseCustomCertificateSelection := CHBXUseCustomCertificateSelection.Checked; // Usa o seletor de certificados customizado, cujos parâmetros estão logo abaixo
896- RO.HttpSendRequestParams.OnBeforeHttpSendRequest := nil;
897- RO.HttpSendRequestParams.OnHttpSendRequestError := nil;
898- RO.HttpSendRequestParams.OnSendingData := nil;
899- RO.HttpSendRequestParams.OnReceivingData := nil;
900- { SelectCertificate }
901- RO.HttpSendRequestParams.SelectCertificateParams.CertificateStore := TCertificateStore(CBBXCertificateStore.ItemIndex);
902- RO.HttpSendRequestParams.SelectCertificateParams.CSPName := EDITCSPName.Text;
903- RO.HttpSendRequestParams.SelectCertificateParams.ProviderTypeId := StrToInt(EDITProviderTypeId.Text);
904- RO.HttpSendRequestParams.SelectCertificateParams.SelectDialogTitle := EDITSelectDialogTitle.Text;
905- RO.HttpSendRequestParams.SelectCertificateParams.SelectDialogDescription := EDITSelectDialogDescription.Text;
906- RO.HttpSendRequestParams.SelectCertificateParams.SystemStoreName := CBBXSubsystemProtocol.Text;
907- RO.HttpSendRequestParams.SelectCertificateParams.CertificateFile := EDITCertificateFile.Text;
908- RO.HttpSendRequestParams.SelectCertificateParams.CertificatePassword := EDITCertificatePassword.Text;
909- RO.HttpSendRequestParams.SelectCertificateParams.WindowHandle := Self.Handle;
910-
911-
912- RE.Content := TStringStream.Create('');
913- try
914- Request(RO, RE);
915- if Pos('Content-Type: text/xml',RE.Headers) > 0 then
916- MEMOResponse.Text := FormatXMLFile(TStringStream(RE.Content).DataString)
917- else
918- MEMOResponse.Text := TStringStream(RE.Content).DataString;
919- MEMOHeaders.Text := RE.Headers;
987+ Res.Content := TStringStream.Create('');
988+ try
989+ Request(Req,Res);
990+ Result := ParseChangeStatusResponse;
991+ finally
992+ Res.Content.Free;
993+ end;
994+ finally
995+ Req.HttpOpenRequestParams.Headers.Free;
996+ end;
997+ finally
998+ Req.HttpOpenRequestParams.AcceptTypes.Free;
999+ end;
9201000 finally
921- RE.Content.Free;
922- RO.HttpSendRequestParams.Headers.Free;
923- RO.HttpOpenRequestParams.Headers.Free;
924- RO.HttpOpenRequestParams.AcceptTypes.Free;
925- RO.Content.Free;
1001+ Req.Content.Free;
9261002 end;
1003+end;
9271004
9281005
929-*)
9301006
931-
932-//function RegExMatch(ASubject, APattern: String; AGroup: Byte; out AMatch: String): Boolean;
933-//begin
934-// Result := False;
935-// AMatch := '';
936-//
937-// with TPerlRegEx.Create do
938-// try
939-// Subject := ASubject;
940-// RegEx := APattern;
941-// if Match then
942-// begin
943-// Result := True;
944-//
945-// if AGroup > 0 then
946-// repeat
947-// if AMatch = '' then
948-// AMatch := Groups[AGroup]
949-// else
950-// AMatch := AMatch + ';' + Groups[AGroup];
951-// until not MatchAgain
952-// else
953-// repeat
954-// if AMatch = '' then
955-// AMatch := MatchedText
956-// else
957-// AMatch := AMatch + ';' + MatchedText;
958-// until not MatchAgain
959-// end;
960-// finally
961-// Free;
962-// end;
963-//end;
964-
965-//function RegExReplaceAll(ASubject, APattern, AReplacement: String; out AResult: String; ASingleLine: Boolean = True; ACaseInsensitive: Boolean = True): Boolean;
966-//begin
967-// Result := False;
968-// AResult := '';
969-//
970-// with TPerlRegEx.Create do
971-// try
972-// if ASingleLine then
973-// Options := Options + [preSingleLine];
974-// if ACaseInsensitive then
975-// Options := Options + [preCaseLess];
976-//
977-// Subject := ASubject;
978-// RegEx := APattern;
979-// Replacement := AReplacement;
980-// if ReplaceAll then
981-// begin
982-// AResult := Subject;
983-// Result := True;
984-// end;
985-// finally
986-// Free;
987-// end;
988-//end;
989-
9901007 // Protege AProtectPattern enquanto realiza a substituição de AOldPattern por
9911008 // AReplacement, colocando o resultado final em AResult
9921009 function RegExProtectAndReplace(ASubject, AProtectPattern, AOldPattern, AReplacement: String; AProtectedSingleLine: Boolean = True; AProtectedCaseInsensitive: Boolean = True; AReplaceSingleLine: Boolean = True; AReplaceCaseInsensitive: Boolean = True): String;
@@ -1123,21 +1140,23 @@
11231140
11241141 procedure TForm9.Button3Click(Sender: TObject);
11251142 var
1126- AT: TAssignedTasks;
1143+ AT: TTasks;
11271144 T: TTask;
1145+ S: TStatus;
11281146 begin
11291147 Memo1.Clear;
11301148
1131- if AssignedTasks(Self.Handle, FStatusColors, AT) then
1149+ if AssignedTasks(Self.Handle, FStatusColors, AT, True) then
11321150 begin
1133- ShowMessage('retornar tambem os possiveis status para os quais a tarefa pode mudar');
11341151 for T in AT do
11351152 begin
1136- Memo1.Lines.Add(T.Id.ToString + ' - ' + T.Status + ' - ' + ColorToString(T.StatusColor) + ' - ' + T.Project + ' - ' +T.Description + ' - ' + T.Category + ' - ' + DateTimeToStr(T.LastUpdate));
1153+ Memo1.Text := Memo1.Text + T.Id.ToString + ' - ' + T.Status + ' - ' + ColorToString(T.StatusColor) + ' - ' + T.Project + ' - ' +T.Summary + ' - ' + T.Category + ' - ' + DateTimeToStr(T.LastUpdate) + ' (';
1154+
1155+ for S in T.PossibleStatusChanges do
1156+ Memo1.Text := Memo1.Text + IntToStr(S.Id) + ' - ' + S.Description + ' ';
1157+
1158+ Memo1.Text := Memo1.Text + ')'#13#10;
11371159 end;
1138-
1139-// Memo1.Lines.Add('UserName = ' + UserName);
1140-// Memo1.Lines.Add('RealName = ' + RealName);
11411160 end
11421161 else
11431162 Memo1.Lines.Add('Nenhum usuário logado');
@@ -1158,7 +1177,7 @@
11581177 C: Cardinal;
11591178 begin
11601179 T.Id := 0083766;
1161- TaskDetails(Self.Handle,T);
1180+ TaskDetails(Self.Handle,FStatusColors,T);
11621181
11631182 if OpenDialog1.Execute then
11641183 begin
@@ -1175,6 +1194,26 @@
11751194 Memo1.Text := 'Comentário nº ' + C.ToString + ' inserido com sucesso';
11761195 end;
11771196
1197+procedure TForm9.Button6Click(Sender: TObject);
1198+var
1199+ Task: TTask;
1200+ NewStatus: TStatus;
1201+begin
1202+ // Primeiro obtém os dados da tarefa cujo status precisa ser alterado. Isso
1203+ // corresponde a abrir a página da tarefa no mantis
1204+ Task.Id := 83766;
1205+ TaskDetails(Self.Handle,FStatusColors,Task);
1206+
1207+ // Obtém aleatoriamente um status que pode ser utilizado na mudança de status
1208+ Randomize;
1209+ NewStatus := Task.PossibleStatusChanges[Random(Pred(Length(Task.PossibleStatusChanges)))];
1210+
1211+ if ChangeStatus(Self.Handle,Task.Id,NewStatus,Memo2.Text,238) then
1212+ Memo1.Text := 'Status alterado com sucesso para "' + NewStatus.Description + '"'
1213+ else
1214+ Memo1.Text := 'Merdas aconteceram';
1215+end;
1216+
11781217 procedure TForm9.ColorListBox1GetColors(Sender: TCustomColorListBox; Items: TStrings);
11791218 var
11801219 SC: TStatusColor;
Show on old repository browser