• R/O
  • SSH
  • HTTPS

mantisbtmonitor: Commit


Commit MetaInfo

Revision72 (tree)
Time2021-12-24 06:46:09
Authorderekwildstar

Log Message

Mudança de estado implementada, mas não testada com mais ênfase
Ultimo commit do ano! Feliz ano novo, feliz natal!

Change Summary

Incremental Difference

--- trunk/client/prj/MantisBTMonitor.dproj (revision 71)
+++ trunk/client/prj/MantisBTMonitor.dproj (revision 72)
@@ -82,11 +82,13 @@
8282 <VerInfo_Build>0</VerInfo_Build>
8383 <VerInfo_AutoGenVersion>false</VerInfo_AutoGenVersion>
8484 <VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
85+ <DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
8586 </PropertyGroup>
8687 <PropertyGroup Condition="'$(Base_Win64)'!=''">
8788 <Icon_MainIcon>MantisBTMonitor_Icon.ico</Icon_MainIcon>
8889 <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
8990 <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
91+ <DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
9092 </PropertyGroup>
9193 <PropertyGroup Condition="'$(Cfg_1)'!=''">
9294 <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
@@ -117,7 +119,7 @@
117119 <VerInfo_MinorVer>0</VerInfo_MinorVer>
118120 <VerInfo_Release>0</VerInfo_Release>
119121 <VerInfo_Locale>1033</VerInfo_Locale>
120- <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.522;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
122+ <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.574;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
121123 <Debugger_RunParams>/desenvolvimento</Debugger_RunParams>
122124 <VerInfo_AutoGenVersion>false</VerInfo_AutoGenVersion>
123125 <VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
@@ -124,7 +126,7 @@
124126 <DCC_DebugInformation>2</DCC_DebugInformation>
125127 <DCC_SymbolReferenceInfo>2</DCC_SymbolReferenceInfo>
126128 <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
127- <VerInfo_Build>522</VerInfo_Build>
129+ <VerInfo_Build>574</VerInfo_Build>
128130 <DCC_MapFile>3</DCC_MapFile>
129131 </PropertyGroup>
130132 <ItemGroup>
--- trunk/client/res/Sobre estes ícones.txt (revision 71)
+++ trunk/client/res/Sobre estes ícones.txt (revision 72)
@@ -1 +1,3 @@
1-Os ícones são dos pacotes iCandy Junior e iCandyJunior Toolbar
\ No newline at end of file
1+https://findicons.com/pack?q=junior
2+Os ícones são dos pacotes iCandy Junior e iCandyJunior Toolbar
3+iCandy_JuniorYel.zip são ícones (.ico) multitamanho que eu achei em algum lugar na web que não tinha todos os icones do conjunto, mas tinha alguns adicionais
\ No newline at end of file
--- trunk/client/src/lib/UFunctions.pas (revision 71)
+++ trunk/client/src/lib/UFunctions.pas (revision 72)
@@ -23,6 +23,9 @@
2323 function CommentBackupExists(ACommentId: Cardinal): Boolean;
2424 procedure CommentBackupDelete(ACommentId: Cardinal);
2525 function CommentBackupLoad(ACommentId: Cardinal): String;
26+//: Adiciona o tag de cabeçalho de comentário de acordo com o id de unidade
27+//: configurado caso um ainda não exista
28+procedure AddCommentHeader(var AComment: String);
2629
2730 implementation
2831
@@ -29,7 +32,7 @@
2932 uses
3033 SysUtils, ShellApi, EncdDecd, Forms, Controls, UConfigurations,
3134 IdGlobalProtocols, RegularExpressionsCore, NetEncoding, Data.DB, ActiveX,
32- StrUtils, KRK.Rtl.Common.FileUtils;
35+ StrUtils, KRK.Rtl.Common.FileUtils, RTTI;
3336
3437 function RegExMatch(ASubject, APattern: String; AGroup: Byte; out AMatch: String): Boolean;
3538 begin
@@ -1154,4 +1157,26 @@
11541157 Result := LoadTextFile(Configurations.TemporaryDirectory + 'CB' + ACommentId.ToString + '.html');
11551158 end;
11561159
1160+procedure AddCommentHeader(var AComment: String);
1161+begin
1162+ // Verifica a existência de qualquer tag de cabeçalho de comentário. Caso
1163+ // nenhum exista, prossegue, do contrário não faz mais nada
1164+ for var UnitId: TUnitId := Low(TUnitId) to High(TUnitId) do
1165+ if Pos('<' + TRttiEnumerationType.GetName(UnitId) + '>',AComment) > 0 then
1166+ Exit;
1167+
1168+ // Verifica a existência de qualquer tag de cabeçalho especial utilizado por
1169+ // testes e homologação para indicar aprovação ou rejeição. Caso nenhum
1170+ // exista, prossegue, do contrário, não faz mais nada
1171+ if (Pos('<teap>',AComment) > 0)
1172+ or (Pos('<hoap>',AComment) > 0)
1173+ or (Pos('<tere>',AComment) > 0)
1174+ or (Pos('<hore>',AComment) > 0) then
1175+ Exit;
1176+
1177+ var CommentHeaderName: String := TRttiEnumerationType.GetName(Configurations.UnityId);
1178+
1179+ AComment := '<' + CommentHeaderName + '></' + CommentHeaderName + '>' + AComment;
1180+end;
1181+
11571182 end.
--- trunk/client/src/lib/UInterposersAndHelpers.pas (revision 71)
+++ trunk/client/src/lib/UInterposersAndHelpers.pas (revision 72)
@@ -4,7 +4,7 @@
44
55 uses
66 SHDocVw, Winapi.Windows, Winapi.Messages, System.Classes, Vcl.ComCtrls,
7- Winapi.ShellAPI;
7+ Winapi.ShellAPI, Vcl.ActnList;
88
99 type
1010 // Se for útil, colcar no Krakatoa
@@ -70,6 +70,14 @@
7070 property DisablePopUpMenu: Boolean read FDisablePopUpMenu write FDisablePopUpMenu default False;
7171 end;
7272
73+ TAction = class(Vcl.ActnList.TAction)
74+ public
75+ procedure Hide;
76+ //procedure Show; overload;
77+ //: Exibe a ação apenas se o tag informado for o tag da ação
78+ //procedure Show(ATag: Word); overload;
79+ end;
80+
7381 implementation
7482
7583 uses
@@ -260,4 +268,22 @@
260268 WinApi.CommCtrl.RemoveWindowSubclass(IEHandle,NewWindowProcedure,Handle);
261269 end;
262270
271+{ TAction }
272+
273+procedure TAction.Hide;
274+begin
275+ Visible := False;
276+end;
277+
278+//procedure TAction.Show;
279+//begin
280+// Visible := True;
281+//end;
282+//
283+//procedure TAction.Show(ATag: Word);
284+//begin
285+// if Tag = ATag then
286+// Visible := True;
287+//end;
288+
263289 end.
--- trunk/client/src/lib/UScrapFunctions.pas (revision 71)
+++ trunk/client/src/lib/UScrapFunctions.pas (revision 72)
@@ -16,6 +16,7 @@
1616 function PrepareCommentForJavaScriptString(AComment: String): String; deprecated 'Não acho que vou usar isso no futuro, mas mantenha por ora';
1717 function UpdateComment(AHandle: Cardinal; ACommentId: Cardinal; AComment: String; AUpdateToken: String): Boolean;
1818 function AddComment(AHandle: Cardinal; ATask: TTask; AComment: String; AAttachments: array of String; out AError: String): Boolean;
19+function ChangeStatus(AHandle: Cardinal; ATaskId: Cardinal; ANewStatusId: Word; AComment: String): Boolean;
1920
2021 implementation
2122
@@ -23,7 +24,7 @@
2324 WinApi.Windows, WinApi.WinInet, System.SysUtils, MSHTML,
2425 KRK.Rtl.Win.WinInet.Utilities, KRK.RegExp.Utils, UConfigurations,
2526 Vcl.Graphics, System.Variants, Vcl.Forms, System.JSON,
26- KRK.Internet.MSHTML.Utilities, ActiveX, KRK.Rtl.Common.FileUtils;
27+ KRK.Internet.MSHTML.Utilities, ActiveX, KRK.Rtl.Common.FileUtils, UFunctions;
2728
2829 function Logout(AHandle: Cardinal): Boolean;
2930 var
@@ -68,6 +69,132 @@
6869 end;
6970 end;
7071
72+function ParseGetUserIdResult(ADocument: String; out AUserId: Cardinal): Boolean;
73+var
74+ HTMLDocument: IHTMLDocument;
75+ HTMLElementCollection: IHTMLElementCollection;
76+begin
77+ AUserId := 0;
78+
79+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument;
80+
81+ (HTMLDocument as IHTMLDocument2).DesignMode := 'On';
82+ (HTMLDocument as IHTMLDocument2).charset := 'utf-8';
83+ {$WARN SYMBOL_PLATFORM OFF}
84+ (HTMLDocument as IHTMLDocument2Disp).Write(ADocument);
85+ {$WARN SYMBOL_PLATFORM ON}
86+ (HTMLDocument as IHTMLDocument2).Close;
87+
88+ HTMLElementCollection := (HTMLDocument as IHTMLDocument3).getElementsByName('user_id');
89+
90+ Result := HTMLElementCollection.length > 0;
91+
92+ if Result then
93+ // Mesmo que a página contenha mais de um element com o mesmo nome, todos
94+ // eles se referem a mesma coisa, logo, podemos pegar o valor do primeiro
95+ AUserId := StrToInt(((HTMLElementCollection as IHTMLElementCollection4).item(0) as IHTMLInputElement).value);
96+end;
97+
98+// A página usada para obter informações básicas do usuário não possui seu Id,
99+// portanto precisamos fazer uma conexão adicional só pra isso
100+function GetUserId(AHandle: Cardinal; out AUserId: Cardinal): Boolean;
101+var
102+ Req: TRequestOptions;
103+ Res: TResponse;
104+begin
105+ ZeroMemory(@Req,SizeOf(TRequestOptions));
106+ ZeroMemory(@Res,SizeOf(TResponse));
107+
108+ AUserId := 0;
109+
110+ Req.AutoClearSSLState := True;
111+
112+ Req.InternetOpenParams.Agent := 'MantisBT Monitor';
113+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
114+ Req.InternetConnectParams.ServerName := PChar(Configurations.MantisBTBaseUrl + '/mantis/account_prefs_page.php');
115+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
116+ Req.InternetConnectParams.Context := AHandle;
117+
118+ Req.HttpOpenRequestParams.Verb := 'GET';
119+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
120+ try
121+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
122+ Req.HttpOpenRequestParams.Context := AHandle;
123+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
124+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
125+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
126+
127+ Res.Content := TStringStream.Create('',TEncoding.UTF8);
128+ try
129+ Request(Req,Res);
130+ Result := ParseGetUserIdResult(TStringStream(Res.Content).DataString,AUserId);
131+ finally
132+ Res.Content.Free;
133+ end;
134+ finally
135+ Req.HttpOpenRequestParams.AcceptTypes.Free;
136+ end;
137+end;
138+
139+function ParseGetUserInfoResult(ADocument: String; out AUserInfo: TUserInfo): Boolean;
140+var
141+ HTMLDocument: IHTMLDocument;
142+ i: Word;
143+ HTMLElement: IHTMLElement;
144+ HTMLElementCollection: IHTMLElementCollection;
145+begin
146+ AUserInfo := Default(TUserInfo);
147+
148+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument;
149+
150+ // Habilita o modo de design, o qual desabilita scripts e permite a
151+ // leitura do código da página exatamente como ele é. Scripts podem
152+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
153+ // ser diferente daquilo que ele seria ao não usar esta propriedade
154+ (HTMLDocument as IHTMLDocument2).DesignMode := 'On';
155+ (HTMLDocument as IHTMLDocument2).charset := 'utf-8';
156+ {$WARN SYMBOL_PLATFORM OFF}
157+ (HTMLDocument as IHTMLDocument2Disp).Write(ADocument);
158+ {$WARN SYMBOL_PLATFORM ON}
159+ (HTMLDocument as IHTMLDocument2).Close;
160+
161+ HTMLElement := (HTMLDocument as IHTMLDocument3).getElementById('email-field');
162+
163+ Result := Assigned(HTMLElement);
164+
165+ if Result then
166+ begin
167+ AUserInfo.EMail := (HTMLElement as IHTMLInputElement).Value;
168+ AUserInfo.RealName := ((HTMLDocument as IHTMLDocument3).getElementById('realname') as IHTMLInputElement).Value;
169+ AUserInfo.UserName := ((HTMLDocument as IHTMLDocument3).getElementsByTagName('td').item(1,1) as IHTMLElement).innerText;
170+ AUserInfo.AccessLevel := ((HTMLDocument as IHTMLDocument3).getElementsByTagName('td').item(13,13) as IHTMLElement).innerText;
171+ AUserInfo.ProjectAccessLevel := ((HTMLDocument as IHTMLDocument3).getElementsByTagName('td').item(15,15) as IHTMLElement).innerText;
172+ // Eu sei que a página só contém 1 tabela com a classe especificada,
173+ // logo eu posso seguramente obter esta tabela diretamente da coleção e
174+ // a partir desta tabela obter logo todas as suas linhas!
175+ HTMLElementCollection := ((HTMLDocument as IHTMLDocument7).getElementsByClassName('table table-striped table-bordered table-condensed table-hover').item(0,0) as IHTMLTable).Rows;
176+
177+ if HTMLElementCollection.length > 0 then
178+ begin
179+ // Cada linha da tabela é um projeto atribuído, logo o array tem este
180+ // tamanho, menos 1, porque o <th> também é considerado uma linha da
181+ // tabela e precisa ser descartado neste caso
182+ SetLength(AUserInfo.AssignedProjects,HTMLElementCollection.Length - 1);
183+ // Varre as linhas da tabela (<tr>) e extrai as informações necessárias.
184+ // O elemento zero é um TH, que é, neste caso, considerado uma linha
185+ // também
186+ for i := 1 to Pred(HTMLElementCollection.Length) do
187+ begin
188+ AUserInfo.AssignedProjects[i-1].Name := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(0,0) as IHTMLElement).InnerText;
189+ AUserInfo.AssignedProjects[i-1].AccessLevel := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(1,1) as IHTMLElement).InnerText;
190+ AUserInfo.AssignedProjects[i-1].Visibility := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(2,2) as IHTMLElement).InnerText;
191+ AUserInfo.AssignedProjects[i-1].Description := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(3,3) as IHTMLElement).InnerText;
192+ end;
193+ end;
194+ end;
195+
196+end;
197+
71198 // O correto é declarar as variáveis IHTMLxxxx com o tipo que implique na menor
72199 // quantidade de casts dentro do código. Aquilo que é efetivamente instanciado é
73200 // uma "soma" das várias interfaces. Também é boa prática criar a variável com
@@ -76,15 +203,10 @@
76203 // tarefa árdua, então, a forma mais simples é declarar as variáveis com as
77204 // interfaces mais básicas e fazer castas quando necessário
78205
79-{$WARN SYMBOL_PLATFORM OFF}
80206 function GetUserInfo(AHandle: Cardinal; out AUserInfo: TUserInfo): Boolean;
81207 var
82208 Req: TRequestOptions;
83209 Res: TResponse;
84- HTMLDocument: IHTMLDocument;
85- i: Word;
86- HTMLElement: IHTMLElement;
87- HTMLElementCollection: IHTMLElementCollection;
88210 begin
89211 Screen.Cursor := crHourGlass;
90212 try
@@ -113,47 +235,7 @@
113235 try
114236 Request(Req,Res);
115237
116- HTMLDocument := coHTMLDocument.Create as IHTMLDocument;
117-
118- // Habilita o modo de design, o qual desabilita scripts e permite a
119- // leitura do código da página exatamente como ele é. Scripts podem
120- // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
121- // ser diferente daquilo que ele seria ao não usar esta propriedade
122- (HTMLDocument as IHTMLDocument2).DesignMode := 'On';
123- (HTMLDocument as IHTMLDocument2).charset := 'utf-8';
124- (HTMLDocument as IHTMLDocument2Disp).Write(TStringStream(Res.Content).DataString);
125- (HTMLDocument as IHTMLDocument2).Close;
126-
127- HTMLElement := (HTMLDocument as IHTMLDocument3).getElementById('email-field');
128-
129- Result := Assigned(HTMLElement);
130-
131- if Result then
132- begin
133- AUserInfo.EMail := (HTMLElement as IHTMLInputElement).Value;
134- AUserInfo.RealName := ((HTMLDocument as IHTMLDocument3).getElementById('realname') as IHTMLInputElement).Value;
135- AUserInfo.UserName := ((HTMLDocument as IHTMLDocument3).getElementsByTagName('td').item(1,1) as IHTMLElement).innerText;
136- AUserInfo.AccessLevel := ((HTMLDocument as IHTMLDocument3).getElementsByTagName('td').item(13,13) as IHTMLElement).innerText;
137- AUserInfo.ProjectAccessLevel := ((HTMLDocument as IHTMLDocument3).getElementsByTagName('td').item(15,15) as IHTMLElement).innerText;
138- // Eu sei que a página só contém 1 tabela com a classe especificada,
139- // logo eu posso seguramente obter esta tabela diretamente da coleção e
140- // a partir desta tabela obter logo todas as suas linhas!
141- HTMLElementCollection := ((HTMLDocument as IHTMLDocument7).getElementsByClassName('table table-striped table-bordered table-condensed table-hover').item(0,0) as IHTMLTable).Rows;
142- // Cada linha da tabela é um projeto atribuído, logo o array tem este
143- // tamanho, menos 1, porque o <th> também é considerado uma linha da
144- // tabela e precisa ser descartado neste caso
145- SetLength(AUserInfo.AssignedProjects,HTMLElementCollection.Length - 1);
146- // Varre as linhas da tabela (<tr>) e extrai as informações necessárias.
147- // O elemento zero é um TH, que é, neste caso, considerado uma linha
148- // também
149- for i := 1 to Pred(HTMLElementCollection.Length) do
150- begin
151- AUserInfo.AssignedProjects[i-1].Name := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(0,0) as IHTMLElement).InnerText;
152- AUserInfo.AssignedProjects[i-1].AccessLevel := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(1,1) as IHTMLElement).InnerText;
153- AUserInfo.AssignedProjects[i-1].Visibility := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(2,2) as IHTMLElement).InnerText;
154- AUserInfo.AssignedProjects[i-1].Description := ((HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(3,3) as IHTMLElement).InnerText;
155- end;
156- end;
238+ Result := ParseGetUserInfoResult(TStringStream(Res.Content).DataString,AUserInfo);
157239 finally
158240 Res.Content.Free;
159241 end;
@@ -160,11 +242,13 @@
160242 finally
161243 Req.HttpOpenRequestParams.AcceptTypes.Free;
162244 end;
245+
246+ if Result then
247+ Result := GetUserId(AHandle,AUserInfo.Id);
163248 finally
164249 Screen.Cursor := crDefault;
165250 end;
166251 end;
167-{$WARN SYMBOL_PLATFORM ON}
168252
169253 function Login(AHandle: Cardinal; AUserName: String; APassword: String; out AUserInfo: TUserInfo): Boolean;
170254 var
@@ -243,6 +327,10 @@
243327
244328 Req.Content := TStringStream.Create('',TEncoding.UTF8);
245329 try
330+ // Adiciona o cabeçalho padrão de acordo com as configurações atuais, caso
331+ // já não exista um cabeçalho
332+ AddCommentHeader(AComment);
333+
246334 Req.InternetOpenParams.Agent := 'MantisBT Monitor';
247335 Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
248336 Req.InternetConnectParams.ServerName := PChar(Configurations.MantisBTBaseUrl + '/mantis/bugnote_update.php');
@@ -982,23 +1070,20 @@
9821070 var HTMLOptionElement: IHTMLOptionElement;
9831071 var Status: TStatus;
9841072
985- // Varre todos os <option>, adicionando suas informações no array
986- for var j: Byte := 0 to Pred(HTMLSelectElement.Length) do
987- begin
988- HTMLOptionElement := HTMLSelectElement.item(j,j) as IHTMLOptionElement;
1073+ if HTMLSelectElement.Length > 0 then
1074+ // Varre todos os <option>, adicionando suas informações no array
1075+ for var j: Byte := 0 to Pred(HTMLSelectElement.Length) do
1076+ begin
1077+ HTMLOptionElement := HTMLSelectElement.item(j,j) as IHTMLOptionElement;
9891078
990- Status.Id := StrToInt(HTMLOptionElement.Value);
991- Status.Description := HTMLOptionElement.Text;
992- Status.Color := Configurations.MantisConfigs.StatusColorById[Status.Id];
993- Status.IsDefault := Status.Id = DefaultStatusId;
994- // Nova forma de incrementar um array dinâmico (a partir do XE7)
995- ATask.PossibleStatusChanges := ATask.PossibleStatusChanges + [Status];
1079+ Status.Id := StrToInt(HTMLOptionElement.Value);
1080+ Status.Description := HTMLOptionElement.Text;
1081+ Status.Color := Configurations.MantisConfigs.StatusColorById[Status.Id];
1082+ Status.IsDefault := Status.Id = DefaultStatusId;
1083+ // Nova forma de incrementar um array dinâmico (a partir do XE7)
1084+ ATask.PossibleStatusChanges := ATask.PossibleStatusChanges + [Status];
1085+ end;
9961086
997-// ATask.FPossibleStatusChanges[j].Id :=
998-// ATask.FPossibleStatusChanges[j].Description := FixEncoding(HTMLOptionElement.Text);
999-// ATask.FPossibleStatusChanges[j].Color := StatusColorByStatusCode(ATask.FPossibleStatusChanges[j].Id);
1000- end;
1001-
10021087 Break;
10031088 end;
10041089 end;
@@ -1346,57 +1431,61 @@
13461431 // Obtendo a coleção de linhas da primeira tabela da tela, a qual possui os
13471432 // casos atribuídos a nós mesmos
13481433 HTMLElementCollection := (HTMLElementCollection.item(0,0) as IHTMLTable).Rows;
1349- // Cada linha da tabela acima é um caso atribuído, logo o array tem este
1350- // tamanho
1351- SetLength(ATasks,HTMLElementCollection.Length);
1352- // Varre cada linha extraindo toda a informação necessária
1353- for var i: Word := 0 to Pred(HTMLElementCollection.Length) do
1434+
1435+ if HTMLElementCollection.length > 0 then
13541436 begin
1355- // Primeira coluna da linha
1356- HTMLElement := (HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(0,0) as IHTMLElement;
1437+ // Cada linha da tabela acima é um caso atribuído, logo o array tem este
1438+ // tamanho
1439+ SetLength(ATasks,HTMLElementCollection.Length);
1440+ // Varre cada linha extraindo toda a informação necessária
1441+ for var i: Word := 0 to Pred(HTMLElementCollection.Length) do
1442+ begin
1443+ // Primeira coluna da linha
1444+ HTMLElement := (HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(0,0) as IHTMLElement;
13571445
1358- ATasks[i].Id := StrToInt(Trim(HTMLElement.InnerText));
1446+ ATasks[i].Id := StrToInt(Trim(HTMLElement.InnerText));
13591447
1360- if AFullInfo then
1361- TaskDetails(AHandle,ATasks[i])
1362- else
1363- begin
1364- // Primeiro <i> dentro da primeira coluna
1365- var Status: TStatus := ATasks[i].Status;
1448+ if AFullInfo then
1449+ TaskDetails(AHandle,ATasks[i])
1450+ else
1451+ begin
1452+ // Primeiro <i> dentro da primeira coluna
1453+ var Status: TStatus := ATasks[i].Status;
13661454
1367- Status.Description := ((HTMLElement as IHTMLElement2).getElementsByTagName('i').Item(0,0) as IHTMLElement).Title;
1368- ParseStatusColorAndId(((HTMLElement as IHTMLElement2).getElementsByTagName('i').Item(0,0) as IHTMLElement)._ClassName,Status);
1369- Status.IsDefault := DefaultStatusId = Status.Id;
1455+ Status.Description := ((HTMLElement as IHTMLElement2).getElementsByTagName('i').Item(0,0) as IHTMLElement).Title;
1456+ ParseStatusColorAndId(((HTMLElement as IHTMLElement2).getElementsByTagName('i').Item(0,0) as IHTMLElement)._ClassName,Status);
1457+ Status.IsDefault := DefaultStatusId = Status.Id;
13701458
1371- ATasks[i].Status := Status;
1459+ ATasks[i].Status := Status;
13721460
1373- // O loop para achar a prioridade é necessário porque o elemento que
1374- // contém esta informação muda de posição dentro do array de <i>.
1375- // Existem tarefas que não tem prioridade e/ou que não não podem ser
1376- // alteradas (ícone do lápis) nestes casos o <i> que contém a
1377- // prioridade, caso ele exista, poderá estar em posições diferentes. O
1378- // loop começa em 1 porque o item zero sempre existe e já foi processado
1379- // nas duas linhas anteriores
1380- for var j: Byte := 1 to Pred((HTMLElement as IHTMLElement2).getElementsByTagName('i').Length) do
1381- begin
1382- AuxString := ((HTMLElement as IHTMLElement2).getElementsByTagName('i').Item(j,j) as IHTMLElement).Title;
1461+ // O loop para achar a prioridade é necessário porque o elemento que
1462+ // contém esta informação muda de posição dentro do array de <i>.
1463+ // Existem tarefas que não tem prioridade e/ou que não não podem ser
1464+ // alteradas (ícone do lápis) nestes casos o <i> que contém a
1465+ // prioridade, caso ele exista, poderá estar em posições diferentes. O
1466+ // loop começa em 1 porque o item zero sempre existe e já foi processado
1467+ // nas duas linhas anteriores
1468+ for var j: Byte := 1 to Pred((HTMLElement as IHTMLElement2).getElementsByTagName('i').Length) do
1469+ begin
1470+ AuxString := ((HTMLElement as IHTMLElement2).getElementsByTagName('i').Item(j,j) as IHTMLElement).Title;
13831471
1384- if (AuxString = 'baixa') or (AuxString = 'média') or (AuxString = 'alta') or (AuxString = 'urgente') then
1385- begin
1386- ATasks[i].Priority := Configurations.MantisConfigs.PriorityByName[AuxString];
1387- Break;
1472+ if (AuxString = 'baixa') or (AuxString = 'média') or (AuxString = 'alta') or (AuxString = 'urgente') then
1473+ begin
1474+ ATasks[i].Priority := Configurations.MantisConfigs.PriorityByName[AuxString];
1475+ Break;
1476+ end;
13881477 end;
1478+ // Segunda coluna da linha
1479+ HTMLElement := (HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(1,1) as IHTMLElement;
1480+ // Todos os <span> existentes na segunda colina da linha
1481+ HTMLSpanCollection := (HTMLElement as IHTMLElement2).getElementsByTagName('span');
1482+ // Primeiro <span>
1483+ ATasks[i].Project := ExtractProjectName((HTMLSpanCollection.Item(0,0) as IHTMLElement).InnerText);
1484+ // Segundo <span>
1485+ ATasks[i].Summary := (HTMLSpanCollection.Item(1,1) as IHTMLElement).InnerText;
1486+ ATasks[i].Category := (HTMLSpanCollection.Item(2,2) as IHTMLElement).InnerText;
1487+ ATasks[i].LastUpdate := ExtractDateTime((HTMLSpanCollection.Item(3,3) as IHTMLElement).InnerText);
13891488 end;
1390- // Segunda coluna da linha
1391- HTMLElement := (HTMLElementCollection.item(i,i) as IHTMLTableRow).Cells.Item(1,1) as IHTMLElement;
1392- // Todos os <span> existentes na segunda colina da linha
1393- HTMLSpanCollection := (HTMLElement as IHTMLElement2).getElementsByTagName('span');
1394- // Primeiro <span>
1395- ATasks[i].Project := ExtractProjectName((HTMLSpanCollection.Item(0,0) as IHTMLElement).InnerText);
1396- // Segundo <span>
1397- ATasks[i].Summary := (HTMLSpanCollection.Item(1,1) as IHTMLElement).InnerText;
1398- ATasks[i].Category := (HTMLSpanCollection.Item(2,2) as IHTMLElement).InnerText;
1399- ATasks[i].LastUpdate := ExtractDateTime((HTMLSpanCollection.Item(3,3) as IHTMLElement).InnerText);
14001489 end;
14011490 end;
14021491
@@ -1682,16 +1771,19 @@
16821771
16831772 HTMLElementCollection := (HTMLDocument as IHTMLDocument3).GetElementsByTagName('div');
16841773
1685- for i := 0 to Pred(HTMLElementCollection.Length) do
1686- begin
1687- HTMLElement := ((HTMLElementCollection as IHTMLElementCollection4).Item(i) as IHTMLElement);
1774+ i := 0; // apenas porque a coleção pode vir vazia
16881775
1689- if HTMLElement._className = 'alert alert-danger' then
1776+ if HTMLElementCollection.length > 0 then
1777+ for i := 0 to Pred(HTMLElementCollection.Length) do
16901778 begin
1691- AError := FirstChildElement(HTMLElement).innerText + '|' + NthChildElement(HTMLElement,1).InnerText;
1692- Break;
1779+ HTMLElement := ((HTMLElementCollection as IHTMLElementCollection4).Item(i) as IHTMLElement);
1780+
1781+ if HTMLElement._className = 'alert alert-danger' then
1782+ begin
1783+ AError := FirstChildElement(HTMLElement).innerText + '|' + NthChildElement(HTMLElement,1).InnerText;
1784+ Break;
1785+ end;
16931786 end;
1694- end;
16951787
16961788 // Caso tenha saído do loop anterior prematuramente, significa que houve um
16971789 // erro, do contrário, suuuuucessooooo!
@@ -1756,6 +1848,10 @@
17561848
17571849 Req.Content := TMemoryStream.Create;
17581850 try
1851+ // Adiciona o cabeçalho padrão de acordo com as configurações atuais, caso
1852+ // já não exista um cabeçalho
1853+ AddCommentHeader(AComment);
1854+
17591855 AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bugnote_add_token',RawByteString(ATask.AddCommentToken),BOUNDARY);
17601856 AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bug_id',RawByteString(ATask.Id.ToString),BOUNDARY);
17611857 AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bugnote_text',UTF8Encode(AComment),BOUNDARY);
@@ -1806,4 +1902,185 @@
18061902 end;
18071903 end;
18081904
1905+function ParseGetChangeStatusParametersResponse(ADocument: String; out ABugUpdateToken: String; out ALastUpdated: String): Boolean;
1906+var
1907+ HTMLDocument: IHTMLDocument;
1908+ HTMLElementCollection: IHTMLElementCollection;
1909+ HTMLInputElement: IHTMLInputElement;
1910+begin
1911+ ABugUpdateToken := '';
1912+ ALastUpdated := '';
1913+
1914+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument;
1915+ (HTMLDocument as IHTMLDocument2).DesignMode := 'On';
1916+ (HTMLDocument as IHTMLDocument2).charset := 'utf-8';
1917+ {$WARN SYMBOL_PLATFORM OFF}
1918+ (HTMLDocument as IHTMLDocument2Disp).Write(ADocument);
1919+ {$WARN SYMBOL_PLATFORM ON}
1920+ (HTMLDocument as IHTMLDocument2).Close;
1921+
1922+ HTMLElementCollection := (HTMLDocument as IHTMLDocument3).GetElementsByTagName('input') as IHTMLElementCollection;
1923+
1924+ if HTMLElementCollection.length > 0 then
1925+ for var i: Word := 0 to Pred(HTMLElementCollection.length) do
1926+ begin
1927+ HTMLInputElement := (HTMLElementCollection as IHTMLElementCollection4).item(i) as IHTMLInputElement;
1928+ // Devem haver apenas dois <input> com as informações que queremos, por isso
1929+ // não preciso lidar com repetições ou sobrescrições
1930+ if HTMLInputElement.name = 'bug_update_token' then
1931+ ABugUpdateToken := HTMLInputElement.Value
1932+ else if HTMLInputElement.Name = 'last_updated' then
1933+ ALastUpdated := HTMLInputElement.Value;
1934+ end;
1935+
1936+ Result := (ABugUpdateToken <> '') and (ALastUpdated <> '');
1937+end;
1938+
1939+function GetChangeStatusParameters(AHandle: Cardinal; ATaskId: Cardinal; ANewStatusId: Word; out ABugUpdateToken: String; out ALastUpdated: String): Boolean;
1940+var
1941+ Req: TRequestOptions;
1942+ Res: TResponse;
1943+begin
1944+ ZeroMemory(@Req,SizeOf(Req));
1945+ ZeroMemory(@Res,SizeOf(Res));
1946+
1947+ Req.AutoClearSSLState := True;
1948+
1949+ Req.Content := TStringStream.Create(Format('new_status=%u&id=%u&change_type=change_status',[ANewStatusId,ATaskId]));
1950+ try
1951+ Req.InternetOpenParams.Agent := 'MantisBT Monitor';
1952+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
1953+ Req.InternetConnectParams.ServerName := PChar(Configurations.MantisBTBaseUrl + '/mantis/bug_change_status_page.php');
1954+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
1955+ Req.InternetConnectParams.Context := AHandle;
1956+
1957+ Req.HttpOpenRequestParams.Verb := 'POST';
1958+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
1959+ try
1960+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
1961+ Req.HttpOpenRequestParams.Context := AHandle;
1962+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
1963+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
1964+ Req.HttpOpenRequestParams.Headers := TStringList.Create;
1965+ try
1966+ Req.HttpOpenRequestParams.Headers.Add('Content-Type: application/x-www-form-urlencoded');
1967+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
1968+
1969+ Res.Content := TStringStream.Create('');
1970+ try
1971+ Request(Req,Res);
1972+ Result := ParseGetChangeStatusParametersResponse(TStringStream(Res.Content).DataString,ABugUpdateToken,ALastUpdated);
1973+ finally
1974+ Res.Content.Free;
1975+ end;
1976+ finally
1977+ Req.HttpOpenRequestParams.Headers.Free;
1978+ end;
1979+ finally
1980+ Req.HttpOpenRequestParams.AcceptTypes.Free;
1981+ end;
1982+ finally
1983+ Req.Content.Free;
1984+ end;
1985+end;
1986+
1987+function ParseChangeStatusResponse(ADocument: String; const ANewStatusId: Word): Boolean;
1988+var
1989+ HTMLDocument: IHTMLDocument;
1990+ HTMLElementCollection: IHTMLElementCollection;
1991+ HTMLElement: IHTMLElement;
1992+ i: Word;
1993+begin
1994+ Result := False;
1995+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument;
1996+
1997+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument;
1998+ (HTMLDocument as IHTMLDocument2).DesignMode := 'On';
1999+ (HTMLDocument as IHTMLDocument2).charset := 'utf-8';
2000+ {$WARN SYMBOL_PLATFORM OFF}
2001+ (HTMLDocument as IHTMLDocument2Disp).Write(ADocument);
2002+ {$WARN SYMBOL_PLATFORM ON}
2003+ (HTMLDocument as IHTMLDocument2).Close;
2004+
2005+ HTMLElementCollection := (HTMLDocument as IHTMLDocument3).GetElementsByTagName('td');
2006+
2007+ if HTMLElementCollection.Length > 0 then
2008+ for i := 0 to Pred(HTMLElementCollection.Length) do
2009+ begin
2010+ HTMLElement := (HTMLElementCollection as IHTMLElementCollection4).item(i) as IHTMLElement;
2011+
2012+ if HTMLElement._className = 'bug-status' then
2013+ begin
2014+ Result := ParseStatusId(FirstChildElement(HTMLElement)._className) = ANewStatusId;
2015+ Break;
2016+ end;
2017+ end;
2018+end;
2019+
2020+function ChangeStatus(AHandle: Cardinal; ATaskId: Cardinal; ANewStatusId: Word; AComment: String): Boolean;
2021+const
2022+ BOUNDARY: RawByteString = 'MantisBTMonitor-1F00CBD1-5117-49A0-84F0-A3A4102DE66E';
2023+var
2024+ BugUpdateToken: String;
2025+ LastUpdated: String;
2026+begin
2027+ Result := GetChangeStatusParameters(AHandle,ATaskId,ANewStatusId,BugUpdateToken,LastUpdated);
2028+
2029+ if Result then
2030+ begin
2031+ // Não existe motivo especial para eu usar Default ao invéz de ZeroMemory,
2032+ // apenas eu achei que aqui ficava mais elegante usar Default e economizar 2
2033+ // linhas de código
2034+ var Req: TRequestOptions := Default(TRequestOptions);
2035+ var Res: TResponse := Default(TResponse);
2036+
2037+ Req.AutoClearSSLState := True;
2038+
2039+ Req.Content := TMemoryStream.Create;
2040+ try
2041+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bug_update_token',RawByteString(BugUpdateToken),BOUNDARY);
2042+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bug_id',RawByteString(ATaskId.ToString),BOUNDARY);
2043+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','status',RawByteString(ANewStatusId.ToString),BOUNDARY);
2044+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','last_updated',RawByteString(LastUpdated),BOUNDARY);
2045+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','handler_id',RawByteString(Configurations.UserInfo.Id.ToString),BOUNDARY);
2046+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bugnote_text',UTF8Encode(AComment),BOUNDARY);
2047+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','action_type','change_status',BOUNDARY);
2048+
2049+ Req.InternetOpenParams.Agent := 'MantisBT Monitor';
2050+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
2051+ Req.InternetConnectParams.ServerName := PChar(Configurations.MantisBTBaseUrl + '/mantis/bug_update.php');
2052+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
2053+ Req.InternetConnectParams.Context := AHandle;
2054+ Req.HttpOpenRequestParams.Verb := 'POST';
2055+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
2056+
2057+ try
2058+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
2059+ Req.HttpOpenRequestParams.Context := AHandle;
2060+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
2061+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
2062+ Req.HttpOpenRequestParams.Headers := TStringList.Create;
2063+ try
2064+ Req.HttpOpenRequestParams.Headers.Add('Content-Type: multipart/form-data; boundary=' + String(BOUNDARY));
2065+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
2066+
2067+ Res.Content := TStringStream.Create('');
2068+ try
2069+ Request(Req,Res);
2070+ Result := ParseChangeStatusResponse(TStringStream(Res.Content).DataString,ANewStatusId);
2071+ finally
2072+ Res.Content.Free;
2073+ end;
2074+ finally
2075+ Req.HttpOpenRequestParams.Headers.Free;
2076+ end;
2077+ finally
2078+ Req.HttpOpenRequestParams.AcceptTypes.Free;
2079+ end;
2080+ finally
2081+ Req.Content.Free;
2082+ end;
2083+ end;
2084+end;
2085+
18092086 end.
--- trunk/client/src/lib/UTypes.pas (revision 71)
+++ trunk/client/src/lib/UTypes.pas (revision 72)
@@ -16,6 +16,7 @@
1616 TAssignedProjects = array of TAssignedProject;
1717
1818 TUserInfo = record
19+ Id: Cardinal;
1920 UserName: string;
2021 RealName: string;
2122 EMail: string;
@@ -51,6 +52,7 @@
5152 private
5253 FStatuses: TStatuses;
5354 FPriorities: TPriorities;
55+
5456 function GetStatusById(AId: Word): TStatus;
5557 function GetStatusIndexById(AId: Word): SmallInt;
5658 function GetPriorityByName(AName: String): TPriority;
@@ -214,6 +216,8 @@
214216 function GetHistoryEntryCount: Word;
215217 function GetRelatedTasksCount: Word;
216218 function GetCommentById(AId: Cardinal): TComment;
219+ function GetPossibleStatusChangeById(AId: Word): TStatus;
220+ function GetStatusChangeIsPossible(AStatusId: Word): Boolean;
217221 public
218222 procedure Clear(AAllButId: Boolean = True);
219223
@@ -235,6 +239,8 @@
235239 property AddCommentToken: String read FAddCommentToken write FAddCommentToken;
236240 property MaxFileSize: Cardinal read FMaxFileSize write FMaxFileSize;
237241 property PossibleStatusChanges: TStatuses read FPossibleStatusChanges write FPossibleStatusChanges;
242+ property PossibleStatusChangeById[AId: Word]: TStatus read GetPossibleStatusChangeById;
243+ property StatusChangeIsPossible[AStatusId: Word]: Boolean read GetStatusChangeIsPossible;
238244 property RelatedTasks: TRelatedTasks read FRelatedTasks write FRelatedTasks;
239245 property Comments: TComments read FComments write FComments;
240246 property History: THistory read FHistory write FHistory;
@@ -433,6 +439,18 @@
433439 Result := Length(FHistory);
434440 end;
435441
442+function TTask.GetPossibleStatusChangeById(AId: Word): TStatus;
443+begin
444+ Result := Default(TStatus);
445+
446+ for var Status: TStatus in FPossibleStatusChanges do
447+ if Status.Id = AId then
448+ begin
449+ Result := Status;
450+ Break;
451+ end;
452+end;
453+
436454 function TTask.GetPreviousResponsible: TPreviousResponsible;
437455 var
438456 FirstIteration: Boolean;
@@ -489,6 +507,11 @@
489507 Result := Length(FRelatedTasks);
490508 end;
491509
510+function TTask.GetStatusChangeIsPossible(AStatusId: Word): Boolean;
511+begin
512+ Result := GetPossibleStatusChangeById(AStatusId).Id > 0;
513+end;
514+
492515 { TAttachment }
493516
494517 function TAttachment.GetCanDelete: Boolean;
--- trunk/client/src/UConfigurations.pas (revision 71)
+++ trunk/client/src/UConfigurations.pas (revision 72)
@@ -8,6 +8,10 @@
88 type
99 TEnvironment = (eUnknown, eDevelopment, eTest, eHomologation, eProduction);
1010 TProfile = (pUnknown, pDeveloper, pTester, pHomologator);
11+ // Na enumeração abaixo eu não usei prefixos porque eu pretendo usar os nomes
12+ // dos elementos diretamente para obter os nomes dos tags especiais, a fim de
13+ // economizar código
14+ TUnitId = (None, uds1, uds2, uds3, uds4, uds5, unts, une1, une2, une3, une4, une5, ungc);
1115
1216 TConfigurations = class(TRegistry)
1317 private
@@ -19,12 +23,14 @@
1923 function GetPassword: String;
2024 function GetProfile: TProfile;
2125 function GetUserName: String;
26+ function GetNotificationTimeOut: Byte;
27+ function GetMantisBTMonitorBaseUrl: String;
28+ function GetTemporaryDirectory: String;
29+ function GetUnitId: TUnitId;
2230 procedure SetPassword(const AValue: String);
2331 procedure SetProfile(const AValue: TProfile);
2432 procedure SetUserName(const AValue: String);
25- function GetNotificationTimeOut: Byte;
26- function GetMantisBTMonitorBaseUrl: String;
27- function GetTemporaryDirectory: String;
33+ procedure SetUnitId(const AValue: TUnitId);
2834 public
2935 constructor Create;
3036 // Propriedades obtidas automaticamente
@@ -40,6 +46,7 @@
4046 property UserName: String read GetUserName write SetUserName;
4147 property Password: String read GetPassword write SetPassword;
4248 property Profile: TProfile read GetProfile write SetProfile;
49+ property UnityId: TUnitId read GetUnitId write SetUnitId;
4350 // Propriedades do Windows que são salvas no Registro do Windows
4451 property NotificationTimeOut: Byte read GetNotificationTimeOut;
4552 end;
@@ -126,7 +133,8 @@
126133
127134 if OpenKeyReadOnly(APPKEY) then
128135 try
129- Result := ReadString('Password');
136+ if ValueExists('Password') then
137+ Result := ReadString('Password');
130138 finally
131139 CloseKey;
132140 end;
@@ -138,7 +146,8 @@
138146
139147 if OpenKeyReadOnly(APPKEY) then
140148 try
141- Result := TProfile(ReadInteger('Profile'));
149+ if ValueExists('Profile') then
150+ Result := TProfile(ReadInteger('Profile'));
142151 finally
143152 CloseKey;
144153 end;
@@ -149,6 +158,19 @@
149158 Result := ExtractFilePath(ParamStr(0)) + 'tmp\';
150159 end;
151160
161+function TConfigurations.GetUnitId: TUnitId;
162+begin
163+ Result := None;
164+
165+ if OpenKeyReadOnly(APPKEY) then
166+ try
167+ if ValueExists('UnitId') then
168+ Result := TUnitId(ReadInteger('UnitId'));
169+ finally
170+ CloseKey;
171+ end;
172+end;
173+
152174 function TConfigurations.GetUserName: String;
153175 begin
154176 Result := '';
@@ -155,7 +177,8 @@
155177
156178 if OpenKeyReadOnly(APPKEY) then
157179 try
158- Result := ReadString('UserName');
180+ if ValueExists('UserName') then
181+ Result := ReadString('UserName');
159182 finally
160183 CloseKey;
161184 end;
@@ -185,6 +208,18 @@
185208 end;
186209 end;
187210
211+procedure TConfigurations.SetUnitId(const AValue: TUnitId);
212+begin
213+ Access := KEY_WRITE;
214+
215+ if OpenKey(APPKEY,False) then
216+ try
217+ WriteInteger('UnitId',Byte(AValue));
218+ finally
219+ CloseKey;
220+ end;
221+end;
222+
188223 procedure TConfigurations.SetUserName(const AValue: String);
189224 begin
190225 Access := KEY_WRITE;
--- trunk/client/src/UDamoTask.pas (revision 71)
+++ trunk/client/src/UDamoTask.pas (revision 72)
@@ -74,6 +74,7 @@
7474 procedure DownloadAttachment(AAttachmentId: Cardinal; AFileName: String; AOpen: Boolean);
7575 procedure Refresh;
7676 procedure ParseTaskIdAndCommentId(AUri: String; out ATaskId: Cardinal; out ACommentId: Cardinal);
77+ procedure BeginExecution;
7778
7879 property Task: TTask read FTask write FTask;
7980 end;
@@ -194,6 +195,11 @@
194195 end;
195196 end;
196197
198+procedure TDamoTask.BeginExecution;
199+begin
200+ ChangeStatus(Application.Handle,FTask.Id,Configurations.MantisConfigs.StatusByName['em execução'].Id,'Comentário fixo de inicialização');
201+end;
202+
197203 procedure TDamoTask.NewComment;
198204 var
199205 Comment: String;
--- trunk/client/src/UFormTask.pas (revision 71)
+++ trunk/client/src/UFormTask.pas (revision 72)
@@ -68,6 +68,10 @@
6868 ACTNRefresh: TAction;
6969 ACTNApprove: TAction;
7070 ACTNDisapprove: TAction;
71+ ACTNTest: TAction;
72+ ACTNHomologate: TAction;
73+ ACTNSendToTest: TAction;
74+ ACTNSendToHomologation: TAction;
7175 procedure TASHStepsToReproduceShow(Sender: TObject);
7276 procedure TASHAdditionalInformationShow(Sender: TObject);
7377 procedure TASHCommentsShow(Sender: TObject);
@@ -90,6 +94,8 @@
9094 procedure EDBRStepsToReproduceWebResourceRequested(Sender: TCustomEdgeBrowser; Args: TWebResourceRequestedEventArgs);
9195 procedure ACTNRefreshExecute(Sender: TObject);
9296 procedure TASHDescriptionShow(Sender: TObject);
97+ procedure ACTNOpenWithMantisExecute(Sender: TObject);
98+ procedure ACTNExecuteExecute(Sender: TObject);
9399 private
94100 { Private declarations }
95101 FDamoTask: TDamoTask;
@@ -116,6 +122,7 @@
116122 procedure LoadAttachmentsAndRelatedTasks;
117123 procedure LoadComments;
118124 procedure LoadHistory;
125+ procedure ConfigureStatusChangeActions;
119126 protected
120127 procedure CreateParams(var Params: TCreateParams); override;
121128 public
@@ -137,6 +144,19 @@
137144
138145 { TFormTask }
139146
147+procedure TFormTask.ACTNExecuteExecute(Sender: TObject);
148+begin
149+ inherited;
150+ FDamoTask.BeginExecution;
151+ FDamoTask.Refresh;
152+end;
153+
154+procedure TFormTask.ACTNOpenWithMantisExecute(Sender: TObject);
155+begin
156+ inherited;
157+ OpenTaskWithMantis(FDamoTask.Task.Id);
158+end;
159+
140160 procedure TFormTask.ACTNRefreshExecute(Sender: TObject);
141161 begin
142162 inherited;
@@ -530,6 +550,8 @@
530550 GRBXRelatedTasks.Caption := ' Tarefas relacionadas (' + FDamoTask.Task.RelatedTasksCount.ToString + ') ';
531551 TASHComments.Caption := 'Comentários (' + FDamoTask.Task.CommentsCount.ToString + ')';
532552 TASHHistory.Caption := 'Histórico da tarefa (' + FDamoTask.Task.HistoryEntryCount.ToString + ')';
553+
554+ ConfigureStatusChangeActions;
533555 end;
534556
535557 procedure TFormTask.PNBBCloseClick(Sender: TObject);
@@ -643,4 +665,95 @@
643665 LoadStepsToReproduce;
644666 end;
645667
668+{
669+
670+https://www.ginifab.com/feeds/pms/rgb_to_hsv_hsl.html para obter valor hsl de uma cor
671+
672+Todos os status do Mantis estão em Configurations.MantisConfigs.Statuses, os
673+quais estão a seguir:
674+
675+(10, 'novo', 4419839, False)
676+(15, 'em análise', 11636724, True)
677+(16, 'geração release', 536870911, False)
678+(17, 'liberação release', 536870911, False)
679+(18, 'execução script', 536870911, False)
680+(19, 'banco em produção', 536870911, False)
681+(20, 'retorno', 15448035, False)
682+(21, 'impedimento', 13464981, False)
683+(22, 'rejeitado', 3556340, False)
684+(50, 'atribuído', 16768962, False)
685+(56, 'a executar', 5828351, False)
686+(60, 'em análise e projeto', 8757270, False)
687+(65, 'em execução', 16168489, False)
688+(66, 'em testes', 12610396, False)
689+(75, 'verificado', 536870911, False)
690+(67, 'liberado p/ homologação', 11318861, False)
691+(76, 'em homologação', 16098626, False)
692+(81, 'homologado', 2533375, False)
693+(82, 'executado', 3658333, False)
694+(85, 'em produção', 6671516, False)
695+(90, 'fechado', 12434877, False)
696+}
697+
698+{
699+fluxo de testes:
700+qnd o mantis chega ele vem atribuído a unidade de testes... "em execução"
701+qnd a gnt vai testar... a gnt atribui o mantis pra gnt... e bota "em testes"
702+qnd aprova a gnt atribui a GC permanecendo "em testes"
703+}
704+
705+procedure TFormTask.ConfigureStatusChangeActions;
706+begin
707+ // Primeiramente exibe ou oculta as ações de mudança de status de acordo com a
708+ // simples possibilidade de isso ser feito.
709+ ACTNExecute.Visible := FDamoTask.Task.StatusChangeIsPossible[ACTNExecute.Tag];
710+ ACTNTest.Visible := FDamoTask.Task.StatusChangeIsPossible[ACTNTest.Tag];
711+ ACTNHomologate.Visible := FDamoTask.Task.StatusChangeIsPossible[ACTNHomologate.Tag];
712+ ACTNReject.Visible := FDamoTask.Task.StatusChangeIsPossible[ACTNReject.Tag];
713+ ACTNImpeachment.Visible := FDamoTask.Task.StatusChangeIsPossible[ACTNImpeachment.Tag];
714+ ACTNDisapprove.Visible := FDamoTask.Task.StatusChangeIsPossible[ACTNDisapprove.Tag]; // Igual a rejeitar
715+ // Oculta ações que não mudam o status. Elas serão exibidas mais adiante de
716+ // acordo com regras específicas
717+ ACTNSendToTest.Hide;
718+ ACTNSendToHomologation.Hide;
719+ ACTNApprove.Hide;
720+ // Exibindo ou ocultando ações de acordo com diversos critérios para cada
721+ // perfil de usuário
722+ case Configurations.Profile of
723+ pDeveloper: begin
724+ // Ocultado ações que não podem aparecer para este perfil de forma alguma
725+ ACTNTest.Hide;
726+ ACTNHomologate.Hide;
727+ ACTNApprove.Hide;
728+ ACTNDisapprove.Hide;
729+ // Exibindo ou ocultando (mantendo ocultas) ações que dependem de status
730+ // epecificos
731+ ACTNSendToTest.Visible := FDamoTask.Task.Status.Id = Configurations.MantisConfigs.StatusByName['em execução'].Id;
732+ ACTNSendToHomologation.Visible := ACTNSendToTest.Visible;
733+ end;
734+ pTester: begin
735+ // Ocultado ações que não podem aparecer para este perfil de forma alguma
736+ ACTNExecute.Hide;
737+ ACTNHomologate.Hide;
738+ ACTNSendToTest.Hide;
739+ ACTNSendToHomologation.Hide;
740+ // Exibindo ou ocultando (mantendo ocultas) ações que dependem de status
741+ // epecificos
742+ ACTNApprove.Visible := FDamoTask.Task.Status.Id = Configurations.MantisConfigs.StatusByName['em testes'].Id;
743+ ACTNDisapprove.Visible := ACTNApprove.Visible;
744+ end;
745+ pHomologator: begin
746+ // Ocultado ações que não podem aparecer para este perfil de forma alguma
747+ ACTNExecute.Hide;
748+ ACTNTest.Hide;
749+ ACTNSendToTest.Hide;
750+ ACTNSendToHomologation.Hide;
751+ // Exibindo ou ocultando (mantendo ocultas) ações que dependem de status
752+ // epecificos
753+ ACTNApprove.Visible := FDamoTask.Task.Status.Id = Configurations.MantisConfigs.StatusByName['em homologação'].Id;
754+ ACTNDisapprove.Visible := ACTNApprove.Visible;
755+ end;
756+ end;
757+end;
758+
646759 end.
Show on old repository browser