Download as
Browse Code »

Commit 9f57fcf01c83c0496e105bf9d43ea35019cd954e

Authored by anderson.peterle@previdencia.gov.br
1 parent 2c54a33b
Exists in master

Exclusão para reposição com versão 2.6-Beta-2 

git-svn-id: http://svn.softwarepublico.gov.br/svn/cacic/cacic/trunk/agente-windows@954 fecfc0c7-e812-0410-ae72-849f08638ee7
Showing 20 changed files with 0 additions and 6307 deletions   Show diff stats
mapa/FormConfig.ddp
View file @2c54a33
No preview for this file type
mapa/FormConfig.dfm
View file @2c54a33
@@ -1,260 +0,0 @@ @@ -1,260 +0,0 @@
1 -object Configs: TConfigs  
2 - Left = 164  
3 - Top = 137  
4 - Width = 409  
5 - Height = 217  
6 - Caption =  
7 - 'MapaCacic - M'#243'dulo Avulso para Coleta de Informa'#231#245'es Patrimoniai' +  
8 - 's'  
9 - Color = clBtnFace  
10 - Font.Charset = DEFAULT_CHARSET  
11 - Font.Color = clWindowText  
12 - Font.Height = -11  
13 - Font.Name = 'MS Sans Serif'  
14 - Font.Style = []  
15 - Icon.Data = {  
16 - 0000010001003232000001000800E00F00001600000028000000320000006400  
17 - 00000100080000000000B80B0000000000000000000000010000000000000000  
18 - 0000FFFFFF006699FF0099FFFF0066FFFF000033FF00002BD70000156A001534  
19 - 380065CA320063C6310052A529004B9625002C59160066CC330066CB330060C0  
20 - 30005DBA2F0059B12D00376D1C004589240059B233001A350F003C77240054A8  
21 - 370034672200234618001E3B150050A23C00478A37000F1E0C004F9940001223  
22 - 0F00315D2A00152A1200539E4A003D7238002A5028001223130026462800438E  
23 - 49000E1C10003F874B003A7E4600326D3D00101F130068BD7B00457C57006BC0  
24 - 8A00294935006FC395000B16120012231D001B413500357B680074C7B0002851  
25 - 47001B4239000E1B18006AB4AA007BD0C400183E3B000F2524007FD5D2008BE9  
26 - E70088E4E30086E0DE00183E3E004FC8C8003D9A9A00193F3F001C4444001C41  
27 - 41001F4545001E3B3B0097FDFD0095FAFA008EEEEE008CEBEB0087E2E20081D8  
28 - D8005D9C9C003B63630098FEFE0093F5F50090F0F00079CACA006BB3B300416C  
29 - 6C0047757500122E2F00235455006FBBBF004D8285004A7C7F0015353800538D  
30 - 94003255590060A2A900416F76002B494D0050878E002C6D79001526290078CB  
31 - D8004D8590001C30350031C4F60033CCFF0033CAFD0032C5F80031BFF10031B8  
32 - EA0032B0E400296781001E36400032AADD0013354400508EAA004E89A3001E34  
33 - 3E0033A1D50035A5DA005CA3C800369AD00030566A0061ACD5003892CA000409  
34 - 0C00569BC600368BC2000E1A220027475D00223F55000B263D001D4F78003C89  
35 - C500060C1100549BD5001F394E004F92CC00235A8E004388CD00285B99004688  
36 - D6004989D200335E93001E324900030C180010315B0018315100071934003369  
37 - B500020407003E7ED600152A4800080E17004F88D8004D85D300548DE1001444  
38 - 96005A8EE9005C90EC000C131F005E92F000141F33001145AD00010204000305  
39 - 09000E1625001B2A47000D1422000B111D00111A2C000F1727001E2E4D004A70  
40 - BC003956910036528900273B63006598FE006395F9006295F7006192F4006090  
41 - F1005E8EED005B8AE500517ACC004C73C000486CB500466AB1004264A7004162  
42 - A4004060A1006597FD006496FA005E8DEB005D8BE9005A87E1005985DF005782  
43 - DA00547ED2004E75C3004466AA003F5E9D00354F8400324B7D002C426E002A3F  
44 - 690024365A0022335500203050001A2741003C5A95000A0F1A00162138002639  
45 - 60004F76C6004567AD000E3288000F2B70000938B900040D2400184AD2000736  
46 - C50002030600032BBF000837D7000629A7000032FE000031FD000031F9000031  
47 - F5000030F100002FEB00002CDF000029D0000028C8000026BF000024B600001E  
48 - 9800001D9300001A880000187D0000156C0000156B0000146400000E4900000A  
49 - 3500000724000230E3000534E60000051D0001092D0000000100FFFFFF000000  
50 - 0000F9FC00000000000000000000000000000000000000000000000000000000  
51 - 00000000000000000000FC0000000000000000000000F6F60000000000000000  
52 - 000000000000000000000000000000000000000000000000000000000000F0F8  
53 - 000000000000000000FDE8E7F800000000000000000000000000000000000000  
54 - 0000000000000000000000000000000000F705EBF900000000000000F9ED0505  
55 - ECF9000000000000000000000000000000000000000000000000000000000000  
56 - 00000000FDE90505F100000000000000F605050505F800000000000000000000  
57 - 000000000000000000000000000000000000000000000000F7050505E5F80000  
58 - 000000F9EA05050505F600000000000000000000000000000000000000000000  
59 - 000000000000000000000000E4E5050505EE0000000000F705050505E5EE0000  
60 - 00000000000000000000000000000000000000000000000000000000000000FD  
61 - E905050505E5FD00000000A5DCEAE5E6EAEFDE00000000000000000000000000  
62 - 00000000000000000000000000000000000000DEEDE8050506DCA30000008057  
63 - 5096EBDB7D626A00000000000000000000000000000000000000000000000000  
64 - 0000000000000064608BE2E2844E630000008356034D96840303640000000000  
65 - 0000000000000000ABAEAEAEAE00000000000000000000000000005D034C9B85  
66 - 4C036000000083500303424F0303630000000000000000ABA5CFD5BDBBC5B4B7  
67 - C8BCC0CDAAA90000000000000000995703535655030362000000805703030303  
68 - 03035E0000000000A9D7B1BA02020202020202020202020202B5BDD2AE000000  
69 - 0000895C0303030303036300000000614B030303030364000000A3D3C6020202  
70 - 02020202020202020202020202020202C3B1A900000000605303030303546A00  
71 - 0000001E314F030303503300D6A5BB0202020202020202020202B70202020202  
72 - 020202020202B8CFAB0000344D030353562720000000002012275603572720A3  
73 - C102020202020202020202B9D5D2B3D1CFBD02020202020202020202C7A5001E  
74 - 3150033B250B290000000080170A2531171433CAC3020202020202020202C7D3  
75 - BCB40202C4D5B3B70202020202020202C2B7D4290B2138190F1A000000000000  
76 - 2914091A091BB09F7C8E0202020202020202D3B9020202020202BBB302020202  
77 - 020202B67F7FA2AE190E110E1020000000000000AD515959A226A19E716D7FB5  
78 - 0202020202D9B10202020202020202CCBF0202020202A47C6C799DB720090E0F  
79 - 1A000000000000AE5D593B5159B7717C9E746C7CA40202020202C20202020202  
80 - 02020202B502020202A17A6C7C9D747A93190919330000000000AB5159BD5157  
81 - 5159C36C7A9E796C79A10202020202020202020202020202020202029F716C7F  
82 - 9D716D88B5261334A300000000006F6590D9BD513B5159B46C719E7C6C79A102  
83 - 0202020202020202020202020202029D706D88916F6B88B402BD3A02CDAC0000  
84 - 00006F6F6F9FBCBD513B5159026D7091828E0202020202020202020202020202  
85 - 020202C288888E6B6F8E02020202020202CF00000000006F6F6E9F9ADA515751  
86 - 59B46B74BA02020202020202020202020202020202020202029E6F7091020202  
87 - 020202020202D3000000AEC26F6F029F9ABD51575159029D0202020202020202  
88 - 02020202020202020202020202028E9D02020202020202020202C6AE0000A502  
89 - 026F6D6F9FD9BD513B5159020202020202020202020202020202020202020202  
90 - 020202020202020202020202020202D70000ADB4026F6F686E9FD9BD51575102  
91 - 0202020202020202020202020202020202020202020202020202020202020202  
92 - 020202AD000000C002026F6F6F027A9ABD513B59BAC8C9D9B0BDDABA02020202  
93 - 020202BADABDB0D9C9C8BAB8B4020202020202020202BED6000000A3C002026F  
94 - 6F6F6E9FD9BD3B5159B1CCBFBEBDBC020202020202020202BCBDBEBFCCB1B2CC  
95 - B502020202020202B9D8AC00000000009CB802026F6F6C027A9A515751020202  
96 - 02020202020202020202020202020202020202020202020202020202AA000000  
97 - 00000000FED4BFB9026F6C6FA4BCBD5151510259595959595959595902020202  
98 - 02020202020202020202020202C3CAD0E1000000000000000000FED6A5D20268  
99 - 6EB9D951515159595959595959595959595902020202020202020202B9BBC1D0  
100 - D4AB9900000000000000000000000000000000026F6F56513B5759595900320F  
101 - 00000059595959C1B1CECFD8D2AAA5A9D6A80000000000000000000000000000  
102 - 0000000000000000026F6F6F59595959000F0F0F000000000059595900000000  
103 - 0000000000000000000000000000000000000000000000000000000000006F6F  
104 - 5959590000000000000000000000595959000000000000000000000000000000  
105 - 0000000000000000000000000000000000000059595906060606060606060606  
106 - 0606065959590000000000000000000000000000000000000000000000000000  
107 - 00000000000000595906060F0F0F060606060606060606065959000000000000  
108 - 0000000000000000000000000000000000FD070707070707070759595906060F  
109 - 0F06060606060606060606062E5959070707070707070707070707F4FC000000  
110 - 0000000000F8EF06060606060606595959060F0F060606060606060606060606  
111 - 0F5959060606060606060606060606F100000000000000000000945A08080808  
112 - 0859590000000000000F0F0F0000000000000000005959080808080808080808  
113 - 085F3E0000000000000000000000005A4404040404595932033204040F0F0404  
114 - 040404040404040404595904040404040404040404455A000000000000000000  
115 - 000000008646354748595905030332320F3204323204040404040404042F5949  
116 - 4375393D49467535474A0000000000000000000000000000EE95175864595959  
117 - 0503560F0F04323204040404040404042E59595E78F10D1651DEF11400570000  
118 - 000000000000000000000000E8A0103762E65959050556033232320432043204  
119 - 040415153259123F77E52B1D038FE91F1F0300000000000000000000000000EF  
120 - 05E00A304CE3595959055603032E2E2E2E0505050505151559590F3250EA7211  
121 - 42810536184B57000000000000000000000000EE05FA112E03DFDD5959055603  
122 - 03012E2E2E0505050505153259E00E324DFA8D093C7B056615555C0000000000  
123 - 00000000000000EE05E9152E03DFE0595959560303322E2E2E3205050505322E  
124 - 59E009304CE38D0F377E057211415C000000000000000000000000EF05E00932  
125 - 4EFBA60E59595903032E2E2E2E3205050505595959A60E3768E76615558C0536  
126 - 184B570000000000000000000000000005A00A375C058711405959592E2E2E2E  
127 - 2E05050559595959058712407B052A1C0398E81C230300000000000000000000  
128 - 0000000006380C5669EB2C143F8D5959592E2E2E2E32595959593F65EB2C143F  
129 - 92ED0B2442E4EF122F5600000000000000000000000000000700005800070000  
130 - 5800000D5959595959595959000059000700005800000D005800000D00000000  
131 - 000000000000F3FFFFFFFFF7C000F3FFFFFFFFF3C000E1FFFFFFFFE1C000C0FF  
132 - FFFFFFC1C000C0FFFFFFFFC0C00080FFFFFFFFC0C00080FFFFFFFF804000807F  
133 - FFFFFF804000007FFFFFFF804000007FFC1FFF804000007F8000FF004000007C  
134 - 00001F0040008070000007804000804000000180400080000000008040008000  
135 - 00000000C000C00000000000C000C00000000001C000800000000001C0000000  
136 - 00000001C000000000000000C000000000000000C00080000000000040000000  
137 - 0000000000000000000000000000000000000000000080000000000000008000  
138 - 0000000040008000000000004000800000000000400080000000000040008000  
139 - 00000000C000C00000000000C000C00000000000C000C00000000001C000E000  
140 - 00000001C000E00000000001C000E00000000003C000F00000000007C000F800  
141 - 00000007C000FC000000000FC000FC000000002FC000FC000000000FC000F800  
142 - 00000007C000F80000000007C000F80000000007C000F80000000007C000FC00  
143 - 0000000FC000FC000000000FC000FDAD8035B5BFC000}  
144 - OldCreateOrder = False  
145 - Position = poScreenCenter  
146 - OnCreate = FormCreate  
147 - PixelsPerInch = 96  
148 - TextHeight = 13  
149 - object Button_Gravar: TButton  
150 - Left = 56  
151 - Top = 123  
152 - Width = 121  
153 - Height = 25  
154 - Caption = 'Grava Configura'#231#245'es'  
155 - TabOrder = 0  
156 - OnClick = Button_GravarClick  
157 - end  
158 - object btCancelaOperacao: TButton  
159 - Left = 219  
160 - Top = 123  
161 - Width = 121  
162 - Height = 25  
163 - Caption = 'Cancela Opera'#231#227'o'  
164 - TabOrder = 1  
165 - OnClick = btCancelaOperacaoClick  
166 - end  
167 - object pnConfiguracoes: TPanel  
168 - Left = 9  
169 - Top = 9  
170 - Width = 382  
171 - Height = 98  
172 - TabOrder = 2  
173 - object Label_ip_serv_cacic: TLabel  
174 - Left = 15  
175 - Top = 34  
176 - Width = 208  
177 - Height = 13  
178 - Caption = 'Identificador do Servidor WEB (IP ou Nome)'  
179 - Font.Charset = DEFAULT_CHARSET  
180 - Font.Color = clWindowText  
181 - Font.Height = -11  
182 - Font.Name = 'MS Sans Serif'  
183 - Font.Style = []  
184 - ParentFont = False  
185 - end  
186 - object Label_cacic_dir: TLabel  
187 - Left = 256  
188 - Top = 34  
189 - Width = 109  
190 - Height = 13  
191 - Caption = 'Pasta do Agente Cacic'  
192 - Font.Charset = DEFAULT_CHARSET  
193 - Font.Color = clWindowText  
194 - Font.Height = -11  
195 - Font.Name = 'MS Sans Serif'  
196 - Font.Style = []  
197 - ParentFont = False  
198 - end  
199 - object lbConfiguracoes: TLabel  
200 - Left = 4  
201 - Top = 8  
202 - Width = 374  
203 - Height = 16  
204 - Alignment = taCenter  
205 - AutoSize = False  
206 - Caption = 'Configura'#231#245'es B'#225'sicas'  
207 - Font.Charset = DEFAULT_CHARSET  
208 - Font.Color = clWindowText  
209 - Font.Height = -15  
210 - Font.Name = 'MS Sans Serif'  
211 - Font.Style = [fsBold]  
212 - ParentFont = False  
213 - end  
214 - object Edit_ip_serv_cacic: TEdit  
215 - Left = 15  
216 - Top = 50  
217 - Width = 208  
218 - Height = 21  
219 - MaxLength = 100  
220 - TabOrder = 0  
221 - Text = 'uxrjo115'  
222 - OnExit = Edit_ip_serv_cacicExit  
223 - end  
224 - object Edit_cacic_dir: TEdit  
225 - Left = 256  
226 - Top = 50  
227 - Width = 110  
228 - Height = 21  
229 - MaxLength = 15  
230 - TabOrder = 1  
231 - Text = 'Cacic'  
232 - OnExit = Edit_cacic_dirExit  
233 - end  
234 - end  
235 - object pnVersao: TPanel  
236 - Left = 343  
237 - Top = 167  
238 - Width = 56  
239 - Height = 14  
240 - BevelOuter = bvLowered  
241 - TabOrder = 3  
242 - object lbVersao: TLabel  
243 - Left = 7  
244 - Top = 1  
245 - Width = 41  
246 - Height = 12  
247 - Caption = 'v: X.X.X.X'  
248 - Font.Charset = DEFAULT_CHARSET  
249 - Font.Color = clWindowText  
250 - Font.Height = -9  
251 - Font.Name = 'Arial'  
252 - Font.Style = []  
253 - ParentFont = False  
254 - end  
255 - end  
256 - object PJVersionInfo1: TPJVersionInfo  
257 - Left = 175  
258 - Top = 121  
259 - end  
260 -end  
mapa/FormConfig.pas
View file @2c54a33
@@ -1,123 +0,0 @@ @@ -1,123 +0,0 @@
1 -(**  
2 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
3 -Copyright 2000, 2001, 2002, 2003, 2004, 2005 Dataprev - Empresa de Tecnologia e Informações da Previdência Social, Brasil  
4 -  
5 -Este arquivo é parte do programa CACIC - Configurador Automático e Coletor de Informações Computacionais  
6 -  
7 -O CACIC é um software livre; você pode redistribui-lo e/ou modifica-lo dentro dos termos da Licença Pública Geral GNU como  
8 -publicada pela Fundação do Software Livre (FSF); na versão 2 da Licença, ou (na sua opinião) qualquer versão.  
9 -  
10 -Este programa é distribuido na esperança que possa ser util, mas SEM NENHUMA GARANTIA; sem uma garantia implicita de ADEQUAÇÂO a qualquer  
11 -MERCADO ou APLICAÇÃO EM PARTICULAR. Veja a Licença Pública Geral GNU para maiores detalhes.  
12 -  
13 -Você deve ter recebido uma cópia da Licença Pública Geral GNU, sob o título "LICENCA.txt", junto com este programa, se não, escreva para a Fundação do Software  
14 -Livre(FSF) Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA  
15 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
16 -*)  
17 -  
18 -unit FormConfig;  
19 -  
20 -interface  
21 -  
22 -uses  
23 - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
24 - Dialogs, StdCtrls,main_mapa, PJVersionInfo, NTFileSecurity, ExtCtrls;  
25 -  
26 -type  
27 - TConfigs = class(TForm)  
28 - Button_Gravar: TButton;  
29 - PJVersionInfo1: TPJVersionInfo;  
30 - btCancelaOperacao: TButton;  
31 - pnConfiguracoes: TPanel;  
32 - Label_ip_serv_cacic: TLabel;  
33 - Edit_ip_serv_cacic: TEdit;  
34 - Label_cacic_dir: TLabel;  
35 - Edit_cacic_dir: TEdit;  
36 - lbConfiguracoes: TLabel;  
37 - pnVersao: TPanel;  
38 - lbVersao: TLabel;  
39 - procedure Button_GravarClick(Sender: TObject);  
40 - procedure Edit_ip_serv_cacicExit(Sender: TObject);  
41 - procedure Edit_cacic_dirExit(Sender: TObject);  
42 - procedure GravaConfiguracoes;  
43 - procedure btCancelaOperacaoClick(Sender: TObject);  
44 - procedure FormCreate(Sender: TObject);  
45 - private  
46 - { Private declarations }  
47 - public  
48 - { Public declarations }  
49 - end;  
50 -  
51 -var  
52 - Configs: TConfigs;  
53 - v_ip_serv_cacic,  
54 - v_cacic_dir : String;  
55 -  
56 -  
57 -implementation  
58 -  
59 -{$R *.dfm}  
60 -  
61 -procedure TConfigs.Button_GravarClick(Sender: TObject);  
62 -begin  
63 - Configs.GravaConfiguracoes;  
64 - Close;  
65 -end;  
66 -  
67 -procedure TConfigs.GravaConfiguracoes;  
68 -var mapa_ini : TextFile;  
69 -begin  
70 - try  
71 - FileSetAttr (ExtractFilePath(Application.Exename) + '\MapaCacic.ini',0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
72 - AssignFile(mapa_ini,ExtractFilePath(Application.Exename) + '\MapaCacic.ini'); {Associa o arquivo a uma variável do tipo TextFile}  
73 - Rewrite (mapa_ini); // Recria o arquivo...  
74 - Append(mapa_ini);  
75 - Writeln(mapa_ini,'');  
76 - Writeln(mapa_ini,'# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #');  
77 - Writeln(mapa_ini,'# CHAVES E VALORES OBRIGATÓRIOS PARA USO DO MapaCacic.exe #');  
78 - Writeln(mapa_ini,'# ================================================================= #');  
79 - Writeln(mapa_ini,'# ip_serv_cacic #');  
80 - Writeln(mapa_ini,'# IP ou Identificação do servidor onde o Módulo Gerente do CACIC foi instalado#');  
81 - Writeln(mapa_ini,'# Ex.: ip_serv_cacic=UXRJO115 #');  
82 - Writeln(mapa_ini,'# ip_serv_cacic=10.xxx.yyy.zzz #');  
83 - Writeln(mapa_ini,'# cacic_dir #');  
84 - Writeln(mapa_ini,'# Pasta a ser criada na estação para instalação do CACIC agente #');  
85 - Writeln(mapa_ini,'# Ex.: cacic_dir=Cacic #');  
86 - Writeln(mapa_ini,'# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #');  
87 - Writeln(mapa_ini,'');  
88 - Writeln(mapa_ini,'[Cacic2]');  
89 -  
90 - // Atribuição dos valores do form FormConfig às variáveis...  
91 - v_ip_serv_cacic := Configs.Edit_ip_serv_cacic.text;  
92 - v_cacic_dir := Configs.Edit_cacic_dir.text;  
93 -  
94 - // Escrita dos parâmetros obrigatórios  
95 - Writeln(mapa_ini,'ip_serv_cacic='+v_ip_serv_cacic);  
96 - Writeln(mapa_ini,'cacic_dir='+v_cacic_dir);  
97 -  
98 - CloseFile(mapa_ini); {Fecha o arquivo texto}  
99 - except  
100 - end;  
101 -end;  
102 -  
103 -procedure TConfigs.Edit_ip_serv_cacicExit(Sender: TObject);  
104 -begin  
105 -if trim(Edit_ip_serv_cacic.Text) = '' then Edit_ip_serv_cacic.SetFocus;  
106 -end;  
107 -  
108 -procedure TConfigs.Edit_cacic_dirExit(Sender: TObject);  
109 -begin  
110 -if trim(Edit_cacic_dir.Text) = '' then Edit_cacic_dir.Text := 'Cacic';  
111 -end;  
112 -  
113 -procedure TConfigs.btCancelaOperacaoClick(Sender: TObject);  
114 -begin  
115 - Application.Terminate;  
116 -end;  
117 -  
118 -procedure TConfigs.FormCreate(Sender: TObject);  
119 -begin  
120 - Configs.lbVersao.Caption := 'v: ' + frmMapaCacic.GetVersionInfo(ParamStr(0));  
121 -end;  
122 -  
123 -end.  
mapa/LEIAME
View file @2c54a33
@@ -1,2 +0,0 @@ @@ -1,2 +0,0 @@
1 -  
2 -Esse módulo foi desenvolvido para atender à necessidade de coleta de informações patrimoniais de forma seletiva por estação, onde o técnico vai presencialmente e, de posse do nível de acesso "Técnico" no módulo gerente WEB, realiza o preenchimento dos campos relativos ao Patrimônio e Localização Física.  
mapa/LibXmlParser.pas
View file @2c54a33
@@ -1,2728 +0,0 @@ @@ -1,2728 +0,0 @@
1 -(**  
2 -===============================================================================================  
3 -Name : LibXmlParser  
4 -===============================================================================================  
5 -Project : All Projects  
6 -===============================================================================================  
7 -Subject : Progressive XML Parser for all types of XML Files  
8 -===============================================================================================  
9 -Author : Stefan Heymann  
10 - Eschenweg 3  
11 - 72076 Tübingen  
12 - GERMANY  
13 -  
14 -E-Mail: stefan@destructor.de  
15 -URL: www.destructor.de  
16 -===============================================================================================  
17 -Source, Legals ("Licence")  
18 ---------------------------  
19 -The official site to get this parser is http://www.destructor.de/  
20 -  
21 -Usage and Distribution of this Source Code is ruled by the  
22 -"Destructor.de Source code Licence" (DSL) which comes with this file or  
23 -can be downloaded at http://www.destructor.de/  
24 -  
25 -IN SHORT: Usage and distribution of this source code is free.  
26 - You use it completely on your own risk.  
27 -  
28 -Postcardware  
29 -------------  
30 -If you like this code, please send a postcard of your city to my above address.  
31 -===============================================================================================  
32 -!!! All parts of this code which are not finished or not conforming exactly to  
33 - the XmlSpec are marked with three exclamation marks  
34 -  
35 --!- Parts where the parser may be able to detect errors in the document's syntax are  
36 - marked with the dash-exlamation mark-dash sequence.  
37 -===============================================================================================  
38 -Terminology:  
39 -------------  
40 -- Start: Start of a buffer part  
41 -- Final: End (last character) of a buffer part  
42 -- DTD: Document Type Definition  
43 -- DTDc: Document Type Declaration  
44 -- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No.  
45 -- Cur*: Fields concerning the "Current" part passed back by the "Scan" method  
46 -===============================================================================================  
47 -Scanning the XML document  
48 --------------------------  
49 -- Create TXmlParser Instance MyXml := TXmlParser.Create;  
50 -- Load XML Document MyXml.LoadFromFile (Filename);  
51 -- Start Scanning MyXml.StartScan;  
52 -- Scan Loop WHILE MyXml.Scan DO  
53 -- Test for Part Type CASE MyXml.CurPartType OF  
54 -- Handle Parts ... : ;;;  
55 -- Handle Parts ... : ;;;  
56 -- Handle Parts ... : ;;;  
57 - END;  
58 -- Destroy MyXml.Free;  
59 -===============================================================================================  
60 -Loading the XML document  
61 -------------------------  
62 -You can load the XML document from a file with the "LoadFromFile" method.  
63 -It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your  
64 -application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever  
65 -protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method.  
66 -"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated  
67 -string, thereby creating a copy of that buffer.  
68 -"SetBuffer" just takes the pointer to another buffer, which means that the given  
69 -buffer pointer must be valid while the document is accessed via TXmlParser.  
70 -===============================================================================================  
71 -Encodings:  
72 -----------  
73 -This XML parser kind of "understands" the following encodings:  
74 -- UTF-8  
75 -- ISO-8859-1  
76 -- Windows-1252  
77 -  
78 -Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry.  
79 -  
80 -Every string which has to be passed to the application passes the virtual method  
81 -"TranslateEncoding" which translates the string from the current encoding (stored in  
82 -"CurEncoding") into the encoding the application wishes to receive.  
83 -The "TranslateEncoding" method that is built into TXmlParser assumes that the application  
84 -wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able  
85 -to convert UTF-8 and ISO-8859-1 encodings.  
86 -For other source and target encodings, you will have to override "TranslateEncoding".  
87 -===============================================================================================  
88 -Buffer Handling  
89 ----------------  
90 -- The document must be loaded completely into a piece of RAM  
91 -- All character positions are referenced by PChar pointers  
92 -- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0)  
93 - or reference the buffer of another instance or object (then, FBuffersize is 0 and  
94 - FBuffer is not NIL)  
95 -- The Property DocBuffer passes back a pointer to the first byte of the document. If there  
96 - is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character.  
97 -===============================================================================================  
98 -Whitespace Handling  
99 --------------------  
100 -The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content:  
101 -While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all  
102 -Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are  
103 -compressed to one.  
104 -If the "Scan" method reports a ptContent part, the application can get the original text  
105 -with all whitespace characters by extracting the characters from "CurStart" to "CurFinal".  
106 -If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or  
107 -use CurStart/CurFinal.  
108 -Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters  
109 -as the XmlSpec requires (XmlSpec 2.11).  
110 -The xml:space attribute is not handled by TXmlParser. This is on behalf of the application.  
111 -===============================================================================================  
112 -Non-XML-Conforming  
113 -------------------  
114 -TXmlParser does not conform 100 % exactly to the XmlSpec:  
115 -- UTF-16 is not supported (XmlSpec 2.2)  
116 - (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser)  
117 -- As the parser only works with single byte strings, all Unicode characters > 255  
118 - can currently not be handled correctly.  
119 -- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11)  
120 - (Workaround: The Application can access the text contents on its own [CurStart, CurFinal],  
121 - thereby applying every normalization it wishes to)  
122 -- The attribute value normalization does not work exactly as defined in the  
123 - Second Edition of the XML 1.0 specification.  
124 -- See also the code parts marked with three consecutive exclamation marks. These are  
125 - parts which are not finished in the current code release.  
126 -  
127 -This list may be incomplete, so it may grow if I get to know any other points.  
128 -As work on the parser proceeds, this list may also shrink.  
129 -===============================================================================================  
130 -Things Todo  
131 ------------  
132 -- Introduce a new event/callback which is called when there is an unresolvable  
133 - entity or character reference  
134 -- Support Unicode  
135 -- Use Streams instead of reading the whole XML into memory  
136 -===============================================================================================  
137 -Change History, Version numbers  
138 --------------------------------  
139 -The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order.  
140 -Versions are counted from 1.0.0 beginning with the version from 2000-03-16.  
141 -Unreleased versions don't get a version number.  
142 -  
143 -Date Author Version Changes  
144 ------------------------------------------------------------------------------------------------  
145 -2000-03-16 HeySt 1.0.0 Start  
146 -2000-03-28 HeySt 1.0.1 Initial Publishing of TXmlParser on the destructor.de Web Site  
147 -2000-03-30 HeySt 1.0.2 TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent  
148 -2000-03-31 HeySt 1.0.3 Deleted the StrPosE function (was not needed anyway)  
149 -2000-04-04 HeySt 1.0.4 TDtdElementRec modified: Start/Final for all Elements;  
150 - Should be backwards compatible.  
151 - AnalyzeDtdc: Set CurPartType to ptDtdc  
152 -2000-04-23 HeySt 1.0.5 New class TObjectList. Eliminated reference to the Delphi 5  
153 - "Contnrs" unit so LibXmlParser is Delphi 4 compatible.  
154 -2000-07-03 HeySt 1.0.6 TNvpNode: Added Constructor  
155 -2000-07-11 HeySt 1.0.7 Removed "Windows" from USES clause  
156 - Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8  
157 - Added three-exclamation-mark comments for CHR function calls  
158 -2000-07-23 HeySt 1.0.8 TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear;  
159 - (This was not a bug; just defensive programming)  
160 -2000-07-29 HeySt 1.0.9 TNvpList: Added methods: Node(Index), Value(Index), Name(Index);  
161 -2000-10-07 HeySt Introduced Conditional Defines  
162 - Uses Contnrs unit and its TObjectList class again for  
163 - Delphi 5 and newer versions  
164 -2001-01-30 HeySt Introduced Version Numbering  
165 - Made LoadFromFile and LoadFromBuffer BOOLEAN functions  
166 - Introduced FileMode parameter for LoadFromFile  
167 - BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call  
168 - Comments worked over  
169 -2001-02-28 HeySt 1.0.10 Completely worked over and tested the UTF-8 functions  
170 - Fixed a bug in TXmlParser.Scan which caused it to start over when it  
171 - was called after the end of scanning, resulting in an endless loop  
172 - TEntityStack is now a TObjectList instead of TList  
173 -2001-07-03 HeySt 1.0.11 Updated Compiler Version IFDEFs for Kylix  
174 -2001-07-11 HeySt 1.0.12 New TCustomXmlScanner component (taken over from LibXmlComps.pas)  
175 -2001-07-14 HeySt 1.0.13 Bugfix TCustomXmlScanner.FOnTranslateEncoding  
176 -2001-10-22 HeySt Don't clear CurName anymore when the parser finds a CDATA section.  
177 -2001-12-03 HeySt 1.0.14 TObjectList.Clear: Make call to INHERITED method (fixes a memory leak)  
178 -2001-12-05 HeySt 1.0.15 TObjectList.Clear: removed call to INHERITED method  
179 - TObjectList.Destroy: Inserted SetCapacity call.  
180 - Reduces need for frequent re-allocation of pointer buffer  
181 - Dedicated to my father, Theodor Heymann  
182 -2002-06-26 HeySt 1.0.16 TXmlParser.Scan: Fixed a bug with PIs whose name is beginning  
183 - with 'xml'. Thanks to Uwe Kamm for submitting this bug.  
184 - The CurEncoding property is now always in uppercase letters (the XML  
185 - spec wants it to be treated case independently so when it's uppercase  
186 - comparisons are faster)  
187 -2002-03-04 HeySt 1.0.17 Included an IFDEF for Delphi 7 (VER150) and Kylix  
188 - There is a new symbol HAS_CONTNRS_UNIT which is used now to  
189 - distinguish between IDEs which come with the Contnrs unit and  
190 - those that don't.  
191 -*)  
192 -  
193 -  
194 -// --- Delphi/Kylix Version Numbers  
195 -// As this is no code, this does not blow up your object or executable code at all  
196 - (*$IFDEF LINUX *)  
197 - (*$DEFINE K1_OR_NEWER *)  
198 - (*$ENDIF *)  
199 -  
200 - (*$IFDEF MSWINDOWS *)  
201 - (*$DEFINE D1_OR_NEWER *)  
202 - (*$IFNDEF VER80 *)  
203 - (*$DEFINE D2_OR_NEWER *)  
204 - (*$IFNDEF VER90 *)  
205 - (*$DEFINE D3_OR_NEWER *)  
206 - (*$IFNDEF VER100 *)  
207 - (*$DEFINE D4_OR_NEWER *)  
208 - (*$IFNDEF VER120 *)  
209 - (*$DEFINE D5_OR_NEWER *)  
210 - (*$IFNDEF VER130 *)  
211 - (*$IFNDEF VER140 *)  
212 - (*$IFNDEF VER150 *)  
213 - If the compiler gets stuck here,  
214 - you are using a compiler version unknown to this code.  
215 - You will probably have to change this code accordingly.  
216 - At first, try to comment out these lines and see what will happen.  
217 - (*$ENDIF *)  
218 - (*$ENDIF *)  
219 - (*$ENDIF *)  
220 - (*$ENDIF *)  
221 - (*$ENDIF *)  
222 - (*$ENDIF *)  
223 - (*$ENDIF *)  
224 - (*$ENDIF *)  
225 -  
226 - (*$IFDEF D5_OR_NEWER *)  
227 - (*$DEFINE HAS_CONTNRS_UNIT *)  
228 - (*$ENDIF *)  
229 -  
230 - (*$IFDEF K1_OR_NEWER *)  
231 - (*$DEFINE HAS_CONTNRS_UNIT *)  
232 - (*$ENDIF *)  
233 -  
234 -  
235 -UNIT LibXmlParser;  
236 -  
237 -INTERFACE  
238 -  
239 -USES  
240 - SysUtils, Classes,  
241 - (*$IFDEF HAS_CONTNRS_UNIT *) // The Contnrs Unit was introduced in Delphi 5  
242 - Contnrs,  
243 - (*$ENDIF*)  
244 - Math;  
245 -  
246 -CONST  
247 - CVersion = '1.0.17'; // This variable will be updated for every release  
248 - // (I hope, I won't forget to do it everytime ...)  
249 -  
250 -TYPE  
251 - TPartType = // --- Document Part Types  
252 - (ptNone, // Nothing  
253 - ptXmlProlog, // XML Prolog XmlSpec 2.8 / 4.3.1  
254 - ptComment, // Comment XmlSpec 2.5  
255 - ptPI, // Processing Instruction XmlSpec 2.6  
256 - ptDtdc, // Document Type Declaration XmlSpec 2.8  
257 - ptStartTag, // Start Tag XmlSpec 3.1  
258 - ptEmptyTag, // Empty-Element Tag XmlSpec 3.1  
259 - ptEndTag, // End Tag XmlSpec 3.1  
260 - ptContent, // Text Content between Tags  
261 - ptCData); // CDATA Section XmlSpec 2.7  
262 -  
263 - TDtdElemType = // --- DTD Elements  
264 - (deElement, // !ELEMENT declaration  
265 - deAttList, // !ATTLIST declaration  
266 - deEntity, // !ENTITY declaration  
267 - deNotation, // !NOTATION declaration  
268 - dePI, // PI in DTD  
269 - deComment, // Comment in DTD  
270 - deError); // Error found in the DTD  
271 -  
272 -TYPE  
273 - TAttrList = CLASS;  
274 - TEntityStack = CLASS;  
275 - TNvpList = CLASS;  
276 - TElemDef = CLASS;  
277 - TElemList = CLASS;  
278 - TEntityDef = CLASS;  
279 - TNotationDef = CLASS;  
280 -  
281 - TDtdElementRec = RECORD // --- This Record is returned by the DTD parser callback function  
282 - Start, Final : PChar; // Start/End of the Element's Declaration  
283 - CASE ElementType : TDtdElemType OF // Type of the Element  
284 - deElement, // <!ELEMENT>  
285 - deAttList : (ElemDef : TElemDef); // <!ATTLIST>  
286 - deEntity : (EntityDef : TEntityDef); // <!ENTITY>  
287 - deNotation : (NotationDef : TNotationDef); // <!NOTATION>  
288 - dePI : (Target : PChar; // <?PI ?>  
289 - Content : PChar;  
290 - AttrList : TAttrList);  
291 - deError : (Pos : PChar); // Error  
292 - // deComment : ((No additional fields here)); // <!-- Comment -->  
293 - END;  
294 -  
295 - TXmlParser = CLASS // --- Internal Properties and Methods  
296 - PROTECTED  
297 - FBuffer : PChar; // NIL if there is no buffer available  
298 - FBufferSize : INTEGER; // 0 if the buffer is not owned by the Document instance  
299 - FSource : STRING; // Name of Source of document. Filename for Documents loaded with LoadFromFile  
300 -  
301 - FXmlVersion : STRING; // XML version from Document header. Default is '1.0'  
302 - FEncoding : STRING; // Encoding from Document header. Default is 'UTF-8'  
303 - FStandalone : BOOLEAN; // Standalone declaration from Document header. Default is 'yes'  
304 - FRootName : STRING; // Name of the Root Element (= DTD name)  
305 - FDtdcFinal : PChar; // Pointer to the '>' character terminating the DTD declaration  
306 -  
307 - FNormalize : BOOLEAN; // If true: Pack Whitespace and don't return empty contents  
308 - EntityStack : TEntityStack; // Entity Stack for Parameter and General Entities  
309 - FCurEncoding : STRING; // Current Encoding during parsing (always uppercase)  
310 -  
311 - PROCEDURE AnalyzeProlog; // Analyze XML Prolog or Text Declaration  
312 - PROCEDURE AnalyzeComment (Start : PChar; VAR Final : PChar); // Analyze Comments  
313 - PROCEDURE AnalyzePI (Start : PChar; VAR Final : PChar); // Analyze Processing Instructions (PI)  
314 - PROCEDURE AnalyzeDtdc; // Analyze Document Type Declaration  
315 - PROCEDURE AnalyzeDtdElements (Start : PChar; VAR Final : PChar); // Analyze DTD declarations  
316 - PROCEDURE AnalyzeTag; // Analyze Start/End/Empty-Element Tags  
317 - PROCEDURE AnalyzeCData; // Analyze CDATA Sections  
318 - PROCEDURE AnalyzeText (VAR IsDone : BOOLEAN); // Analyze Text Content between Tags  
319 - PROCEDURE AnalyzeElementDecl (Start : PChar; VAR Final : PChar);  
320 - PROCEDURE AnalyzeAttListDecl (Start : PChar; VAR Final : PChar);  
321 - PROCEDURE AnalyzeEntityDecl (Start : PChar; VAR Final : PChar);  
322 - PROCEDURE AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);  
323 -  
324 - PROCEDURE PushPE (VAR Start : PChar);  
325 - PROCEDURE ReplaceCharacterEntities (VAR Str : STRING);  
326 - PROCEDURE ReplaceParameterEntities (VAR Str : STRING);  
327 - PROCEDURE ReplaceGeneralEntities (VAR Str : STRING);  
328 -  
329 - FUNCTION GetDocBuffer : PChar; // Returns FBuffer or a pointer to a NUL char if Buffer is empty  
330 -  
331 - PUBLIC // --- Document Properties  
332 - PROPERTY XmlVersion : STRING READ FXmlVersion; // XML version from the Document Prolog  
333 - PROPERTY Encoding : STRING READ FEncoding; // Document Encoding from Prolog  
334 - PROPERTY Standalone : BOOLEAN READ FStandalone; // Standalone Declaration from Prolog  
335 - PROPERTY RootName : STRING READ FRootName; // Name of the Root Element  
336 - PROPERTY Normalize : BOOLEAN READ FNormalize WRITE FNormalize; // True if Content is to be normalized  
337 - PROPERTY Source : STRING READ FSource; // Name of Document Source (Filename)  
338 - PROPERTY DocBuffer : PChar READ GetDocBuffer; // Returns document buffer  
339 - PUBLIC // --- DTD Objects  
340 - Elements : TElemList; // Elements: List of TElemDef (contains Attribute Definitions)  
341 - Entities : TNvpList; // General Entities: List of TEntityDef  
342 - ParEntities : TNvpList; // Parameter Entities: List of TEntityDef  
343 - Notations : TNvpList; // Notations: List of TNotationDef  
344 - PUBLIC  
345 - CONSTRUCTOR Create;  
346 - DESTRUCTOR Destroy; OVERRIDE;  
347 -  
348 - // --- Document Handling  
349 - FUNCTION LoadFromFile (Filename : STRING;  
350 - FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;  
351 - // Loads Document from given file  
352 - FUNCTION LoadFromBuffer (Buffer : PChar) : BOOLEAN; // Loads Document from another buffer  
353 - PROCEDURE SetBuffer (Buffer : PChar); // References another buffer  
354 - PROCEDURE Clear; // Clear Document  
355 -  
356 - PUBLIC  
357 - // --- Scanning through the document  
358 - CurPartType : TPartType; // Current Type  
359 - CurName : STRING; // Current Name  
360 - CurContent : STRING; // Current Normalized Content  
361 - CurStart : PChar; // Current First character  
362 - CurFinal : PChar; // Current Last character  
363 - CurAttr : TAttrList; // Current Attribute List  
364 - PROPERTY CurEncoding : STRING READ FCurEncoding; // Current Encoding  
365 - PROCEDURE StartScan;  
366 - FUNCTION Scan : BOOLEAN;  
367 -  
368 - // --- Events / Callbacks  
369 - FUNCTION LoadExternalEntity (SystemId, PublicId,  
370 - Notation : STRING) : TXmlParser; VIRTUAL;  
371 - FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; VIRTUAL;  
372 - PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); VIRTUAL;  
373 - END;  
374 -  
375 - TValueType = // --- Attribute Value Type  
376 - (vtNormal, // Normal specified Attribute  
377 - vtImplied, // #IMPLIED attribute value  
378 - vtFixed, // #FIXED attribute value  
379 - vtDefault); // Attribute value from default value in !ATTLIST declaration  
380 -  
381 - TAttrDefault = // --- Attribute Default Type  
382 - (adDefault, // Normal default value  
383 - adRequired, // #REQUIRED attribute  
384 - adImplied, // #IMPLIED attribute  
385 - adFixed); // #FIXED attribute  
386 -  
387 - TAttrType = // --- Type of attribute  
388 - (atUnknown, // Unknown type  
389 - atCData, // Character data only  
390 - atID, // ID  
391 - atIdRef, // ID Reference  
392 - atIdRefs, // Several ID References, separated by Whitespace  
393 - atEntity, // Name of an unparsed Entity  
394 - atEntities, // Several unparsed Entity names, separated by Whitespace  
395 - atNmToken, // Name Token  
396 - atNmTokens, // Several Name Tokens, separated by Whitespace  
397 - atNotation, // A selection of Notation names (Unparsed Entity)  
398 - atEnumeration); // Enumeration  
399 -  
400 - TElemType = // --- Element content type  
401 - (etEmpty, // Element is always empty  
402 - etAny, // Element can have any mixture of PCDATA and any elements  
403 - etChildren, // Element must contain only elements  
404 - etMixed); // Mixed PCDATA and elements  
405 -  
406 - (*$IFDEF HAS_CONTNRS_UNIT *)  
407 - TObjectList = Contnrs.TObjectList; // Re-Export this identifier  
408 - (*$ELSE *)  
409 - TObjectList = CLASS (TList)  
410 - DESTRUCTOR Destroy; OVERRIDE;  
411 - PROCEDURE Delete (Index : INTEGER);  
412 - PROCEDURE Clear; OVERRIDE;  
413 - END;  
414 - (*$ENDIF *)  
415 -  
416 - TNvpNode = CLASS // Name-Value Pair Node  
417 - Name : STRING;  
418 - Value : STRING;  
419 - CONSTRUCTOR Create (TheName : STRING = ''; TheValue : STRING = '');  
420 - END;  
421 -  
422 - TNvpList = CLASS (TObjectList) // Name-Value Pair List  
423 - PROCEDURE Add (Node : TNvpNode);  
424 - FUNCTION Node (Name : STRING) : TNvpNode; OVERLOAD;  
425 - FUNCTION Node (Index : INTEGER) : TNvpNode; OVERLOAD;  
426 - FUNCTION Value (Name : STRING) : STRING; OVERLOAD;  
427 - FUNCTION Value (Index : INTEGER) : STRING; OVERLOAD;  
428 - FUNCTION Name (Index : INTEGER) : STRING;  
429 - END;  
430 -  
431 - TAttr = CLASS (TNvpNode) // Attribute of a Start-Tag or Empty-Element-Tag  
432 - ValueType : TValueType;  
433 - AttrType : TAttrType;  
434 - END;  
435 -  
436 - TAttrList = CLASS (TNvpList) // List of Attributes  
437 - PROCEDURE Analyze (Start : PChar; VAR Final : PChar);  
438 - END;  
439 -  
440 - TEntityStack = CLASS (TObjectList) // Stack where current position is stored before parsing entities  
441 - PROTECTED  
442 - Owner : TXmlParser;  
443 - PUBLIC  
444 - CONSTRUCTOR Create (TheOwner : TXmlParser);  
445 - PROCEDURE Push (LastPos : PChar); OVERLOAD;  
446 - PROCEDURE Push (Instance : TObject; LastPos : PChar); OVERLOAD;  
447 - FUNCTION Pop : PChar; // Returns next char or NIL if EOF is reached. Frees Instance.  
448 - END;  
449 -  
450 - TAttrDef = CLASS (TNvpNode) // Represents a <!ATTLIST Definition. "Value" is the default value  
451 - TypeDef : STRING; // Type definition from the DTD  
452 - Notations : STRING; // Notation List, separated by pipe symbols '|'  
453 - AttrType : TAttrType; // Attribute Type  
454 - DefaultType : TAttrDefault; // Default Type  
455 - END;  
456 -  
457 - TElemDef = CLASS (TNvpList) // Represents a <!ELEMENT Definition. Is a list of TAttrDef-Nodes  
458 - Name : STRING; // Element name  
459 - ElemType : TElemType; // Element type  
460 - Definition : STRING; // Element definition from DTD  
461 - END;  
462 -  
463 - TElemList = CLASS (TObjectList) // List of TElemDef nodes  
464 - FUNCTION Node (Name : STRING) : TElemDef;  
465 - PROCEDURE Add (Node : TElemDef);  
466 - END;  
467 -  
468 - TEntityDef = CLASS (TNvpNode) // Represents a <!ENTITY Definition.  
469 - SystemId : STRING;  
470 - PublicId : STRING;  
471 - NotationName : STRING;  
472 - END;  
473 -  
474 - TNotationDef = CLASS (TNvpNode) // Represents a <!NOTATION Definition. Value is the System ID  
475 - PublicId : STRING;  
476 - END;  
477 -  
478 - TCharset = SET OF CHAR;  
479 -  
480 -  
481 -CONST  
482 - CWhitespace = [#32, #9, #13, #10]; // Whitespace characters (XmlSpec 2.3)  
483 - CLetter = [#$41..#$5A, #$61..#$7A, #$C0..#$D6, #$D8..#$F6, #$F8..#$FF];  
484 - CDigit = [#$30..#$39];  
485 - CNameChar = CLetter + CDigit + ['.', '-', '_', ':', #$B7];  
486 - CNameStart = CLetter + ['_', ':'];  
487 - CQuoteChar = ['"', ''''];  
488 - CPubidChar = [#32, ^M, ^J, #9, 'a'..'z', 'A'..'Z', '0'..'9',  
489 - '-', '''', '(', ')', '+', ',', '.', '/', ':',  
490 - '=', '?', ';', '!', '*', '#', '@', '$', '_', '%'];  
491 -  
492 - CDStart = '<![CDATA[';  
493 - CDEnd = ']]>';  
494 -  
495 - // --- Name Constants for the above enumeration types  
496 - CPartType_Name : ARRAY [TPartType] OF STRING =  
497 - ('', 'XML Prolog', 'Comment', 'PI',  
498 - 'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag',  
499 - 'Text', 'CDATA');  
500 - CValueType_Name : ARRAY [TValueType] OF STRING = ('Normal', 'Implied', 'Fixed', 'Default');  
501 - CAttrDefault_Name : ARRAY [TAttrDefault] OF STRING = ('Default', 'Required', 'Implied', 'Fixed');  
502 - CElemType_Name : ARRAY [TElemType] OF STRING = ('Empty', 'Any', 'Childs only', 'Mixed');  
503 - CAttrType_Name : ARRAY [TAttrType] OF STRING = ('Unknown', 'CDATA',  
504 - 'ID', 'IDREF', 'IDREFS',  
505 - 'ENTITY', 'ENTITIES',  
506 - 'NMTOKEN', 'NMTOKENS',  
507 - 'Notation', 'Enumeration');  
508 -  
509 -FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING; // Convert WS to spaces #x20  
510 -PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar); // SetString by Start/Final of buffer  
511 -FUNCTION StrSFPas (Start, Finish : PChar) : STRING; // Convert buffer part to Pascal string  
512 -FUNCTION TrimWs (Source : STRING) : STRING; // Trim Whitespace  
513 -  
514 -FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING; // Convert Win-1252 to UTF-8  
515 -FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING; // Convert UTF-8 to Win-1252  
516 -  
517 -  
518 -(*  
519 -===============================================================================================  
520 -TCustomXmlScanner event based component wrapper for TXmlParser  
521 -===============================================================================================  
522 -*)  
523 -  
524 -TYPE  
525 - TCustomXmlScanner = CLASS;  
526 - TXmlPrologEvent = PROCEDURE (Sender : TObject; XmlVersion, Encoding: STRING; Standalone : BOOLEAN) OF OBJECT;  
527 - TCommentEvent = PROCEDURE (Sender : TObject; Comment : STRING) OF OBJECT;  
528 - TPIEvent = PROCEDURE (Sender : TObject; Target, Content: STRING; Attributes : TAttrList) OF OBJECT;  
529 - TDtdEvent = PROCEDURE (Sender : TObject; RootElementName : STRING) OF OBJECT;  
530 - TStartTagEvent = PROCEDURE (Sender : TObject; TagName : STRING; Attributes : TAttrList) OF OBJECT;  
531 - TEndTagEvent = PROCEDURE (Sender : TObject; TagName : STRING) OF OBJECT;  
532 - TContentEvent = PROCEDURE (Sender : TObject; Content : STRING) OF OBJECT;  
533 - TElementEvent = PROCEDURE (Sender : TObject; ElemDef : TElemDef) OF OBJECT;  
534 - TEntityEvent = PROCEDURE (Sender : TObject; EntityDef : TEntityDef) OF OBJECT;  
535 - TNotationEvent = PROCEDURE (Sender : TObject; NotationDef : TNotationDef) OF OBJECT;  
536 - TErrorEvent = PROCEDURE (Sender : TObject; ErrorPos : PChar) OF OBJECT;  
537 - TExternalEvent = PROCEDURE (Sender : TObject; SystemId, PublicId, NotationId : STRING;  
538 - VAR Result : TXmlParser) OF OBJECT;  
539 - TEncodingEvent = FUNCTION (Sender : TObject; CurrentEncoding, Source : STRING) : STRING OF OBJECT;  
540 -  
541 -  
542 - TCustomXmlScanner = CLASS (TComponent)  
543 - PROTECTED  
544 - FXmlParser : TXmlParser;  
545 - FOnXmlProlog : TXmlPrologEvent;  
546 - FOnComment : TCommentEvent;  
547 - FOnPI : TPIEvent;  
548 - FOnDtdRead : TDtdEvent;  
549 - FOnStartTag : TStartTagEvent;  
550 - FOnEmptyTag : TStartTagEvent;  
551 - FOnEndTag : TEndTagEvent;  
552 - FOnContent : TContentEvent;  
553 - FOnCData : TContentEvent;  
554 - FOnElement : TElementEvent;  
555 - FOnAttList : TElementEvent;  
556 - FOnEntity : TEntityEvent;  
557 - FOnNotation : TNotationEvent;  
558 - FOnDtdError : TErrorEvent;  
559 - FOnLoadExternal : TExternalEvent;  
560 - FOnTranslateEncoding : TEncodingEvent;  
561 - FStopParser : BOOLEAN;  
562 - FUNCTION GetNormalize : BOOLEAN;  
563 - PROCEDURE SetNormalize (Value : BOOLEAN);  
564 -  
565 - PROCEDURE WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); VIRTUAL;  
566 - PROCEDURE WhenComment (Comment : STRING); VIRTUAL;  
567 - PROCEDURE WhenPI (Target, Content: STRING; Attributes : TAttrList); VIRTUAL;  
568 - PROCEDURE WhenDtdRead (RootElementName : STRING); VIRTUAL;  
569 - PROCEDURE WhenStartTag (TagName : STRING; Attributes : TAttrList); VIRTUAL;  
570 - PROCEDURE WhenEmptyTag (TagName : STRING; Attributes : TAttrList); VIRTUAL;  
571 - PROCEDURE WhenEndTag (TagName : STRING); VIRTUAL;  
572 - PROCEDURE WhenContent (Content : STRING); VIRTUAL;  
573 - PROCEDURE WhenCData (Content : STRING); VIRTUAL;  
574 - PROCEDURE WhenElement (ElemDef : TElemDef); VIRTUAL;  
575 - PROCEDURE WhenAttList (ElemDef : TElemDef); VIRTUAL;  
576 - PROCEDURE WhenEntity (EntityDef : TEntityDef); VIRTUAL;  
577 - PROCEDURE WhenNotation (NotationDef : TNotationDef); VIRTUAL;  
578 - PROCEDURE WhenDtdError (ErrorPos : PChar); VIRTUAL;  
579 -  
580 - PUBLIC  
581 - CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE;  
582 - DESTRUCTOR Destroy; OVERRIDE;  
583 -  
584 - PROCEDURE LoadFromFile (Filename : TFilename); // Load XML Document from file  
585 - PROCEDURE LoadFromBuffer (Buffer : PChar); // Load XML Document from buffer  
586 - PROCEDURE SetBuffer (Buffer : PChar); // Refer to Buffer  
587 - FUNCTION GetFilename : TFilename;  
588 -  
589 - PROCEDURE Execute; // Perform scanning  
590 -  
591 - PROTECTED  
592 - PROPERTY XmlParser : TXmlParser READ FXmlParser;  
593 - PROPERTY StopParser : BOOLEAN READ FStopParser WRITE FStopParser;  
594 - PROPERTY Filename : TFilename READ GetFilename WRITE LoadFromFile;  
595 - PROPERTY Normalize : BOOLEAN READ GetNormalize WRITE SetNormalize;  
596 - PROPERTY OnXmlProlog : TXmlPrologEvent READ FOnXmlProlog WRITE FOnXmlProlog;  
597 - PROPERTY OnComment : TCommentEvent READ FOnComment WRITE FOnComment;  
598 - PROPERTY OnPI : TPIEvent READ FOnPI WRITE FOnPI;  
599 - PROPERTY OnDtdRead : TDtdEvent READ FOnDtdRead WRITE FOnDtdRead;  
600 - PROPERTY OnStartTag : TStartTagEvent READ FOnStartTag WRITE FOnStartTag;  
601 - PROPERTY OnEmptyTag : TStartTagEvent READ FOnEmptyTag WRITE FOnEmptyTag;  
602 - PROPERTY OnEndTag : TEndTagEvent READ FOnEndTag WRITE FOnEndTag;  
603 - PROPERTY OnContent : TContentEvent READ FOnContent WRITE FOnContent;  
604 - PROPERTY OnCData : TContentEvent READ FOnCData WRITE FOnCData;  
605 - PROPERTY OnElement : TElementEvent READ FOnElement WRITE FOnElement;  
606 - PROPERTY OnAttList : TElementEvent READ FOnAttList WRITE FOnAttList;  
607 - PROPERTY OnEntity : TEntityEvent READ FOnEntity WRITE FOnEntity;  
608 - PROPERTY OnNotation : TNotationEvent READ FOnNotation WRITE FOnNotation;  
609 - PROPERTY OnDtdError : TErrorEvent READ FOnDtdError WRITE FOnDtdError;  
610 - PROPERTY OnLoadExternal : TExternalEvent READ FOnLoadExternal WRITE FOnLoadExternal;  
611 - PROPERTY OnTranslateEncoding : TEncodingEvent READ FOnTranslateEncoding WRITE FOnTranslateEncoding;  
612 - END;  
613 -  
614 -(*  
615 -===============================================================================================  
616 -IMPLEMENTATION  
617 -===============================================================================================  
618 -*)  
619 -  
620 -IMPLEMENTATION  
621 -  
622 -  
623 -(*  
624 -===============================================================================================  
625 -Unicode and UTF-8 stuff  
626 -===============================================================================================  
627 -*)  
628 -  
629 -CONST  
630 - // --- Character Translation Table for Unicode <-> Win-1252  
631 - WIN1252_UNICODE : ARRAY [$00..$FF] OF WORD = (  
632 - $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009,  
633 - $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013,  
634 - $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D,  
635 - $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027,  
636 - $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031,  
637 - $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B,  
638 - $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045,  
639 - $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,  
640 - $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059,  
641 - $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063,  
642 - $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D,  
643 - $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077,  
644 - $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,  
645 -  
646 - $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030,  
647 - $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C,  
648 - $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D,  
649 - $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,  
650 - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1,  
651 - $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB,  
652 - $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5,  
653 - $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,  
654 - $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9,  
655 - $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3,  
656 - $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED,  
657 - $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,  
658 - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF);  
659 -  
660 -(* UTF-8 (somewhat simplified)  
661 - -----  
662 - Character Range Byte sequence  
663 - --------------- -------------------------- (x=Bits from original character)  
664 - $0000..$007F 0xxxxxxx  
665 - $0080..$07FF 110xxxxx 10xxxxxx  
666 - $8000..$FFFF 1110xxxx 10xxxxxx 10xxxxxx  
667 -  
668 - Example  
669 - --------  
670 - Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS ("ä"):  
671 -  
672 - ISO-8859-1, Decimal 228  
673 - Win1252, Hex $E4  
674 - ANSI Bin 1110 0100  
675 - abcd efgh  
676 -  
677 - UTF-8 Binary 1100xxab 10cdefgh  
678 - Binary 11000011 10100100  
679 - Hex $C3 $A4  
680 - Decimal 195 164  
681 - ANSI Ã ¤ *)  
682 -  
683 -  
684 -FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING;  
685 - (* Converts the given Windows ANSI (Win1252) String to UTF-8. *)  
686 -VAR  
687 - I : INTEGER; // Loop counter  
688 - U : WORD; // Current Unicode value  
689 - Len : INTEGER; // Current real length of "Result" string  
690 -BEGIN  
691 - SetLength (Result, Length (Source) * 3); // Worst case  
692 - Len := 0;  
693 - FOR I := 1 TO Length (Source) DO BEGIN  
694 - U := WIN1252_UNICODE [ORD (Source [I])];  
695 - CASE U OF  
696 - $0000..$007F : BEGIN  
697 - INC (Len);  
698 - Result [Len] := CHR (U);  
699 - END;  
700 - $0080..$07FF : BEGIN  
701 - INC (Len);  
702 - Result [Len] := CHR ($C0 OR (U SHR 6));  
703 - INC (Len);  
704 - Result [Len] := CHR ($80 OR (U AND $3F));  
705 - END;  
706 - $0800..$FFFF : BEGIN  
707 - INC (Len);  
708 - Result [Len] := CHR ($E0 OR (U SHR 12));  
709 - INC (Len);  
710 - Result [Len] := CHR ($80 OR ((U SHR 6) AND $3F));  
711 - INC (Len);  
712 - Result [Len] := CHR ($80 OR (U AND $3F));  
713 - END;  
714 - END;  
715 - END;  
716 - SetLength (Result, Len);  
717 -END;  
718 -  
719 -  
720 -FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;  
721 - (* Converts the given UTF-8 String to Windows ANSI (Win-1252).  
722 - If a character can not be converted, the "UnknownChar" is inserted. *)  
723 -VAR  
724 - SourceLen : INTEGER; // Length of Source string  
725 - I, K : INTEGER;  
726 - A : BYTE; // Current ANSI character value  
727 - U : WORD;  
728 - Ch : CHAR; // Dest char  
729 - Len : INTEGER; // Current real length of "Result" string  
730 -BEGIN  
731 - SourceLen := Length (Source);  
732 - SetLength (Result, SourceLen); // Enough room to live  
733 - Len := 0;  
734 - I := 1;  
735 - WHILE I <= SourceLen DO BEGIN  
736 - A := ORD (Source [I]);  
737 - IF A < $80 THEN BEGIN // Range $0000..$007F  
738 - INC (Len);  
739 - Result [Len] := Source [I];  
740 - INC (I);  
741 - END  
742 - ELSE BEGIN // Determine U, Inc I  
743 - IF (A AND $E0 = $C0) AND (I < SourceLen) THEN BEGIN // Range $0080..$07FF  
744 - U := (WORD (A AND $1F) SHL 6) OR (ORD (Source [I+1]) AND $3F);  
745 - INC (I, 2);  
746 - END  
747 - ELSE IF (A AND $F0 = $E0) AND (I < SourceLen-1) THEN BEGIN // Range $0800..$FFFF  
748 - U := (WORD (A AND $0F) SHL 12) OR  
749 - (WORD (ORD (Source [I+1]) AND $3F) SHL 6) OR  
750 - ( ORD (Source [I+2]) AND $3F);  
751 - INC (I, 3);  
752 - END  
753 - ELSE BEGIN // Unknown/unsupported  
754 - INC (I);  
755 - FOR K := 7 DOWNTO 0 DO  
756 - IF A AND (1 SHL K) = 0 THEN BEGIN  
757 - INC (I, (A SHR (K+1))-1);  
758 - BREAK;  
759 - END;  
760 - U := WIN1252_UNICODE [ORD (UnknownChar)];  
761 - END;  
762 - Ch := UnknownChar; // Retrieve ANSI char  
763 - FOR A := $00 TO $FF DO  
764 - IF WIN1252_UNICODE [A] = U THEN BEGIN  
765 - Ch := CHR (A);  
766 - BREAK;  
767 - END;  
768 - INC (Len);  
769 - Result [Len] := Ch;  
770 - END;  
771 - END;  
772 - SetLength (Result, Len);  
773 -END;  
774 -  
775 -  
776 -(*  
777 -===============================================================================================  
778 -"Special" Helper Functions  
779 -  
780 -Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster  
781 -on my K6-233 machine. You can test it yourself just by commenting them out.  
782 -They do exactly the same as the Assembler routines defined in SysUtils.  
783 -(This is where you can see how great the Delphi compiler really is. The compiled code is  
784 -faster than hand-coded assembler!)  
785 -===============================================================================================  
786 ---> Just move this line below the StrScan function --> *)  
787 -  
788 -  
789 -FUNCTION StrPos (CONST Str, SearchStr : PChar) : PChar;  
790 - // Same functionality as SysUtils.StrPos  
791 -VAR  
792 - First : CHAR;  
793 - Len : INTEGER;  
794 -BEGIN  
795 - First := SearchStr^;  
796 - Len := StrLen (SearchStr);  
797 - Result := Str;  
798 - REPEAT  
799 - IF Result^ = First THEN  
800 - IF StrLComp (Result, SearchStr, Len) = 0 THEN BREAK;  
801 - IF Result^ = #0 THEN BEGIN  
802 - Result := NIL;  
803 - BREAK;  
804 - END;  
805 - INC (Result);  
806 - UNTIL FALSE;  
807 -END;  
808 -  
809 -  
810 -FUNCTION StrScan (CONST Start : PChar; CONST Ch : CHAR) : PChar;  
811 - // Same functionality as SysUtils.StrScan  
812 -BEGIN  
813 - Result := Start;  
814 - WHILE Result^ <> Ch DO BEGIN  
815 - IF Result^ = #0 THEN BEGIN  
816 - Result := NIL;  
817 - EXIT;  
818 - END;  
819 - INC (Result);  
820 - END;  
821 -END;  
822 -  
823 -  
824 -(*  
825 -===============================================================================================  
826 -Helper Functions  
827 -===============================================================================================  
828 -*)  
829 -  
830 -FUNCTION DelChars (Source : STRING; CharsToDelete : TCharset) : STRING;  
831 - // Delete all "CharsToDelete" from the string  
832 -VAR  
833 - I : INTEGER;  
834 -BEGIN  
835 - Result := Source;  
836 - FOR I := Length (Result) DOWNTO 1 DO  
837 - IF Result [I] IN CharsToDelete THEN  
838 - Delete (Result, I, 1);  
839 -END;  
840 -  
841 -  
842 -FUNCTION TrimWs (Source : STRING) : STRING;  
843 - // Trimms off Whitespace characters from both ends of the string  
844 -VAR  
845 - I : INTEGER;  
846 -BEGIN  
847 - // --- Trim Left  
848 - I := 1;  
849 - WHILE (I <= Length (Source)) AND (Source [I] IN CWhitespace) DO  
850 - INC (I);  
851 - Result := Copy (Source, I, MaxInt);  
852 -  
853 - // --- Trim Right  
854 - I := Length (Result);  
855 - WHILE (I > 1) AND (Result [I] IN CWhitespace) DO  
856 - DEC (I);  
857 - Delete (Result, I+1, Length (Result)-I);  
858 -END;  
859 -  
860 -  
861 -FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING;  
862 - // Converts all Whitespace characters to the Space #x20 character  
863 - // If "PackWs" is true, contiguous Whitespace characters are packed to one  
864 -VAR  
865 - I : INTEGER;  
866 -BEGIN  
867 - Result := Source;  
868 - FOR I := Length (Result) DOWNTO 1 DO  
869 - IF (Result [I] IN CWhitespace) THEN  
870 - IF PackWs AND (I > 1) AND (Result [I-1] IN CWhitespace)  
871 - THEN Delete (Result, I, 1)  
872 - ELSE Result [I] := #32;  
873 -END;  
874 -  
875 -  
876 -PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);  
877 -BEGIN  
878 - SetString (S, BufferStart, BufferFinal-BufferStart+1);  
879 -END;  
880 -  
881 -  
882 -FUNCTION StrLPas (Start : PChar; Len : INTEGER) : STRING;  
883 -BEGIN  
884 - SetString (Result, Start, Len);  
885 -END;  
886 -  
887 -  
888 -FUNCTION StrSFPas (Start, Finish : PChar) : STRING;  
889 -BEGIN  
890 - SetString (Result, Start, Finish-Start+1);  
891 -END;  
892 -  
893 -  
894 -FUNCTION StrScanE (CONST Source : PChar; CONST CharToScanFor : CHAR) : PChar;  
895 - // If "CharToScanFor" is not found, StrScanE returns the last char of the  
896 - // buffer instead of NIL  
897 -BEGIN  
898 - Result := StrScan (Source, CharToScanFor);  
899 - IF Result = NIL THEN  
900 - Result := StrEnd (Source)-1;  
901 -END;  
902 -  
903 -  
904 -PROCEDURE ExtractName (Start : PChar; Terminators : TCharset; VAR Final : PChar);  
905 - (* Extracts the complete Name beginning at "Start".  
906 - It is assumed that the name is contained in Markup, so the '>' character is  
907 - always a Termination.  
908 - Start: IN Pointer to first char of name. Is always considered to be valid  
909 - Terminators: IN Characters which terminate the name  
910 - Final: OUT Pointer to last char of name *)  
911 -BEGIN  
912 - Final := Start+1;  
913 - Include (Terminators, #0);  
914 - Include (Terminators, '>');  
915 - WHILE NOT (Final^ IN Terminators) DO  
916 - INC (Final);  
917 - DEC (Final);  
918 -END;  
919 -  
920 -  
921 -PROCEDURE ExtractQuote (Start : PChar; VAR Content : STRING; VAR Final : PChar);  
922 - (* Extract a string which is contained in single or double Quotes.  
923 - Start: IN Pointer to opening quote  
924 - Content: OUT The quoted string  
925 - Final: OUT Pointer to closing quote *)  
926 -BEGIN  
927 - Final := StrScan (Start+1, Start^);  
928 - IF Final = NIL THEN BEGIN  
929 - Final := StrEnd (Start+1)-1;  
930 - SetString (Content, Start+1, Final-Start);  
931 - END  
932 - ELSE  
933 - SetString (Content, Start+1, Final-1-Start);  
934 -END;  
935 -  
936 -  
937 -(*  
938 -===============================================================================================  
939 -TEntityStackNode  
940 -This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text.  
941 -The "Instance" field holds the Instance pointer of an External Entity buffer. When it is  
942 -popped, the Instance is freed.  
943 -The "Encoding" field holds the name of the Encoding. External Parsed Entities may have  
944 -another encoding as the document entity (XmlSpec 4.3.3). So when there is an "<?xml" PI  
945 -found in the stream (= Text Declaration at the beginning of external parsed entities), the  
946 -Encoding found there is used for the External Entity (is assigned to TXmlParser.CurEncoding)  
947 -Default Encoding is for the Document Entity is UTF-8. It is assumed that External Entities  
948 -have the same Encoding as the Document Entity, unless they carry a Text Declaration.  
949 -===============================================================================================  
950 -*)  
951 -  
952 -TYPE  
953 - TEntityStackNode = CLASS  
954 - Instance : TObject;  
955 - Encoding : STRING;  
956 - LastPos : PChar;  
957 - END;  
958 -  
959 -(*  
960 -===============================================================================================  
961 -TEntityStack  
962 -For nesting of Entities.  
963 -When there is an entity reference found in the data stream, the corresponding entity  
964 -definition is searched and the current position is pushed to this stack.  
965 -From then on, the program scans the entitiy replacement text as if it were normal content.  
966 -When the parser reaches the end of an entity, the current position is popped off the  
967 -stack again.  
968 -===============================================================================================  
969 -*)  
970 -  
971 -CONSTRUCTOR TEntityStack.Create (TheOwner : TXmlParser);  
972 -BEGIN  
973 - INHERITED Create;  
974 - Owner := TheOwner;  
975 -END;  
976 -  
977 -  
978 -PROCEDURE TEntityStack.Push (LastPos : PChar);  
979 -BEGIN  
980 - Push (NIL, LastPos);  
981 -END;  
982 -  
983 -  
984 -PROCEDURE TEntityStack.Push (Instance : TObject; LastPos : PChar);  
985 -VAR  
986 - ESN : TEntityStackNode;  
987 -BEGIN  
988 - ESN := TEntityStackNode.Create;  
989 - ESN.Instance := Instance;  
990 - ESN.Encoding := Owner.FCurEncoding; // Save current Encoding  
991 - ESN.LastPos := LastPos;  
992 - Add (ESN);  
993 -END;  
994 -  
995 -  
996 -FUNCTION TEntityStack.Pop : PChar;  
997 -VAR  
998 - ESN : TEntityStackNode;  
999 -BEGIN  
1000 - IF Count > 0 THEN BEGIN  
1001 - ESN := TEntityStackNode (Items [Count-1]);  
1002 - Result := ESN.LastPos;  
1003 - IF ESN.Instance <> NIL THEN  
1004 - ESN.Instance.Free;  
1005 - IF ESN.Encoding <> '' THEN  
1006 - Owner.FCurEncoding := ESN.Encoding; // Restore current Encoding  
1007 - Delete (Count-1);  
1008 - END  
1009 - ELSE  
1010 - Result := NIL;  
1011 -END;  
1012 -  
1013 -  
1014 -(*  
1015 -===============================================================================================  
1016 -TExternalID  
1017 ------------  
1018 -XmlSpec 4.2.2: ExternalID ::= 'SYSTEM' S SystemLiteral |  
1019 - 'PUBLIC' S PubidLiteral S SystemLiteral  
1020 -XmlSpec 4.7: PublicID ::= 'PUBLIC' S PubidLiteral  
1021 -SystemLiteral and PubidLiteral are quoted  
1022 -===============================================================================================  
1023 -*)  
1024 -  
1025 -TYPE  
1026 - TExternalID = CLASS  
1027 - PublicId : STRING;  
1028 - SystemId : STRING;  
1029 - Final : PChar;  
1030 - CONSTRUCTOR Create (Start : PChar);  
1031 - END;  
1032 -  
1033 -CONSTRUCTOR TExternalID.Create (Start : PChar);  
1034 -BEGIN  
1035 - INHERITED Create;  
1036 - Final := Start;  
1037 - IF StrLComp (Start, 'SYSTEM', 6) = 0 THEN BEGIN  
1038 - WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);  
1039 - IF NOT (Final^ IN CQuoteChar) THEN EXIT;  
1040 - ExtractQuote (Final, SystemID, Final);  
1041 - END  
1042 - ELSE IF StrLComp (Start, 'PUBLIC', 6) = 0 THEN BEGIN  
1043 - WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);  
1044 - IF NOT (Final^ IN CQuoteChar) THEN EXIT;  
1045 - ExtractQuote (Final, PublicID, Final);  
1046 - INC (Final);  
1047 - WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);  
1048 - IF NOT (Final^ IN CQuoteChar) THEN EXIT;  
1049 - ExtractQuote (Final, SystemID, Final);  
1050 - END;  
1051 -END;  
1052 -  
1053 -  
1054 -(*  
1055 -===============================================================================================  
1056 -TXmlParser  
1057 -===============================================================================================  
1058 -*)  
1059 -  
1060 -CONSTRUCTOR TXmlParser.Create;  
1061 -BEGIN  
1062 - INHERITED Create;  
1063 - FBuffer := NIL;  
1064 - FBufferSize := 0;  
1065 - Elements := TElemList.Create;  
1066 - Entities := TNvpList.Create;  
1067 - ParEntities := TNvpList.Create;  
1068 - Notations := TNvpList.Create;  
1069 - CurAttr := TAttrList.Create;  
1070 - EntityStack := TEntityStack.Create (Self);  
1071 - Clear;  
1072 -END;  
1073 -  
1074 -  
1075 -DESTRUCTOR TXmlParser.Destroy;  
1076 -BEGIN  
1077 - Clear;  
1078 - Elements.Free;  
1079 - Entities.Free;  
1080 - ParEntities.Free;  
1081 - Notations.Free;  
1082 - CurAttr.Free;  
1083 - EntityStack.Free;  
1084 - INHERITED Destroy;  
1085 -END;  
1086 -  
1087 -  
1088 -PROCEDURE TXmlParser.Clear;  
1089 - // Free Buffer and clear all object attributes  
1090 -BEGIN  
1091 - IF (FBufferSize > 0) AND (FBuffer <> NIL) THEN  
1092 - FreeMem (FBuffer);  
1093 - FBuffer := NIL;  
1094 - FBufferSize := 0;  
1095 - FSource := '';  
1096 - FXmlVersion := '';  
1097 - FEncoding := '';  
1098 - FStandalone := FALSE;  
1099 - FRootName := '';  
1100 - FDtdcFinal := NIL;  
1101 - FNormalize := TRUE;  
1102 - Elements.Clear;  
1103 - Entities.Clear;  
1104 - ParEntities.Clear;  
1105 - Notations.Clear;  
1106 - CurAttr.Clear;  
1107 - EntityStack.Clear;  
1108 -END;  
1109 -  
1110 -  
1111 -FUNCTION TXmlParser.LoadFromFile (Filename : STRING; FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;  
1112 - // Loads Document from given file  
1113 - // Returns TRUE if successful  
1114 -VAR  
1115 - f : FILE;  
1116 - ReadIn : INTEGER;  
1117 - OldFileMode : INTEGER;  
1118 -BEGIN  
1119 - Result := FALSE;  
1120 - Clear;  
1121 -  
1122 - // --- Open File  
1123 - OldFileMode := SYSTEM.FileMode;  
1124 - TRY  
1125 - SYSTEM.FileMode := FileMode;  
1126 - TRY  
1127 - AssignFile (f, Filename);  
1128 - Reset (f, 1);  
1129 - EXCEPT  
1130 - EXIT;  
1131 - END;  
1132 -  
1133 - TRY  
1134 - // --- Allocate Memory  
1135 - TRY  
1136 - FBufferSize := Filesize (f) + 1;  
1137 - GetMem (FBuffer, FBufferSize);  
1138 - EXCEPT  
1139 - Clear;  
1140 - EXIT;  
1141 - END;  
1142 -  
1143 - // --- Read File  
1144 - TRY  
1145 - BlockRead (f, FBuffer^, FBufferSize, ReadIn);  
1146 - (FBuffer+ReadIn)^ := #0; // NULL termination  
1147 - EXCEPT  
1148 - Clear;  
1149 - EXIT;  
1150 - END;  
1151 - FINALLY  
1152 - CloseFile (f);  
1153 - END;  
1154 -  
1155 - FSource := Filename;  
1156 - Result := TRUE;  
1157 -  
1158 - FINALLY  
1159 - SYSTEM.FileMode := OldFileMode;  
1160 - END;  
1161 -END;  
1162 -  
1163 -  
1164 -FUNCTION TXmlParser.LoadFromBuffer (Buffer : PChar) : BOOLEAN;  
1165 - // Loads Document from another buffer  
1166 - // Returns TRUE if successful  
1167 - // The "Source" property becomes '<MEM>' if successful  
1168 -BEGIN  
1169 - Result := FALSE;  
1170 - Clear;  
1171 - FBufferSize := StrLen (Buffer) + 1;  
1172 - TRY  
1173 - GetMem (FBuffer, FBufferSize);  
1174 - EXCEPT  
1175 - Clear;  
1176 - EXIT;  
1177 - END;  
1178 - StrCopy (FBuffer, Buffer);  
1179 - FSource := '<MEM>';  
1180 - Result := TRUE;  
1181 -END;  
1182 -  
1183 -  
1184 -PROCEDURE TXmlParser.SetBuffer (Buffer : PChar); // References another buffer  
1185 -BEGIN  
1186 - Clear;  
1187 - FBuffer := Buffer;  
1188 - FBufferSize := 0;  
1189 - FSource := '<REFERENCE>';  
1190 -END;  
1191 -  
1192 -  
1193 -//-----------------------------------------------------------------------------------------------  
1194 -// Scanning through the document  
1195 -//-----------------------------------------------------------------------------------------------  
1196 -  
1197 -PROCEDURE TXmlParser.StartScan;  
1198 -BEGIN  
1199 - CurPartType := ptNone;  
1200 - CurName := '';  
1201 - CurContent := '';  
1202 - CurStart := NIL;  
1203 - CurFinal := NIL;  
1204 - CurAttr.Clear;  
1205 - EntityStack.Clear;  
1206 -END;  
1207 -  
1208 -  
1209 -FUNCTION TXmlParser.Scan : BOOLEAN;  
1210 - // Scans the next Part  
1211 - // Returns TRUE if a part could be found, FALSE if there is no part any more  
1212 - //  
1213 - // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part  
1214 - // if there is no Content due to normalization  
1215 -VAR  
1216 - IsDone : BOOLEAN;  
1217 -BEGIN  
1218 - REPEAT  
1219 - IsDone := TRUE;  
1220 -  
1221 - // --- Start of next Part  
1222 - IF CurStart = NIL  
1223 - THEN CurStart := DocBuffer  
1224 - ELSE CurStart := CurFinal+1;  
1225 - CurFinal := CurStart;  
1226 -  
1227 - // --- End of Document of Pop off a new part from the Entity stack?  
1228 - IF CurStart^ = #0 THEN  
1229 - CurStart := EntityStack.Pop;  
1230 -  
1231 - // --- No Document or End Of Document: Terminate Scan  
1232 - IF (CurStart = NIL) OR (CurStart^ = #0) THEN BEGIN  
1233 - CurStart := StrEnd (DocBuffer);  
1234 - CurFinal := CurStart-1;  
1235 - EntityStack.Clear;  
1236 - Result := FALSE;  
1237 - EXIT;  
1238 - END;  
1239 -  
1240 - IF (StrLComp (CurStart, '<?xml', 5) = 0) AND  
1241 - ((CurStart+5)^ IN CWhitespace) THEN AnalyzeProlog // XML Declaration, Text Declaration  
1242 - ELSE IF StrLComp (CurStart, '<?', 2) = 0 THEN AnalyzePI (CurStart, CurFinal) // PI  
1243 - ELSE IF StrLComp (CurStart, '<!--', 4) = 0 THEN AnalyzeComment (CurStart, CurFinal) // Comment  
1244 - ELSE IF StrLComp (CurStart, '<!DOCTYPE', 9) = 0 THEN AnalyzeDtdc // DTDc  
1245 - ELSE IF StrLComp (CurStart, CDStart, Length (CDStart)) = 0 THEN AnalyzeCdata // CDATA Section  
1246 - ELSE IF StrLComp (CurStart, '<', 1) = 0 THEN AnalyzeTag // Start-Tag, End-Tag, Empty-Element-Tag  
1247 - ELSE AnalyzeText (IsDone); // Text Content  
1248 - UNTIL IsDone;  
1249 - Result := TRUE;  
1250 -END;  
1251 -  
1252 -  
1253 -PROCEDURE TXmlParser.AnalyzeProlog;  
1254 - // Analyze XML Prolog or Text Declaration  
1255 -VAR  
1256 - F : PChar;  
1257 -BEGIN  
1258 - CurAttr.Analyze (CurStart+5, F);  
1259 - IF EntityStack.Count = 0 THEN BEGIN  
1260 - FXmlVersion := CurAttr.Value ('version');  
1261 - FEncoding := CurAttr.Value ('encoding');  
1262 - FStandalone := CurAttr.Value ('standalone') = 'yes';  
1263 - END;  
1264 - CurFinal := StrPos (F, '?>');  
1265 - IF CurFinal <> NIL  
1266 - THEN INC (CurFinal)  
1267 - ELSE CurFinal := StrEnd (CurStart)-1;  
1268 - FCurEncoding := AnsiUpperCase (CurAttr.Value ('encoding'));  
1269 - IF FCurEncoding = '' THEN  
1270 - FCurEncoding := 'UTF-8'; // Default XML Encoding is UTF-8  
1271 - CurPartType := ptXmlProlog;  
1272 - CurName := '';  
1273 - CurContent := '';  
1274 -END;  
1275 -  
1276 -  
1277 -PROCEDURE TXmlParser.AnalyzeComment (Start : PChar; VAR Final : PChar);  
1278 - // Analyze Comments  
1279 -BEGIN  
1280 - Final := StrPos (Start+4, '-->');  
1281 - IF Final = NIL  
1282 - THEN Final := StrEnd (Start)-1  
1283 - ELSE INC (Final, 2);  
1284 - CurPartType := ptComment;  
1285 -END;  
1286 -  
1287 -  
1288 -PROCEDURE TXmlParser.AnalyzePI (Start : PChar; VAR Final : PChar);  
1289 - // Analyze Processing Instructions (PI)  
1290 - // This is also called for Character  
1291 -VAR  
1292 - F : PChar;  
1293 -BEGIN  
1294 - CurPartType := ptPI;  
1295 - Final := StrPos (Start+2, '?>');  
1296 - IF Final = NIL  
1297 - THEN Final := StrEnd (Start)-1  
1298 - ELSE INC (Final);  
1299 - ExtractName (Start+2, CWhitespace + ['?', '>'], F);  
1300 - SetStringSF (CurName, Start+2, F);  
1301 - SetStringSF (CurContent, F+1, Final-2);  
1302 - CurAttr.Analyze (F+1, F);  
1303 -END;  
1304 -  
1305 -  
1306 -PROCEDURE TXmlParser.AnalyzeDtdc;  
1307 - (* Analyze Document Type Declaration  
1308 - doctypedecl ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'  
1309 - markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment  
1310 - PEReference ::= '%' Name ';'  
1311 -  
1312 - elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'  
1313 - AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'  
1314 - EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' |  
1315 - '<!ENTITY' S '%' S Name S PEDef S? '>'  
1316 - NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'  
1317 - PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char* )))? '?>'  
1318 - Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->' *)  
1319 -TYPE  
1320 - TPhase = (phName, phDtd, phInternal, phFinishing);  
1321 -VAR  
1322 - Phase : TPhase;  
1323 - F : PChar;  
1324 - ExternalID : TExternalID;  
1325 - ExternalDTD : TXmlParser;  
1326 - DER : TDtdElementRec;  
1327 -BEGIN  
1328 - DER.Start := CurStart;  
1329 - EntityStack.Clear; // Clear stack for Parameter Entities  
1330 - CurPartType := ptDtdc;  
1331 -  
1332 - // --- Don't read DTDc twice  
1333 - IF FDtdcFinal <> NIL THEN BEGIN  
1334 - CurFinal := FDtdcFinal;  
1335 - EXIT;  
1336 - END;  
1337 -  
1338 - // --- Scan DTDc  
1339 - CurFinal := CurStart + 9; // First char after '<!DOCTYPE'  
1340 - Phase := phName;  
1341 - REPEAT  
1342 - CASE CurFinal^ OF  
1343 - '%' : BEGIN  
1344 - PushPE (CurFinal);  
1345 - CONTINUE;  
1346 - END;  
1347 - #0 : IF EntityStack.Count = 0 THEN  
1348 - BREAK  
1349 - ELSE BEGIN  
1350 - CurFinal := EntityStack.Pop;  
1351 - CONTINUE;  
1352 - END;  
1353 - '[' : BEGIN  
1354 - Phase := phInternal;  
1355 - AnalyzeDtdElements (CurFinal+1, CurFinal);  
1356 - CONTINUE;  
1357 - END;  
1358 - ']' : Phase := phFinishing;  
1359 - '>' : BREAK;  
1360 - ELSE IF NOT (CurFinal^ IN CWhitespace) THEN BEGIN  
1361 - CASE Phase OF  
1362 - phName : IF (CurFinal^ IN CNameStart) THEN BEGIN  
1363 - ExtractName (CurFinal, CWhitespace + ['[', '>'], F);  
1364 - SetStringSF (FRootName, CurFinal, F);  
1365 - CurFinal := F;  
1366 - Phase := phDtd;  
1367 - END;  
1368 - phDtd : IF (StrLComp (CurFinal, 'SYSTEM', 6) = 0) OR  
1369 - (StrLComp (CurFinal, 'PUBLIC', 6) = 0) THEN BEGIN  
1370 - ExternalID := TExternalID.Create (CurFinal);  
1371 - ExternalDTD := LoadExternalEntity (ExternalId.SystemId, ExternalID.PublicId, '');  
1372 - F := StrPos (ExternalDtd.DocBuffer, '<!');  
1373 - IF F <> NIL THEN  
1374 - AnalyzeDtdElements (F, F);  
1375 - ExternalDTD.Free;  
1376 - CurFinal := ExternalID.Final;  
1377 - ExternalID.Free;  
1378 - END;  
1379 - ELSE BEGIN  
1380 - DER.ElementType := deError;  
1381 - DER.Pos := CurFinal;  
1382 - DER.Final := CurFinal;  
1383 - DtdElementFound (DER);  
1384 - END;  
1385 - END;  
1386 -  
1387 - END;  
1388 - END;  
1389 - INC (CurFinal);  
1390 - UNTIL FALSE;  
1391 -  
1392 - CurPartType := ptDtdc;  
1393 - CurName := '';  
1394 - CurContent := '';  
1395 -  
1396 - // It is an error in the document if "EntityStack" is not empty now  
1397 - IF EntityStack.Count > 0 THEN BEGIN  
1398 - DER.ElementType := deError;  
1399 - DER.Final := CurFinal;  
1400 - DER.Pos := CurFinal;  
1401 - DtdElementFound (DER);  
1402 - END;  
1403 -  
1404 - EntityStack.Clear; // Clear stack for General Entities  
1405 - FDtdcFinal := CurFinal;  
1406 -END;  
1407 -  
1408 -  
1409 -PROCEDURE TXmlParser.AnalyzeDtdElements (Start : PChar; VAR Final : PChar);  
1410 - // Analyze the "Elements" of a DTD contained in the external or  
1411 - // internal DTD subset.  
1412 -VAR  
1413 - DER : TDtdElementRec;  
1414 -BEGIN  
1415 - Final := Start;  
1416 - REPEAT  
1417 - CASE Final^ OF  
1418 - '%' : BEGIN  
1419 - PushPE (Final);  
1420 - CONTINUE;  
1421 - END;  
1422 - #0 : IF EntityStack.Count = 0 THEN  
1423 - BREAK  
1424 - ELSE BEGIN  
1425 - CurFinal := EntityStack.Pop;  
1426 - CONTINUE;  
1427 - END;  
1428 - ']',  
1429 - '>' : BREAK;  
1430 - '<' : IF StrLComp (Final, '<!ELEMENT', 9) = 0 THEN AnalyzeElementDecl (Final, Final)  
1431 - ELSE IF StrLComp (Final, '<!ATTLIST', 9) = 0 THEN AnalyzeAttListDecl (Final, Final)  
1432 - ELSE IF StrLComp (Final, '<!ENTITY', 8) = 0 THEN AnalyzeEntityDecl (Final, Final)  
1433 - ELSE IF StrLComp (Final, '<!NOTATION', 10) = 0 THEN AnalyzeNotationDecl (Final, Final)  
1434 - ELSE IF StrLComp (Final, '<?', 2) = 0 THEN BEGIN // PI in DTD  
1435 - DER.ElementType := dePI;  
1436 - DER.Start := Final;  
1437 - AnalyzePI (Final, Final);  
1438 - DER.Target := PChar (CurName);  
1439 - DER.Content := PChar (CurContent);  
1440 - DER.AttrList := CurAttr;  
1441 - DER.Final := Final;  
1442 - DtdElementFound (DER);  
1443 - END  
1444 - ELSE IF StrLComp (Final, '<!--', 4) = 0 THEN BEGIN // Comment in DTD  
1445 - DER.ElementType := deComment;  
1446 - DER.Start := Final;  
1447 - AnalyzeComment (Final, Final);  
1448 - DER.Final := Final;  
1449 - DtdElementFound (DER);  
1450 - END  
1451 - ELSE BEGIN  
1452 - DER.ElementType := deError;  
1453 - DER.Start := Final;  
1454 - DER.Pos := Final;  
1455 - DER.Final := Final;  
1456 - DtdElementFound (DER);  
1457 - END;  
1458 -  
1459 - END;  
1460 - INC (Final);  
1461 - UNTIL FALSE;  
1462 -END;  
1463 -  
1464 -  
1465 -PROCEDURE TXmlParser.AnalyzeTag;  
1466 - // Analyze Tags  
1467 -VAR  
1468 - S, F : PChar;  
1469 - Attr : TAttr;  
1470 - ElemDef : TElemDef;  
1471 - AttrDef : TAttrDef;  
1472 - I : INTEGER;  
1473 -BEGIN  
1474 - CurPartType := ptStartTag;  
1475 - S := CurStart+1;  
1476 - IF S^ = '/' THEN BEGIN  
1477 - CurPartType := ptEndTag;  
1478 - INC (S);  
1479 - END;  
1480 - ExtractName (S, CWhitespace + ['/'], F);  
1481 - SetStringSF (CurName, S, F);  
1482 - CurAttr.Analyze (F+1, CurFinal);  
1483 - IF CurFinal^ = '/' THEN BEGIN  
1484 - CurPartType := ptEmptyTag;  
1485 - END;  
1486 - CurFinal := StrScanE (CurFinal, '>');  
1487 -  
1488 - // --- Set Default Attribute values for nonexistent attributes  
1489 - IF (CurPartType = ptStartTag) OR (CurPartType = ptEmptyTag) THEN BEGIN  
1490 - ElemDef := Elements.Node (CurName);  
1491 - IF ElemDef <> NIL THEN BEGIN  
1492 - FOR I := 0 TO ElemDef.Count-1 DO BEGIN  
1493 - AttrDef := TAttrDef (ElemDef [I]);  
1494 - Attr := TAttr (CurAttr.Node (AttrDef.Name));  
1495 - IF (Attr = NIL) AND (AttrDef.Value <> '') THEN BEGIN  
1496 - Attr := TAttr.Create (AttrDef.Name, AttrDef.Value);  
1497 - Attr.ValueType := vtDefault;  
1498 - CurAttr.Add (Attr);  
1499 - END;  
1500 - IF Attr <> NIL THEN BEGIN  
1501 - CASE AttrDef.DefaultType OF  
1502 - adDefault : ;  
1503 - adRequired : ; // -!- It is an error in the document if "Attr.Value" is an empty string  
1504 - adImplied : Attr.ValueType := vtImplied;  
1505 - adFixed : BEGIN  
1506 - Attr.ValueType := vtFixed;  
1507 - Attr.Value := AttrDef.Value;  
1508 - END;  
1509 - END;  
1510 - Attr.AttrType := AttrDef.AttrType;  
1511 - END;  
1512 - END;  
1513 - END;  
1514 -  
1515 - // --- Normalize Attribute Values. XmlSpec:  
1516 - // - a character reference is processed by appending the referenced character to the attribute value  
1517 - // - an entity reference is processed by recursively processing the replacement text of the entity  
1518 - // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value,  
1519 - // except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external  
1520 - // parsed entity or the literal entity value of an internal parsed entity  
1521 - // - other characters are processed by appending them to the normalized value  
1522 - // If the declared value is not CDATA, then the XML processor must further process the  
1523 - // normalized attribute value by discarding any leading and trailing space (#x20) characters,  
1524 - // and by replacing sequences of space (#x20) characters by a single space (#x20) character.  
1525 - // All attributes for which no declaration has been read should be treated by a  
1526 - // non-validating parser as if declared CDATA.  
1527 - // !!! The XML 1.0 SE specification is somewhat different here  
1528 - // This code does not conform exactly to this specification  
1529 - FOR I := 0 TO CurAttr.Count-1 DO  
1530 - WITH TAttr (CurAttr [I]) DO BEGIN  
1531 - ReplaceGeneralEntities (Value);  
1532 - ReplaceCharacterEntities (Value);  
1533 - IF (AttrType <> atCData) AND (AttrType <> atUnknown)  
1534 - THEN Value := TranslateEncoding (TrimWs (ConvertWs (Value, TRUE)))  
1535 - ELSE Value := TranslateEncoding (ConvertWs (Value, FALSE));  
1536 - END;  
1537 - END;  
1538 -END;  
1539 -  
1540 -  
1541 -PROCEDURE TXmlParser.AnalyzeCData;  
1542 - // Analyze CDATA Sections  
1543 -BEGIN  
1544 - CurPartType := ptCData;  
1545 - CurFinal := StrPos (CurStart, CDEnd);  
1546 - IF CurFinal = NIL THEN BEGIN  
1547 - CurFinal := StrEnd (CurStart)-1;  
1548 - CurContent := TranslateEncoding (StrPas (CurStart+Length (CDStart)));  
1549 - END  
1550 - ELSE BEGIN  
1551 - SetStringSF (CurContent, CurStart+Length (CDStart), CurFinal-1);  
1552 - INC (CurFinal, Length (CDEnd)-1);  
1553 - CurContent := TranslateEncoding (CurContent);  
1554 - END;  
1555 -END;  
1556 -  
1557 -  
1558 -PROCEDURE TXmlParser.AnalyzeText (VAR IsDone : BOOLEAN);  
1559 - (* Analyzes Text Content between Tags. CurFinal will point to the last content character.  
1560 - Content ends at a '<' character or at the end of the document.  
1561 - Entity References and Character Entity references are resolved.  
1562 - If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to  
1563 - one Space #x20 character, Whitespace at the beginning and end of content will  
1564 - be trimmed off and content which is or becomes empty is not returned to  
1565 - the application (in this case, "IsDone" is set to FALSE which causes the  
1566 - Scan method to proceed directly to the next part. *)  
1567 -  
1568 - PROCEDURE ProcessEntity;  
1569 - (* Is called if there is an ampsersand '&' character found in the document.  
1570 - IN "CurFinal" points to the ampersand  
1571 - OUT "CurFinal" points to the first character after the semi-colon ';' *)  
1572 - VAR  
1573 - P : PChar;  
1574 - Name : STRING;  
1575 - EntityDef : TEntityDef;  
1576 - ExternalEntity : TXmlParser;  
1577 - BEGIN  
1578 - P := StrScan (CurFinal , ';');  
1579 - IF P <> NIL THEN BEGIN  
1580 - SetStringSF (Name, CurFinal+1, P-1);  
1581 -  
1582 - // Is it a Character Entity?  
1583 - IF (CurFinal+1)^ = '#' THEN BEGIN  
1584 - IF UpCase ((CurFinal+2)^) = 'X' // !!! Can't use "CHR" for Unicode characters > 255:  
1585 - THEN CurContent := CurContent + CHR (StrToIntDef ('$'+Copy (Name, 3, MaxInt), 32))  
1586 - ELSE CurContent := CurContent + CHR (StrToIntDef (Copy (Name, 2, MaxInt), 32));  
1587 - CurFinal := P+1;  
1588 - EXIT;  
1589 - END  
1590 -  
1591 - // Is it a Predefined Entity?  
1592 - ELSE IF Name = 'lt' THEN BEGIN CurContent := CurContent + '<'; CurFinal := P+1; EXIT; END  
1593 - ELSE IF Name = 'gt' THEN BEGIN CurContent := CurContent + '>'; CurFinal := P+1; EXIT; END  
1594 - ELSE IF Name = 'amp' THEN BEGIN CurContent := CurContent + '&'; CurFinal := P+1; EXIT; END  
1595 - ELSE IF Name = 'apos' THEN BEGIN CurContent := CurContent + ''''; CurFinal := P+1; EXIT; END  
1596 - ELSE IF Name = 'quot' THEN BEGIN CurContent := CurContent + '"'; CurFinal := P+1; EXIT; END;  
1597 -  
1598 - // Replace with Entity from DTD  
1599 - EntityDef := TEntityDef (Entities.Node (Name));  
1600 - IF EntityDef <> NIL THEN BEGIN  
1601 - IF EntityDef.Value <> '' THEN BEGIN  
1602 - EntityStack.Push (P+1);  
1603 - CurFinal := PChar (EntityDef.Value);  
1604 - END  
1605 - ELSE BEGIN  
1606 - ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);  
1607 - EntityStack.Push (ExternalEntity, P+1);  
1608 - CurFinal := ExternalEntity.DocBuffer;  
1609 - END;  
1610 - END  
1611 - ELSE BEGIN  
1612 - CurContent := CurContent + Name;  
1613 - CurFinal := P+1;  
1614 - END;  
1615 - END  
1616 - ELSE BEGIN  
1617 - INC (CurFinal);  
1618 - END;  
1619 - END;  
1620 -  
1621 -VAR  
1622 - C : INTEGER;  
1623 -BEGIN  
1624 - CurFinal := CurStart;  
1625 - CurPartType := ptContent;  
1626 - CurContent := '';  
1627 - C := 0;  
1628 - REPEAT  
1629 - CASE CurFinal^ OF  
1630 - '&' : BEGIN  
1631 - CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));  
1632 - C := 0;  
1633 - ProcessEntity;  
1634 - CONTINUE;  
1635 - END;  
1636 - #0 : BEGIN  
1637 - IF EntityStack.Count = 0 THEN  
1638 - BREAK  
1639 - ELSE BEGIN  
1640 - CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));  
1641 - C := 0;  
1642 - CurFinal := EntityStack.Pop;  
1643 - CONTINUE;  
1644 - END;  
1645 - END;  
1646 - '<' : BREAK;  
1647 - ELSE INC (C);  
1648 - END;  
1649 - INC (CurFinal);  
1650 - UNTIL FALSE;  
1651 - CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));  
1652 - DEC (CurFinal);  
1653 -  
1654 - IF FNormalize THEN BEGIN  
1655 - CurContent := ConvertWs (TrimWs (CurContent), TRUE);  
1656 - IsDone := CurContent <> ''; // IsDone will only get FALSE if PackSpaces is TRUE  
1657 - END;  
1658 -END;  
1659 -  
1660 -  
1661 -PROCEDURE TXmlParser.AnalyzeElementDecl (Start : PChar; VAR Final : PChar);  
1662 - (* Parse <!ELEMENT declaration starting at "Start"  
1663 - Final must point to the terminating '>' character  
1664 - XmlSpec 3.2:  
1665 - elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'  
1666 - contentspec ::= 'EMPTY' | 'ANY' | Mixed | children  
1667 - Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' |  
1668 - '(' S? '#PCDATA' S? ')'  
1669 - children ::= (choice | seq) ('?' | '*' | '+')?  
1670 - choice ::= '(' S? cp ( S? '|' S? cp )* S? ')'  
1671 - cp ::= (Name | choice | seq) ('?' | '*' | '+')?  
1672 - seq ::= '(' S? cp ( S? ',' S? cp )* S? ')'  
1673 -  
1674 - More simply:  
1675 - contentspec ::= EMPTY  
1676 - ANY  
1677 - '(#PCDATA)'  
1678 - '(#PCDATA | A | B)*'  
1679 - '(A, B, C)'  
1680 - '(A | B | C)'  
1681 - '(A?, B*, C+),  
1682 - '(A, (B | C | D)* )' *)  
1683 -VAR  
1684 - Element : TElemDef;  
1685 - Elem2 : TElemDef;  
1686 - F : PChar;  
1687 - DER : TDtdElementRec;  
1688 -BEGIN  
1689 - Element := TElemDef.Create;  
1690 - Final := Start + 9;  
1691 - DER.Start := Start;  
1692 - REPEAT  
1693 - IF Final^ = '>' THEN BREAK;  
1694 - IF (Final^ IN CNameStart) AND (Element.Name = '') THEN BEGIN  
1695 - ExtractName (Final, CWhitespace, F);  
1696 - SetStringSF (Element.Name, Final, F);  
1697 - Final := F;  
1698 - F := StrScan (Final+1, '>');  
1699 - IF F = NIL THEN BEGIN  
1700 - Element.Definition := STRING (Final);  
1701 - Final := StrEnd (Final);  
1702 - BREAK;  
1703 - END  
1704 - ELSE BEGIN  
1705 - SetStringSF (Element.Definition, Final+1, F-1);  
1706 - Final := F;  
1707 - BREAK;  
1708 - END;  
1709 - END;  
1710 - INC (Final);  
1711 - UNTIL FALSE;  
1712 - Element.Definition := DelChars (Element.Definition, CWhitespace);  
1713 - ReplaceParameterEntities (Element.Definition);  
1714 - IF Element.Definition = 'EMPTY' THEN Element.ElemType := etEmpty  
1715 - ELSE IF Element.Definition = 'ANY' THEN Element.ElemType := etAny  
1716 - ELSE IF Copy (Element.Definition, 1, 8) = '(#PCDATA' THEN Element.ElemType := etMixed  
1717 - ELSE IF Copy (Element.Definition, 1, 1) = '(' THEN Element.ElemType := etChildren  
1718 - ELSE Element.ElemType := etAny;  
1719 -  
1720 - Elem2 := Elements.Node (Element.Name);  
1721 - IF Elem2 <> NIL THEN  
1722 - Elements.Delete (Elements.IndexOf (Elem2));  
1723 - Elements.Add (Element);  
1724 - Final := StrScanE (Final, '>');  
1725 - DER.ElementType := deElement;  
1726 - DER.ElemDef := Element;  
1727 - DER.Final := Final;  
1728 - DtdElementFound (DER);  
1729 -END;  
1730 -  
1731 -  
1732 -PROCEDURE TXmlParser.AnalyzeAttListDecl (Start : PChar; VAR Final : PChar);  
1733 - (* Parse <!ATTLIST declaration starting at "Start"  
1734 - Final must point to the terminating '>' character  
1735 - XmlSpec 3.3:  
1736 - AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'  
1737 - AttDef ::= S Name S AttType S DefaultDecl  
1738 - AttType ::= StringType | TokenizedType | EnumeratedType  
1739 - StringType ::= 'CDATA'  
1740 - TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'  
1741 - EnumeratedType ::= NotationType | Enumeration  
1742 - NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'  
1743 - Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'  
1744 - DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)  
1745 - AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"  
1746 - Examples:  
1747 - <!ATTLIST address  
1748 - A1 CDATA "Default"  
1749 - A2 ID #REQUIRED  
1750 - A3 IDREF #IMPLIED  
1751 - A4 IDREFS #IMPLIED  
1752 - A5 ENTITY #FIXED "&at;&#252;"  
1753 - A6 ENTITIES #REQUIRED  
1754 - A7 NOTATION (WMF | DXF) "WMF"  
1755 - A8 (A | B | C) #REQUIRED> *)  
1756 -TYPE  
1757 - TPhase = (phElementName, phName, phType, phNotationContent, phDefault);  
1758 -VAR  
1759 - Phase : TPhase;  
1760 - F : PChar;  
1761 - ElementName : STRING;  
1762 - ElemDef : TElemDef;  
1763 - AttrDef : TAttrDef;  
1764 - AttrDef2 : TAttrDef;  
1765 - Strg : STRING;  
1766 - DER : TDtdElementRec;  
1767 -BEGIN  
1768 - Final := Start + 9; // The character after <!ATTLIST  
1769 - Phase := phElementName;  
1770 - DER.Start := Start;  
1771 - AttrDef := NIL;  
1772 - ElemDef := NIL;  
1773 - REPEAT  
1774 - IF NOT (Final^ IN CWhitespace) THEN  
1775 - CASE Final^ OF  
1776 - '%' : BEGIN  
1777 - PushPE (Final);  
1778 - CONTINUE;  
1779 - END;  
1780 - #0 : IF EntityStack.Count = 0 THEN  
1781 - BREAK  
1782 - ELSE BEGIN  
1783 - Final := EntityStack.Pop;  
1784 - CONTINUE;  
1785 - END;  
1786 - '>' : BREAK;  
1787 - ELSE CASE Phase OF  
1788 - phElementName : BEGIN  
1789 - ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);  
1790 - SetStringSF (ElementName, Final, F);  
1791 - Final := F;  
1792 - ElemDef := Elements.Node (ElementName);  
1793 - IF ElemDef = NIL THEN BEGIN  
1794 - ElemDef := TElemDef.Create;  
1795 - ElemDef.Name := ElementName;  
1796 - ElemDef.Definition := 'ANY';  
1797 - ElemDef.ElemType := etAny;  
1798 - Elements.Add (ElemDef);  
1799 - END;  
1800 - Phase := phName;  
1801 - END;  
1802 - phName : BEGIN  
1803 - AttrDef := TAttrDef.Create;  
1804 - ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);  
1805 - SetStringSF (AttrDef.Name, Final, F);  
1806 - Final := F;  
1807 - AttrDef2 := TAttrDef (ElemDef.Node (AttrDef.Name));  
1808 - IF AttrDef2 <> NIL THEN  
1809 - ElemDef.Delete (ElemDef.IndexOf (AttrDef2));  
1810 - ElemDef.Add (AttrDef);  
1811 - Phase := phType;  
1812 - END;  
1813 - phType : BEGIN  
1814 - IF Final^ = '(' THEN BEGIN  
1815 - F := StrScan (Final+1, ')');  
1816 - IF F <> NIL  
1817 - THEN SetStringSF (AttrDef.TypeDef, Final+1, F-1)  
1818 - ELSE AttrDef.TypeDef := STRING (Final+1);  
1819 - AttrDef.TypeDef := DelChars (AttrDef.TypeDef, CWhitespace);  
1820 - AttrDef.AttrType := atEnumeration;  
1821 - ReplaceParameterEntities (AttrDef.TypeDef);  
1822 - ReplaceCharacterEntities (AttrDef.TypeDef);  
1823 - Phase := phDefault;  
1824 - END  
1825 - ELSE IF StrLComp (Final, 'NOTATION', 8) = 0 THEN BEGIN  
1826 - INC (Final, 8);  
1827 - AttrDef.AttrType := atNotation;  
1828 - Phase := phNotationContent;  
1829 - END  
1830 - ELSE BEGIN  
1831 - ExtractName (Final, CWhitespace+CQuoteChar+['#'], F);  
1832 - SetStringSF (AttrDef.TypeDef, Final, F);  
1833 - IF AttrDef.TypeDef = 'CDATA' THEN AttrDef.AttrType := atCData  
1834 - ELSE IF AttrDef.TypeDef = 'ID' THEN AttrDef.AttrType := atId  
1835 - ELSE IF AttrDef.TypeDef = 'IDREF' THEN AttrDef.AttrType := atIdRef  
1836 - ELSE IF AttrDef.TypeDef = 'IDREFS' THEN AttrDef.AttrType := atIdRefs  
1837 - ELSE IF AttrDef.TypeDef = 'ENTITY' THEN AttrDef.AttrType := atEntity  
1838 - ELSE IF AttrDef.TypeDef = 'ENTITIES' THEN AttrDef.AttrType := atEntities  
1839 - ELSE IF AttrDef.TypeDef = 'NMTOKEN' THEN AttrDef.AttrType := atNmToken  
1840 - ELSE IF AttrDef.TypeDef = 'NMTOKENS' THEN AttrDef.AttrType := atNmTokens;  
1841 - Phase := phDefault;  
1842 - END  
1843 - END;  
1844 - phNotationContent : BEGIN  
1845 - F := StrScan (Final, ')');  
1846 - IF F <> NIL THEN  
1847 - SetStringSF (AttrDef.Notations, Final+1, F-1)  
1848 - ELSE BEGIN  
1849 - AttrDef.Notations := STRING (Final+1);  
1850 - Final := StrEnd (Final);  
1851 - END;  
1852 - ReplaceParameterEntities (AttrDef.Notations);  
1853 - AttrDef.Notations := DelChars (AttrDef.Notations, CWhitespace);  
1854 - Phase := phDefault;  
1855 - END;  
1856 - phDefault : BEGIN  
1857 - IF Final^ = '#' THEN BEGIN  
1858 - ExtractName (Final, CWhiteSpace + CQuoteChar, F);  
1859 - SetStringSF (Strg, Final, F);  
1860 - Final := F;  
1861 - ReplaceParameterEntities (Strg);  
1862 - IF Strg = '#REQUIRED' THEN BEGIN AttrDef.DefaultType := adRequired; Phase := phName; END  
1863 - ELSE IF Strg = '#IMPLIED' THEN BEGIN AttrDef.DefaultType := adImplied; Phase := phName; END  
1864 - ELSE IF Strg = '#FIXED' THEN AttrDef.DefaultType := adFixed;  
1865 - END  
1866 - ELSE IF (Final^ IN CQuoteChar) THEN BEGIN  
1867 - ExtractQuote (Final, AttrDef.Value, Final);  
1868 - ReplaceParameterEntities (AttrDef.Value);  
1869 - ReplaceCharacterEntities (AttrDef.Value);  
1870 - Phase := phName;  
1871 - END;  
1872 - IF Phase = phName THEN BEGIN  
1873 - AttrDef := NIL;  
1874 - END;  
1875 - END;  
1876 -  
1877 - END;  
1878 - END;  
1879 - INC (Final);  
1880 - UNTIL FALSE;  
1881 -  
1882 - Final := StrScan (Final, '>');  
1883 -  
1884 - DER.ElementType := deAttList;  
1885 - DER.ElemDef := ElemDef;  
1886 - DER.Final := Final;  
1887 - DtdElementFound (DER);  
1888 -END;  
1889 -  
1890 -  
1891 -PROCEDURE TXmlParser.AnalyzeEntityDecl (Start : PChar; VAR Final : PChar);  
1892 - (* Parse <!ENTITY declaration starting at "Start"  
1893 - Final must point to the terminating '>' character  
1894 - XmlSpec 4.2:  
1895 - EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' |  
1896 - '<!ENTITY' S '%' S Name S PEDef S? '>'  
1897 - EntityDef ::= EntityValue | (ExternalID NDataDecl?)  
1898 - PEDef ::= EntityValue | ExternalID  
1899 - NDataDecl ::= S 'NDATA' S Name  
1900 - EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' |  
1901 - "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'"  
1902 - PEReference ::= '%' Name ';'  
1903 -  
1904 - Examples  
1905 - <!ENTITY test1 "Stefan Heymann"> <!-- Internal, general, parsed -->  
1906 - <!ENTITY test2 SYSTEM "ent2.xml"> <!-- External, general, parsed -->  
1907 - <!ENTITY test2 SYSTEM "ent3.gif" NDATA gif> <!-- External, general, unparsed -->  
1908 - <!ENTITY % test3 "<!ELEMENT q ANY>"> <!-- Internal, parameter -->  
1909 - <!ENTITY % test6 SYSTEM "ent6.xml"> <!-- External, parameter -->  
1910 - <!ENTITY test4 "&test1; ist lieb"> <!-- IGP, Replacement text <> literal value -->  
1911 - <!ENTITY test5 "<p>Dies ist ein Test-Absatz</p>"> <!-- IGP, See XmlSpec 2.4 -->  
1912 - *)  
1913 -TYPE  
1914 - TPhase = (phName, phContent, phNData, phNotationName, phFinalGT);  
1915 -VAR  
1916 - Phase : TPhase;  
1917 - IsParamEntity : BOOLEAN;  
1918 - F : PChar;  
1919 - ExternalID : TExternalID;  
1920 - EntityDef : TEntityDef;  
1921 - EntityDef2 : TEntityDef;  
1922 - DER : TDtdElementRec;  
1923 -BEGIN  
1924 - Final := Start + 8; // First char after <!ENTITY  
1925 - DER.Start := Start;  
1926 - Phase := phName;  
1927 - IsParamEntity := FALSE;  
1928 - EntityDef := TEntityDef.Create;  
1929 - REPEAT  
1930 - IF NOT (Final^ IN CWhitespace) THEN  
1931 - CASE Final^ OF  
1932 - '%' : IsParamEntity := TRUE;  
1933 - '>' : BREAK;  
1934 - ELSE CASE Phase OF  
1935 - phName : IF Final^ IN CNameStart THEN BEGIN  
1936 - ExtractName (Final, CWhitespace + CQuoteChar, F);  
1937 - SetStringSF (EntityDef.Name, Final, F);  
1938 - Final := F;  
1939 - Phase := phContent;  
1940 - END;  
1941 - phContent : IF Final^ IN CQuoteChar THEN BEGIN  
1942 - ExtractQuote (Final, EntityDef.Value, Final);  
1943 - Phase := phFinalGT;  
1944 - END  
1945 - ELSE IF (StrLComp (Final, 'SYSTEM', 6) = 0) OR  
1946 - (StrLComp (Final, 'PUBLIC', 6) = 0) THEN BEGIN  
1947 - ExternalID := TExternalID.Create (Final);  
1948 - EntityDef.SystemId := ExternalID.SystemId;  
1949 - EntityDef.PublicId := ExternalID.PublicId;  
1950 - Final := ExternalID.Final;  
1951 - Phase := phNData;  
1952 - ExternalID.Free;  
1953 - END;  
1954 - phNData : IF StrLComp (Final, 'NDATA', 5) = 0 THEN BEGIN  
1955 - INC (Final, 4);  
1956 - Phase := phNotationName;  
1957 - END;  
1958 - phNotationName : IF Final^ IN CNameStart THEN BEGIN  
1959 - ExtractName (Final, CWhitespace + ['>'], F);  
1960 - SetStringSF (EntityDef.NotationName, Final, F);  
1961 - Final := F;  
1962 - Phase := phFinalGT;  
1963 - END;  
1964 - phFinalGT : ; // -!- There is an error in the document if this branch is called  
1965 - END;  
1966 - END;  
1967 - INC (Final);  
1968 - UNTIL FALSE;  
1969 - IF IsParamEntity THEN BEGIN  
1970 - EntityDef2 := TEntityDef (ParEntities.Node (EntityDef.Name));  
1971 - IF EntityDef2 <> NIL THEN  
1972 - ParEntities.Delete (ParEntities.IndexOf (EntityDef2));  
1973 - ParEntities.Add (EntityDef);  
1974 - ReplaceCharacterEntities (EntityDef.Value);  
1975 - END  
1976 - ELSE BEGIN  
1977 - EntityDef2 := TEntityDef (Entities.Node (EntityDef.Name));  
1978 - IF EntityDef2 <> NIL THEN  
1979 - Entities.Delete (Entities.IndexOf (EntityDef2));  
1980 - Entities.Add (EntityDef);  
1981 - ReplaceParameterEntities (EntityDef.Value); // Create replacement texts (see XmlSpec 4.5)  
1982 - ReplaceCharacterEntities (EntityDef.Value);  
1983 - END;  
1984 - Final := StrScanE (Final, '>');  
1985 -  
1986 - DER.ElementType := deEntity;  
1987 - DER.EntityDef := EntityDef;  
1988 - DER.Final := Final;  
1989 - DtdElementFound (DER);  
1990 -END;  
1991 -  
1992 -  
1993 -PROCEDURE TXmlParser.AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);  
1994 - // Parse <!NOTATION declaration starting at "Start"  
1995 - // Final must point to the terminating '>' character  
1996 - // XmlSpec 4.7: NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'  
1997 -TYPE  
1998 - TPhase = (phName, phExtId, phEnd);  
1999 -VAR  
2000 - ExternalID : TExternalID;  
2001 - Phase : TPhase;  
2002 - F : PChar;  
2003 - NotationDef : TNotationDef;  
2004 - DER : TDtdElementRec;  
2005 -BEGIN  
2006 - Final := Start + 10; // Character after <!NOTATION  
2007 - DER.Start := Start;  
2008 - Phase := phName;  
2009 - NotationDef := TNotationDef.Create;  
2010 - REPEAT  
2011 - IF NOT (Final^ IN CWhitespace) THEN  
2012 - CASE Final^ OF  
2013 - '>',  
2014 - #0 : BREAK;  
2015 - ELSE CASE Phase OF  
2016 - phName : BEGIN  
2017 - ExtractName (Final, CWhitespace + ['>'], F);  
2018 - SetStringSF (NotationDef.Name, Final, F);  
2019 - Final := F;  
2020 - Phase := phExtId;  
2021 - END;  
2022 - phExtId : BEGIN  
2023 - ExternalID := TExternalID.Create (Final);  
2024 - NotationDef.Value := ExternalID.SystemId;  
2025 - NotationDef.PublicId := ExternalID.PublicId;  
2026 - Final := ExternalId.Final;  
2027 - ExternalId.Free;  
2028 - Phase := phEnd;  
2029 - END;  
2030 - phEnd : ; // -!- There is an error in the document if this branch is called  
2031 - END;  
2032 - END;  
2033 - INC (Final);  
2034 - UNTIL FALSE;  
2035 - Notations.Add (NotationDef);  
2036 - Final := StrScanE (Final, '>');  
2037 -  
2038 - DER.ElementType := deNotation;  
2039 - DER.NotationDef := NotationDef;  
2040 - DER.Final := Final;  
2041 - DtdElementFound (DER);  
2042 -END;  
2043 -  
2044 -  
2045 -PROCEDURE TXmlParser.PushPE (VAR Start : PChar);  
2046 - (* If there is a parameter entity reference found in the data stream,  
2047 - the current position will be pushed to the entity stack.  
2048 - Start: IN Pointer to the '%' character starting the PE reference  
2049 - OUT Pointer to first character of PE replacement text *)  
2050 -VAR  
2051 - P : PChar;  
2052 - EntityDef : TEntityDef;  
2053 -BEGIN  
2054 - P := StrScan (Start, ';');  
2055 - IF P <> NIL THEN BEGIN  
2056 - EntityDef := TEntityDef (ParEntities.Node (StrSFPas (Start+1, P-1)));  
2057 - IF EntityDef <> NIL THEN BEGIN  
2058 - EntityStack.Push (P+1);  
2059 - Start := PChar (EntityDef.Value);  
2060 - END  
2061 - ELSE  
2062 - Start := P+1;  
2063 - END;  
2064 -END;  
2065 -  
2066 -  
2067 -PROCEDURE TXmlParser.ReplaceCharacterEntities (VAR Str : STRING);  
2068 - // Replaces all Character Entity References in the String  
2069 -VAR  
2070 - Start : INTEGER;  
2071 - PAmp : PChar;  
2072 - PSemi : PChar;  
2073 - PosAmp : INTEGER;  
2074 - Len : INTEGER; // Length of Entity Reference  
2075 -BEGIN  
2076 - IF Str = '' THEN EXIT;  
2077 - Start := 1;  
2078 - REPEAT  
2079 - PAmp := StrPos (PChar (Str) + Start-1, '&#');  
2080 - IF PAmp = NIL THEN BREAK;  
2081 - PSemi := StrScan (PAmp+2, ';');  
2082 - IF PSemi = NIL THEN BREAK;  
2083 - PosAmp := PAmp - PChar (Str) + 1;  
2084 - Len := PSemi-PAmp+1;  
2085 - IF CompareText (Str [PosAmp+2], 'x') = 0 // !!! Can't use "CHR" for Unicode characters > 255  
2086 - THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0))  
2087 - ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32));  
2088 - Delete (Str, PosAmp+1, Len-1);  
2089 - Start := PosAmp + 1;  
2090 - UNTIL FALSE;  
2091 -END;  
2092 -  
2093 -  
2094 -PROCEDURE TXmlParser.ReplaceParameterEntities (VAR Str : STRING);  
2095 - // Recursively replaces all Parameter Entity References in the String  
2096 - PROCEDURE ReplaceEntities (VAR Str : STRING);  
2097 - VAR  
2098 - Start : INTEGER;  
2099 - PAmp : PChar;  
2100 - PSemi : PChar;  
2101 - PosAmp : INTEGER;  
2102 - Len : INTEGER;  
2103 - Entity : TEntityDef;  
2104 - Repl : STRING; // Replacement  
2105 - BEGIN  
2106 - IF Str = '' THEN EXIT;  
2107 - Start := 1;  
2108 - REPEAT  
2109 - PAmp := StrPos (PChar (Str)+Start-1, '%');  
2110 - IF PAmp = NIL THEN BREAK;  
2111 - PSemi := StrScan (PAmp+2, ';');  
2112 - IF PSemi = NIL THEN BREAK;  
2113 - PosAmp := PAmp - PChar (Str) + 1;  
2114 - Len := PSemi-PAmp+1;  
2115 - Entity := TEntityDef (ParEntities.Node (Copy (Str, PosAmp+1, Len-2)));  
2116 - IF Entity <> NIL THEN BEGIN  
2117 - Repl := Entity.Value;  
2118 - ReplaceEntities (Repl); // Recursion  
2119 - END  
2120 - ELSE  
2121 - Repl := Copy (Str, PosAmp, Len);  
2122 - Delete (Str, PosAmp, Len);  
2123 - Insert (Repl, Str, PosAmp);  
2124 - Start := PosAmp + Length (Repl);  
2125 - UNTIL FALSE;  
2126 - END;  
2127 -BEGIN  
2128 - ReplaceEntities (Str);  
2129 -END;  
2130 -  
2131 -  
2132 -PROCEDURE TXmlParser.ReplaceGeneralEntities (VAR Str : STRING);  
2133 - // Recursively replaces General Entity References in the String  
2134 - PROCEDURE ReplaceEntities (VAR Str : STRING);  
2135 - VAR  
2136 - Start : INTEGER;  
2137 - PAmp : PChar;  
2138 - PSemi : PChar;  
2139 - PosAmp : INTEGER;  
2140 - Len : INTEGER;  
2141 - EntityDef : TEntityDef;  
2142 - EntName : STRING;  
2143 - Repl : STRING; // Replacement  
2144 - ExternalEntity : TXmlParser;  
2145 - BEGIN  
2146 - IF Str = '' THEN EXIT;  
2147 - Start := 1;  
2148 - REPEAT  
2149 - PAmp := StrPos (PChar (Str)+Start-1, '&');  
2150 - IF PAmp = NIL THEN BREAK;  
2151 - PSemi := StrScan (PAmp+2, ';');  
2152 - IF PSemi = NIL THEN BREAK;  
2153 - PosAmp := PAmp - PChar (Str) + 1;  
2154 - Len := PSemi-PAmp+1;  
2155 - EntName := Copy (Str, PosAmp+1, Len-2);  
2156 - IF EntName = 'lt' THEN Repl := '<'  
2157 - ELSE IF EntName = 'gt' THEN Repl := '>'  
2158 - ELSE IF EntName = 'amp' THEN Repl := '&'  
2159 - ELSE IF EntName = 'apos' THEN Repl := ''''  
2160 - ELSE IF EntName = 'quot' THEN Repl := '"'  
2161 - ELSE BEGIN  
2162 - EntityDef := TEntityDef (Entities.Node (EntName));  
2163 - IF EntityDef <> NIL THEN BEGIN  
2164 - IF EntityDef.Value <> '' THEN // Internal Entity  
2165 - Repl := EntityDef.Value  
2166 - ELSE BEGIN // External Entity  
2167 - ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);  
2168 - Repl := StrPas (ExternalEntity.DocBuffer); // !!! What if it contains a Text Declaration?  
2169 - ExternalEntity.Free;  
2170 - END;  
2171 - ReplaceEntities (Repl); // Recursion  
2172 - END  
2173 - ELSE  
2174 - Repl := Copy (Str, PosAmp, Len);  
2175 - END;  
2176 - Delete (Str, PosAmp, Len);  
2177 - Insert (Repl, Str, PosAmp);  
2178 - Start := PosAmp + Length (Repl);  
2179 - UNTIL FALSE;  
2180 - END;  
2181 -BEGIN  
2182 - ReplaceEntities (Str);  
2183 -END;  
2184 -  
2185 -  
2186 -FUNCTION TXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;  
2187 - // This will be called whenever there is a Parsed External Entity or  
2188 - // the DTD External Subset to be parsed.  
2189 - // It has to create a TXmlParser instance and load the desired Entity.  
2190 - // This instance of LoadExternalEntity assumes that "SystemId" is a valid  
2191 - // file name (relative to the Document source) and loads this file using  
2192 - // the LoadFromFile method.  
2193 -VAR  
2194 - Filename : STRING;  
2195 -BEGIN  
2196 - // --- Convert System ID to complete filename  
2197 - Filename := StringReplace (SystemId, '/', '\', [rfReplaceAll]);  
2198 - IF Copy (FSource, 1, 1) <> '<' THEN  
2199 - IF (Copy (Filename, 1, 2) = '\\') OR (Copy (Filename, 2, 1) = ':') THEN  
2200 - // Already has an absolute Path  
2201 - ELSE BEGIN  
2202 - Filename := ExtractFilePath (FSource) + Filename;  
2203 - END;  
2204 -  
2205 - // --- Load the File  
2206 - Result := TXmlParser.Create;  
2207 - Result.LoadFromFile (Filename);  
2208 -END;  
2209 -  
2210 -  
2211 -FUNCTION TXmlParser.TranslateEncoding (CONST Source : STRING) : STRING;  
2212 - // The member variable "CurEncoding" always holds the name of the current  
2213 - // encoding, e.g. 'UTF-8' or 'ISO-8859-1'.  
2214 - // This virtual method "TranslateEncoding" is responsible for translating  
2215 - // the content passed in the "Source" parameter to the Encoding which  
2216 - // is expected by the application.  
2217 - // This instance of "TranlateEncoding" assumes that the Application expects  
2218 - // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1  
2219 - // encodings.  
2220 - // If you want your application to understand or create other encodings, you  
2221 - // override this function.  
2222 -BEGIN  
2223 - IF CurEncoding = 'UTF-8'  
2224 - THEN Result := Utf8ToAnsi (Source)  
2225 - ELSE Result := Source;  
2226 -END;  
2227 -  
2228 -  
2229 -PROCEDURE TXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);  
2230 - // This method is called for every element which is found in the DTD  
2231 - // declaration. The variant record TDtdElementRec is passed which  
2232 - // holds informations about the element.  
2233 - // You can override this function to handle DTD declarations.  
2234 - // Note that when you parse the same Document instance a second time,  
2235 - // the DTD will not get parsed again.  
2236 -BEGIN  
2237 -END;  
2238 -  
2239 -  
2240 -FUNCTION TXmlParser.GetDocBuffer: PChar;  
2241 - // Returns FBuffer or a pointer to a NUL char if Buffer is empty  
2242 -BEGIN  
2243 - IF FBuffer = NIL  
2244 - THEN Result := #0  
2245 - ELSE Result := FBuffer;  
2246 -END;  
2247 -  
2248 -  
2249 -(*$IFNDEF HAS_CONTNRS_UNIT  
2250 -===============================================================================================  
2251 -TObjectList  
2252 -===============================================================================================  
2253 -*)  
2254 -  
2255 -DESTRUCTOR TObjectList.Destroy;  
2256 -BEGIN  
2257 - Clear;  
2258 - SetCapacity(0);  
2259 - INHERITED Destroy;  
2260 -END;  
2261 -  
2262 -  
2263 -PROCEDURE TObjectList.Delete (Index : INTEGER);  
2264 -BEGIN  
2265 - IF (Index < 0) OR (Index >= Count) THEN EXIT;  
2266 - TObject (Items [Index]).Free;  
2267 - INHERITED Delete (Index);  
2268 -END;  
2269 -  
2270 -  
2271 -PROCEDURE TObjectList.Clear;  
2272 -BEGIN  
2273 - WHILE Count > 0 DO  
2274 - Delete (Count-1);  
2275 -END;  
2276 -  
2277 -(*$ENDIF *)  
2278 -  
2279 -(*  
2280 -===============================================================================================  
2281 -TNvpNode  
2282 ---------  
2283 -Node base class for the TNvpList  
2284 -===============================================================================================  
2285 -*)  
2286 -  
2287 -CONSTRUCTOR TNvpNode.Create (TheName, TheValue : STRING);  
2288 -BEGIN  
2289 - INHERITED Create;  
2290 - Name := TheName;  
2291 - Value := TheValue;  
2292 -END;  
2293 -  
2294 -  
2295 -(*  
2296 -===============================================================================================  
2297 -TNvpList  
2298 ---------  
2299 -A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5  
2300 -===============================================================================================  
2301 -*)  
2302 -  
2303 -PROCEDURE TNvpList.Add (Node : TNvpNode);  
2304 -VAR  
2305 - I : INTEGER;  
2306 -BEGIN  
2307 - FOR I := Count-1 DOWNTO 0 DO  
2308 - IF Node.Name > TNvpNode (Items [I]).Name THEN BEGIN  
2309 - Insert (I+1, Node);  
2310 - EXIT;  
2311 - END;  
2312 - Insert (0, Node);  
2313 -END;  
2314 -  
2315 -  
2316 -  
2317 -FUNCTION TNvpList.Node (Name : STRING) : TNvpNode;  
2318 - // Binary search for Node  
2319 -VAR  
2320 - L, H : INTEGER; // Low, High Limit  
2321 - T, C : INTEGER; // Test Index, Comparison result  
2322 - Last : INTEGER; // Last Test Index  
2323 -BEGIN  
2324 - IF Count=0 THEN BEGIN  
2325 - Result := NIL;  
2326 - EXIT;  
2327 - END;  
2328 -  
2329 - L := 0;  
2330 - H := Count;  
2331 - Last := -1;  
2332 - REPEAT  
2333 - T := (L+H) DIV 2;  
2334 - IF T=Last THEN BREAK;  
2335 - Result := TNvpNode (Items [T]);  
2336 - C := CompareStr (Result.Name, Name);  
2337 - IF C = 0 THEN EXIT  
2338 - ELSE IF C < 0 THEN L := T  
2339 - ELSE H := T;  
2340 - Last := T;  
2341 - UNTIL FALSE;  
2342 - Result := NIL;  
2343 -END;  
2344 -  
2345 -  
2346 -FUNCTION TNvpList.Node (Index : INTEGER) : TNvpNode;  
2347 -BEGIN  
2348 - IF (Index < 0) OR (Index >= Count)  
2349 - THEN Result := NIL  
2350 - ELSE Result := TNvpNode (Items [Index]);  
2351 -END;  
2352 -  
2353 -  
2354 -FUNCTION TNvpList.Value (Name : STRING) : STRING;  
2355 -VAR  
2356 - Nvp : TNvpNode;  
2357 -BEGIN  
2358 - Nvp := TNvpNode (Node (Name));  
2359 - IF Nvp <> NIL  
2360 - THEN Result := Nvp.Value  
2361 - ELSE Result := '';  
2362 -END;  
2363 -  
2364 -  
2365 -FUNCTION TNvpList.Value (Index : INTEGER) : STRING;  
2366 -BEGIN  
2367 - IF (Index < 0) OR (Index >= Count)  
2368 - THEN Result := ''  
2369 - ELSE Result := TNvpNode (Items [Index]).Value;  
2370 -END;  
2371 -  
2372 -  
2373 -FUNCTION TNvpList.Name (Index : INTEGER) : STRING;  
2374 -BEGIN  
2375 - IF (Index < 0) OR (Index >= Count)  
2376 - THEN Result := ''  
2377 - ELSE Result := TNvpNode (Items [Index]).Name;  
2378 -END;  
2379 -  
2380 -  
2381 -(*  
2382 -===============================================================================================  
2383 -TAttrList  
2384 -List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer.  
2385 -Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo"  
2386 -attributes in XML Prologs, Text Declarations and PIs.  
2387 -===============================================================================================  
2388 -*)  
2389 -  
2390 -PROCEDURE TAttrList.Analyze (Start : PChar; VAR Final : PChar);  
2391 - // Analyze the Buffer for Attribute=Name pairs.  
2392 - // Terminates when there is a character which is not IN CNameStart  
2393 - // (e.g. '?>' or '>' or '/>')  
2394 -TYPE  
2395 - TPhase = (phName, phEq, phValue);  
2396 -VAR  
2397 - Phase : TPhase;  
2398 - F : PChar;  
2399 - Name : STRING;  
2400 - Value : STRING;  
2401 - Attr : TAttr;  
2402 -BEGIN  
2403 - Clear;  
2404 - Phase := phName;  
2405 - Final := Start;  
2406 - REPEAT  
2407 - IF (Final^ = #0) OR (Final^ = '>') THEN BREAK;  
2408 - IF NOT (Final^ IN CWhitespace) THEN  
2409 - CASE Phase OF  
2410 - phName : BEGIN  
2411 - IF NOT (Final^ IN CNameStart) THEN EXIT;  
2412 - ExtractName (Final, CWhitespace + ['=', '/'], F);  
2413 - SetStringSF (Name, Final, F);  
2414 - Final := F;  
2415 - Phase := phEq;  
2416 - END;  
2417 - phEq : BEGIN  
2418 - IF Final^ = '=' THEN  
2419 - Phase := phValue  
2420 - END;  
2421 - phValue : BEGIN  
2422 - IF Final^ IN CQuoteChar THEN BEGIN  
2423 - ExtractQuote (Final, Value, F);  
2424 - Attr := TAttr.Create;  
2425 - Attr.Name := Name;  
2426 - Attr.Value := Value;  
2427 - Attr.ValueType := vtNormal;  
2428 - Add (Attr);  
2429 - Final := F;  
2430 - Phase := phName;  
2431 - END;  
2432 - END;  
2433 - END;  
2434 - INC (Final);  
2435 - UNTIL FALSE;  
2436 -END;  
2437 -  
2438 -  
2439 -(*  
2440 -===============================================================================================  
2441 -TElemList  
2442 -List of TElemDef nodes.  
2443 -===============================================================================================  
2444 -*)  
2445 -  
2446 -FUNCTION TElemList.Node (Name : STRING) : TElemDef;  
2447 - // Binary search for the Node with the given Name  
2448 -VAR  
2449 - L, H : INTEGER; // Low, High Limit  
2450 - T, C : INTEGER; // Test Index, Comparison result  
2451 - Last : INTEGER; // Last Test Index  
2452 -BEGIN  
2453 - IF Count=0 THEN BEGIN  
2454 - Result := NIL;  
2455 - EXIT;  
2456 - END;  
2457 -  
2458 - L := 0;  
2459 - H := Count;  
2460 - Last := -1;  
2461 - REPEAT  
2462 - T := (L+H) DIV 2;  
2463 - IF T=Last THEN BREAK;  
2464 - Result := TElemDef (Items [T]);  
2465 - C := CompareStr (Result.Name, Name);  
2466 - IF C = 0 THEN EXIT  
2467 - ELSE IF C < 0 THEN L := T  
2468 - ELSE H := T;  
2469 - Last := T;  
2470 - UNTIL FALSE;  
2471 - Result := NIL;  
2472 -END;  
2473 -  
2474 -  
2475 -PROCEDURE TElemList.Add (Node : TElemDef);  
2476 -VAR  
2477 - I : INTEGER;  
2478 -BEGIN  
2479 - FOR I := Count-1 DOWNTO 0 DO  
2480 - IF Node.Name > TElemDef (Items [I]).Name THEN BEGIN  
2481 - Insert (I+1, Node);  
2482 - EXIT;  
2483 - END;  
2484 - Insert (0, Node);  
2485 -END;  
2486 -  
2487 -  
2488 -(*  
2489 -===============================================================================================  
2490 -TScannerXmlParser  
2491 -A TXmlParser descendant for the TCustomXmlScanner component  
2492 -===============================================================================================  
2493 -*)  
2494 -  
2495 -TYPE  
2496 - TScannerXmlParser = CLASS (TXmlParser)  
2497 - Scanner : TCustomXmlScanner;  
2498 - CONSTRUCTOR Create (TheScanner : TCustomXmlScanner);  
2499 - FUNCTION LoadExternalEntity (SystemId, PublicId,  
2500 - Notation : STRING) : TXmlParser; OVERRIDE;  
2501 - FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; OVERRIDE;  
2502 - PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); OVERRIDE;  
2503 - END;  
2504 -  
2505 -CONSTRUCTOR TScannerXmlParser.Create (TheScanner : TCustomXmlScanner);  
2506 -BEGIN  
2507 - INHERITED Create;  
2508 - Scanner := TheScanner;  
2509 -END;  
2510 -  
2511 -  
2512 -FUNCTION TScannerXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;  
2513 -BEGIN  
2514 - IF Assigned (Scanner.FOnLoadExternal)  
2515 - THEN Scanner.FOnLoadExternal (Scanner, SystemId, PublicId, Notation, Result)  
2516 - ELSE Result := INHERITED LoadExternalEntity (SystemId, PublicId, Notation);  
2517 -END;  
2518 -  
2519 -  
2520 -FUNCTION TScannerXmlParser.TranslateEncoding (CONST Source : STRING) : STRING;  
2521 -BEGIN  
2522 - IF Assigned (Scanner.FOnTranslateEncoding)  
2523 - THEN Result := Scanner.FOnTranslateEncoding (Scanner, CurEncoding, Source)  
2524 - ELSE Result := INHERITED TranslateEncoding (Source);  
2525 -END;  
2526 -  
2527 -  
2528 -PROCEDURE TScannerXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);  
2529 -BEGIN  
2530 - WITH DtdElementRec DO  
2531 - CASE ElementType OF  
2532 - deElement : Scanner.WhenElement (ElemDef);  
2533 - deAttList : Scanner.WhenAttList (ElemDef);  
2534 - deEntity : Scanner.WhenEntity (EntityDef);  
2535 - deNotation : Scanner.WhenNotation (NotationDef);  
2536 - dePI : Scanner.WhenPI (STRING (Target), STRING (Content), AttrList);  
2537 - deComment : Scanner.WhenComment (StrSFPas (Start, Final));  
2538 - deError : Scanner.WhenDtdError (Pos);  
2539 - END;  
2540 -END;  
2541 -  
2542 -  
2543 -(*  
2544 -===============================================================================================  
2545 -TCustomXmlScanner  
2546 -===============================================================================================  
2547 -*)  
2548 -  
2549 -CONSTRUCTOR TCustomXmlScanner.Create (AOwner: TComponent);  
2550 -BEGIN  
2551 - INHERITED;  
2552 - FXmlParser := TScannerXmlParser.Create (Self);  
2553 -END;  
2554 -  
2555 -  
2556 -DESTRUCTOR TCustomXmlScanner.Destroy;  
2557 -BEGIN  
2558 - FXmlParser.Free;  
2559 - INHERITED;  
2560 -END;  
2561 -  
2562 -  
2563 -PROCEDURE TCustomXmlScanner.LoadFromFile (Filename : TFilename);  
2564 - // Load XML Document from file  
2565 -BEGIN  
2566 - FXmlParser.LoadFromFile (Filename);  
2567 -END;  
2568 -  
2569 -  
2570 -PROCEDURE TCustomXmlScanner.LoadFromBuffer (Buffer : PChar);  
2571 - // Load XML Document from buffer  
2572 -BEGIN  
2573 - FXmlParser.LoadFromBuffer (Buffer);  
2574 -END;  
2575 -  
2576 -  
2577 -PROCEDURE TCustomXmlScanner.SetBuffer (Buffer : PChar);  
2578 - // Refer to Buffer  
2579 -BEGIN  
2580 - FXmlParser.SetBuffer (Buffer);  
2581 -END;  
2582 -  
2583 -  
2584 -FUNCTION TCustomXmlScanner.GetFilename : TFilename;  
2585 -BEGIN  
2586 - Result := FXmlParser.Source;  
2587 -END;  
2588 -  
2589 -  
2590 -FUNCTION TCustomXmlScanner.GetNormalize : BOOLEAN;  
2591 -BEGIN  
2592 - Result := FXmlParser.Normalize;  
2593 -END;  
2594 -  
2595 -  
2596 -PROCEDURE TCustomXmlScanner.SetNormalize (Value : BOOLEAN);  
2597 -BEGIN  
2598 - FXmlParser.Normalize := Value;  
2599 -END;  
2600 -  
2601 -  
2602 -PROCEDURE TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN);  
2603 - // Is called when the parser has parsed the <? xml ?> declaration of the prolog  
2604 -BEGIN  
2605 - IF Assigned (FOnXmlProlog) THEN FOnXmlProlog (Self, XmlVersion, Encoding, Standalone);  
2606 -END;  
2607 -  
2608 -  
2609 -PROCEDURE TCustomXmlScanner.WhenComment (Comment : STRING);  
2610 - // Is called when the parser has parsed a <!-- comment -->  
2611 -BEGIN  
2612 - IF Assigned (FOnComment) THEN FOnComment (Self, Comment);  
2613 -END;  
2614 -  
2615 -  
2616 -PROCEDURE TCustomXmlScanner.WhenPI (Target, Content: STRING; Attributes : TAttrList);  
2617 - // Is called when the parser has parsed a <?processing instruction ?>  
2618 -BEGIN  
2619 - IF Assigned (FOnPI) THEN FOnPI (Self, Target, Content, Attributes);  
2620 -END;  
2621 -  
2622 -  
2623 -PROCEDURE TCustomXmlScanner.WhenDtdRead (RootElementName : STRING);  
2624 - // Is called when the parser has completely parsed the DTD  
2625 -BEGIN  
2626 - IF Assigned (FOnDtdRead) THEN FOnDtdRead (Self, RootElementName);  
2627 -END;  
2628 -  
2629 -  
2630 -PROCEDURE TCustomXmlScanner.WhenStartTag (TagName : STRING; Attributes : TAttrList);  
2631 - // Is called when the parser has parsed a start tag like <p>  
2632 -BEGIN  
2633 - IF Assigned (FOnStartTag) THEN FOnStartTag (Self, TagName, Attributes);  
2634 -END;  
2635 -  
2636 -  
2637 -PROCEDURE TCustomXmlScanner.WhenEmptyTag (TagName : STRING; Attributes : TAttrList);  
2638 - // Is called when the parser has parsed an Empty Element Tag like <br/>  
2639 -BEGIN  
2640 - IF Assigned (FOnEmptyTag) THEN FOnEmptyTag (Self, TagName, Attributes);  
2641 -END;  
2642 -  
2643 -  
2644 -PROCEDURE TCustomXmlScanner.WhenEndTag (TagName : STRING);  
2645 - // Is called when the parser has parsed an End Tag like </p>  
2646 -BEGIN  
2647 - IF Assigned (FOnEndTag) THEN FOnEndTag (Self, TagName);  
2648 -END;  
2649 -  
2650 -  
2651 -PROCEDURE TCustomXmlScanner.WhenContent (Content : STRING);  
2652 - // Is called when the parser has parsed an element's text content  
2653 -BEGIN  
2654 - IF Assigned (FOnContent) THEN FOnContent (Self, Content);  
2655 -END;  
2656 -  
2657 -  
2658 -PROCEDURE TCustomXmlScanner.WhenCData (Content : STRING);  
2659 - // Is called when the parser has parsed a CDATA section  
2660 -BEGIN  
2661 - IF Assigned (FOnCData) THEN FOnCData (Self, Content);  
2662 -END;  
2663 -  
2664 -  
2665 -PROCEDURE TCustomXmlScanner.WhenElement (ElemDef : TElemDef);  
2666 - // Is called when the parser has parsed an <!ELEMENT> definition  
2667 - // inside the DTD  
2668 -BEGIN  
2669 - IF Assigned (FOnElement) THEN FOnElement (Self, ElemDef);  
2670 -END;  
2671 -  
2672 -  
2673 -PROCEDURE TCustomXmlScanner.WhenAttList (ElemDef : TElemDef);  
2674 - // Is called when the parser has parsed an <!ATTLIST> definition  
2675 - // inside the DTD  
2676 -BEGIN  
2677 - IF Assigned (FOnAttList) THEN FOnAttList (Self, ElemDef);  
2678 -END;  
2679 -  
2680 -  
2681 -PROCEDURE TCustomXmlScanner.WhenEntity (EntityDef : TEntityDef);  
2682 - // Is called when the parser has parsed an <!ENTITY> definition  
2683 - // inside the DTD  
2684 -BEGIN  
2685 - IF Assigned (FOnEntity) THEN FOnEntity (Self, EntityDef);  
2686 -END;  
2687 -  
2688 -  
2689 -PROCEDURE TCustomXmlScanner.WhenNotation (NotationDef : TNotationDef);  
2690 - // Is called when the parser has parsed a <!NOTATION> definition  
2691 - // inside the DTD  
2692 -BEGIN  
2693 - IF Assigned (FOnNotation) THEN FOnNotation (Self, NotationDef);  
2694 -END;  
2695 -  
2696 -  
2697 -PROCEDURE TCustomXmlScanner.WhenDtdError (ErrorPos : PChar);  
2698 - // Is called when the parser has found an Error in the DTD  
2699 -BEGIN  
2700 - IF Assigned (FOnDtdError) THEN FOnDtdError (Self, ErrorPos);  
2701 -END;  
2702 -  
2703 -  
2704 -PROCEDURE TCustomXmlScanner.Execute;  
2705 - // Perform scanning  
2706 - // Scanning is done synchronously, i.e. you can expect events to be triggered  
2707 - // in the order of the XML data stream. Execute will finish when the whole XML  
2708 - // document has been scanned or when the StopParser property has been set to TRUE.  
2709 -BEGIN  
2710 - FStopParser := FALSE;  
2711 - FXmlParser.StartScan;  
2712 - WHILE FXmlParser.Scan AND (NOT FStopParser) DO  
2713 - CASE FXmlParser.CurPartType OF  
2714 - ptNone : ;  
2715 - ptXmlProlog : WhenXmlProlog (FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone);  
2716 - ptComment : WhenComment (StrSFPas (FXmlParser.CurStart, FXmlParser.CurFinal));  
2717 - ptPI : WhenPI (FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr);  
2718 - ptDtdc : WhenDtdRead (FXmlParser.RootName);  
2719 - ptStartTag : WhenStartTag (FXmlParser.CurName, FXmlParser.CurAttr);  
2720 - ptEmptyTag : WhenEmptyTag (FXmlParser.CurName, FXmlParser.CurAttr);  
2721 - ptEndTag : WhenEndTag (FXmlParser.CurName);  
2722 - ptContent : WhenContent (FXmlParser.CurContent);  
2723 - ptCData : WhenCData (FXmlParser.CurContent);  
2724 - END;  
2725 -END;  
2726 -  
2727 -  
2728 -END.  
mapa/acesso.ddp
View file @2c54a33
No preview for this file type
mapa/acesso.dfm
View file @2c54a33
@@ -1,309 +0,0 @@ @@ -1,309 +0,0 @@
1 -object frmAcesso: TfrmAcesso  
2 - Left = 301  
3 - Top = 147  
4 - BorderIcons = []  
5 - BorderStyle = bsSingle  
6 - Caption =  
7 - 'MapaCacic - M'#243'dulo Avulso para Coleta de Informa'#231#245'es Patrimoniai' +  
8 - 's'  
9 - ClientHeight = 284  
10 - ClientWidth = 605  
11 - Color = clBtnFace  
12 - Font.Charset = DEFAULT_CHARSET  
13 - Font.Color = clWindowText  
14 - Font.Height = -11  
15 - Font.Name = 'MS Sans Serif'  
16 - Font.Style = []  
17 - Icon.Data = {  
18 - 0000010001003232000001000800E00F00001600000028000000320000006400  
19 - 00000100080000000000B80B0000000000000000000000010000000000000000  
20 - 0000FFFFFF006699FF0099FFFF0066FFFF000033FF00002BD70000156A001534  
21 - 380065CA320063C6310052A529004B9625002C59160066CC330066CB330060C0  
22 - 30005DBA2F0059B12D00376D1C004589240059B233001A350F003C77240054A8  
23 - 370034672200234618001E3B150050A23C00478A37000F1E0C004F9940001223  
24 - 0F00315D2A00152A1200539E4A003D7238002A5028001223130026462800438E  
25 - 49000E1C10003F874B003A7E4600326D3D00101F130068BD7B00457C57006BC0  
26 - 8A00294935006FC395000B16120012231D001B413500357B680074C7B0002851  
27 - 47001B4239000E1B18006AB4AA007BD0C400183E3B000F2524007FD5D2008BE9  
28 - E70088E4E30086E0DE00183E3E004FC8C8003D9A9A00193F3F001C4444001C41  
29 - 41001F4545001E3B3B0097FDFD0095FAFA008EEEEE008CEBEB0087E2E20081D8  
30 - D8005D9C9C003B63630098FEFE0093F5F50090F0F00079CACA006BB3B300416C  
31 - 6C0047757500122E2F00235455006FBBBF004D8285004A7C7F0015353800538D  
32 - 94003255590060A2A900416F76002B494D0050878E002C6D79001526290078CB  
33 - D8004D8590001C30350031C4F60033CCFF0033CAFD0032C5F80031BFF10031B8  
34 - EA0032B0E400296781001E36400032AADD0013354400508EAA004E89A3001E34  
35 - 3E0033A1D50035A5DA005CA3C800369AD00030566A0061ACD5003892CA000409  
36 - 0C00569BC600368BC2000E1A220027475D00223F55000B263D001D4F78003C89  
37 - C500060C1100549BD5001F394E004F92CC00235A8E004388CD00285B99004688  
38 - D6004989D200335E93001E324900030C180010315B0018315100071934003369  
39 - B500020407003E7ED600152A4800080E17004F88D8004D85D300548DE1001444  
40 - 96005A8EE9005C90EC000C131F005E92F000141F33001145AD00010204000305  
41 - 09000E1625001B2A47000D1422000B111D00111A2C000F1727001E2E4D004A70  
42 - BC003956910036528900273B63006598FE006395F9006295F7006192F4006090  
43 - F1005E8EED005B8AE500517ACC004C73C000486CB500466AB1004264A7004162  
44 - A4004060A1006597FD006496FA005E8DEB005D8BE9005A87E1005985DF005782  
45 - DA00547ED2004E75C3004466AA003F5E9D00354F8400324B7D002C426E002A3F  
46 - 690024365A0022335500203050001A2741003C5A95000A0F1A00162138002639  
47 - 60004F76C6004567AD000E3288000F2B70000938B900040D2400184AD2000736  
48 - C50002030600032BBF000837D7000629A7000032FE000031FD000031F9000031  
49 - F5000030F100002FEB00002CDF000029D0000028C8000026BF000024B600001E  
50 - 9800001D9300001A880000187D0000156C0000156B0000146400000E4900000A  
51 - 3500000724000230E3000534E60000051D0001092D0000000100FFFFFF000000  
52 - 0000F9FC00000000000000000000000000000000000000000000000000000000  
53 - 00000000000000000000FC0000000000000000000000F6F60000000000000000  
54 - 000000000000000000000000000000000000000000000000000000000000F0F8  
55 - 000000000000000000FDE8E7F800000000000000000000000000000000000000  
56 - 0000000000000000000000000000000000F705EBF900000000000000F9ED0505  
57 - ECF9000000000000000000000000000000000000000000000000000000000000  
58 - 00000000FDE90505F100000000000000F605050505F800000000000000000000  
59 - 000000000000000000000000000000000000000000000000F7050505E5F80000  
60 - 000000F9EA05050505F600000000000000000000000000000000000000000000  
61 - 000000000000000000000000E4E5050505EE0000000000F705050505E5EE0000  
62 - 00000000000000000000000000000000000000000000000000000000000000FD  
63 - E905050505E5FD00000000A5DCEAE5E6EAEFDE00000000000000000000000000  
64 - 00000000000000000000000000000000000000DEEDE8050506DCA30000008057  
65 - 5096EBDB7D626A00000000000000000000000000000000000000000000000000  
66 - 0000000000000064608BE2E2844E630000008356034D96840303640000000000  
67 - 0000000000000000ABAEAEAEAE00000000000000000000000000005D034C9B85  
68 - 4C036000000083500303424F0303630000000000000000ABA5CFD5BDBBC5B4B7  
69 - C8BCC0CDAAA90000000000000000995703535655030362000000805703030303  
70 - 03035E0000000000A9D7B1BA02020202020202020202020202B5BDD2AE000000  
71 - 0000895C0303030303036300000000614B030303030364000000A3D3C6020202  
72 - 02020202020202020202020202020202C3B1A900000000605303030303546A00  
73 - 0000001E314F030303503300D6A5BB0202020202020202020202B70202020202  
74 - 020202020202B8CFAB0000344D030353562720000000002012275603572720A3  
75 - C102020202020202020202B9D5D2B3D1CFBD02020202020202020202C7A5001E  
76 - 3150033B250B290000000080170A2531171433CAC3020202020202020202C7D3  
77 - BCB40202C4D5B3B70202020202020202C2B7D4290B2138190F1A000000000000  
78 - 2914091A091BB09F7C8E0202020202020202D3B9020202020202BBB302020202  
79 - 020202B67F7FA2AE190E110E1020000000000000AD515959A226A19E716D7FB5  
80 - 0202020202D9B10202020202020202CCBF0202020202A47C6C799DB720090E0F  
81 - 1A000000000000AE5D593B5159B7717C9E746C7CA40202020202C20202020202  
82 - 02020202B502020202A17A6C7C9D747A93190919330000000000AB5159BD5157  
83 - 5159C36C7A9E796C79A10202020202020202020202020202020202029F716C7F  
84 - 9D716D88B5261334A300000000006F6590D9BD513B5159B46C719E7C6C79A102  
85 - 0202020202020202020202020202029D706D88916F6B88B402BD3A02CDAC0000  
86 - 00006F6F6F9FBCBD513B5159026D7091828E0202020202020202020202020202  
87 - 020202C288888E6B6F8E02020202020202CF00000000006F6F6E9F9ADA515751  
88 - 59B46B74BA02020202020202020202020202020202020202029E6F7091020202  
89 - 020202020202D3000000AEC26F6F029F9ABD51575159029D0202020202020202  
90 - 02020202020202020202020202028E9D02020202020202020202C6AE0000A502  
91 - 026F6D6F9FD9BD513B5159020202020202020202020202020202020202020202  
92 - 020202020202020202020202020202D70000ADB4026F6F686E9FD9BD51575102  
93 - 0202020202020202020202020202020202020202020202020202020202020202  
94 - 020202AD000000C002026F6F6F027A9ABD513B59BAC8C9D9B0BDDABA02020202  
95 - 020202BADABDB0D9C9C8BAB8B4020202020202020202BED6000000A3C002026F  
96 - 6F6F6E9FD9BD3B5159B1CCBFBEBDBC020202020202020202BCBDBEBFCCB1B2CC  
97 - B502020202020202B9D8AC00000000009CB802026F6F6C027A9A515751020202  
98 - 02020202020202020202020202020202020202020202020202020202AA000000  
99 - 00000000FED4BFB9026F6C6FA4BCBD5151510259595959595959595902020202  
100 - 02020202020202020202020202C3CAD0E1000000000000000000FED6A5D20268  
101 - 6EB9D951515159595959595959595959595902020202020202020202B9BBC1D0  
102 - D4AB9900000000000000000000000000000000026F6F56513B5759595900320F  
103 - 00000059595959C1B1CECFD8D2AAA5A9D6A80000000000000000000000000000  
104 - 0000000000000000026F6F6F59595959000F0F0F000000000059595900000000  
105 - 0000000000000000000000000000000000000000000000000000000000006F6F  
106 - 5959590000000000000000000000595959000000000000000000000000000000  
107 - 0000000000000000000000000000000000000059595906060606060606060606  
108 - 0606065959590000000000000000000000000000000000000000000000000000  
109 - 00000000000000595906060F0F0F060606060606060606065959000000000000  
110 - 0000000000000000000000000000000000FD070707070707070759595906060F  
111 - 0F06060606060606060606062E5959070707070707070707070707F4FC000000  
112 - 0000000000F8EF06060606060606595959060F0F060606060606060606060606  
113 - 0F5959060606060606060606060606F100000000000000000000945A08080808  
114 - 0859590000000000000F0F0F0000000000000000005959080808080808080808  
115 - 085F3E0000000000000000000000005A4404040404595932033204040F0F0404  
116 - 040404040404040404595904040404040404040404455A000000000000000000  
117 - 000000008646354748595905030332320F3204323204040404040404042F5949  
118 - 4375393D49467535474A0000000000000000000000000000EE95175864595959  
119 - 0503560F0F04323204040404040404042E59595E78F10D1651DEF11400570000  
120 - 000000000000000000000000E8A0103762E65959050556033232320432043204  
121 - 040415153259123F77E52B1D038FE91F1F0300000000000000000000000000EF  
122 - 05E00A304CE3595959055603032E2E2E2E0505050505151559590F3250EA7211  
123 - 42810536184B57000000000000000000000000EE05FA112E03DFDD5959055603  
124 - 03012E2E2E0505050505153259E00E324DFA8D093C7B056615555C0000000000  
125 - 00000000000000EE05E9152E03DFE0595959560303322E2E2E3205050505322E  
126 - 59E009304CE38D0F377E057211415C000000000000000000000000EF05E00932  
127 - 4EFBA60E59595903032E2E2E2E3205050505595959A60E3768E76615558C0536  
128 - 184B570000000000000000000000000005A00A375C058711405959592E2E2E2E  
129 - 2E05050559595959058712407B052A1C0398E81C230300000000000000000000  
130 - 0000000006380C5669EB2C143F8D5959592E2E2E2E32595959593F65EB2C143F  
131 - 92ED0B2442E4EF122F5600000000000000000000000000000700005800070000  
132 - 5800000D5959595959595959000059000700005800000D005800000D00000000  
133 - 000000000000F3FFFFFFFFF7C000F3FFFFFFFFF3C000E1FFFFFFFFE1C000C0FF  
134 - FFFFFFC1C000C0FFFFFFFFC0C00080FFFFFFFFC0C00080FFFFFFFF804000807F  
135 - FFFFFF804000007FFFFFFF804000007FFC1FFF804000007F8000FF004000007C  
136 - 00001F0040008070000007804000804000000180400080000000008040008000  
137 - 00000000C000C00000000000C000C00000000001C000800000000001C0000000  
138 - 00000001C000000000000000C000000000000000C00080000000000040000000  
139 - 0000000000000000000000000000000000000000000080000000000000008000  
140 - 0000000040008000000000004000800000000000400080000000000040008000  
141 - 00000000C000C00000000000C000C00000000000C000C00000000001C000E000  
142 - 00000001C000E00000000001C000E00000000003C000F00000000007C000F800  
143 - 00000007C000FC000000000FC000FC000000002FC000FC000000000FC000F800  
144 - 00000007C000F80000000007C000F80000000007C000F80000000007C000FC00  
145 - 0000000FC000FC000000000FC000FDAD8035B5BFC000}  
146 - KeyPreview = True  
147 - OldCreateOrder = False  
148 - Position = poDesktopCenter  
149 - OnActivate = FormActivate  
150 - OnCreate = FormCreate  
151 - OnKeyDown = FormKeyDown  
152 - OnShow = FormShow  
153 - PixelsPerInch = 96  
154 - TextHeight = 13  
155 - object lbNomeServidorWEB: TLabel  
156 - Left = 0  
157 - Top = 272  
158 - Width = 300  
159 - Height = 12  
160 - AutoSize = False  
161 - Caption = 'Servidor de Aplica'#231#227'o: ABCDEFGHIJKLMNOP'  
162 - Font.Charset = DEFAULT_CHARSET  
163 - Font.Color = clWindowText  
164 - Font.Height = -9  
165 - Font.Name = 'Arial'  
166 - Font.Style = [fsBold]  
167 - ParentFont = False  
168 - end  
169 - object lbVersao: TLabel  
170 - Left = 303  
171 - Top = 272  
172 - Width = 300  
173 - Height = 12  
174 - Alignment = taRightJustify  
175 - AutoSize = False  
176 - Caption = 'Vers'#227'o: X.X.X.X'  
177 - Font.Charset = DEFAULT_CHARSET  
178 - Font.Color = clWindowText  
179 - Font.Height = -9  
180 - Font.Name = 'Arial'  
181 - Font.Style = []  
182 - ParentFont = False  
183 - end  
184 - object btAcesso: TButton  
185 - Left = 174  
186 - Top = 233  
187 - Width = 100  
188 - Height = 30  
189 - Caption = 'Acessar'  
190 - Default = True  
191 - Enabled = False  
192 - Font.Charset = DEFAULT_CHARSET  
193 - Font.Color = clWindowText  
194 - Font.Height = -13  
195 - Font.Name = 'Arial'  
196 - Font.Style = [fsBold]  
197 - ParentFont = False  
198 - TabOrder = 0  
199 - OnClick = btAcessoClick  
200 - end  
201 - object btCancela: TButton  
202 - Left = 330  
203 - Top = 233  
204 - Width = 100  
205 - Height = 30  
206 - Caption = 'Cancelar'  
207 - Font.Charset = DEFAULT_CHARSET  
208 - Font.Color = clWindowText  
209 - Font.Height = -13  
210 - Font.Name = 'Arial'  
211 - Font.Style = [fsBold]  
212 - ParentFont = False  
213 - TabOrder = 1  
214 - OnClick = btCancelaClick  
215 - end  
216 - object pnAcesso: TPanel  
217 - Left = 2  
218 - Top = 3  
219 - Width = 602  
220 - Height = 196  
221 - BevelInner = bvRaised  
222 - BevelOuter = bvLowered  
223 - TabOrder = 2  
224 - object lbNomeUsuarioAcesso: TLabel  
225 - Left = 56  
226 - Top = 39  
227 - Width = 109  
228 - Height = 16  
229 - Caption = 'Nome de Usu'#225'rio:'  
230 - Font.Charset = DEFAULT_CHARSET  
231 - Font.Color = clWindowText  
232 - Font.Height = -13  
233 - Font.Name = 'MS Sans Serif'  
234 - Font.Style = []  
235 - ParentFont = False  
236 - end  
237 - object lbSenhaAcesso: TLabel  
238 - Left = 394  
239 - Top = 39  
240 - Width = 110  
241 - Height = 16  
242 - Caption = 'Senha de Acesso:'  
243 - Font.Charset = DEFAULT_CHARSET  
244 - Font.Color = clWindowText  
245 - Font.Height = -13  
246 - Font.Name = 'MS Sans Serif'  
247 - Font.Style = []  
248 - ParentFont = False  
249 - end  
250 - object lbAviso: TLabel  
251 - Left = 4  
252 - Top = 121  
253 - Width = 593  
254 - Height = 13  
255 - Alignment = taCenter  
256 - AutoSize = False  
257 - Caption =  
258 - 'ATEN'#199#195'O: O usu'#225'rio deve estar cadastrado no Gerente WEB e deve t' +  
259 - 'er acesso PRIM'#193'RIO ou SECUND'#193'RIO a este local'  
260 - Font.Charset = DEFAULT_CHARSET  
261 - Font.Color = clNavy  
262 - Font.Height = -11  
263 - Font.Name = 'MS Sans Serif'  
264 - Font.Style = []  
265 - ParentFont = False  
266 - end  
267 - object edNomeUsuarioAcesso: TEdit  
268 - Left = 56  
269 - Top = 55  
270 - Width = 150  
271 - Height = 21  
272 - MaxLength = 20  
273 - TabOrder = 0  
274 - OnKeyUp = edNomeUsuarioAcessoKeyUp  
275 - end  
276 - object edSenhaAcesso: TEdit  
277 - Left = 394  
278 - Top = 55  
279 - Width = 150  
280 - Height = 21  
281 - PasswordChar = #1  
282 - TabOrder = 1  
283 - OnKeyUp = edSenhaAcessoKeyUp  
284 - end  
285 - end  
286 - object pnMensagens: TPanel  
287 - Left = 1  
288 - Top = 200  
289 - Width = 602  
290 - Height = 24  
291 - BevelInner = bvLowered  
292 - TabOrder = 3  
293 - object lbMsg_Erro_Senha: TLabel  
294 - Left = 3  
295 - Top = 4  
296 - Width = 589  
297 - Height = 17  
298 - Alignment = taCenter  
299 - AutoSize = False  
300 - end  
301 - end  
302 - object tm_Mensagem: TTimer  
303 - Enabled = False  
304 - Interval = 5000  
305 - OnTimer = tm_MensagemTimer  
306 - Left = 282  
307 - Top = 241  
308 - end  
309 -end  
mapa/acesso.pas
View file @2c54a33
@@ -1,249 +0,0 @@ @@ -1,249 +0,0 @@
1 -(**  
2 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
3 -Copyright 2000, 2001, 2002, 2003, 2004, 2005 Dataprev - Empresa de Tecnologia e Informações da Previdência Social, Brasil  
4 -  
5 -Este arquivo é parte do programa CACIC - Configurador Automático e Coletor de Informações Computacionais  
6 -  
7 -O CACIC é um software livre; você pode redistribui-lo e/ou modifica-lo dentro dos termos da Licença Pública Geral GNU como  
8 -publicada pela Fundação do Software Livre (FSF); na versão 2 da Licença, ou (na sua opinião) qualquer versão.  
9 -  
10 -Este programa é distribuido na esperança que possa ser util, mas SEM NENHUMA GARANTIA; sem uma garantia implicita de ADEQUAÇÂO a qualquer  
11 -MERCADO ou APLICAÇÃO EM PARTICULAR. Veja a Licença Pública Geral GNU para maiores detalhes.  
12 -  
13 -Você deve ter recebido uma cópia da Licença Pública Geral GNU, sob o título "LICENCA.txt", junto com este programa, se não, escreva para a Fundação do Software  
14 -Livre(FSF) Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA  
15 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
16 -*)  
17 -  
18 -unit acesso;  
19 -  
20 -interface  
21 -  
22 -uses  
23 - Windows,  
24 - Messages,  
25 - SysUtils,  
26 - Variants,  
27 - Classes,  
28 - Graphics,  
29 - Controls,  
30 - Forms,  
31 - StdCtrls,  
32 - ExtCtrls,  
33 - dialogs;  
34 -  
35 -type  
36 - TfrmAcesso = class(TForm)  
37 - btAcesso: TButton;  
38 - btCancela: TButton;  
39 - pnAcesso: TPanel;  
40 - lbNomeUsuarioAcesso: TLabel;  
41 - edNomeUsuarioAcesso: TEdit;  
42 - lbSenhaAcesso: TLabel;  
43 - edSenhaAcesso: TEdit;  
44 - pnMensagens: TPanel;  
45 - lbMsg_Erro_Senha: TLabel;  
46 - lbAviso: TLabel;  
47 - tm_Mensagem: TTimer;  
48 - lbNomeServidorWEB: TLabel;  
49 - lbVersao: TLabel;  
50 - procedure btAcessoClick(Sender: TObject);  
51 - procedure btCancelaClick(Sender: TObject);  
52 - procedure FormCreate(Sender: TObject);  
53 - procedure edNomeUsuarioAcessoKeyUp(Sender: TObject; var Key: Word;  
54 - Shift: TShiftState);  
55 - procedure FormShow(Sender: TObject);  
56 - procedure edSenhaAcessoKeyUp(Sender: TObject; var Key: Word;  
57 - Shift: TShiftState);  
58 - procedure tm_MensagemTimer(Sender: TObject);  
59 - procedure FormActivate(Sender: TObject);  
60 - Procedure VerificaVersao;  
61 - procedure FormKeyDown(Sender: TObject; var Key: Word;  
62 - Shift: TShiftState);  
63 - private  
64 - { Private declarations }  
65 - public  
66 - { Public declarations }  
67 - end;  
68 -  
69 -var  
70 - frmAcesso: TfrmAcesso;  
71 -  
72 -implementation  
73 -uses main_mapa;  
74 -{$R *.dfm}  
75 -  
76 -procedure TfrmAcesso.btAcessoClick(Sender: TObject);  
77 -var Request_mapa : TStringList;  
78 - strRetorno,  
79 - str_local_Aux : String;  
80 -begin  
81 - frmMapaCacic.boolAcessoOK := false;  
82 - Request_mapa:=TStringList.Create;  
83 -  
84 - lbMsg_Erro_Senha.Caption := str_local_Aux;  
85 -  
86 - // Envio dos dados ao DataBase...  
87 - Request_mapa.Values['nm_acesso'] := frmMapaCacic.g_oCacic.enCrypt(edNomeUsuarioAcesso.Text);  
88 - Request_mapa.Values['te_senha'] := frmMapaCacic.g_oCacic.EnCrypt(edSenhaAcesso.Text);  
89 - Request_mapa.Values['cs_MapaCacic'] := frmMapaCacic.g_oCacic.EnCrypt('S');  
90 - Request_mapa.Values['te_operacao'] := frmMapaCacic.g_oCacic.EnCrypt('Autentication');  
91 - Request_mapa.Values['te_versao_mapa'] := frmMapaCacic.g_oCacic.EnCrypt(frmMapaCacic.getVersionInfo(ParamStr(0)));  
92 -  
93 - strRetorno := frmMapaCacic.ComunicaServidor('mapa_acesso.php', Request_mapa, 'Autenticando o Acesso...');  
94 - Request_mapa.free;  
95 -  
96 - if (frmMapaCacic.XML_RetornaValor('STATUS', strRetorno)='OK') then  
97 - Begin  
98 - str_local_Aux := trim(frmMapaCacic.g_oCacic.deCrypt(frmMapaCacic.XML_RetornaValor('ID_USUARIO',strRetorno)));  
99 - if (str_local_Aux <> '') then  
100 - Begin  
101 - frmMapaCacic.strId_usuario := str_local_Aux;  
102 - str_local_Aux := '';  
103 - frmMapaCacic.boolAcessoOK := true; // Acesso OK!  
104 - End  
105 - else  
106 - Begin  
107 - str_local_Aux := 'Usuário/Senha incorretos ou Usuário sem Acesso Primário/Secundário a este local!';  
108 - End  
109 - End  
110 - else  
111 - Begin  
112 - str_local_Aux := 'Problemas na comunicação!';  
113 - End;  
114 -  
115 - lbMsg_Erro_Senha.Caption := str_local_Aux;  
116 -  
117 - if (frmMapaCacic.boolAcessoOK) then  
118 - Begin  
119 - lbAviso.Caption := 'USUÁRIO AUTENTICADO: "' + trim(frmMapaCacic.g_oCacic.deCrypt(frmMapaCacic.XML_RetornaValor('NM_USUARIO_COMPLETO',strRetorno)))+'"';  
120 - lbAviso.Font.Style := [fsBold];  
121 - lbAviso.Font.Color := clGreen;  
122 - Application.ProcessMessages;  
123 - Sleep(3000);  
124 - End  
125 - else  
126 - lbMsg_Erro_Senha.Font.Color := clRed;  
127 -  
128 - tm_Mensagem.Enabled := true;  
129 -  
130 - frmMapaCacic.log_diario(str_local_Aux);  
131 -  
132 - Application.ProcessMessages;  
133 -  
134 - if (frmMapaCacic.boolAcessoOK) then  
135 - self.Close  
136 - else  
137 - Begin  
138 - edNomeUsuarioAcesso.AutoSelect := false;  
139 - edNomeUsuarioAcesso.SetFocus;  
140 - End;  
141 -end;  
142 -  
143 -Procedure TfrmAcesso.VerificaVersao;  
144 -var Request_mapa : TStringList;  
145 - strRetorno,  
146 - strAUX : String;  
147 - boolVersaoOK : Boolean;  
148 -begin  
149 - boolVersaoOK := false;  
150 - Request_mapa:=TStringList.Create;  
151 -  
152 - // Envio dos dados ao DataBase...  
153 - Request_mapa.Values['cs_MapaCacic'] := frmMapaCacic.g_oCacic.EnCrypt('S');  
154 - Request_mapa.Values['te_operacao'] := frmMapaCacic.g_oCacic.EnCrypt('Autentication');  
155 - Request_mapa.Values['te_versao_mapa'] := frmMapaCacic.g_oCacic.EnCrypt(frmMapaCacic.getVersionInfo(ParamStr(0)));  
156 -  
157 - strRetorno := frmMapaCacic.ComunicaServidor('mapa_acesso.php', Request_mapa, 'Verificando Versão...');  
158 - Request_mapa.free;  
159 -  
160 - if (frmMapaCacic.XML_RetornaValor('STATUS', strRetorno)='OK') then  
161 - Begin  
162 - strAUX := trim(frmMapaCacic.g_oCacic.deCrypt(frmMapaCacic.XML_RetornaValor('TE_VERSAO_MAPA',strRetorno)));  
163 - if (strAUX = '') then  
164 - boolVersaoOK := true  
165 - else  
166 - MessageDLG(#13#10#13#10+'ATENÇÃO! Foi disponibilizada a versão "'+strAUX+'".'+#13#10#13#10+'Acesse o gerente cacic na opção "Repositório" e baixe o programa "MapaCACIC"!'+#13#10,mtWarning,[mbOK],0);  
167 - End  
168 - else  
169 - MessageDLG(#13#10#13#10+'ATENÇÃO! Há problema na comunicação com o módulo Gerente WEB.'+#13#10#13#10,mtWarning,[mbOK],0);  
170 -end;  
171 -  
172 -  
173 -procedure TfrmAcesso.btCancelaClick(Sender: TObject);  
174 -begin  
175 - lbMsg_Erro_Senha.Caption := 'Aguarde... Finalizando!';  
176 - Application.ProcessMessages;  
177 - Self.Close;  
178 - boolFinalizar := true;  
179 -end;  
180 -  
181 -procedure TfrmAcesso.FormCreate(Sender: TObject);  
182 -begin  
183 - intPausaPadrao := 3000; //(3 mil milisegundos = 3 segundos)  
184 - frmAcesso.lbVersao.Caption := 'Versão: ' + frmMapaCacic.GetVersionInfo(ParamStr(0));  
185 - frmMapaCacic.lbNomeServidorWEB.Caption := 'Servidor de Aplicação: '+frmMapaCacic.GetValorDatMemoria('Configs.EnderecoServidor', frmMapaCacic.tStringsMapaCACIC);  
186 - frmMapaCacic.lbMensagens.Caption := 'Entrada de Dados para Autenticação no Módulo Gerente WEB Cacic';  
187 - VerificaVersao;  
188 -end;  
189 -  
190 -procedure TfrmAcesso.edNomeUsuarioAcessoKeyUp(Sender: TObject;  
191 - var Key: Word; Shift: TShiftState);  
192 -begin  
193 - if not (trim(frmAcesso.edNomeUsuarioAcesso.Text) = '') and  
194 - not (trim(frmAcesso.edSenhaAcesso.Text) = '') then  
195 - frmAcesso.btAcesso.Enabled := true  
196 - else  
197 - frmAcesso.btAcesso.Enabled := false;  
198 -end;  
199 -  
200 -procedure TfrmAcesso.FormShow(Sender: TObject);  
201 -begin  
202 - frmAcesso.edNomeUsuarioAcesso.SetFocus;  
203 -end;  
204 -  
205 -procedure TfrmAcesso.edSenhaAcessoKeyUp(Sender: TObject; var Key: Word;  
206 - Shift: TShiftState);  
207 -begin  
208 - if not (trim(frmAcesso.edNomeUsuarioAcesso.Text) = '') and  
209 - not (trim(frmAcesso.edSenhaAcesso.Text) = '') then  
210 - frmAcesso.btAcesso.Enabled := true  
211 - else  
212 - frmAcesso.btAcesso.Enabled := false;  
213 -end;  
214 -  
215 -procedure TfrmAcesso.tm_MensagemTimer(Sender: TObject);  
216 -begin  
217 - tm_Mensagem.Enabled := false;  
218 - lbMsg_Erro_Senha.Caption := '';  
219 - lbMsg_Erro_Senha.Font.Color := clBlack;  
220 -end;  
221 -  
222 -procedure TfrmAcesso.FormActivate(Sender: TObject);  
223 -var strAux : String;  
224 -begin  
225 - strAux := 'Servidor de Aplicação: ' + frmMapaCacic.GetValorDatMemoria('Configs.EnderecoServidor', frmMapaCacic.tStringsMapaCACIC);  
226 - if not (strAux = '') then  
227 - Begin  
228 - frmAcesso.lbNomeServidorWEB.Caption := strAux;  
229 - End  
230 - else  
231 - Begin  
232 - frmMapaCacic.Mensagem('Favor verificar a instalação do Cacic.' +#13#10 + 'Não Existe Servidor de Aplicação configurado!',true,intPausaPadrao);  
233 - frmMapaCacic.Finalizar(true);  
234 - End;  
235 -end;  
236 -  
237 -procedure TfrmAcesso.FormKeyDown(Sender: TObject; var Key: Word;  
238 - Shift: TShiftState);  
239 -begin  
240 - IF (key = VK_RETURN) then  
241 - Begin  
242 - if (edNomeUsuarioAcesso.Focused) and (trim(edNomeUsuarioAcesso.Text) <> '') then  
243 - edSenhaAcesso.SetFocus  
244 - else if (edSenhaAcesso.Focused) and (trim(edSenhaAcesso.Text) <> '') then  
245 - btAcessoClick(nil);  
246 - End;  
247 -end;  
248 -  
249 -end.  
mapa/main_mapa.ddp
View file @2c54a33
No preview for this file type
mapa/main_mapa.dfm
View file @2c54a33
@@ -1,599 +0,0 @@ @@ -1,599 +0,0 @@
1 -object frmMapaCacic: TfrmMapaCacic  
2 - Left = 211  
3 - Top = 193  
4 - BorderIcons = [biSystemMenu]  
5 - BorderStyle = bsSingle  
6 - Caption =  
7 - 'MapaCacic - M'#243'dulo Avulso para Coleta de Informa'#231#245'es Patrimoniai' +  
8 - 's'  
9 - ClientHeight = 316  
10 - ClientWidth = 782  
11 - Color = clBtnFace  
12 - Font.Charset = DEFAULT_CHARSET  
13 - Font.Color = clWindowText  
14 - Font.Height = -9  
15 - Font.Name = 'MS Sans Serif'  
16 - Font.Style = []  
17 - Icon.Data = {  
18 - 0000010001003232000001000800E00F00001600000028000000320000006400  
19 - 00000100080000000000B80B0000000000000000000000010000000000000000  
20 - 0000FFFFFF006699FF0099FFFF0066FFFF000033FF00002BD70000156A001534  
21 - 380065CA320063C6310052A529004B9625002C59160066CC330066CB330060C0  
22 - 30005DBA2F0059B12D00376D1C004589240059B233001A350F003C77240054A8  
23 - 370034672200234618001E3B150050A23C00478A37000F1E0C004F9940001223  
24 - 0F00315D2A00152A1200539E4A003D7238002A5028001223130026462800438E  
25 - 49000E1C10003F874B003A7E4600326D3D00101F130068BD7B00457C57006BC0  
26 - 8A00294935006FC395000B16120012231D001B413500357B680074C7B0002851  
27 - 47001B4239000E1B18006AB4AA007BD0C400183E3B000F2524007FD5D2008BE9  
28 - E70088E4E30086E0DE00183E3E004FC8C8003D9A9A00193F3F001C4444001C41  
29 - 41001F4545001E3B3B0097FDFD0095FAFA008EEEEE008CEBEB0087E2E20081D8  
30 - D8005D9C9C003B63630098FEFE0093F5F50090F0F00079CACA006BB3B300416C  
31 - 6C0047757500122E2F00235455006FBBBF004D8285004A7C7F0015353800538D  
32 - 94003255590060A2A900416F76002B494D0050878E002C6D79001526290078CB  
33 - D8004D8590001C30350031C4F60033CCFF0033CAFD0032C5F80031BFF10031B8  
34 - EA0032B0E400296781001E36400032AADD0013354400508EAA004E89A3001E34  
35 - 3E0033A1D50035A5DA005CA3C800369AD00030566A0061ACD5003892CA000409  
36 - 0C00569BC600368BC2000E1A220027475D00223F55000B263D001D4F78003C89  
37 - C500060C1100549BD5001F394E004F92CC00235A8E004388CD00285B99004688  
38 - D6004989D200335E93001E324900030C180010315B0018315100071934003369  
39 - B500020407003E7ED600152A4800080E17004F88D8004D85D300548DE1001444  
40 - 96005A8EE9005C90EC000C131F005E92F000141F33001145AD00010204000305  
41 - 09000E1625001B2A47000D1422000B111D00111A2C000F1727001E2E4D004A70  
42 - BC003956910036528900273B63006598FE006395F9006295F7006192F4006090  
43 - F1005E8EED005B8AE500517ACC004C73C000486CB500466AB1004264A7004162  
44 - A4004060A1006597FD006496FA005E8DEB005D8BE9005A87E1005985DF005782  
45 - DA00547ED2004E75C3004466AA003F5E9D00354F8400324B7D002C426E002A3F  
46 - 690024365A0022335500203050001A2741003C5A95000A0F1A00162138002639  
47 - 60004F76C6004567AD000E3288000F2B70000938B900040D2400184AD2000736  
48 - C50002030600032BBF000837D7000629A7000032FE000031FD000031F9000031  
49 - F5000030F100002FEB00002CDF000029D0000028C8000026BF000024B600001E  
50 - 9800001D9300001A880000187D0000156C0000156B0000146400000E4900000A  
51 - 3500000724000230E3000534E60000051D0001092D0000000100FFFFFF000000  
52 - 0000F9FC00000000000000000000000000000000000000000000000000000000  
53 - 00000000000000000000FC0000000000000000000000F6F60000000000000000  
54 - 000000000000000000000000000000000000000000000000000000000000F0F8  
55 - 000000000000000000FDE8E7F800000000000000000000000000000000000000  
56 - 0000000000000000000000000000000000F705EBF900000000000000F9ED0505  
57 - ECF9000000000000000000000000000000000000000000000000000000000000  
58 - 00000000FDE90505F100000000000000F605050505F800000000000000000000  
59 - 000000000000000000000000000000000000000000000000F7050505E5F80000  
60 - 000000F9EA05050505F600000000000000000000000000000000000000000000  
61 - 000000000000000000000000E4E5050505EE0000000000F705050505E5EE0000  
62 - 00000000000000000000000000000000000000000000000000000000000000FD  
63 - E905050505E5FD00000000A5DCEAE5E6EAEFDE00000000000000000000000000  
64 - 00000000000000000000000000000000000000DEEDE8050506DCA30000008057  
65 - 5096EBDB7D626A00000000000000000000000000000000000000000000000000  
66 - 0000000000000064608BE2E2844E630000008356034D96840303640000000000  
67 - 0000000000000000ABAEAEAEAE00000000000000000000000000005D034C9B85  
68 - 4C036000000083500303424F0303630000000000000000ABA5CFD5BDBBC5B4B7  
69 - C8BCC0CDAAA90000000000000000995703535655030362000000805703030303  
70 - 03035E0000000000A9D7B1BA02020202020202020202020202B5BDD2AE000000  
71 - 0000895C0303030303036300000000614B030303030364000000A3D3C6020202  
72 - 02020202020202020202020202020202C3B1A900000000605303030303546A00  
73 - 0000001E314F030303503300D6A5BB0202020202020202020202B70202020202  
74 - 020202020202B8CFAB0000344D030353562720000000002012275603572720A3  
75 - C102020202020202020202B9D5D2B3D1CFBD02020202020202020202C7A5001E  
76 - 3150033B250B290000000080170A2531171433CAC3020202020202020202C7D3  
77 - BCB40202C4D5B3B70202020202020202C2B7D4290B2138190F1A000000000000  
78 - 2914091A091BB09F7C8E0202020202020202D3B9020202020202BBB302020202  
79 - 020202B67F7FA2AE190E110E1020000000000000AD515959A226A19E716D7FB5  
80 - 0202020202D9B10202020202020202CCBF0202020202A47C6C799DB720090E0F  
81 - 1A000000000000AE5D593B5159B7717C9E746C7CA40202020202C20202020202  
82 - 02020202B502020202A17A6C7C9D747A93190919330000000000AB5159BD5157  
83 - 5159C36C7A9E796C79A10202020202020202020202020202020202029F716C7F  
84 - 9D716D88B5261334A300000000006F6590D9BD513B5159B46C719E7C6C79A102  
85 - 0202020202020202020202020202029D706D88916F6B88B402BD3A02CDAC0000  
86 - 00006F6F6F9FBCBD513B5159026D7091828E0202020202020202020202020202  
87 - 020202C288888E6B6F8E02020202020202CF00000000006F6F6E9F9ADA515751  
88 - 59B46B74BA02020202020202020202020202020202020202029E6F7091020202  
89 - 020202020202D3000000AEC26F6F029F9ABD51575159029D0202020202020202  
90 - 02020202020202020202020202028E9D02020202020202020202C6AE0000A502  
91 - 026F6D6F9FD9BD513B5159020202020202020202020202020202020202020202  
92 - 020202020202020202020202020202D70000ADB4026F6F686E9FD9BD51575102  
93 - 0202020202020202020202020202020202020202020202020202020202020202  
94 - 020202AD000000C002026F6F6F027A9ABD513B59BAC8C9D9B0BDDABA02020202  
95 - 020202BADABDB0D9C9C8BAB8B4020202020202020202BED6000000A3C002026F  
96 - 6F6F6E9FD9BD3B5159B1CCBFBEBDBC020202020202020202BCBDBEBFCCB1B2CC  
97 - B502020202020202B9D8AC00000000009CB802026F6F6C027A9A515751020202  
98 - 02020202020202020202020202020202020202020202020202020202AA000000  
99 - 00000000FED4BFB9026F6C6FA4BCBD5151510259595959595959595902020202  
100 - 02020202020202020202020202C3CAD0E1000000000000000000FED6A5D20268  
101 - 6EB9D951515159595959595959595959595902020202020202020202B9BBC1D0  
102 - D4AB9900000000000000000000000000000000026F6F56513B5759595900320F  
103 - 00000059595959C1B1CECFD8D2AAA5A9D6A80000000000000000000000000000  
104 - 0000000000000000026F6F6F59595959000F0F0F000000000059595900000000  
105 - 0000000000000000000000000000000000000000000000000000000000006F6F  
106 - 5959590000000000000000000000595959000000000000000000000000000000  
107 - 0000000000000000000000000000000000000059595906060606060606060606  
108 - 0606065959590000000000000000000000000000000000000000000000000000  
109 - 00000000000000595906060F0F0F060606060606060606065959000000000000  
110 - 0000000000000000000000000000000000FD070707070707070759595906060F  
111 - 0F06060606060606060606062E5959070707070707070707070707F4FC000000  
112 - 0000000000F8EF06060606060606595959060F0F060606060606060606060606  
113 - 0F5959060606060606060606060606F100000000000000000000945A08080808  
114 - 0859590000000000000F0F0F0000000000000000005959080808080808080808  
115 - 085F3E0000000000000000000000005A4404040404595932033204040F0F0404  
116 - 040404040404040404595904040404040404040404455A000000000000000000  
117 - 000000008646354748595905030332320F3204323204040404040404042F5949  
118 - 4375393D49467535474A0000000000000000000000000000EE95175864595959  
119 - 0503560F0F04323204040404040404042E59595E78F10D1651DEF11400570000  
120 - 000000000000000000000000E8A0103762E65959050556033232320432043204  
121 - 040415153259123F77E52B1D038FE91F1F0300000000000000000000000000EF  
122 - 05E00A304CE3595959055603032E2E2E2E0505050505151559590F3250EA7211  
123 - 42810536184B57000000000000000000000000EE05FA112E03DFDD5959055603  
124 - 03012E2E2E0505050505153259E00E324DFA8D093C7B056615555C0000000000  
125 - 00000000000000EE05E9152E03DFE0595959560303322E2E2E3205050505322E  
126 - 59E009304CE38D0F377E057211415C000000000000000000000000EF05E00932  
127 - 4EFBA60E59595903032E2E2E2E3205050505595959A60E3768E76615558C0536  
128 - 184B570000000000000000000000000005A00A375C058711405959592E2E2E2E  
129 - 2E05050559595959058712407B052A1C0398E81C230300000000000000000000  
130 - 0000000006380C5669EB2C143F8D5959592E2E2E2E32595959593F65EB2C143F  
131 - 92ED0B2442E4EF122F5600000000000000000000000000000700005800070000  
132 - 5800000D5959595959595959000059000700005800000D005800000D00000000  
133 - 000000000000F3FFFFFFFFF7C000F3FFFFFFFFF3C000E1FFFFFFFFE1C000C0FF  
134 - FFFFFFC1C000C0FFFFFFFFC0C00080FFFFFFFFC0C00080FFFFFFFF804000807F  
135 - FFFFFF804000007FFFFFFF804000007FFC1FFF804000007F8000FF004000007C  
136 - 00001F0040008070000007804000804000000180400080000000008040008000  
137 - 00000000C000C00000000000C000C00000000001C000800000000001C0000000  
138 - 00000001C000000000000000C000000000000000C00080000000000040000000  
139 - 0000000000000000000000000000000000000000000080000000000000008000  
140 - 0000000040008000000000004000800000000000400080000000000040008000  
141 - 00000000C000C00000000000C000C00000000000C000C00000000001C000E000  
142 - 00000001C000E00000000001C000E00000000003C000F00000000007C000F800  
143 - 00000007C000FC000000000FC000FC000000002FC000FC000000000FC000F800  
144 - 00000007C000F80000000007C000F80000000007C000F80000000007C000FC00  
145 - 0000000FC000FC000000000FC000FDAD8035B5BFC000}  
146 - OldCreateOrder = False  
147 - Position = poDesktopCenter  
148 - Visible = True  
149 - OnActivate = FormActivate  
150 - OnClose = FormClose  
151 - OnCreate = FormCreate  
152 - PixelsPerInch = 96  
153 - TextHeight = 13  
154 - object lbNomeServidorWEB: TLabel  
155 - Left = 0  
156 - Top = 303  
157 - Width = 390  
158 - Height = 12  
159 - AutoSize = False  
160 - Font.Charset = DEFAULT_CHARSET  
161 - Font.Color = clWindowText  
162 - Font.Height = -9  
163 - Font.Name = 'Arial'  
164 - Font.Style = [fsBold]  
165 - ParentFont = False  
166 - end  
167 - object lbVersao: TLabel  
168 - Left = 389  
169 - Top = 303  
170 - Width = 390  
171 - Height = 12  
172 - Alignment = taRightJustify  
173 - AutoSize = False  
174 - Caption = 'v: X.X.X.X'  
175 - Font.Charset = DEFAULT_CHARSET  
176 - Font.Color = clWindowText  
177 - Font.Height = -9  
178 - Font.Name = 'Arial'  
179 - Font.Style = []  
180 - ParentFont = False  
181 - end  
182 - object gbLeiaComAtencao: TGroupBox  
183 - Left = 1  
184 - Top = -1  
185 - Width = 780  
186 - Height = 53  
187 - Caption = ' Leia com aten'#231#227'o '  
188 - Color = clBtnFace  
189 - Font.Charset = DEFAULT_CHARSET  
190 - Font.Color = clRed  
191 - Font.Height = -13  
192 - Font.Name = 'MS Sans Serif'  
193 - Font.Style = [fsBold]  
194 - ParentColor = False  
195 - ParentFont = False  
196 - TabOrder = 0  
197 - Visible = False  
198 - object lbLeiaComAtencao: TLabel  
199 - Left = 5  
200 - Top = 14  
201 - Width = 769  
202 - Height = 32  
203 - AutoSize = False  
204 - Caption =  
205 - 'O preenchimento correto dos campos abaixo '#233' de extrema import'#226'nc' +  
206 - 'ia para um efetivo controle patrimonial e de localiza'#231#227'o de equi' +  
207 - 'pamentos.'  
208 - Font.Charset = DEFAULT_CHARSET  
209 - Font.Color = clBlack  
210 - Font.Height = -13  
211 - Font.Name = 'MS Sans Serif'  
212 - Font.Style = []  
213 - ParentFont = False  
214 - WordWrap = True  
215 - end  
216 - end  
217 - object gbInformacoesSobreComputador: TGroupBox  
218 - Left = 1  
219 - Top = 61  
220 - Width = 780  
221 - Height = 151  
222 - Caption =  
223 - 'Informa'#231#245'es sobre localiza'#231#227'o f'#237'sica e patrimonial deste computa' +  
224 - 'dor'  
225 - Font.Charset = DEFAULT_CHARSET  
226 - Font.Color = clBlue  
227 - Font.Height = -11  
228 - Font.Name = 'MS Sans Serif'  
229 - Font.Style = [fsBold]  
230 - ParentFont = False  
231 - TabOrder = 1  
232 - Visible = False  
233 - object lbEtiqueta1: TLabel  
234 - Left = 3  
235 - Top = 15  
236 - Width = 48  
237 - Height = 13  
238 - Caption = 'Etiqueta 1'  
239 - Font.Charset = DEFAULT_CHARSET  
240 - Font.Color = clWindowText  
241 - Font.Height = -11  
242 - Font.Name = 'MS Sans Serif'  
243 - Font.Style = []  
244 - ParentFont = False  
245 - Visible = False  
246 - end  
247 - object lbEtiqueta2: TLabel  
248 - Left = 3  
249 - Top = 105  
250 - Width = 48  
251 - Height = 13  
252 - Caption = 'Etiqueta 2'  
253 - Font.Charset = DEFAULT_CHARSET  
254 - Font.Color = clWindowText  
255 - Font.Height = -11  
256 - Font.Name = 'MS Sans Serif'  
257 - Font.Style = []  
258 - ParentFont = False  
259 - Visible = False  
260 - end  
261 - object lbEtiqueta3: TLabel  
262 - Left = 341  
263 - Top = 15  
264 - Width = 48  
265 - Height = 13  
266 - Caption = 'Etiqueta 3'  
267 - Font.Charset = DEFAULT_CHARSET  
268 - Font.Color = clWindowText  
269 - Font.Height = -11  
270 - Font.Name = 'MS Sans Serif'  
271 - Font.Style = []  
272 - ParentFont = False  
273 - Visible = False  
274 - end  
275 - object lbEtiqueta4: TLabel  
276 - Left = 341  
277 - Top = 60  
278 - Width = 48  
279 - Height = 13  
280 - Caption = 'Etiqueta 4'  
281 - Font.Charset = DEFAULT_CHARSET  
282 - Font.Color = clWindowText  
283 - Font.Height = -11  
284 - Font.Name = 'MS Sans Serif'  
285 - Font.Style = []  
286 - ParentFont = False  
287 - Visible = False  
288 - end  
289 - object lbEtiqueta5: TLabel  
290 - Left = 493  
291 - Top = 60  
292 - Width = 48  
293 - Height = 13  
294 - Caption = 'Etiqueta 5'  
295 - Font.Charset = DEFAULT_CHARSET  
296 - Font.Color = clWindowText  
297 - Font.Height = -11  
298 - Font.Name = 'MS Sans Serif'  
299 - Font.Style = []  
300 - ParentFont = False  
301 - Visible = False  
302 - end  
303 - object lbEtiqueta6: TLabel  
304 - Left = 645  
305 - Top = 60  
306 - Width = 48  
307 - Height = 13  
308 - Caption = 'Etiqueta 6'  
309 - Font.Charset = DEFAULT_CHARSET  
310 - Font.Color = clWindowText  
311 - Font.Height = -11  
312 - Font.Name = 'MS Sans Serif'  
313 - Font.Style = []  
314 - ParentFont = False  
315 - Visible = False  
316 - end  
317 - object lbEtiqueta7: TLabel  
318 - Left = 341  
319 - Top = 105  
320 - Width = 48  
321 - Height = 13  
322 - Caption = 'Etiqueta 7'  
323 - Font.Charset = DEFAULT_CHARSET  
324 - Font.Color = clWindowText  
325 - Font.Height = -11  
326 - Font.Name = 'MS Sans Serif'  
327 - Font.Style = []  
328 - ParentFont = False  
329 - Visible = False  
330 - end  
331 - object lbEtiqueta8: TLabel  
332 - Left = 493  
333 - Top = 105  
334 - Width = 48  
335 - Height = 13  
336 - Caption = 'Etiqueta 8'  
337 - Font.Charset = DEFAULT_CHARSET  
338 - Font.Color = clWindowText  
339 - Font.Height = -11  
340 - Font.Name = 'MS Sans Serif'  
341 - Font.Style = []  
342 - ParentFont = False  
343 - Visible = False  
344 - end  
345 - object lbEtiqueta9: TLabel  
346 - Left = 645  
347 - Top = 105  
348 - Width = 48  
349 - Height = 13  
350 - Caption = 'Etiqueta 9'  
351 - Font.Charset = DEFAULT_CHARSET  
352 - Font.Color = clWindowText  
353 - Font.Height = -11  
354 - Font.Name = 'MS Sans Serif'  
355 - Font.Style = []  
356 - ParentFont = False  
357 - Visible = False  
358 - end  
359 - object lbEtiqueta1a: TLabel  
360 - Left = 3  
361 - Top = 60  
362 - Width = 54  
363 - Height = 13  
364 - Caption = 'Etiqueta 1a'  
365 - Font.Charset = DEFAULT_CHARSET  
366 - Font.Color = clWindowText  
367 - Font.Height = -11  
368 - Font.Name = 'MS Sans Serif'  
369 - Font.Style = []  
370 - ParentFont = False  
371 - Visible = False  
372 - end  
373 - object cb_id_unid_organizacional_nivel1: TComboBox  
374 - Left = 3  
375 - Top = 30  
376 - Width = 325  
377 - Height = 21  
378 - Hint = 'Esse '#233' o texto de ajuda da "Etiqueta 1"'  
379 - Style = csDropDownList  
380 - Font.Charset = DEFAULT_CHARSET  
381 - Font.Color = clWindowText  
382 - Font.Height = -11  
383 - Font.Name = 'MS Sans Serif'  
384 - Font.Style = []  
385 - ItemHeight = 13  
386 - ParentFont = False  
387 - ParentShowHint = False  
388 - ShowHint = True  
389 - TabOrder = 0  
390 - Visible = False  
391 - OnChange = cb_id_unid_organizacional_nivel1Change  
392 - end  
393 - object cb_id_unid_organizacional_nivel2: TComboBox  
394 - Left = 3  
395 - Top = 120  
396 - Width = 325  
397 - Height = 21  
398 - Style = csDropDownList  
399 - Enabled = False  
400 - Font.Charset = DEFAULT_CHARSET  
401 - Font.Color = clWindowText  
402 - Font.Height = -11  
403 - Font.Name = 'MS Sans Serif'  
404 - Font.Style = []  
405 - ItemHeight = 13  
406 - ParentFont = False  
407 - ParentShowHint = False  
408 - ShowHint = True  
409 - TabOrder = 1  
410 - Visible = False  
411 - end  
412 - object ed_te_localizacao_complementar: TEdit  
413 - Left = 341  
414 - Top = 30  
415 - Width = 434  
416 - Height = 22  
417 - Font.Charset = DEFAULT_CHARSET  
418 - Font.Color = clWindowText  
419 - Font.Height = -11  
420 - Font.Name = 'Arial'  
421 - Font.Style = []  
422 - MaxLength = 100  
423 - ParentFont = False  
424 - ParentShowHint = False  
425 - ShowHint = True  
426 - TabOrder = 2  
427 - Visible = False  
428 - end  
429 - object ed_te_info_patrimonio3: TEdit  
430 - Left = 645  
431 - Top = 75  
432 - Width = 130  
433 - Height = 21  
434 - Font.Charset = DEFAULT_CHARSET  
435 - Font.Color = clWindowText  
436 - Font.Height = -11  
437 - Font.Name = 'MS Sans Serif'  
438 - Font.Style = []  
439 - MaxLength = 20  
440 - ParentFont = False  
441 - ParentShowHint = False  
442 - ShowHint = True  
443 - TabOrder = 5  
444 - Visible = False  
445 - end  
446 - object ed_te_info_patrimonio1: TEdit  
447 - Left = 341  
448 - Top = 75  
449 - Width = 130  
450 - Height = 21  
451 - Font.Charset = DEFAULT_CHARSET  
452 - Font.Color = clWindowText  
453 - Font.Height = -11  
454 - Font.Name = 'MS Sans Serif'  
455 - Font.Style = []  
456 - MaxLength = 20  
457 - ParentFont = False  
458 - ParentShowHint = False  
459 - ShowHint = True  
460 - TabOrder = 3  
461 - Visible = False  
462 - end  
463 - object ed_te_info_patrimonio2: TEdit  
464 - Left = 493  
465 - Top = 75  
466 - Width = 130  
467 - Height = 21  
468 - Font.Charset = DEFAULT_CHARSET  
469 - Font.Color = clWindowText  
470 - Font.Height = -11  
471 - Font.Name = 'MS Sans Serif'  
472 - Font.Style = []  
473 - MaxLength = 20  
474 - ParentFont = False  
475 - ParentShowHint = False  
476 - ShowHint = True  
477 - TabOrder = 4  
478 - Visible = False  
479 - end  
480 - object ed_te_info_patrimonio6: TEdit  
481 - Left = 645  
482 - Top = 120  
483 - Width = 130  
484 - Height = 21  
485 - Font.Charset = DEFAULT_CHARSET  
486 - Font.Color = clWindowText  
487 - Font.Height = -11  
488 - Font.Name = 'MS Sans Serif'  
489 - Font.Style = []  
490 - MaxLength = 20  
491 - ParentFont = False  
492 - ParentShowHint = False  
493 - ShowHint = True  
494 - TabOrder = 8  
495 - Visible = False  
496 - end  
497 - object ed_te_info_patrimonio4: TEdit  
498 - Left = 341  
499 - Top = 120  
500 - Width = 130  
501 - Height = 21  
502 - Font.Charset = DEFAULT_CHARSET  
503 - Font.Color = clWindowText  
504 - Font.Height = -11  
505 - Font.Name = 'MS Sans Serif'  
506 - Font.Style = []  
507 - MaxLength = 20  
508 - ParentFont = False  
509 - ParentShowHint = False  
510 - ShowHint = True  
511 - TabOrder = 6  
512 - Visible = False  
513 - end  
514 - object ed_te_info_patrimonio5: TEdit  
515 - Left = 493  
516 - Top = 120  
517 - Width = 130  
518 - Height = 21  
519 - Font.Charset = DEFAULT_CHARSET  
520 - Font.Color = clWindowText  
521 - Font.Height = -11  
522 - Font.Name = 'MS Sans Serif'  
523 - Font.Style = []  
524 - MaxLength = 20  
525 - ParentFont = False  
526 - ParentShowHint = False  
527 - ShowHint = True  
528 - TabOrder = 7  
529 - Visible = False  
530 - end  
531 - object cb_id_unid_organizacional_nivel1a: TComboBox  
532 - Left = 3  
533 - Top = 75  
534 - Width = 325  
535 - Height = 22  
536 - Style = csDropDownList  
537 - Enabled = False  
538 - Font.Charset = DEFAULT_CHARSET  
539 - Font.Color = clWindowText  
540 - Font.Height = -11  
541 - Font.Name = 'Arial'  
542 - Font.Style = []  
543 - ItemHeight = 14  
544 - ParentFont = False  
545 - ParentShowHint = False  
546 - ShowHint = True  
547 - TabOrder = 9  
548 - Visible = False  
549 - OnChange = cb_id_unid_organizacional_nivel1aChange  
550 - end  
551 - object Panel1: TPanel  
552 - Left = 333  
553 - Top = 16  
554 - Width = 2  
555 - Height = 125  
556 - Caption = 'Panel1'  
557 - TabOrder = 10  
558 - end  
559 - end  
560 - object btGravarInformacoes: TButton  
561 - Left = 251  
562 - Top = 254  
563 - Width = 275  
564 - Height = 30  
565 - Caption = 'Grava e Envia Informa'#231#245'es Patrimoniais'  
566 - Font.Charset = DEFAULT_CHARSET  
567 - Font.Color = clWindowText  
568 - Font.Height = -13  
569 - Font.Name = 'Arial'  
570 - Font.Style = [fsBold]  
571 - ParentFont = False  
572 - TabOrder = 2  
573 - Visible = False  
574 - OnClick = AtualizaPatrimonio  
575 - end  
576 - object pnMensagens: TPanel  
577 - Left = 1  
578 - Top = 212  
579 - Width = 779  
580 - Height = 22  
581 - BevelInner = bvLowered  
582 - TabOrder = 3  
583 - object lbMensagens: TLabel  
584 - Left = 2  
585 - Top = 2  
586 - Width = 775  
587 - Height = 18  
588 - Align = alClient  
589 - Alignment = taCenter  
590 - AutoSize = False  
591 - Font.Charset = DEFAULT_CHARSET  
592 - Font.Color = clWindowText  
593 - Font.Height = -13  
594 - Font.Name = 'MS Sans Serif'  
595 - Font.Style = []  
596 - ParentFont = False  
597 - end  
598 - end  
599 -end  
mapa/main_mapa.pas
View file @2c54a33
@@ -1,1577 +0,0 @@ @@ -1,1577 +0,0 @@
1 -(**  
2 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
3 -Copyright 2000, 2001, 2002, 2003, 2004, 2005 Dataprev - Empresa de Tecnologia e Informações da Previdência Social, Brasil  
4 -  
5 -Este arquivo é parte do programa CACIC - Configurador Automático e Coletor de Informações Computacionais  
6 -  
7 -O CACIC é um software livre; você pode redistribui-lo e/ou modifica-lo dentro dos termos da Licença Pública Geral GNU como  
8 -publicada pela Fundação do Software Livre (FSF); na versão 2 da Licença, ou (na sua opinião) qualquer versão.  
9 -  
10 -Este programa é distribuido na esperança que possa ser util, mas SEM NENHUMA GARANTIA; sem uma garantia implicita de ADEQUAÇÂO a qualquer  
11 -MERCADO ou APLICAÇÃO EM PARTICULAR. Veja a Licença Pública Geral GNU para maiores detalhes.  
12 -  
13 -Você deve ter recebido uma cópia da Licença Pública Geral GNU, sob o título "LICENCA.txt", junto com este programa, se não, escreva para a Fundação do Software  
14 -Livre(FSF) Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA  
15 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
16 -*)  
17 -  
18 -unit main_mapa;  
19 -  
20 -interface  
21 -  
22 -uses  
23 - IniFiles,  
24 - Windows,  
25 - Sysutils, // Deve ser colocado após o Windows acima, nunca antes  
26 - strutils,  
27 - Registry,  
28 - LibXmlParser,  
29 - XML,  
30 - IdTCPConnection,  
31 - IdTCPClient,  
32 - IdHTTP,  
33 - IdBaseComponent,  
34 - IdComponent,  
35 - WinSock,  
36 - NB30,  
37 - StdCtrls,  
38 - Controls,  
39 - Classes,  
40 - Forms,  
41 - PJVersionInfo,  
42 - ExtCtrls,  
43 - Graphics,  
44 - Dialogs,  
45 - CACIC_Library;  
46 -  
47 -var  
48 - strCipherClosed,  
49 - strCipherOpened : string;  
50 -  
51 -var  
52 - intPausaPadrao : integer;  
53 -  
54 -var v_Aguarde : TextFile;  
55 -  
56 -var  
57 - boolDebugs,  
58 - boolFinalizar : boolean;  
59 -  
60 -type  
61 - TfrmMapaCacic = class(TForm)  
62 - gbLeiaComAtencao: TGroupBox;  
63 - lbLeiaComAtencao: TLabel;  
64 - gbInformacoesSobreComputador: TGroupBox;  
65 - lbEtiqueta1: TLabel;  
66 - lbEtiqueta2: TLabel;  
67 - lbEtiqueta3: TLabel;  
68 - cb_id_unid_organizacional_nivel1: TComboBox;  
69 - cb_id_unid_organizacional_nivel2: TComboBox;  
70 - ed_te_localizacao_complementar: TEdit;  
71 - btGravarInformacoes: TButton;  
72 - lbEtiqueta4: TLabel;  
73 - lbEtiqueta5: TLabel;  
74 - lbEtiqueta6: TLabel;  
75 - lbEtiqueta7: TLabel;  
76 - lbEtiqueta8: TLabel;  
77 - lbEtiqueta9: TLabel;  
78 - ed_te_info_patrimonio1: TEdit;  
79 - ed_te_info_patrimonio2: TEdit;  
80 - ed_te_info_patrimonio3: TEdit;  
81 - ed_te_info_patrimonio4: TEdit;  
82 - ed_te_info_patrimonio5: TEdit;  
83 - ed_te_info_patrimonio6: TEdit;  
84 - pnMensagens: TPanel;  
85 - lbMensagens: TLabel;  
86 - lbEtiqueta1a: TLabel;  
87 - cb_id_unid_organizacional_nivel1a: TComboBox;  
88 - Panel1: TPanel;  
89 - lbNomeServidorWEB: TLabel;  
90 - lbVersao: TLabel;  
91 -  
92 - procedure mapa;  
93 - function SetValorChaveRegEdit(Chave: String; Dado: Variant): Variant;  
94 - function GetValorChaveRegEdit(Chave: String): Variant;  
95 - function GetRootKey(strRootKey: String): HKEY;  
96 - Function RemoveCaracteresEspeciais(Texto, p_Fill : String; p_start, p_end:integer) : String;  
97 - Procedure CipherClose(p_DatFileName : string; p_tstrCipherOpened : TStrings);  
98 - Procedure CipherOpen(p_DatFileName : string; var p_tstrCipherOpened : TStrings);  
99 - Function GetValorDatMemoria(p_Chave : String; p_tstrCipherOpened : TStrings) : String;  
100 - procedure MontaCombos(p_strConfigs : String);  
101 - procedure MontaInterface(p_strConfigs : String);  
102 - procedure FormClose(Sender: TObject; var Action: TCloseAction);  
103 - procedure cb_id_unid_organizacional_nivel1Change(Sender: TObject);  
104 - procedure AtualizaPatrimonio(Sender: TObject);  
105 - procedure RecuperaValoresAnteriores(p_strConfigs : String);  
106 - procedure log_diario(strMsg : String);  
107 - procedure log_DEBUG(p_msg:string);  
108 - Procedure SetValorDatMemoria(p_Chave : string; p_Valor : String; p_tstrCipherOpened : TStrings);  
109 - function GetVersionInfo(p_File: string):string;  
110 - function VerFmt(const MS, LS: DWORD): string;  
111 - function GetFolderDate(Folder: string): TDateTime;  
112 - procedure CriaFormSenha(Sender: TObject);  
113 - Function ComunicaServidor(URL : String; Request : TStringList; MsgAcao: String) : String;  
114 - Function XML_RetornaValor(Tag : String; Fonte : String): String;  
115 - function Parse(p_ClassName, p_SectionName, p_DataName:string; p_Report : TStringList) : String;  
116 - procedure Matar(v_dir,v_files: string);  
117 - procedure Finalizar(p_pausa:boolean);  
118 - procedure Apaga_Temps;  
119 - procedure Sair;  
120 - function LastPos(SubStr, S: string): Integer;  
121 - Function Rat(OQue: String; Onde: String) : Integer;  
122 - Function RemoveZerosFimString(Texto : String) : String;  
123 - function GetValorChaveRegIni(p_SectionName, p_KeyName, p_IniFileName : String) : String;  
124 - Function RetornaValorVetorUON1(id1 : string) : String;  
125 - Function RetornaValorVetorUON1a(id1a : string) : String;  
126 - Function RetornaValorVetorUON2(id2,idLocal : string) : String;  
127 - function LetrasDrives: string;  
128 - function SearchFile(p_Drive,p_File:string) : boolean;  
129 - procedure GetSubDirs(Folder:string; sList:TStringList);  
130 - procedure Mensagem(p_strMsg : String; p_boolAlerta : boolean; p_intPausaSegundos : integer);  
131 - procedure cb_id_unid_organizacional_nivel1aChange(Sender: TObject);  
132 - procedure FormActivate(Sender: TObject);  
133 - procedure FormCreate(Sender: TObject);  
134 - private  
135 - strId_unid_organizacional_nivel1,  
136 - strId_unid_organizacional_nivel1a,  
137 - strId_unid_organizacional_nivel2,  
138 - strId_Local,  
139 - strTe_localizacao_complementar,  
140 - strTe_info_patrimonio1,  
141 - strTe_info_patrimonio2,  
142 - strTe_info_patrimonio3,  
143 - strTe_info_patrimonio4,  
144 - strTe_info_patrimonio5,  
145 - strTe_info_patrimonio6 : String;  
146 - public  
147 - boolAcessoOK : boolean;  
148 - strId_usuario : String;  
149 - g_oCacic : TCACIC;  
150 - tStringsCACIC,  
151 - tStringsMapaCACIC : TStrings;  
152 - end;  
153 -  
154 -var  
155 - frmMapaCacic: TfrmMapaCacic;  
156 -  
157 -implementation  
158 -  
159 -uses acesso, Math;  
160 -  
161 -{$R *.dfm}  
162 -  
163 -  
164 -// Estruturas de dados para armazenar os itens da uon1 e uon2  
165 -type  
166 - TRegistroUON1 = record  
167 - id1 : String;  
168 - nm1 : String;  
169 - end;  
170 - TVetorUON1 = array of TRegistroUON1;  
171 -  
172 - TRegistroUON1a = record  
173 - id1 : String;  
174 - id1a : String;  
175 - nm1a : String;  
176 - id_local: String;  
177 - end;  
178 -  
179 - TVetorUON1a = array of TRegistroUON1a;  
180 -  
181 - TRegistroUON2 = record  
182 - id1a : String;  
183 - id2 : String;  
184 - nm2 : String;  
185 - id_local: String;  
186 - end;  
187 - TVetorUON2 = array of TRegistroUON2;  
188 -  
189 -var VetorUON1 : TVetorUON1;  
190 - VetorUON1a : TVetorUON1a;  
191 - VetorUON2 : TVetorUON2;  
192 -  
193 - // Esse array é usado apenas para saber a uon1a, após a filtragem pelo uon1  
194 - VetorUON1aFiltrado : array of String;  
195 -  
196 - // Esse array é usado apenas para saber a uon2, após a filtragem pelo uon1a  
197 - VetorUON2Filtrado : array of String;  
198 -  
199 -// Baixada de http://www.geocities.com/SiliconValley/Bay/1058/fdelphi.html  
200 -Function TfrmMapaCacic.Rat(OQue: String; Onde: String) : Integer;  
201 -// Procura uma string dentro de outra, da direita para esquerda  
202 -// Retorna a posição onde foi encontrada ou 0 caso não seja encontrada  
203 -var  
204 -Pos : Integer;  
205 -Tam1 : Integer;  
206 -Tam2 : Integer;  
207 -Achou : Boolean;  
208 -begin  
209 -Tam1 := Length(OQue);  
210 -Tam2 := Length(Onde);  
211 -Pos := Tam2-Tam1+1;  
212 -Achou := False;  
213 -while (Pos >= 1) and not Achou do  
214 - begin  
215 - if Copy(Onde, Pos, Tam1) = OQue then  
216 - begin  
217 - Achou := True  
218 - end  
219 - else  
220 - begin  
221 - Pos := Pos - 1;  
222 - end;  
223 - end;  
224 -Result := Pos;  
225 -end;  
226 -  
227 -procedure TfrmMapaCacic.Mensagem(p_strMsg : String; p_boolAlerta : boolean; p_intPausaSegundos : integer);  
228 -Begin  
229 - log_DEBUG(p_strMsg);  
230 - if p_boolAlerta then  
231 - lbMensagens.Font.Color := clRed  
232 - else  
233 - lbMensagens.Font.Color := clBlack;  
234 -  
235 - lbMensagens.Caption := p_strMsg;  
236 - log_diario(lbMensagens.Caption);  
237 - Application.ProcessMessages;  
238 - if (p_intPausaSegundos > 0) then  
239 - sleep(p_intPausaSegundos);  
240 -End;  
241 -  
242 -procedure TfrmMapaCacic.log_diario(strMsg : String);  
243 -var  
244 - HistoricoLog : TextFile;  
245 - strDataArqLocal, strDataAtual : string;  
246 -begin  
247 - try  
248 - FileSetAttr (g_oCacic.getCacicPath + 'MapaCacic.log',0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
249 - AssignFile(HistoricoLog,g_oCacic.getCacicPath + 'MapaCacic.log'); {Associa o arquivo a uma variável do tipo TextFile}  
250 - {$IOChecks off}  
251 - Reset(HistoricoLog); {Abre o arquivo texto}  
252 - {$IOChecks on}  
253 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
254 - begin  
255 - Rewrite (HistoricoLog);  
256 - Append(HistoricoLog);  
257 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Log <=======================');  
258 - end;  
259 - DateTimeToString(strDataArqLocal, 'yyyymmdd', FileDateToDateTime(Fileage(g_oCacic.getCacicPath + 'MapaCacic.log')));  
260 - DateTimeToString(strDataAtual , 'yyyymmdd', Date);  
261 - if (strDataAtual <> strDataArqLocal) then // Se o arquivo INI não é da data atual...  
262 - begin  
263 - Rewrite (HistoricoLog); //Cria/Recria o arquivo  
264 - Append(HistoricoLog);  
265 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Log <=======================');  
266 - end;  
267 - Append(HistoricoLog);  
268 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now)+ '[MapaCacic] '+strMsg); {Grava a string Texto no arquivo texto}  
269 - CloseFile(HistoricoLog); {Fecha o arquivo texto}  
270 - except  
271 - end;  
272 -end;  
273 -function TfrmMapaCacic.VerFmt(const MS, LS: DWORD): string;  
274 - // Format the version number from the given DWORDs containing the info  
275 -begin  
276 - Result := Format('%d.%d.%d.%d',  
277 - [HiWord(MS), LoWord(MS), HiWord(LS), LoWord(LS)])  
278 -end;  
279 -  
280 -function TfrmMapaCacic.GetVersionInfo(p_File: string):string;  
281 -var PJVersionInfo1: TPJVersionInfo;  
282 -begin  
283 - PJVersionInfo1 := TPJVersionInfo.Create(nil);  
284 - PJVersionInfo1.FileName := PChar(p_File);  
285 - Result := VerFmt(PJVersionInfo1.FixedFileInfo.dwFileVersionMS, PJVersionInfo1.FixedFileInfo.dwFileVersionLS);  
286 - PJVersionInfo1.Free;  
287 -end;  
288 -  
289 -procedure TfrmMapaCacic.log_DEBUG(p_msg:string);  
290 -Begin  
291 - if boolDebugs then log_diario('(v.'+getVersionInfo(ParamStr(0))+') DEBUG - '+p_msg);  
292 -End;  
293 -  
294 -// Função criada devido a divergências entre os valores retornados pelos métodos dos componentes MSI e seus Reports.  
295 -function TfrmMapaCacic.Parse(p_ClassName, p_SectionName, p_DataName:string; p_Report : TStringList) : String;  
296 -var intClasses, intSections, intDatas, v_achei_SectionName, v_array_SectionName_Count : integer;  
297 - v_ClassName, v_DataName, v_string_consulta : string;  
298 - v_array_SectionName : tstrings;  
299 -begin  
300 - Result := '';  
301 - if (p_SectionName <> '') then  
302 - Begin  
303 - v_array_SectionName := g_oCacic.explode(p_SectionName,'/');  
304 - v_array_SectionName_Count := v_array_SectionName.Count;  
305 - End  
306 - else v_array_SectionName_Count := 0;  
307 - v_achei_SectionName := 0;  
308 - v_ClassName := 'classname="' + p_ClassName + '">';  
309 - v_DataName := '<data name="' + p_DataName + '"';  
310 -  
311 - intClasses := 0;  
312 - try  
313 - While intClasses < p_Report.Count Do  
314 - Begin  
315 - if (pos(v_ClassName,p_Report[intClasses])>0) then  
316 - Begin  
317 - intSections := intClasses;  
318 - While intSections < p_Report.Count Do  
319 - Begin  
320 - if (p_SectionName<>'') then  
321 - Begin  
322 - v_string_consulta := '<section name="' + v_array_SectionName[v_achei_SectionName]+'">';  
323 - if (pos(v_string_consulta,p_Report[intSections])>0) then v_achei_SectionName := v_achei_SectionName+1;  
324 - End;  
325 -  
326 - if (v_achei_SectionName = v_array_SectionName_Count) then  
327 - Begin  
328 -  
329 - intDatas := intSections;  
330 - While intDatas < p_Report.Count Do  
331 - Begin  
332 -  
333 - if (pos(v_DataName,p_Report[intDatas])>0) then  
334 - Begin  
335 - Result := Copy(p_Report[intDatas],pos('>',p_Report[intDatas])+1,length(p_Report[intDatas]));  
336 - Result := StringReplace(Result,'</data>','',[rfReplaceAll]);  
337 - intClasses := p_Report.Count;  
338 - intSections := p_Report.Count;  
339 - intDatas := p_Report.Count;  
340 - End;  
341 - intDatas := intDatas + 1;  
342 - End; //for intDatas...  
343 - End; // if pos(v_SectionName...  
344 - intSections := intSections + 1;  
345 - End; // for intSections...  
346 - End; // if pos(v_ClassName...  
347 - intClasses := intClasses + 1;  
348 - End; // for intClasses...  
349 - except  
350 - frmMapaCacic.Mensagem('ERRO! Problema na rotina parse',true,intPausaPadrao);  
351 - end;  
352 -end;  
353 -  
354 -procedure TfrmMapaCacic.Matar(v_dir,v_files: string);  
355 -var SearchRec: TSearchRec;  
356 - Result: Integer;  
357 -begin  
358 - Result:=FindFirst(v_dir+v_files, faAnyFile, SearchRec);  
359 - while result=0 do  
360 - begin  
361 - log_DEBUG('Excluindo: "'+v_dir+SearchRec.Name+'"');  
362 - DeleteFile(PChar(v_dir+SearchRec.Name));  
363 - Result:=FindNext(SearchRec);  
364 - end;  
365 -end;  
366 -  
367 -procedure TfrmMapaCacic.Sair;  
368 -Begin  
369 - g_oCacic.Free();  
370 - Application.Terminate;  
371 -End;  
372 -  
373 -procedure TfrmMapaCacic.Finalizar(p_pausa:boolean);  
374 -Begin  
375 - Mensagem('Finalizando MapaCacic...',false,0);  
376 -  
377 - CipherClose(g_oCacic.getCacicPath + 'MapaCACIC.dat', tStringsMapaCACIC);  
378 - Apaga_Temps;  
379 - if p_pausa then sleep(2000); // Pausa de 2 segundos para conclusão de operações de arquivos.  
380 - Sair;  
381 -End;  
382 -  
383 -procedure TfrmMapaCacic.Apaga_Temps;  
384 -begin  
385 - Matar(g_oCacic.getCacicPath + 'temp\','*.vbs');  
386 - Matar(g_oCacic.getCacicPath + 'temp\','*.txt');  
387 -end;  
388 -//  
389 -function TfrmMapaCacic.LastPos(SubStr, S: string): Integer;  
390 -var  
391 - Found, Len, Pos: integer;  
392 -begin  
393 - Pos := Length(S);  
394 - Len := Length(SubStr);  
395 - Found := 0;  
396 - while (Pos > 0) and (Found = 0) do  
397 - begin  
398 - if Copy(S, Pos, Len) = SubStr then  
399 - Found := Pos;  
400 - Dec(Pos);  
401 - end;  
402 - LastPos := Found;  
403 -end;  
404 -  
405 -  
406 -Function TfrmMapaCacic.XML_RetornaValor(Tag : String; Fonte : String): String;  
407 -VAR  
408 - Parser : TXmlParser;  
409 -begin  
410 - Parser := TXmlParser.Create;  
411 - Parser.Normalize := TRUE;  
412 - Parser.LoadFromBuffer(PAnsiChar(Fonte));  
413 - Parser.StartScan;  
414 - WHILE Parser.Scan DO  
415 - Begin  
416 - if (Parser.CurPartType in [ptContent, ptCData]) Then // Process Parser.CurContent field here  
417 - begin  
418 - if (UpperCase(Parser.CurName) = UpperCase(Tag)) then  
419 - Result := RemoveZerosFimString(Parser.CurContent);  
420 - end;  
421 - end;  
422 - Parser.Free;  
423 - log_DEBUG('XML Parser retornando: "'+Result+'" para Tag "'+Tag+'"');  
424 -end;  
425 -  
426 -Function TfrmMapaCacic.RemoveZerosFimString(Texto : String) : String;  
427 -var I : Integer;  
428 - str_local_Aux : String;  
429 -Begin  
430 - str_local_Aux := '';  
431 - if (Length(trim(Texto))>0) then  
432 - For I := Length(Texto) downto 0 do  
433 - if (ord(Texto[I])<>0) Then  
434 - str_local_Aux := Texto[I] + str_local_Aux;  
435 - Result := trim(str_local_Aux);  
436 -end;  
437 -  
438 -Function TfrmMapaCacic.ComunicaServidor(URL : String; Request : TStringList; MsgAcao: String) : String;  
439 -var Response_CS : TStringStream;  
440 - strEndereco,  
441 - strEnderecoServidor,  
442 - strEnderecoWS : String;  
443 - idHTTP1 : TIdHTTP;  
444 - intAux : integer;  
445 - tStringListAuxRequest : TStringList;  
446 -Begin  
447 - tStringListAuxRequest := TStringList.Create;  
448 - tStringListAuxRequest := Request;  
449 -  
450 - tStringListAuxRequest.Values['cs_cipher'] := '1';  
451 - tStringListAuxRequest.Values['cs_compress'] := '0';  
452 -  
453 -  
454 - strEnderecoWS := GetValorDatMemoria('Configs.Endereco_WS', tStringsCACIC);  
455 - strEnderecoServidor := GetValorDatMemoria('Configs.EnderecoServidor', tStringsCACIC);  
456 -  
457 - if (trim(strEnderecoWS)='') then  
458 - strEnderecoWS := '/cacic2/ws/';  
459 -  
460 - if (trim(strEnderecoServidor)='') then  
461 - strEnderecoServidor := Trim(GetValorChaveRegIni('Cacic2','ip_serv_cacic',g_oCacic.getCacicPath + 'cacic2.ini'));  
462 -  
463 - strEndereco := 'http://' + strEnderecoServidor + strEnderecoWS + URL;  
464 -  
465 - if (trim(MsgAcao)='') then  
466 - MsgAcao := '>> Enviando informações iniciais ao Gerente WEB.';  
467 -  
468 - log_diario(MsgAcao);  
469 -  
470 - Application.ProcessMessages;  
471 -  
472 - Response_CS := TStringStream.Create('');  
473 -  
474 - log_DEBUG('Iniciando comunicação com http://' + strEnderecoServidor + strEnderecoWS + URL);  
475 -  
476 - Try  
477 - idHTTP1 := TIdHTTP.Create(nil);  
478 - idHTTP1.AllowCookies := true;  
479 - idHTTP1.ASCIIFilter := false;  
480 - idHTTP1.AuthRetries := 1;  
481 - idHTTP1.BoundPort := 0;  
482 - idHTTP1.HandleRedirects := false;  
483 - idHTTP1.ProxyParams.BasicAuthentication := false;  
484 - idHTTP1.ProxyParams.ProxyPort := 0;  
485 - idHTTP1.ReadTimeout := 0;  
486 - idHTTP1.RecvBufferSize := 32768;  
487 - idHTTP1.RedirectMaximum := 15;  
488 - idHTTP1.Request.UserAgent := g_oCacic.enCrypt('AGENTE_CACIC');  
489 - idHTTP1.Request.Username := g_oCacic.enCrypt('USER_CACIC');  
490 - idHTTP1.Request.Password := g_oCacic.enCrypt('PW_CACIC');  
491 - idHTTP1.Request.Accept := 'text/html, */*';  
492 - idHTTP1.Request.BasicAuthentication := true;  
493 - idHTTP1.Request.ContentLength := -1;  
494 - idHTTP1.Request.ContentRangeStart := 0;  
495 - idHTTP1.Request.ContentRangeEnd := 0;  
496 - idHTTP1.Request.ContentType := 'text/html';  
497 - idHTTP1.SendBufferSize := 32768;  
498 - idHTTP1.Tag := 0;  
499 -  
500 - if boolDebugs then  
501 - Begin  
502 - Log_Debug('Valores de REQUEST para envio ao Gerente WEB:');  
503 - for intAux := 0 to tStringListAuxRequest.count -1 do  
504 - Log_Debug('#'+inttostr(intAux)+': '+tStringListAuxRequest[intAux]);  
505 - End;  
506 -  
507 - IdHTTP1.Post(strEndereco, tStringListAuxRequest, Response_CS);  
508 - idHTTP1.Free;  
509 - log_DEBUG('Retorno: "'+Response_CS.DataString+'"');  
510 - Except  
511 - Mensagem('ERRO! Comunicação impossível com o endereço ' + strEndereco + ': '+Response_CS.DataString,true,intPausaPadrao);  
512 - result := '0';  
513 - Exit;  
514 - end;  
515 -  
516 - Application.ProcessMessages;  
517 - Try  
518 - if (UpperCase(XML_RetornaValor('Status', Response_CS.DataString)) <> 'OK') Then  
519 - Begin  
520 - Mensagem('PROBLEMAS DURANTE A COMUNICAÇÃO',true,intPausaPadrao);  
521 - log_diario('Endereço: ' + strEndereco);  
522 - log_diario('Mensagem: ' + Response_CS.DataString);  
523 - result := '0';  
524 - end  
525 - Else  
526 - Begin  
527 - result := Response_CS.DataString;  
528 - end;  
529 - Response_CS.Free;  
530 - Except  
531 - Begin  
532 - Mensagem('PROBLEMAS DURANTE A COMUNICAÇÃO',true,intPausaPadrao);  
533 - log_diario('Endereço: ' + strEndereco);  
534 - log_diario('Mensagem: ' + Response_CS.DataString);  
535 - result := '0';  
536 - End;  
537 - End;  
538 -end;  
539 -  
540 -//Para buscar do Arquivo INI...  
541 -// Marreta devido a limitações do KERNEL w9x no tratamento de arquivos texto e suas seções  
542 -function TfrmMapaCacic.GetValorChaveRegIni(p_SectionName, p_KeyName, p_IniFileName : String) : String;  
543 -var  
544 -  
545 - FileText : TStringList;  
546 - i, j, v_Size_Section, v_Size_Key : integer;  
547 - v_SectionName, v_KeyName : string;  
548 - begin  
549 - Result := '';  
550 - v_SectionName := '[' + p_SectionName + ']';  
551 - v_Size_Section := strLen(PChar(v_SectionName));  
552 - v_KeyName := p_KeyName + '=';  
553 - v_Size_Key := strLen(PChar(v_KeyName));  
554 -  
555 - FileText := TStringList.Create;  
556 -  
557 - try  
558 - FileText.LoadFromFile(p_IniFileName);  
559 - For i := 0 To FileText.Count - 1 Do  
560 - Begin  
561 - if (LowerCase(Trim(PChar(Copy(FileText[i],1,v_Size_Section)))) = LowerCase(Trim(PChar(v_SectionName)))) then  
562 - Begin  
563 - For j := i to FileText.Count - 1 Do  
564 - Begin  
565 - if (LowerCase(Trim(PChar(Copy(FileText[j],1,v_Size_Key)))) = LowerCase(Trim(PChar(v_KeyName)))) then  
566 - Begin  
567 - Result := PChar(Copy(FileText[j],v_Size_Key + 1,strLen(PChar(FileText[j]))-v_Size_Key));  
568 - Break;  
569 - End;  
570 - End;  
571 - End;  
572 - if (Result <> '') then break;  
573 - End;  
574 - finally  
575 - FileText.Free;  
576 - end;  
577 - end;  
578 -  
579 -function TfrmMapaCacic.GetFolderDate(Folder: string): TDateTime;  
580 -var  
581 - Rec: TSearchRec;  
582 - Found: Integer;  
583 - Date: TDateTime;  
584 -begin  
585 - if Folder[Length(folder)] = '\' then  
586 - Delete(Folder, Length(folder), 1);  
587 - Result := 0;  
588 - Found := FindFirst(Folder, faDirectory, Rec);  
589 - try  
590 - if Found = 0 then  
591 - begin  
592 - Date := FileDateToDateTime(Rec.Time);  
593 - Result := Date;  
594 - end;  
595 - finally  
596 - FindClose(Rec);  
597 - end;  
598 -end;  
599 -  
600 -Procedure TfrmMapaCacic.CipherClose(p_DatFileName : string; p_tstrCipherOpened : TStrings);  
601 -var strCipherOpenImploded : string;  
602 - txtFileDatFile : TextFile;  
603 -begin  
604 - try  
605 - FileSetAttr (p_DatFileName,0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
606 - AssignFile(txtFileDatFile,p_DatFileName); {Associa o arquivo a uma variável do tipo TextFile}  
607 -  
608 - // Criação do arquivo .DAT  
609 - Rewrite (txtFileDatFile);  
610 - Append(txtFileDatFile);  
611 -  
612 - strCipherOpenImploded := g_oCacic.implode(p_tstrCipherOpened,'=CacicIsFree=');  
613 - log_DEBUG('Rotina de Fechamento do arquivo DAT ATIVANDO criptografia.');  
614 - strCipherClosed := g_oCacic.enCrypt(strCipherOpenImploded);  
615 - log_DEBUG('Rotina de Fechamento do arquivo DAT RESTAURANDO estado da criptografia.');  
616 -  
617 - Writeln(txtFileDatFile,strCipherClosed); {Grava a string Texto no arquivo texto}  
618 -  
619 - CloseFile(txtFileDatFile);  
620 - except  
621 - end;  
622 -end;  
623 -  
624 -Procedure TfrmMapaCacic.CipherOpen(p_DatFileName : string; var p_tstrCipherOpened : TStrings);  
625 -var v_DatFile : TextFile;  
626 - v_strCipherOpened,  
627 - v_strCipherClosed : string;  
628 - intLoop : integer;  
629 -begin  
630 - v_strCipherOpened := '';  
631 - if FileExists(p_DatFileName) then  
632 - begin  
633 - AssignFile(v_DatFile,p_DatFileName);  
634 - {$IOChecks off}  
635 - Reset(v_DatFile);  
636 - {$IOChecks on}  
637 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
638 - begin  
639 - Rewrite (v_DatFile);  
640 - Append(v_DatFile);  
641 - end;  
642 -  
643 - Readln(v_DatFile,v_strCipherClosed);  
644 - while not EOF(v_DatFile) do Readln(v_DatFile,v_strCipherClosed);  
645 - CloseFile(v_DatFile);  
646 - strCipherOpened:= g_oCacic.deCrypt(v_strCipherClosed);  
647 - end;  
648 - if (trim(strCipherOpened)<>'') then  
649 - p_tstrCipherOpened := g_oCacic.explode(strCipherOpened,'=CacicIsFree=')  
650 - else  
651 - p_tstrCipherOpened := g_oCacic.explode('Configs.ID_SO'+g_oCacic.getSeparatorKey+g_oCacic.getWindowsStrId() +g_oCacic.getSeparatorKey+'Configs.Endereco_WS'+g_oCacic.getSeparatorKey+'/cacic2/ws/',g_oCacic.getSeparatorKey+'Patrimonio.dt_ultima_renovacao'+g_oCacic.getSeparatorKey+'0');  
652 -  
653 - if p_tstrCipherOpened.Count mod 2 = 0 then  
654 - p_tstrCipherOpened.Add('');  
655 -  
656 - log_DEBUG('MemoryDAT aberto com sucesso!');  
657 - if boolDebugs then  
658 - for intLoop := 0 to (p_tstrCipherOpened.Count-1) do  
659 - log_DEBUG('Posição ['+inttostr(intLoop)+'] do MemoryDAT: '+p_tstrCipherOpened[intLoop]);  
660 -  
661 -end;  
662 -  
663 -Procedure TfrmMapaCacic.SetValorDatMemoria(p_Chave : string; p_Valor : String; p_tstrCipherOpened : TStrings);  
664 -begin  
665 - log_DEBUG('Gravando Chave: "'+p_Chave+ '" => "'+p_Valor+'"');  
666 - // Exemplo: p_Chave => Configs.nu_ip_servidor : p_Valor => 10.71.0.120  
667 - if (p_tstrCipherOpened.IndexOf(p_Chave)<>-1) then  
668 - p_tstrCipherOpened[p_tstrCipherOpened.IndexOf(p_Chave)+1] := p_Valor  
669 - else  
670 - Begin  
671 - p_tstrCipherOpened.Add(p_Chave);  
672 - p_tstrCipherOpened.Add(p_Valor);  
673 - End;  
674 -end;  
675 -Function TfrmMapaCacic.GetValorDatMemoria(p_Chave : String; p_tstrCipherOpened : TStrings) : String;  
676 -begin  
677 - log_DEBUG('Resgatando Chave: "'+p_Chave+ '" => "'+Result+'"');  
678 - if (p_tstrCipherOpened.IndexOf(p_Chave)<>-1) then  
679 - Result := trim(p_tstrCipherOpened[p_tstrCipherOpened.IndexOf(p_Chave)+1])  
680 - else  
681 - Result := '';  
682 -end;  
683 -  
684 -function TfrmMapaCacic.SetValorChaveRegEdit(Chave: String; Dado: Variant): Variant;  
685 -var RegEditSet: TRegistry;  
686 - RegDataType: TRegDataType;  
687 - strRootKey, strKey, strValue : String;  
688 - ListaAuxSet : TStrings;  
689 - I : Integer;  
690 -begin  
691 - ListaAuxSet := g_oCacic.explode(Chave, '\');  
692 - strRootKey := ListaAuxSet[0];  
693 - For I := 1 To ListaAuxSet.Count - 2 Do  
694 - strKey := strKey + ListaAuxSet[I] + '\';  
695 - strValue := ListaAuxSet[ListaAuxSet.Count - 1];  
696 -  
697 - RegEditSet := TRegistry.Create;  
698 - try  
699 - log_DEBUG('Em TfrmMapaCacic.SetValorChaveRegEdit: Abrindo Registry para Escrita => Root: "'+strRootKey+ '" Key: "'+strKey+'"');  
700 - RegEditSet.Access := KEY_WRITE;  
701 - RegEditSet.Rootkey := GetRootKey(strRootKey);  
702 -  
703 - if RegEditSet.OpenKey(strKey, True) then  
704 - Begin  
705 - RegDataType := RegEditSet.GetDataType(strValue);  
706 -  
707 - // Sempre será String  
708 - RegDataType := rdString;  
709 -  
710 - if RegDataType = rdString then  
711 - begin  
712 - RegEditSet.WriteString(strValue, Dado);  
713 - end  
714 - else if RegDataType = rdExpandString then  
715 - begin  
716 - RegEditSet.WriteExpandString(strValue, Dado);  
717 - end  
718 - else if RegDataType = rdInteger then  
719 - begin  
720 - RegEditSet.WriteInteger(strValue, Dado);  
721 - end  
722 - else  
723 - begin  
724 - RegEditSet.WriteString(strValue, Dado);  
725 - end;  
726 -  
727 - end;  
728 - finally  
729 - RegEditSet.CloseKey;  
730 - end;  
731 - ListaAuxSet.Free;  
732 - RegEditSet.Free;  
733 -end;  
734 -  
735 -function TfrmMapaCacic.GetRootKey(strRootKey: String): HKEY;  
736 -begin  
737 - if Trim(strRootKey) = 'HKEY_LOCAL_MACHINE' Then Result := HKEY_LOCAL_MACHINE  
738 - else if Trim(strRootKey) = 'HKEY_CLASSES_ROOT' Then Result := HKEY_CLASSES_ROOT  
739 - else if Trim(strRootKey) = 'HKEY_CURRENT_USER' Then Result := HKEY_CURRENT_USER  
740 - else if Trim(strRootKey) = 'HKEY_USERS' Then Result := HKEY_USERS  
741 - else if Trim(strRootKey) = 'HKEY_CURRENT_CONFIG' Then Result := HKEY_CURRENT_CONFIG  
742 - else if Trim(strRootKey) = 'HKEY_DYN_DATA' Then Result := HKEY_DYN_DATA;  
743 -end;  
744 -  
745 -Function TfrmMapaCacic.RetornaValorVetorUON1(id1 : string) : String;  
746 -var I : Integer;  
747 -begin  
748 - For I := 0 to (Length(VetorUON1)-1) Do  
749 - If (VetorUON1[I].id1 = id1) Then Result := VetorUON1[I].nm1;  
750 -end;  
751 -  
752 -Function TfrmMapaCacic.RetornaValorVetorUON1a(id1a : string) : String;  
753 -var I : Integer;  
754 -begin  
755 - For I := 0 to (Length(VetorUON1a)-1) Do  
756 - If (VetorUON1a[I].id1a = id1a) Then Result := VetorUON1a[I].nm1a;  
757 -end;  
758 -  
759 -Function TfrmMapaCacic.RetornaValorVetorUON2(id2, idLocal: string) : String;  
760 -var I : Integer;  
761 -begin  
762 - For I := 0 to (Length(VetorUON2)-1) Do  
763 - If (VetorUON2[I].id2 = id2) and  
764 - (VetorUON2[I].id_local = idLocal) Then Result := VetorUON2[I].nm2;  
765 -end;  
766 -  
767 -procedure TfrmMapaCacic.RecuperaValoresAnteriores(p_strConfigs : String);  
768 -begin  
769 - Mensagem('Recuperando Valores Anteriores...',false,intPausaPadrao div 3);  
770 -  
771 - strId_unid_organizacional_nivel1 := GetValorDatMemoria('Patrimonio.id_unid_organizacional_nivel1',tStringsMapaCACIC);  
772 - if (strId_unid_organizacional_nivel1='') then  
773 - strId_unid_organizacional_nivel1 := g_oCacic.deCrypt(XML.XML_RetornaValor('ID_UON1', p_strConfigs));  
774 -  
775 - strId_unid_organizacional_nivel1a := GetValorDatMemoria('Patrimonio.id_unid_organizacional_nivel1a',tStringsMapaCACIC);  
776 - if (strId_unid_organizacional_nivel1a='') then  
777 - strId_unid_organizacional_nivel1a := g_oCacic.deCrypt(XML.XML_RetornaValor('ID_UON1a', p_strConfigs));  
778 -  
779 - strId_unid_organizacional_nivel2 := GetValorDatMemoria('Patrimonio.id_unid_organizacional_nivel2',tStringsMapaCACIC);  
780 - if (strId_unid_organizacional_nivel2='') then  
781 - strId_unid_organizacional_nivel2 := g_oCacic.deCrypt(XML.XML_RetornaValor('ID_UON2', p_strConfigs));  
782 -  
783 - strId_Local := GetValorDatMemoria('Patrimonio.id_local',tStringsMapaCACIC);  
784 - if (strId_Local='') then  
785 - strId_Local := g_oCacic.deCrypt(XML.XML_RetornaValor('ID_LOCAL', p_strConfigs));  
786 -  
787 - Try  
788 - cb_id_unid_organizacional_nivel1.ItemIndex := cb_id_unid_organizacional_nivel1.Items.IndexOf(RetornaValorVetorUON1(strId_unid_organizacional_nivel1));  
789 - cb_id_unid_organizacional_nivel1Change(Nil); // Para filtrar os valores do combo2 de acordo com o valor selecionado no combo1  
790 - cb_id_unid_organizacional_nivel1a.ItemIndex := cb_id_unid_organizacional_nivel1a.Items.IndexOf(RetornaValorVetorUON1(strId_unid_organizacional_nivel1));  
791 - Except  
792 - end;  
793 -  
794 - Try  
795 - cb_id_unid_organizacional_nivel1a.ItemIndex := cb_id_unid_organizacional_nivel1a.Items.IndexOf(RetornaValorVetorUON1a(strId_unid_organizacional_nivel1a));  
796 - cb_id_unid_organizacional_nivel1aChange(Nil); // Para filtrar os valores do combo3 de acordo com o valor selecionado no combo2  
797 - cb_id_unid_organizacional_nivel2.ItemIndex := cb_id_unid_organizacional_nivel2.Items.IndexOf(RetornaValorVetorUON2(strId_unid_organizacional_nivel2,strId_Local));  
798 - Except  
799 - end;  
800 -  
801 - lbEtiqueta1.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta1', p_strConfigs));  
802 - lbEtiqueta1a.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta1a', p_strConfigs));  
803 -  
804 - strTe_localizacao_complementar := GetValorDatMemoria('Patrimonio.te_localizacao_complementar',tStringsMapaCACIC);  
805 - if (strTe_localizacao_complementar='') then strTe_localizacao_complementar := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_LOC_COMPL', p_strConfigs));  
806 -  
807 - // Tentarei buscar informação gravada no Registry  
808 - strTe_info_patrimonio1 := GetValorChaveRegEdit('HKEY_LOCAL_MACHINE\SOFTWARE\Dataprev\Patrimonio\te_info_patrimonio1');  
809 - if (strTe_info_patrimonio1='') then  
810 - Begin  
811 - strTe_info_patrimonio1 := GetValorDatMemoria('Patrimonio.te_info_patrimonio1',tStringsMapaCACIC);  
812 - End;  
813 - if (strTe_info_patrimonio1='') then strTe_info_patrimonio1 := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_INFO1', p_strConfigs));  
814 -  
815 - strTe_info_patrimonio2 := GetValorDatMemoria('Patrimonio.te_info_patrimonio2',tStringsMapaCACIC);  
816 - if (strTe_info_patrimonio2='') then strTe_info_patrimonio2 := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_INFO2', p_strConfigs));  
817 -  
818 - strTe_info_patrimonio3 := GetValorDatMemoria('Patrimonio.te_info_patrimonio3',tStringsMapaCACIC);  
819 - if (strTe_info_patrimonio3='') then strTe_info_patrimonio3 := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_INFO3', p_strConfigs));  
820 -  
821 - // Tentarei buscar informação gravada no Registry  
822 - strTe_info_patrimonio4 := GetValorChaveRegEdit('HKEY_LOCAL_MACHINE\SOFTWARE\Dataprev\Patrimonio\te_info_patrimonio4');  
823 - if (strTe_info_patrimonio4='') then  
824 - Begin  
825 - strTe_info_patrimonio4 := GetValorDatMemoria('Patrimonio.te_info_patrimonio4',tStringsMapaCACIC);  
826 - End;  
827 - if (strTe_info_patrimonio4='') then strTe_info_patrimonio4 := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_INFO4', p_strConfigs));  
828 -  
829 - strTe_info_patrimonio5 := GetValorDatMemoria('Patrimonio.te_info_patrimonio5',tStringsMapaCACIC);  
830 - if (strTe_info_patrimonio5='') then strTe_info_patrimonio5 := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_INFO5', p_strConfigs));  
831 -  
832 - strTe_info_patrimonio6 := GetValorDatMemoria('Patrimonio.te_info_patrimonio6',tStringsMapaCACIC);  
833 - if (strTe_info_patrimonio6='') then strTe_info_patrimonio6 := g_oCacic.deCrypt(XML.XML_RetornaValor('TE_INFO6', p_strConfigs));  
834 -end;  
835 -  
836 -procedure TfrmMapaCacic.MontaCombos(p_strConfigs : String);  
837 -var Parser : TXmlParser;  
838 - i : integer;  
839 - strAux,  
840 - strAux1,  
841 - strTagName,  
842 - strItemName : string;  
843 -begin  
844 - Mensagem('Montando Listas para Seleção de Unidades Organizacionais...',false,intPausaPadrao div 3);  
845 -  
846 - Parser := TXmlParser.Create;  
847 - Parser.Normalize := True;  
848 - Parser.LoadFromBuffer(PAnsiChar(p_strConfigs));  
849 - log_DEBUG('p_strConfigs: '+p_strConfigs);  
850 - Parser.StartScan;  
851 - i := -1;  
852 - strItemName := '';  
853 - strTagName := '';  
854 - While Parser.Scan DO  
855 - Begin  
856 - strItemName := UpperCase(Parser.CurName);  
857 - if (Parser.CurPartType = ptStartTag) and (strItemName = 'IT1') Then  
858 - Begin  
859 - i := i + 1;  
860 - SetLength(VetorUON1, i + 1); // Aumento o tamanho da matriz dinamicamente de acordo com o número de itens recebidos.  
861 - strTagName := 'IT1';  
862 - end  
863 - else if (Parser.CurPartType = ptEndTag) and (strItemName = 'IT1') then  
864 - strTagName := ''  
865 - else if (Parser.CurPartType in [ptContent, ptCData]) and (strTagName='IT1')Then  
866 - Begin  
867 - strAux1 := g_oCacic.deCrypt(Parser.CurContent);  
868 - if (strItemName = 'ID1') then  
869 - Begin  
870 - VetorUON1[i].id1 := strAux1;  
871 - log_DEBUG('Gravei VetorUON1.id1: "'+strAux1+'"');  
872 - End  
873 - else if (strItemName = 'NM1') then  
874 - Begin  
875 - VetorUON1[i].nm1 := strAux1;  
876 - log_DEBUG('Gravei VetorUON1.nm1: "'+strAux1+'"');  
877 - End;  
878 - End;  
879 - End;  
880 -  
881 - // Código para montar o combo 2  
882 - Parser.StartScan;  
883 - strTagName := '';  
884 - strAux1 := '';  
885 -  
886 - i := -1;  
887 - While Parser.Scan DO  
888 - Begin  
889 - strItemName := UpperCase(Parser.CurName);  
890 - if (Parser.CurPartType = ptStartTag) and (strItemName = 'IT1A') Then  
891 - Begin  
892 - i := i + 1;  
893 - SetLength(VetorUON1a, i + 1); // Aumento o tamanho da matriz dinamicamente de acordo com o número de itens recebidos.  
894 - strTagName := 'IT1A';  
895 - end  
896 - else if (Parser.CurPartType = ptEndTag) and (strItemName = 'IT1A') then  
897 - strTagName := ''  
898 - else if (Parser.CurPartType in [ptContent, ptCData]) and (strTagName='IT1A')Then  
899 - Begin  
900 - strAux1 := g_oCacic.deCrypt(Parser.CurContent);  
901 - if (strItemName = 'ID1') then  
902 - Begin  
903 - VetorUON1a[i].id1 := strAux1;  
904 - log_DEBUG('Gravei VetorUON1a.id1: "'+strAux1+'"');  
905 - End  
906 - else if (strItemName = 'SG_LOC') then  
907 - Begin  
908 - strAux := ' ('+strAux1 + ')';  
909 - End  
910 - else if (strItemName = 'ID1A') then  
911 - Begin  
912 - VetorUON1a[i].id1a := strAux1;  
913 - log_DEBUG('Gravei VetorUON1a.id1a: "'+strAux1+'"');  
914 - End  
915 - else if (strItemName = 'NM1A') then  
916 - Begin  
917 - VetorUON1a[i].nm1a := strAux1+strAux;  
918 - log_DEBUG('Gravei VetorUON1a.nm1a: "'+strAux1+strAux+'"');  
919 - End  
920 - else if (strItemName = 'ID_LOCAL') then  
921 - Begin  
922 - VetorUON1a[i].id_local := strAux1;  
923 - log_DEBUG('Gravei VetorUON1a.id_local: "'+strAux1+'"');  
924 - End;  
925 -  
926 - End;  
927 - end;  
928 -  
929 - // Código para montar o combo 3  
930 - Parser.StartScan;  
931 - strTagName := '';  
932 - i := -1;  
933 -  
934 - While Parser.Scan DO  
935 - Begin  
936 - strItemName := UpperCase(Parser.CurName);  
937 - if (Parser.CurPartType = ptStartTag) and (strItemName = 'IT2') Then  
938 - Begin  
939 - i := i + 1;  
940 - SetLength(VetorUON2, i + 1); // Aumento o tamanho da matriz dinamicamente de acordo com o número de itens recebidos.  
941 - strTagName := 'IT2';  
942 - end  
943 - else if (Parser.CurPartType = ptEndTag) and (strItemName = 'IT2') then  
944 - strTagName := ''  
945 - else if (Parser.CurPartType in [ptContent, ptCData]) and (strTagName='IT2')Then  
946 - Begin  
947 - strAux1 := g_oCacic.deCrypt(Parser.CurContent);  
948 - if (strItemName = 'ID1A') then  
949 - Begin  
950 - VetorUON2[i].id1a := strAux1;  
951 - log_DEBUG('Gravei VetorUON2.id1a: "'+strAux1+'"');  
952 - End  
953 - else if (strItemName = 'ID2') then  
954 - Begin  
955 - VetorUON2[i].id2 := strAux1;  
956 - log_DEBUG('Gravei VetorUON2.id2: "'+strAux1+'"');  
957 - End  
958 - else if (strItemName = 'NM2') then  
959 - Begin  
960 - VetorUON2[i].nm2 := strAux1;  
961 - log_DEBUG('Gravei VetorUON2.nm2: "'+strAux1+'"');  
962 - End  
963 - else if (strItemName = 'ID_LOCAL') then  
964 - Begin  
965 - VetorUON2[i].id_local := strAux1;  
966 - log_DEBUG('Gravei VetorUON2.id_local: "'+strAux1+'"');  
967 - End;  
968 -  
969 - End;  
970 - end;  
971 - Parser.Free;  
972 -  
973 - // Como os itens do combo1 nunca mudam durante a execução do programa (ao contrario dos combo2 e 3), posso colocar o seu preenchimento aqui mesmo.  
974 - cb_id_unid_organizacional_nivel1.Items.Clear;  
975 - For i := 0 to Length(VetorUON1) - 1 Do  
976 - cb_id_unid_organizacional_nivel1.Items.Add(VetorUON1[i].nm1);  
977 -  
978 - if (Length(VetorUON1) = 0) then  
979 - Begin  
980 - frmMapaCacic.Mensagem('ATENÇÃO! Não encontrei Entidades, Linhas de Negócio ou Órgãos cadastrados para esta subrede.',true,intPausaPadrao * 2);  
981 - Finalizar(true);  
982 - End;  
983 -  
984 - For i := 0 to Length(VetorUON1) - 1 Do  
985 - Begin  
986 - Log_DEBUG('VetorUON1['+IntToStr(i)+'].id1='+VetorUON1[i].id1);  
987 - Log_DEBUG('VetorUON1['+IntToStr(i)+'].nm1='+VetorUON1[i].nm1);  
988 - End;  
989 -  
990 - For i := 0 to Length(VetorUON1a) - 1 Do  
991 - Begin  
992 - Log_DEBUG('VetorUON1a['+IntToStr(i)+'].id1='+VetorUON1a[i].id1);  
993 - Log_DEBUG('VetorUON1a['+IntToStr(i)+'].id1a='+VetorUON1a[i].id1a);  
994 - Log_DEBUG('VetorUON1a['+IntToStr(i)+'].nm1a='+VetorUON1a[i].nm1a);  
995 - Log_DEBUG('VetorUON1a['+IntToStr(i)+'].id_local='+VetorUON1a[i].id_local);  
996 - End;  
997 -  
998 - For i := 0 to Length(VetorUON2) - 1 Do  
999 - Begin  
1000 - Log_DEBUG('VetorUON2['+IntToStr(i)+'].id1a='+VetorUON2[i].id1a);  
1001 - Log_DEBUG('VetorUON2['+IntToStr(i)+'].id2='+VetorUON2[i].id2);  
1002 - Log_DEBUG('VetorUON2['+IntToStr(i)+'].nm2='+VetorUON2[i].nm2);  
1003 - Log_DEBUG('VetorUON2['+IntToStr(i)+'].id_local='+VetorUON2[i].id_local);  
1004 - End;  
1005 -end;  
1006 -  
1007 -  
1008 -procedure TfrmMapaCacic.cb_id_unid_organizacional_nivel1Change(Sender: TObject);  
1009 -var i, j: Word;  
1010 - strIdUON1 : String;  
1011 -begin  
1012 - log_DEBUG('Nível 1 CHANGE');  
1013 - // Filtro os itens do combo2, de acordo com o item selecionado no combo1  
1014 - strIdUON1 := VetorUON1[cb_id_unid_organizacional_nivel1.ItemIndex].id1;  
1015 - cb_id_unid_organizacional_nivel1a.Items.Clear;  
1016 - cb_id_unid_organizacional_nivel2.Items.Clear;  
1017 - cb_id_unid_organizacional_nivel1a.Enabled := false;  
1018 - cb_id_unid_organizacional_nivel2.Enabled := false;  
1019 - SetLength(VetorUON1aFiltrado, 0);  
1020 -  
1021 - log_DEBUG('Tamanho de VetorUON1..: '+IntToStr(Length(VetorUON1)));  
1022 - log_DEBUG('ItemIndex de cb_nivel1: '+IntToStr(cb_id_unid_organizacional_nivel1.ItemIndex));  
1023 - log_DEBUG('Tamanho de VetorUON1a.: '+IntToStr(Length(VetorUON1a)));  
1024 - For i := 0 to Length(VetorUON1a) - 1 Do  
1025 - Begin  
1026 - Try  
1027 - if VetorUON1a[i].id1 = strIdUON1 then  
1028 - Begin  
1029 - log_DEBUG('Add em cb_nivel1a: '+VetorUON1a[i].nm1a);  
1030 - cb_id_unid_organizacional_nivel1a.Items.Add(VetorUON1a[i].nm1a);  
1031 - j := Length(VetorUON1aFiltrado);  
1032 - SetLength(VetorUON1aFiltrado, j + 1);  
1033 - VetorUON1aFiltrado[j] := VetorUON1a[i].id1a + '#' +VetorUON1a[i].id_local;  
1034 - log_DEBUG('VetorUON1aFiltrado['+IntToStr(j)+']= '+VetorUON1aFiltrado[j]);  
1035 - end;  
1036 - Except  
1037 - End;  
1038 - end;  
1039 - if (cb_id_unid_organizacional_nivel1a.Items.Count > 0) then  
1040 - Begin  
1041 - cb_id_unid_organizacional_nivel1a.Enabled := true;  
1042 - cb_id_unid_organizacional_nivel1a.ItemIndex := 0;  
1043 - log_DEBUG('Provocando CHANGE em nivel1a');  
1044 - cb_id_unid_organizacional_nivel1aChange(nil);  
1045 - End;  
1046 -end;  
1047 -  
1048 -procedure TfrmMapaCacic.cb_id_unid_organizacional_nivel1aChange(  
1049 - Sender: TObject);  
1050 -var i, j: Word;  
1051 - strIdUON1a,  
1052 - strIdLocal : String;  
1053 - intAux : integer;  
1054 - tstrAux : TStrings;  
1055 -begin  
1056 - log_DEBUG('Nível 1a CHANGE');  
1057 - // Filtro os itens do combo2, de acordo com o item selecionado no combo1  
1058 - //intAux := IfThen(cb_id_unid_organizacional_nivel1a.Items.Count > 1,cb_id_unid_organizacional_nivel1a.ItemIndex+1,0);  
1059 - intAux := cb_id_unid_organizacional_nivel1a.ItemIndex;  
1060 - Log_debug('cb_id_unid_organizacional_nivel1a.ItemIndex = '+intToStr(cb_id_unid_organizacional_nivel1a.ItemIndex));  
1061 -  
1062 - Log_debug('VetorUON1aFiltrado['+intToStr(cb_id_unid_organizacional_nivel1a.ItemIndex)+'] => '+VetorUON1aFiltrado[cb_id_unid_organizacional_nivel1a.ItemIndex]);  
1063 - tstrAux := TStrings.Create;  
1064 - tstrAux := g_oCacic.explode(VetorUON1aFiltrado[cb_id_unid_organizacional_nivel1a.ItemIndex],'#');  
1065 -  
1066 - strIdUON1a := tstrAux[0];  
1067 - strIdLocal := tstrAux[1];  
1068 -  
1069 - tstrAux.Free;  
1070 -  
1071 - Log_debug('strIdLocal = '+strIdLocal);  
1072 - cb_id_unid_organizacional_nivel2.Items.Clear;  
1073 - cb_id_unid_organizacional_nivel2.Enabled := false;  
1074 - SetLength(VetorUON2Filtrado, 0);  
1075 -  
1076 - log_DEBUG('Tamanho de VetorUON1a..: '+IntToStr(Length(VetorUON1a)));  
1077 - log_DEBUG('ItemIndex de cb_nivel1a: '+IntToStr(cb_id_unid_organizacional_nivel1a.ItemIndex));  
1078 - log_DEBUG('Tamanho de VetorUON2...: '+IntToStr(Length(VetorUON2)));  
1079 -  
1080 - For i := 0 to Length(VetorUON2) - 1 Do  
1081 - Begin  
1082 - Try  
1083 - if (VetorUON2[i].id1a = strIdUON1a) and  
1084 - (VetorUON2[i].id_local = strIdLocal) then  
1085 - Begin  
1086 - log_DEBUG('Add em cb_nivel2: '+VetorUON2[i].nm2);  
1087 - cb_id_unid_organizacional_nivel2.Items.Add(VetorUON2[i].nm2);  
1088 - j := Length(VetorUON2Filtrado);  
1089 - SetLength(VetorUON2Filtrado, j + 1);  
1090 - VetorUON2Filtrado[j] := VetorUON2[i].id2 + '#' + VetorUON2[i].id_local;  
1091 - log_DEBUG('VetorUON2Filtrado['+IntToStr(j)+']= '+VetorUON2Filtrado[j]);  
1092 - end;  
1093 - Except  
1094 - End;  
1095 - end;  
1096 - if (cb_id_unid_organizacional_nivel2.Items.Count > 0) then  
1097 - Begin  
1098 - cb_id_unid_organizacional_nivel2.Enabled := true;  
1099 - cb_id_unid_organizacional_nivel2.ItemIndex := 0;  
1100 - End;  
1101 -end;  
1102 -  
1103 -  
1104 -procedure TfrmMapaCacic.AtualizaPatrimonio(Sender: TObject);  
1105 -var strIdUON1,  
1106 - strIdUON1a,  
1107 - strIdUON2,  
1108 - strIdLocal,  
1109 - strRetorno : String;  
1110 - tstrListAux : TStringList;  
1111 - tstrAux : TStrings;  
1112 -begin  
1113 - tstrAux := TStrings.Create;  
1114 - tstrAux := g_oCacic.explode(VetorUON2Filtrado[cb_id_unid_organizacional_nivel2.ItemIndex],'#');  
1115 - Try  
1116 - strIdUON1 := VetorUON1[cb_id_unid_organizacional_nivel1.ItemIndex].id1;  
1117 - strIdUON2 := tstrAux[0];  
1118 - strIdLocal := tstrAux[1];  
1119 - Except  
1120 - end;  
1121 -  
1122 - tstrAux := g_oCacic.explode(VetorUON1aFiltrado[cb_id_unid_organizacional_nivel1a.ItemIndex],'#');  
1123 - Try  
1124 - strIdUON1a := tstrAux[0];  
1125 - Except  
1126 - end;  
1127 -  
1128 - tstrAux.Free;  
1129 - Mensagem('Enviando Informações Coletadas ao Banco de Dados...',false,intPausaPadrao div 3);  
1130 - // Envio dos Dados Coletados ao Banco de Dados  
1131 - tstrListAux := TStringList.Create;  
1132 - tstrListAux.Values['te_node_address'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_NODE_ADDRESS' , frmMapaCacic.tStringsCACIC));  
1133 - tstrListAux.Values['id_so'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('Configs.ID_SO' , frmMapaCacic.tStringsCACIC));  
1134 - tstrListAux.Values['te_so'] := g_oCacic.enCrypt(g_oCacic.getWindowsStrId());  
1135 - tstrListAux.Values['id_ip_rede'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.ID_IP_REDE' , frmMapaCacic.tStringsCACIC));  
1136 - tstrListAux.Values['te_ip'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_IP' , frmMapaCacic.tStringsCACIC));  
1137 - tstrListAux.Values['te_nome_computador'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_NOME_COMPUTADOR' , frmMapaCacic.tStringsCACIC));  
1138 - tstrListAux.Values['te_workgroup'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_WORKGROUP' , frmMapaCacic.tStringsCACIC));  
1139 - tstrListAux.Values['id_usuario'] := g_oCacic.enCrypt(frmMapaCacic.strId_usuario);  
1140 - tstrListAux.Values['id_unid_organizacional_nivel1'] := g_oCacic.enCrypt(strIdUON1);  
1141 - tstrListAux.Values['id_unid_organizacional_nivel1a']:= g_oCacic.enCrypt(strIdUON1A);  
1142 - tstrListAux.Values['id_unid_organizacional_nivel2'] := g_oCacic.enCrypt(strIdUON2);  
1143 - tstrListAux.Values['te_localizacao_complementar' ] := g_oCacic.enCrypt(ed_te_localizacao_complementar.Text);  
1144 - tstrListAux.Values['te_info_patrimonio1' ] := g_oCacic.enCrypt(ed_te_info_patrimonio1.Text);  
1145 - tstrListAux.Values['te_info_patrimonio2' ] := g_oCacic.enCrypt(ed_te_info_patrimonio2.Text);  
1146 - tstrListAux.Values['te_info_patrimonio3' ] := g_oCacic.enCrypt(ed_te_info_patrimonio3.Text);  
1147 - tstrListAux.Values['te_info_patrimonio4' ] := g_oCacic.enCrypt(ed_te_info_patrimonio4.Text);  
1148 - tstrListAux.Values['te_info_patrimonio5' ] := g_oCacic.enCrypt(ed_te_info_patrimonio5.Text);  
1149 - tstrListAux.Values['te_info_patrimonio6' ] := g_oCacic.enCrypt(ed_te_info_patrimonio6.Text);  
1150 -  
1151 - log_DEBUG('Informações para contato com mapa_set_patrimonio:');  
1152 - log_DEBUG('te_node_address: '+tstrListAux.Values['te_node_address']);  
1153 - log_DEBUG('id_so: '+tstrListAux.Values['id_so']);  
1154 - log_DEBUG('te_so: '+tstrListAux.Values['te_so']);  
1155 - log_DEBUG('id_ip_rede: '+tstrListAux.Values['id_ip_rede']);  
1156 - log_DEBUG('te_ip: '+tstrListAux.Values['te_ip']);  
1157 - log_DEBUG('te_nome_computador: '+tstrListAux.Values['te_nome_computador']);  
1158 - log_DEBUG('te_workgroup: '+tstrListAux.Values['te_workgroup']);  
1159 -  
1160 - strRetorno := frmMapaCacic.ComunicaServidor('mapa_set_patrimonio.php', tstrListAux, '');  
1161 - tstrListAux.Free;  
1162 -  
1163 - if not (frmMapaCacic.XML_RetornaValor('STATUS', strRetorno)='OK') then  
1164 - Mensagem('ATENÇÃO: PROBLEMAS NO ENVIO DAS INFORMAÇÕES COLETADAS AO BANCO DE DADOS...',true,intPausaPadrao)  
1165 - else  
1166 - Begin  
1167 - Mensagem('Salvando Informações Coletadas em Base Local...',false,intPausaPadrao div 3);  
1168 - SetValorDatMemoria('Patrimonio.id_unid_organizacional_nivel1' , strIdUON1, tStringsMapaCACIC);  
1169 - SetValorDatMemoria('Patrimonio.id_unid_organizacional_nivel1a', strIdUON1a, tStringsMapaCACIC);  
1170 - SetValorDatMemoria('Patrimonio.id_unid_organizacional_nivel2' , strIdUON2, tStringsMapaCACIC);  
1171 - SetValorDatMemoria('Patrimonio.id_local' , strIdLocal, tStringsMapaCACIC);  
1172 - SetValorDatMemoria('Patrimonio.te_localizacao_complementar' , ed_te_localizacao_complementar.Text, tStringsMapaCACIC);  
1173 - SetValorDatMemoria('Patrimonio.te_info_patrimonio1' , ed_te_info_patrimonio1.Text, tStringsMapaCACIC);  
1174 - SetValorChaveRegEdit('HKEY_LOCAL_MACHINE\SOFTWARE\Dataprev\Patrimonio\te_info_patrimonio1', ed_te_info_patrimonio1.Text);  
1175 - SetValorDatMemoria('Patrimonio.te_info_patrimonio2' , ed_te_info_patrimonio2.Text, tStringsMapaCACIC);  
1176 - SetValorDatMemoria('Patrimonio.te_info_patrimonio3' , ed_te_info_patrimonio3.Text, tStringsMapaCACIC);  
1177 - SetValorDatMemoria('Patrimonio.te_info_patrimonio4' , ed_te_info_patrimonio4.Text, tStringsMapaCACIC);  
1178 - SetValorChaveRegEdit('HKEY_LOCAL_MACHINE\SOFTWARE\Dataprev\Patrimonio\te_info_patrimonio4', ed_te_info_patrimonio4.Text);  
1179 - SetValorDatMemoria('Patrimonio.te_info_patrimonio5' , ed_te_info_patrimonio5.Text, tStringsMapaCACIC);  
1180 - SetValorDatMemoria('Patrimonio.te_info_patrimonio6' , ed_te_info_patrimonio6.Text, tStringsMapaCACIC);  
1181 - SetValorDatMemoria('Patrimonio.ultima_rede_obtida' , GetValorDatMemoria('TcpIp.ID_IP_REDE',frmMapaCacic.tStringsCACIC),tStringsMapaCACIC);  
1182 - SetValorDatMemoria('Patrimonio.dt_ultima_renovacao' , FormatDateTime('yyyymmddhhnnss', Now),tStringsMapaCACIC);  
1183 - End;  
1184 - Finalizar(true);  
1185 -end;  
1186 -  
1187 -procedure TfrmMapaCacic.MontaInterface(p_strConfigs : String);  
1188 -Begin  
1189 - Mensagem('Montando Interface para Coleta de Informações...',false,intPausaPadrao div 3);  
1190 -  
1191 - lbEtiqueta1.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta1', p_strConfigs));  
1192 - lbEtiqueta1.Visible := true;  
1193 - cb_id_unid_organizacional_nivel1.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta1', p_strConfigs));  
1194 - cb_id_unid_organizacional_nivel1.Visible := true;  
1195 -  
1196 - lbEtiqueta1a.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta1a', p_strConfigs));  
1197 - lbEtiqueta1a.Visible := true;  
1198 - cb_id_unid_organizacional_nivel1a.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta1a', p_strConfigs));  
1199 - cb_id_unid_organizacional_nivel1a.Visible := true;  
1200 -  
1201 - lbEtiqueta2.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta2', p_strConfigs));  
1202 - lbEtiqueta2.Visible := true;  
1203 - cb_id_unid_organizacional_nivel2.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta2', p_strConfigs));  
1204 - cb_id_unid_organizacional_nivel2.Visible := true;  
1205 -  
1206 - lbEtiqueta3.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta3', p_strConfigs));  
1207 - lbEtiqueta3.Visible := true;  
1208 - ed_te_localizacao_complementar.Text := strTe_localizacao_complementar;  
1209 - ed_te_localizacao_complementar.Visible := true;  
1210 -  
1211 - log_DEBUG('in_exibir_etiqueta4 -> "'+g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta4', p_strConfigs))+'"');  
1212 - if (trim(g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta4', p_strConfigs))) = 'S') then  
1213 - begin  
1214 - lbEtiqueta4.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta4', p_strConfigs));  
1215 - lbEtiqueta4.Visible := true;  
1216 - ed_te_info_patrimonio1.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta4', p_strConfigs));  
1217 - ed_te_info_patrimonio1.Text := strTe_info_patrimonio1;  
1218 - ed_te_info_patrimonio1.visible := True;  
1219 - end;  
1220 -  
1221 - log_DEBUG('in_exibir_etiqueta5 -> "'+g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta5', p_strConfigs))+'"');  
1222 - if (trim(g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta5', p_strConfigs))) = 'S') then  
1223 - begin  
1224 - lbEtiqueta5.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta5', p_strConfigs));  
1225 - lbEtiqueta5.Visible := true;  
1226 - ed_te_info_patrimonio2.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta5', p_strConfigs));  
1227 - ed_te_info_patrimonio2.Text := strTe_info_patrimonio2;  
1228 - ed_te_info_patrimonio2.visible := True;  
1229 - end;  
1230 -  
1231 - log_DEBUG('in_exibir_etiqueta6 -> "'+g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta6', p_strConfigs))+'"');  
1232 - if (trim(g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta6', p_strConfigs))) = 'S') then  
1233 - begin  
1234 - lbEtiqueta6.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta6', p_strConfigs));  
1235 - lbEtiqueta6.Visible := true;  
1236 - ed_te_info_patrimonio3.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta6', p_strConfigs));  
1237 - ed_te_info_patrimonio3.Text := strTe_info_patrimonio3;  
1238 - ed_te_info_patrimonio3.visible := True;  
1239 - end;  
1240 -  
1241 - log_DEBUG('in_exibir_etiqueta7 -> "'+g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta7', p_strConfigs))+'"');  
1242 - if (trim(g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta7', p_strConfigs))) = 'S') then  
1243 - begin  
1244 - lbEtiqueta7.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta7', p_strConfigs));  
1245 - lbEtiqueta7.Visible := true;  
1246 - ed_te_info_patrimonio4.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta7', p_strConfigs));  
1247 - ed_te_info_patrimonio4.Text := strTe_info_patrimonio4;  
1248 - ed_te_info_patrimonio4.visible := True;  
1249 - end;  
1250 -  
1251 - log_DEBUG('in_exibir_etiqueta8 -> "'+g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta8', p_strConfigs))+'"');  
1252 - if (trim(g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta8', p_strConfigs))) = 'S') then  
1253 - begin  
1254 - lbEtiqueta8.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta8', p_strConfigs));  
1255 - lbEtiqueta8.Visible := true;  
1256 - ed_te_info_patrimonio5.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta8', p_strConfigs));  
1257 - ed_te_info_patrimonio5.Text := strTe_info_patrimonio5;  
1258 - ed_te_info_patrimonio5.visible := True;  
1259 - end;  
1260 -  
1261 - log_DEBUG('in_exibir_etiqueta9 -> "'+g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta9', p_strConfigs))+'"');  
1262 - if (trim(g_oCacic.deCrypt(XML.XML_RetornaValor('in_exibir_etiqueta9', p_strConfigs))) = 'S') then  
1263 - begin  
1264 - lbEtiqueta9.Caption := g_oCacic.deCrypt(XML.XML_RetornaValor('te_etiqueta9', p_strConfigs));  
1265 - lbEtiqueta9.Visible := true;  
1266 - ed_te_info_patrimonio6.Hint := g_oCacic.deCrypt(XML.XML_RetornaValor('te_help_etiqueta9', p_strConfigs));  
1267 - ed_te_info_patrimonio6.Text := strTe_info_patrimonio6;  
1268 - ed_te_info_patrimonio6.visible := True;  
1269 - end;  
1270 -  
1271 - Application.ProcessMessages;  
1272 - Mensagem('',false,0);  
1273 - btGravarInformacoes.Visible := true;  
1274 -end;  
1275 -  
1276 -procedure TfrmMapaCacic.FormClose(Sender: TObject; var Action: TCloseAction);  
1277 -begin  
1278 - Finalizar(true);  
1279 -end;  
1280 -// Função adaptada de http://www.latiumsoftware.com/en/delphi/00004.php  
1281 -//Para buscar do RegEdit...  
1282 -function TfrmMapaCacic.GetValorChaveRegEdit(Chave: String): Variant;  
1283 -var RegEditGet: TRegistry;  
1284 - RegDataType: TRegDataType;  
1285 - strRootKey, strKey, strValue, s: String;  
1286 - ListaAuxGet : TStrings;  
1287 - DataSize, Len, I : Integer;  
1288 -begin  
1289 - try  
1290 - Result := '';  
1291 - ListaAuxGet := g_oCacic.explode(Chave, '\');  
1292 -  
1293 - strRootKey := ListaAuxGet[0];  
1294 - For I := 1 To ListaAuxGet.Count - 2 Do strKey := strKey + ListaAuxGet[I] + '\';  
1295 - strValue := ListaAuxGet[ListaAuxGet.Count - 1];  
1296 - if (strValue = '(Padrão)') then strValue := ''; //Para os casos de se querer buscar o valor default (Padrão)  
1297 - RegEditGet := TRegistry.Create;  
1298 -  
1299 - RegEditGet.Access := KEY_READ;  
1300 - RegEditGet.Rootkey := GetRootKey(strRootKey);  
1301 - if RegEditGet.OpenKeyReadOnly(strKey) then //teste  
1302 - Begin  
1303 - RegDataType := RegEditGet.GetDataType(strValue);  
1304 - if (RegDataType = rdString) or (RegDataType = rdExpandString) then Result := RegEditGet.ReadString(strValue)  
1305 - else if RegDataType = rdInteger then Result := RegEditGet.ReadInteger(strValue)  
1306 - else if (RegDataType = rdBinary) or (RegDataType = rdUnknown)  
1307 - then  
1308 - begin  
1309 - DataSize := RegEditGet.GetDataSize(strValue);  
1310 - if DataSize = -1 then exit;  
1311 - SetLength(s, DataSize);  
1312 - Len := RegEditGet.ReadBinaryData(strValue, PChar(s)^, DataSize);  
1313 - if Len <> DataSize then exit;  
1314 - Result := trim(RemoveCaracteresEspeciais(s,' ',32,126));  
1315 - end  
1316 - end;  
1317 - finally  
1318 - RegEditGet.CloseKey;  
1319 - RegEditGet.Free;  
1320 - ListaAuxGet.Free;  
1321 -  
1322 - end;  
1323 -end;  
1324 -  
1325 -Function TfrmMapaCacic.RemoveCaracteresEspeciais(Texto, p_Fill : String; p_start, p_end:integer) : String;  
1326 -var I : Integer;  
1327 - strAux : String;  
1328 -Begin  
1329 -// if ord(Texto[I]) in [32..126] Then  
1330 -// else strAux := strAux + ' '; // Coloca um espaço onde houver caracteres especiais  
1331 - strAux := '';  
1332 - if (Length(trim(Texto))>0) then  
1333 - For I := 0 To Length(Texto) Do  
1334 - if ord(Texto[I]) in [p_start..p_end] Then  
1335 - strAux := strAux + Texto[I]  
1336 - else  
1337 - strAux := strAux + p_Fill;  
1338 - Result := strAux;  
1339 -end;  
1340 -procedure TfrmMapaCacic.CriaFormSenha(Sender: TObject);  
1341 -begin  
1342 - Application.CreateForm(TfrmAcesso, frmAcesso);  
1343 -end;  
1344 -  
1345 -// Baixada de http://www.infoeng.hpg.ig.com.br/borland_delphi_dicas_2.htm  
1346 -function TfrmMapaCacic.LetrasDrives: string;  
1347 -var  
1348 -Drives: DWord;  
1349 -I, Tipo: byte;  
1350 -v_Unidade : string;  
1351 -begin  
1352 -Result := '';  
1353 -Drives := GetLogicalDrives;  
1354 -if Drives <> 0 then  
1355 -for I := 65 to 90 do  
1356 - if ((Drives shl (31 - (I - 65))) shr 31) = 1 then  
1357 - Begin  
1358 - v_Unidade := Char(I) + ':\';  
1359 - Tipo := GetDriveType(PChar(v_Unidade));  
1360 - case Tipo of  
1361 - DRIVE_FIXED: Result := Result + Char(I);  
1362 - end;  
1363 - End;  
1364 -end;  
1365 -// By Muad Dib 2003  
1366 -// at http://www.planet-source-code.com.  
1367 -// Excelente!!!  
1368 -function TfrmMapaCacic.SearchFile(p_Drive,p_File:string) : boolean;  
1369 -var sr:TSearchRec;  
1370 - sDirList:TStringList;  
1371 - i:integer;  
1372 - strResSearch : String;  
1373 -begin  
1374 - Result := false;  
1375 - strResSearch := '';  
1376 - if FindFirst(p_Drive+p_File,faAnyFile,sr) = 0 then  
1377 - Begin  
1378 - strResSearch := p_Drive+p_File;  
1379 - Result := true;  
1380 - End  
1381 - else  
1382 - Begin  
1383 - repeat  
1384 - until FindNext(sr)<>0;  
1385 - FindClose(sr);  
1386 - sDirList:= TStringList.Create;  
1387 - try  
1388 - GetSubDirs(p_Drive,sDirList);  
1389 - for i:=0 to sDirList.Count-1 do  
1390 - if (sDirList[i]<>'.') and (sDirList[i]<>'..') then  
1391 - begin  
1392 - //Application.ProcessMessages;  
1393 - if (SearchFile(IncludeTrailingPathDelimiter(p_Drive+sDirList[i]),p_File)) then  
1394 - Begin  
1395 - Result := true;  
1396 - Break;  
1397 - End;  
1398 - end;  
1399 - finally  
1400 - sDirList.Free;  
1401 - End;  
1402 - end;  
1403 -end;  
1404 -procedure TfrmMapaCacic.GetSubDirs(Folder:string; sList:TStringList);  
1405 - var  
1406 - sr:TSearchRec;  
1407 -begin  
1408 - if FindFirst(Folder+'*.*',faDirectory,sr)=0 then  
1409 - try  
1410 - repeat  
1411 - if(sr.Attr and faDirectory)=faDirectory then  
1412 - sList.Add(sr.Name);  
1413 - until FindNext(sr)<>0;  
1414 - finally  
1415 - FindClose(sr);  
1416 - end;  
1417 -end;  
1418 -  
1419 -procedure TfrmMapaCacic.mapa;  
1420 -var strConfigs : String;  
1421 - tstrAUX : TStrings;  
1422 -begin  
1423 - tstrAUX := TStrings.Create;  
1424 -  
1425 - Try  
1426 - strConfigs := GetValorDatMemoria('Patrimonio.Configs', frmMapaCacic.tStringsMapaCACIC);  
1427 - gbLeiaComAtencao.Visible := true;  
1428 - gbInformacoesSobreComputador.Visible := true;  
1429 - MontaCombos(strConfigs);  
1430 - RecuperaValoresAnteriores(strConfigs);  
1431 - MontaInterface(strConfigs);  
1432 - Application.ProcessMessages;  
1433 - Except  
1434 - End;  
1435 -End;  
1436 -  
1437 -procedure TfrmMapaCacic.FormActivate(Sender: TObject);  
1438 -var intAux : integer;  
1439 - strLetrasDrives,  
1440 - strRetorno,  
1441 - v_strCacicPath : String;  
1442 - Request_mapa : TStringList;  
1443 -begin  
1444 - if not boolFinalizar then  
1445 - Begin  
1446 - g_oCacic := TCACIC.Create();  
1447 -  
1448 - g_oCacic.setBoolCipher(true);  
1449 - frmMapaCacic.lbVersao.Caption := 'Versão: ' + frmMapaCacic.GetVersionInfo(ParamStr(0));  
1450 -  
1451 - if (g_oCacic.isWindowsNTPlataform()) and (not g_oCacic.isWindowsAdmin()) then  
1452 - MessageDLG(#13#10+'ATENÇÃO! Essa aplicação requer execução com nível administrativo.',mtError,[mbOK],0)  
1453 - else  
1454 - Begin  
1455 - frmMapaCacic.tStringsMapaCACIC := TStrings.Create;  
1456 -  
1457 - // Buscarei o caminho do Sistema em \WinDIR\chkSIS.DAT  
1458 - CipherOpen(g_oCacic.getWinDir + 'chksis.dat',frmMapaCacic.tStringsMapaCACIC);  
1459 - v_strCacicPath := GetValorDatMemoria('cacic2.cacic_dir',frmMapaCacic.tStringsMapaCACIC);  
1460 -  
1461 - if not (v_strCacicPath = '') then  
1462 - Begin  
1463 - frmMapaCacic.tStringsCACIC := TStrings.Create;  
1464 - g_oCacic.setCacicPath(v_strCacicPath);  
1465 -  
1466 - // A existência e bloqueio do arquivo abaixo evitará que o Cacic2.exe entre em ação  
1467 - AssignFile(v_Aguarde,g_oCacic.getCacicPath + 'temp\aguarde_MAPACACIC.txt'); {Associa o arquivo a uma variável do tipo TextFile}  
1468 - {$IOChecks off}  
1469 - Reset(v_Aguarde); {Abre o arquivo texto}  
1470 - {$IOChecks on}  
1471 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
1472 - Rewrite (v_Aguarde);  
1473 -  
1474 - Append(v_Aguarde);  
1475 - Writeln(v_Aguarde,'Apenas um pseudo-cookie para o Cacic2 esperar o término de MapaCACIC');  
1476 - Append(v_Aguarde);  
1477 -  
1478 - CipherOpen(frmMapaCacic.g_oCacic.getCacicPath + frmMapaCacic.g_oCacic.getDatFileName,frmMapaCacic.tStringsCACIC);  
1479 -  
1480 - if not FileExists(frmMapaCacic.g_oCacic.getCacicPath + 'MapaCACIC.dat') then  
1481 - CopyFile(PChar(frmMapaCacic.g_oCacic.getCacicPath + frmMapaCacic.g_oCacic.getDatFileName), PChar(frmMapaCacic.g_oCacic.getCacicPath + 'MapaCACIC.dat'), true);  
1482 -  
1483 - frmMapaCacic.CipherOpen(frmMapaCacic.g_oCacic.getCacicPath + 'MapaCACIC.dat',frmMapaCacic.tStringsMapaCACIC);  
1484 -  
1485 - // Sobreponho as informações do MapaCACIC com informações do CACIC, caso sejam mais antigas  
1486 - if (GetValorDatMemoria('Patrimonio.dt_ultima_renovacao',tStringsMapaCACIC) = '') or  
1487 - (StrToInt64(GetValorDatMemoria('Patrimonio.dt_ultima_renovacao',tStringsMapaCACIC)) < StrToInt64(GetValorDatMemoria('Patrimonio.dt_ultima_renovacao',tStringsCACIC))) then  
1488 - frmMapaCacic.tStringsMapaCACIC := frmMapaCacic.tStringsCACIC;  
1489 -  
1490 - frmMapaCacic.lbNomeServidorWEB.Caption := 'Servidor de Aplicação: '+frmMapaCacic.GetValorDatMemoria('Configs.EnderecoServidor', frmMapaCacic.tStringsCACIC);  
1491 - frmMapaCacic.lbMensagens.Caption := 'Entrada de Dados para Autenticação no Módulo Gerente WEB Cacic';  
1492 - if (frmMapaCacic.GetValorDatMemoria('TcpIp.TE_NODE_ADDRESS' , frmMapaCacic.tStringsCACIC)='') then  
1493 - Begin  
1494 - frmMapaCacic.boolAcessoOK := false;  
1495 - MessageDLG(#13#10+'Atenção! É necessário executar as coletas do Sistema Cacic.' + #13#10 + #13#10 +  
1496 - 'Caso o Sistema Cacic já esteja instalado, clique com botão direito' + #13#10 +  
1497 - 'sobre o ícone da bandeja, escolha a opção "Executar Agora" e aguarde' + #13#10 +  
1498 - 'o fim do processo.',mtError,[mbOK],0);  
1499 - frmMapaCacic.Finalizar(false);  
1500 - End  
1501 - else  
1502 - Begin  
1503 -  
1504 - boolDebugs := false;  
1505 - if DirectoryExists(g_oCacic.getCacicPath + 'Temp\Debugs') then  
1506 - Begin  
1507 - if (FormatDateTime('ddmmyyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs')) = FormatDateTime('ddmmyyyy', date)) then  
1508 - Begin  
1509 - boolDebugs := true;  
1510 - log_DEBUG('Pasta "' + g_oCacic.getCacicPath + 'Temp\Debugs" com data '+FormatDateTime('dd-mm-yyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs'))+' encontrada. DEBUG ativado.');  
1511 - End;  
1512 - End;  
1513 -  
1514 - log_DEBUG('Versão do MapaCacic: '+frmMapaCacic.lbVersao.Caption);  
1515 -  
1516 - // Acessar...  
1517 - CriaFormSenha(nil);  
1518 - frmAcesso.ShowModal;  
1519 -  
1520 - if boolFinalizar then  
1521 - Finalizar(false)  
1522 - else if boolAcessoOK then  
1523 - Begin  
1524 - pnMensagens.Visible := true;  
1525 - Mensagem('Efetuando Comunicação com o Módulo Gerente WEB em "'+GetValorDatMemoria('Configs.EnderecoServidor', tStringsCACIC)+'"...',false,intPausaPadrao div 3);  
1526 - frmAcesso.Free;  
1527 -  
1528 - // Povoamento com dados de configurações da interface patrimonial  
1529 - // Solicita ao servidor as configurações para a Coleta de Informações de Patrimônio  
1530 - Request_mapa := TStringList.Create;  
1531 - Request_mapa.Values['te_node_address'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_NODE_ADDRESS' , frmMapaCacic.tStringsCACIC));  
1532 - Request_mapa.Values['id_so'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('Configs.ID_SO' , frmMapaCacic.tStringsCACIC));  
1533 - Request_mapa.Values['te_so'] := g_oCacic.enCrypt(g_oCacic.getWindowsStrId());  
1534 - Request_mapa.Values['id_ip_rede'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.ID_IP_REDE' , frmMapaCacic.tStringsCACIC));  
1535 - Request_mapa.Values['te_ip'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_IP' , frmMapaCacic.tStringsCACIC));  
1536 - Request_mapa.Values['te_nome_computador']:= g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_NOME_COMPUTADOR', frmMapaCacic.tStringsCACIC));  
1537 - Request_mapa.Values['te_workgroup'] := g_oCacic.enCrypt(frmMapaCacic.GetValorDatMemoria('TcpIp.TE_WORKGROUP' , frmMapaCacic.tStringsCACIC));  
1538 - Request_mapa.Values['id_usuario'] := g_oCacic.enCrypt(frmMapaCacic.strId_usuario);  
1539 -  
1540 - strRetorno := frmMapaCacic.ComunicaServidor('mapa_get_patrimonio.php', Request_mapa, '.');  
1541 -  
1542 - log_DEBUG('Retorno: "'+strRetorno+'"');  
1543 -  
1544 - if (frmMapaCacic.XML_RetornaValor('STATUS', strRetorno)='OK') then  
1545 - Begin  
1546 - Mensagem('Comunicação Efetuada com Sucesso! Salvando Configurações Obtidas...',false,intPausaPadrao div 3);  
1547 - frmMapaCacic.SetValorDatMemoria('Patrimonio.Configs', strRetorno, frmMapaCacic.tStringsMapaCACIC)  
1548 - End  
1549 - else  
1550 - Begin  
1551 - Mensagem('PROBLEMAS NA COMUNICAÇÃO COM O MÓDULO GERENTE WEB...',true,intPausaPadrao);  
1552 - Finalizar(true);  
1553 - End;  
1554 -  
1555 - Request_mapa.Free;  
1556 -  
1557 - mapa;  
1558 - End;  
1559 - End;  
1560 - End  
1561 - else  
1562 - Begin  
1563 - frmMapaCacic.boolAcessoOK := false;  
1564 - MessageDLG(#13#10+'Atenção! É necessário reinstalar o CACIC nesta estação.' + #13#10 + #13#10 +  
1565 - 'A estrutura encontra-se corrompida.' + #13#10,mtError,[mbOK],0);  
1566 - frmMapaCacic.Finalizar(false);  
1567 - End;  
1568 - End;  
1569 - End;  
1570 -end;  
1571 -  
1572 -procedure TfrmMapaCacic.FormCreate(Sender: TObject);  
1573 -begin  
1574 - boolFinalizar := false;  
1575 -end;  
1576 -  
1577 -end.  
mapa/mapa.cfg
View file @2c54a33
@@ -1,42 +0,0 @@ @@ -1,42 +0,0 @@
1 --$A8  
2 --$B-  
3 --$C+  
4 --$D+  
5 --$E-  
6 --$F-  
7 --$G+  
8 --$H+  
9 --$I+  
10 --$J-  
11 --$K-  
12 --$L+  
13 --$M-  
14 --$N+  
15 --$O+  
16 --$P+  
17 --$Q-  
18 --$R-  
19 --$S-  
20 --$T-  
21 --$U-  
22 --$V+  
23 --$W-  
24 --$X+  
25 --$YD  
26 --$Z1  
27 --cg  
28 --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
29 --H+  
30 --W+  
31 --M  
32 --$M16384,1048576  
33 --K$00400000  
34 --LE"c:\arquivos de programas\borland\delphi7\Projects\Bpl"  
35 --LN"c:\arquivos de programas\borland\delphi7\Projects\Bpl"  
36 --U"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion"  
37 --O"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion"  
38 --I"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion"  
39 --R"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion"  
40 --w-UNSAFE_TYPE  
41 --w-UNSAFE_CODE  
42 --w-UNSAFE_CAST  
mapa/mapa.dof
View file @2c54a33
@@ -1,149 +0,0 @@ @@ -1,149 +0,0 @@
1 -[FileVersion]  
2 -Version=7.0  
3 -[Compiler]  
4 -A=8  
5 -B=0  
6 -C=1  
7 -D=1  
8 -E=0  
9 -F=0  
10 -G=1  
11 -H=1  
12 -I=1  
13 -J=0  
14 -K=0  
15 -L=1  
16 -M=0  
17 -N=1  
18 -O=1  
19 -P=1  
20 -Q=0  
21 -R=0  
22 -S=0  
23 -T=0  
24 -U=0  
25 -V=1  
26 -W=0  
27 -X=1  
28 -Y=1  
29 -Z=1  
30 -ShowHints=1  
31 -ShowWarnings=1  
32 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
33 -NamespacePrefix=  
34 -SymbolDeprecated=1  
35 -SymbolLibrary=1  
36 -SymbolPlatform=1  
37 -UnitLibrary=1  
38 -UnitPlatform=1  
39 -UnitDeprecated=1  
40 -HResultCompat=1  
41 -HidingMember=1  
42 -HiddenVirtual=1  
43 -Garbage=1  
44 -BoundsError=1  
45 -ZeroNilCompat=1  
46 -StringConstTruncated=1  
47 -ForLoopVarVarPar=1  
48 -TypedConstVarPar=1  
49 -AsgToTypedConst=1  
50 -CaseLabelRange=1  
51 -ForVariable=1  
52 -ConstructingAbstract=1  
53 -ComparisonFalse=1  
54 -ComparisonTrue=1  
55 -ComparingSignedUnsigned=1  
56 -CombiningSignedUnsigned=1  
57 -UnsupportedConstruct=1  
58 -FileOpen=1  
59 -FileOpenUnitSrc=1  
60 -BadGlobalSymbol=1  
61 -DuplicateConstructorDestructor=1  
62 -InvalidDirective=1  
63 -PackageNoLink=1  
64 -PackageThreadVar=1  
65 -ImplicitImport=1  
66 -HPPEMITIgnored=1  
67 -NoRetVal=1  
68 -UseBeforeDef=1  
69 -ForLoopVarUndef=1  
70 -UnitNameMismatch=1  
71 -NoCFGFileFound=1  
72 -MessageDirective=1  
73 -ImplicitVariants=1  
74 -UnicodeToLocale=1  
75 -LocaleToUnicode=1  
76 -ImagebaseMultiple=1  
77 -SuspiciousTypecast=1  
78 -PrivatePropAccessor=1  
79 -UnsafeType=0  
80 -UnsafeCode=0  
81 -UnsafeCast=0  
82 -[Linker]  
83 -MapFile=0  
84 -OutputObjs=0  
85 -ConsoleApp=1  
86 -DebugInfo=0  
87 -RemoteSymbols=0  
88 -MinStackSize=16384  
89 -MaxStackSize=1048576  
90 -ImageBase=4194304  
91 -ExeDescription=  
92 -[Directories]  
93 -OutputDir=  
94 -UnitOutputDir=  
95 -PackageDLLOutputDir=  
96 -PackageDCPOutputDir=  
97 -SearchPath=C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion  
98 -Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k;MSI_D7_Rtl  
99 -Conditionals=  
100 -DebugSourceDirs=C:\Arquivos de programas\Borland\Delphi7\Mitec\D7;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Hashes  
101 -UsePackages=0  
102 -[Parameters]  
103 -RunParams=  
104 -HostApplication=  
105 -Launcher=  
106 -UseLauncher=0  
107 -DebugCWD=  
108 -[Language]  
109 -ActiveLang=  
110 -ProjectLang=  
111 -RootDir=C:\Arquivos de programas\Borland\Delphi7\Bin\  
112 -[Version Info]  
113 -IncludeVerInfo=1  
114 -AutoIncBuild=0  
115 -MajorVer=1  
116 -MinorVer=0  
117 -Release=0  
118 -Build=0  
119 -Debug=0  
120 -PreRelease=0  
121 -Special=0  
122 -Private=0  
123 -DLL=0  
124 -Locale=1046  
125 -CodePage=1252  
126 -[Version Info Keys]  
127 -CompanyName=Dataprev-ES  
128 -FileDescription=MAPA-CACIC - Módulo Avulso para Coleta de Informações Patrimoniais  
129 -FileVersion=1.0.0.0  
130 -InternalName=  
131 -LegalCopyright=  
132 -LegalTrademarks=  
133 -OriginalFilename=  
134 -ProductName=  
135 -ProductVersion=1.0.0.0  
136 -Comments=Baseado na Licença GPL(General Public License)  
137 -[HistoryLists\hlDebugSourcePath]  
138 -Count=1  
139 -Item0=C:\Arquivos de programas\Borland\Delphi7\Mitec\D7;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Hashes  
140 -[HistoryLists\hlUnitAliases]  
141 -Count=1  
142 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
143 -[HistoryLists\hlSearchPath]  
144 -Count=5  
145 -Item0=C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion  
146 -Item1=C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP  
147 -Item2=C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Ciphers;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Hashes  
148 -Item3=C:\Arquivos de programas\Borland\Delphi7\mitec;C:\Arquivos de programas\Borland\Delphi7\Mitec\D7  
149 -Item4=C:\Arquivos de programas\Borland\Delphi7\mitec  
mapa/mapa.res
View file @2c54a33
No preview for this file type
mapa/mapa_icon.ico
View file @2c54a33
No preview for this file type
mapa/mapacacic.cfg
View file @2c54a33
@@ -1,38 +0,0 @@ @@ -1,38 +0,0 @@
1 --$A8  
2 --$B-  
3 --$C+  
4 --$D+  
5 --$E-  
6 --$F-  
7 --$G+  
8 --$H+  
9 --$I+  
10 --$J-  
11 --$K-  
12 --$L+  
13 --$M-  
14 --$N+  
15 --$O+  
16 --$P+  
17 --$Q-  
18 --$R-  
19 --$S-  
20 --$T-  
21 --$U-  
22 --$V+  
23 --$W-  
24 --$X+  
25 --$YD  
26 --$Z1  
27 --cg  
28 --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
29 --H+  
30 --W+  
31 --M  
32 --$M16384,1048576  
33 --K$00400000  
34 --LE"c:\arquivos de programas\borland\delphi7\Projects\Bpl"  
35 --LN"c:\arquivos de programas\borland\delphi7\Projects\Bpl"  
36 --w-UNSAFE_TYPE  
37 --w-UNSAFE_CODE  
38 --w-UNSAFE_CAST  
mapa/mapacacic.dof
View file @2c54a33
@@ -1,136 +0,0 @@ @@ -1,136 +0,0 @@
1 -[FileVersion]  
2 -Version=7.0  
3 -[Compiler]  
4 -A=8  
5 -B=0  
6 -C=1  
7 -D=1  
8 -E=0  
9 -F=0  
10 -G=1  
11 -H=1  
12 -I=1  
13 -J=0  
14 -K=0  
15 -L=1  
16 -M=0  
17 -N=1  
18 -O=1  
19 -P=1  
20 -Q=0  
21 -R=0  
22 -S=0  
23 -T=0  
24 -U=0  
25 -V=1  
26 -W=0  
27 -X=1  
28 -Y=1  
29 -Z=1  
30 -ShowHints=1  
31 -ShowWarnings=1  
32 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
33 -NamespacePrefix=  
34 -SymbolDeprecated=1  
35 -SymbolLibrary=1  
36 -SymbolPlatform=1  
37 -UnitLibrary=1  
38 -UnitPlatform=1  
39 -UnitDeprecated=1  
40 -HResultCompat=1  
41 -HidingMember=1  
42 -HiddenVirtual=1  
43 -Garbage=1  
44 -BoundsError=1  
45 -ZeroNilCompat=1  
46 -StringConstTruncated=1  
47 -ForLoopVarVarPar=1  
48 -TypedConstVarPar=1  
49 -AsgToTypedConst=1  
50 -CaseLabelRange=1  
51 -ForVariable=1  
52 -ConstructingAbstract=1  
53 -ComparisonFalse=1  
54 -ComparisonTrue=1  
55 -ComparingSignedUnsigned=1  
56 -CombiningSignedUnsigned=1  
57 -UnsupportedConstruct=1  
58 -FileOpen=1  
59 -FileOpenUnitSrc=1  
60 -BadGlobalSymbol=1  
61 -DuplicateConstructorDestructor=1  
62 -InvalidDirective=1  
63 -PackageNoLink=1  
64 -PackageThreadVar=1  
65 -ImplicitImport=1  
66 -HPPEMITIgnored=1  
67 -NoRetVal=1  
68 -UseBeforeDef=1  
69 -ForLoopVarUndef=1  
70 -UnitNameMismatch=1  
71 -NoCFGFileFound=1  
72 -MessageDirective=1  
73 -ImplicitVariants=1  
74 -UnicodeToLocale=1  
75 -LocaleToUnicode=1  
76 -ImagebaseMultiple=1  
77 -SuspiciousTypecast=1  
78 -PrivatePropAccessor=1  
79 -UnsafeType=0  
80 -UnsafeCode=0  
81 -UnsafeCast=0  
82 -[Linker]  
83 -MapFile=0  
84 -OutputObjs=0  
85 -ConsoleApp=1  
86 -DebugInfo=0  
87 -RemoteSymbols=0  
88 -MinStackSize=16384  
89 -MaxStackSize=1048576  
90 -ImageBase=4194304  
91 -ExeDescription=  
92 -[Directories]  
93 -OutputDir=  
94 -UnitOutputDir=  
95 -PackageDLLOutputDir=  
96 -PackageDCPOutputDir=  
97 -SearchPath=  
98 -Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k;MSI_D7_Rtl  
99 -Conditionals=  
100 -DebugSourceDirs=  
101 -UsePackages=0  
102 -[Parameters]  
103 -RunParams=  
104 -HostApplication=  
105 -Launcher=  
106 -UseLauncher=0  
107 -DebugCWD=  
108 -[Language]  
109 -ActiveLang=  
110 -ProjectLang=  
111 -RootDir=C:\Arquivos de programas\Borland\Delphi7\Bin\  
112 -[Version Info]  
113 -IncludeVerInfo=1  
114 -AutoIncBuild=0  
115 -MajorVer=2  
116 -MinorVer=5  
117 -Release=0  
118 -Build=6  
119 -Debug=0  
120 -PreRelease=0  
121 -Special=0  
122 -Private=0  
123 -DLL=0  
124 -Locale=1046  
125 -CodePage=1252  
126 -[Version Info Keys]  
127 -CompanyName=Dataprev - Emp. de TI da Prev.Social - URES  
128 -FileDescription=MapaCACIC - Módulo Avulso para Coleta de Informações Patrimoniais para o Sistema CACIC  
129 -FileVersion=2.5.0.6  
130 -InternalName=  
131 -LegalCopyright=  
132 -LegalTrademarks=  
133 -OriginalFilename=  
134 -ProductName=MapaCACIC  
135 -ProductVersion=2.6  
136 -Comments=Baseado na Licença GPL(General Public License)  
mapa/mapacacic.dpr
View file @2c54a33
@@ -1,61 +0,0 @@ @@ -1,61 +0,0 @@
1 -(**  
2 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
3 -Copyright 2000, 2001, 2002, 2003, 2004, 2005 Dataprev - Empresa de Tecnologia e Informações da Previdência Social, Brasil  
4 -  
5 -Este arquivo é parte do programa CACIC - Configurador Automático e Coletor de Informações Computacionais  
6 -  
7 -O CACIC é um software livre; você pode redistribui-lo e/ou modifica-lo dentro dos termos da Licença Pública Geral GNU como  
8 -publicada pela Fundação do Software Livre (FSF); na versão 2 da Licença, ou (na sua opinião) qualquer versão.  
9 -  
10 -Este programa é distribuido na esperança que possa ser util, mas SEM NENHUMA GARANTIA; sem uma garantia implicita de ADEQUAÇÂO a qualquer  
11 -MERCADO ou APLICAÇÃO EM PARTICULAR. Veja a Licença Pública Geral GNU para maiores detalhes.  
12 -  
13 -Você deve ter recebido uma cópia da Licença Pública Geral GNU, sob o título "LICENCA.txt", junto com este programa, se não, escreva para a Fundação do Software  
14 -Livre(FSF) Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA  
15 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
16 -*)  
17 -  
18 -program MapaCacic;  
19 -  
20 -uses  
21 - Forms,  
22 - Windows,  
23 - main_mapa in 'main_mapa.pas' {frmMapaCacic},  
24 - LibXmlParser in 'LibXmlParser.pas',  
25 - XML in 'xml.pas',  
26 - acesso in 'acesso.pas' {frmAcesso},  
27 - CACIC_Library in '..\CACIC_Library.pas';  
28 -  
29 -{$R *.res}  
30 -  
31 -const  
32 - CACIC_APP_NAME = 'MapaCacic';  
33 -  
34 -var  
35 - hwind:HWND;  
36 - oCacic : TCACIC;  
37 -  
38 -begin  
39 - oCacic := TCACIC.Create();  
40 -  
41 - if( oCacic.isAppRunning( CACIC_APP_NAME ) )  
42 - then begin  
43 - hwind := 0;  
44 - repeat // The string 'My app' must match your App Title (below)  
45 - hwind:=Windows.FindWindowEx(0,hwind,'TApplication', CACIC_APP_NAME );  
46 - until (hwind<>Application.Handle);  
47 - IF (hwind<>0) then  
48 - begin  
49 - Windows.ShowWindow(hwind,SW_SHOWNORMAL);  
50 - Windows.SetForegroundWindow(hwind);  
51 - end;  
52 - FreeMemory(0);  
53 - end  
54 - else  
55 - begin  
56 - Application.Initialize;  
57 - Application.CreateForm(TfrmMapaCacic, frmMapaCacic);  
58 - Application.Run;  
59 - end;  
60 - oCacic.Free();  
61 -end.  
mapa/mapacacic.res
View file @2c54a33
No preview for this file type
mapa/xml.pas
View file @2c54a33
@@ -1,34 +0,0 @@ @@ -1,34 +0,0 @@
1 -unit XML;  
2 -  
3 -  
4 -interface  
5 -  
6 -Uses LibXmlParser, SysUtils;  
7 -  
8 -Function XML_RetornaValor(Tag : String; Fonte : String) : String;  
9 -  
10 -implementation  
11 -  
12 -  
13 -Function XML_RetornaValor(Tag : String; Fonte : String): String;  
14 -VAR  
15 - Parser : TXmlParser;  
16 -begin  
17 - Parser := TXmlParser.Create;  
18 - Parser.Normalize := TRUE;  
19 - Parser.LoadFromBuffer(PAnsiChar(Fonte));  
20 - Parser.StartScan;  
21 - WHILE Parser.Scan DO  
22 - Begin  
23 - if (Parser.CurPartType in [ptContent, ptCData]) Then // Process Parser.CurContent field here  
24 - begin  
25 - if (UpperCase(Parser.CurName) = UpperCase(Tag)) then  
26 - Begin  
27 - Result := Parser.CurContent;  
28 - end;  
29 - end;  
30 - end;  
31 - Parser.Free;  
32 -end;  
33 -  
34 -end.