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   -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   -(**
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   -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   -(**
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   -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   -(**
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   -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   -(**
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   --$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   -[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   --$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   -[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   -(**
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   -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.