Commit 5455a25d8b8ee7bf35f17ad2a02012f835bc5b87

Authored by anderson.peterle@previdencia.gov.br
1 parent 315361af
Exists in master

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

git-svn-id: http://svn.softwarepublico.gov.br/svn/cacic/cacic/trunk/agente-windows@964 fecfc0c7-e812-0410-ae72-849f08638ee7
col_undi/col_undi.cfg
@@ -1,38 +0,0 @@ @@ -1,38 +0,0 @@
1 --$A8  
2 --$B-  
3 --$C+  
4 --$D+  
5 --$E-  
6 --$F-  
7 --$G+  
8 --$H+  
9 --$I+  
10 --$J-  
11 --$K-  
12 --$L+  
13 --$M-  
14 --$N+  
15 --$O+  
16 --$P+  
17 --$Q-  
18 --$R-  
19 --$S-  
20 --$T-  
21 --$U-  
22 --$V+  
23 --$W-  
24 --$X+  
25 --$YD  
26 --$Z1  
27 --cg  
28 --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
29 --H+  
30 --W+  
31 --M  
32 --$M16384,1048576  
33 --K$00400000  
34 --LE"c:\arquivos de programas\borland\delphi7\Projects\Bpl"  
35 --LN"c:\arquivos de programas\borland\delphi7\Projects\Bpl"  
36 --w-UNSAFE_TYPE  
37 --w-UNSAFE_CODE  
38 --w-UNSAFE_CAST  
col_undi/col_undi.dof
@@ -1,136 +0,0 @@ @@ -1,136 +0,0 @@
1 -[FileVersion]  
2 -Version=7.0  
3 -[Compiler]  
4 -A=8  
5 -B=0  
6 -C=1  
7 -D=1  
8 -E=0  
9 -F=0  
10 -G=1  
11 -H=1  
12 -I=1  
13 -J=0  
14 -K=0  
15 -L=1  
16 -M=0  
17 -N=1  
18 -O=1  
19 -P=1  
20 -Q=0  
21 -R=0  
22 -S=0  
23 -T=0  
24 -U=0  
25 -V=1  
26 -W=0  
27 -X=1  
28 -Y=1  
29 -Z=1  
30 -ShowHints=1  
31 -ShowWarnings=1  
32 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;  
33 -NamespacePrefix=  
34 -SymbolDeprecated=1  
35 -SymbolLibrary=1  
36 -SymbolPlatform=1  
37 -UnitLibrary=1  
38 -UnitPlatform=1  
39 -UnitDeprecated=1  
40 -HResultCompat=1  
41 -HidingMember=1  
42 -HiddenVirtual=1  
43 -Garbage=1  
44 -BoundsError=1  
45 -ZeroNilCompat=1  
46 -StringConstTruncated=1  
47 -ForLoopVarVarPar=1  
48 -TypedConstVarPar=1  
49 -AsgToTypedConst=1  
50 -CaseLabelRange=1  
51 -ForVariable=1  
52 -ConstructingAbstract=1  
53 -ComparisonFalse=1  
54 -ComparisonTrue=1  
55 -ComparingSignedUnsigned=1  
56 -CombiningSignedUnsigned=1  
57 -UnsupportedConstruct=1  
58 -FileOpen=1  
59 -FileOpenUnitSrc=1  
60 -BadGlobalSymbol=1  
61 -DuplicateConstructorDestructor=1  
62 -InvalidDirective=1  
63 -PackageNoLink=1  
64 -PackageThreadVar=1  
65 -ImplicitImport=1  
66 -HPPEMITIgnored=1  
67 -NoRetVal=1  
68 -UseBeforeDef=1  
69 -ForLoopVarUndef=1  
70 -UnitNameMismatch=1  
71 -NoCFGFileFound=1  
72 -MessageDirective=1  
73 -ImplicitVariants=1  
74 -UnicodeToLocale=1  
75 -LocaleToUnicode=1  
76 -ImagebaseMultiple=1  
77 -SuspiciousTypecast=1  
78 -PrivatePropAccessor=1  
79 -UnsafeType=0  
80 -UnsafeCode=0  
81 -UnsafeCast=0  
82 -[Linker]  
83 -MapFile=0  
84 -OutputObjs=0  
85 -ConsoleApp=1  
86 -DebugInfo=0  
87 -RemoteSymbols=0  
88 -MinStackSize=16384  
89 -MaxStackSize=1048576  
90 -ImageBase=4194304  
91 -ExeDescription=  
92 -[Directories]  
93 -OutputDir=  
94 -UnitOutputDir=  
95 -PackageDLLOutputDir=  
96 -PackageDCPOutputDir=  
97 -SearchPath=  
98 -Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k;MSI_D7_Rtl  
99 -Conditionals=  
100 -DebugSourceDirs=  
101 -UsePackages=0  
102 -[Parameters]  
103 -RunParams=  
104 -HostApplication=  
105 -Launcher=  
106 -UseLauncher=0  
107 -DebugCWD=  
108 -[Language]  
109 -ActiveLang=  
110 -ProjectLang=  
111 -RootDir=C:\Arquivos de programas\Borland\Delphi7\Bin\  
112 -[Version Info]  
113 -IncludeVerInfo=1  
114 -AutoIncBuild=0  
115 -MajorVer=2  
116 -MinorVer=5  
117 -Release=0  
118 -Build=773  
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=Coletor de Informações de Unidades de Disco do Sistema CACIC  
129 -FileVersion=2.5.0.773  
130 -InternalName=  
131 -LegalCopyright=  
132 -LegalTrademarks=  
133 -OriginalFilename=  
134 -ProductName=Col_UNDI  
135 -ProductVersion=2.6  
136 -Comments=Baseado na licença GPL (General Public License)  
col_undi/col_undi.dpr
@@ -1,436 +0,0 @@ @@ -1,436 +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 -NOTA: O componente MiTeC System Information Component (MSIC) é baseado na classe TComponent e contém alguns subcomponentes baseados na classe TPersistent  
17 - Este componente é apenas freeware e não open-source, e foi baixado de http://www.mitec.cz/Downloads/MSIC.zip  
18 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
19 -*)  
20 -  
21 -program col_undi;  
22 -{$R *.res}  
23 -{$APPTYPE CONSOLE}  
24 -uses  
25 - Windows,  
26 - IniFiles,  
27 - SysUtils,  
28 - Classes,  
29 - Registry,  
30 - MSI_DISK,  
31 - MSI_XML_Reports,  
32 - CACIC_Library in '..\CACIC_Library.pas';  
33 -  
34 -var  
35 - v_strCipherClosed : String;  
36 - v_debugs : boolean;  
37 -  
38 -var  
39 - v_tstrCipherOpened,  
40 - v_tstrCipherOpened1,  
41 - tstrTripa1 : TStrings;  
42 -  
43 -var  
44 - intAux : integer;  
45 -  
46 -var  
47 - g_oCacic : TCACIC;  
48 -  
49 -const  
50 - CACIC_APP_NAME = 'col_undi';  
51 -  
52 -procedure log_diario(strMsg : String);  
53 -var  
54 - HistoricoLog : TextFile;  
55 - strDataArqLocal, strDataAtual : string;  
56 -begin  
57 - try  
58 - FileSetAttr (g_oCacic.getCacicPath + 'cacic2.log',0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
59 - AssignFile(HistoricoLog,g_oCacic.getCacicPath + 'cacic2.log'); {Associa o arquivo a uma variável do tipo TextFile}  
60 - {$IOChecks off}  
61 - Reset(HistoricoLog); {Abre o arquivo texto}  
62 - {$IOChecks on}  
63 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
64 - begin  
65 - Rewrite (HistoricoLog);  
66 - Append(HistoricoLog);  
67 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Log do CACIC <=======================');  
68 - end;  
69 - DateTimeToString(strDataArqLocal, 'yyyymmdd', FileDateToDateTime(Fileage(g_oCacic.getCacicPath + 'cacic2.log')));  
70 - DateTimeToString(strDataAtual , 'yyyymmdd', Date);  
71 - if (strDataAtual <> strDataArqLocal) then // Se o arquivo INI não é da data atual...  
72 - begin  
73 - Rewrite (HistoricoLog); //Cria/Recria o arquivo  
74 - Append(HistoricoLog);  
75 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Log do CACIC <=======================');  
76 - end;  
77 - Append(HistoricoLog);  
78 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now)+ '[Coletor UNDI] '+strMsg); {Grava a string Texto no arquivo texto}  
79 - CloseFile(HistoricoLog); {Fecha o arquivo texto}  
80 - except  
81 - log_diario('Erro na gravação do log!');  
82 - end;  
83 -end;  
84 -  
85 -Function CipherClose(p_DatFileName : string; p_tstrCipherOpened : TStrings) : String;  
86 -var v_strCipherOpenImploded : string;  
87 - v_DatFile : TextFile;  
88 -begin  
89 - try  
90 - FileSetAttr (p_DatFileName,0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
91 - AssignFile(v_DatFile,p_DatFileName); {Associa o arquivo a uma variável do tipo TextFile}  
92 -  
93 - // Criação do arquivo .DAT  
94 - Rewrite (v_DatFile);  
95 - Append(v_DatFile);  
96 -  
97 - v_strCipherOpenImploded := g_oCacic.implode(p_tstrCipherOpened,g_oCacic.getSeparatorKey);  
98 - v_strCipherClosed := g_oCacic.enCrypt(v_strCipherOpenImploded);  
99 -  
100 - Writeln(v_DatFile,v_strCipherClosed); {Grava a string Texto no arquivo texto}  
101 -  
102 - CloseFile(v_DatFile);  
103 - except  
104 - end;  
105 -end;  
106 -  
107 -Function CipherOpen(p_DatFileName : string) : TStrings;  
108 -var v_DatFile : TextFile;  
109 - v_strCipherOpened,  
110 - v_strCipherClosed : string;  
111 -begin  
112 - v_strCipherOpened := '';  
113 - if FileExists(p_DatFileName) then  
114 - begin  
115 - AssignFile(v_DatFile,p_DatFileName);  
116 - {$IOChecks off}  
117 - Reset(v_DatFile);  
118 - {$IOChecks on}  
119 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
120 - begin  
121 - Rewrite (v_DatFile);  
122 - Append(v_DatFile);  
123 - end;  
124 -  
125 - Readln(v_DatFile,v_strCipherClosed);  
126 - while not EOF(v_DatFile) do Readln(v_DatFile,v_strCipherClosed);  
127 - CloseFile(v_DatFile);  
128 - v_strCipherOpened:= g_oCacic.deCrypt(v_strCipherClosed);  
129 - end;  
130 - if (trim(v_strCipherOpened)<>'') then  
131 - Result := g_oCacic.explode(v_strCipherOpened,g_oCacic.getSeparatorKey)  
132 - else  
133 - Result := 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);  
134 -  
135 - if Result.Count mod 2 <> 0 then  
136 - Result.Add('');  
137 -end;  
138 -  
139 -Procedure SetValorDatMemoria(p_Chave : string; p_Valor : String; p_tstrCipherOpened : TStrings);  
140 -begin  
141 - // Exemplo: p_Chave => Configs.nu_ip_servidor : p_Valor => 10.71.0.120  
142 - if (p_tstrCipherOpened.IndexOf(p_Chave)<>-1) then  
143 - p_tstrCipherOpened[v_tstrCipherOpened.IndexOf(p_Chave)+1] := p_Valor  
144 - else  
145 - Begin  
146 - p_tstrCipherOpened.Add(p_Chave);  
147 - p_tstrCipherOpened.Add(p_Valor);  
148 - End;  
149 -end;  
150 -  
151 -Function GetValorDatMemoria(p_Chave : String; p_tstrCipherOpened : TStrings) : String;  
152 -begin  
153 - if (p_tstrCipherOpened.IndexOf(p_Chave)<>-1) then  
154 - Result := p_tstrCipherOpened[p_tstrCipherOpened.IndexOf(p_Chave)+1]  
155 - else  
156 - Result := '';  
157 -end;  
158 -  
159 -function GetFolderDate(Folder: string): TDateTime;  
160 -var  
161 - Rec: TSearchRec;  
162 - Found: Integer;  
163 - Date: TDateTime;  
164 -begin  
165 - if Folder[Length(folder)] = '\' then  
166 - Delete(Folder, Length(folder), 1);  
167 - Result := 0;  
168 - Found := FindFirst(Folder, faDirectory, Rec);  
169 - try  
170 - if Found = 0 then  
171 - begin  
172 - Date := FileDateToDateTime(Rec.Time);  
173 - Result := Date;  
174 - end;  
175 - finally  
176 - FindClose(Rec);  
177 - end;  
178 -end;  
179 -  
180 -function GetRootKey(strRootKey: String): HKEY;  
181 -begin  
182 - /// Encontrar uma maneira mais elegante de fazer esses testes.  
183 - if Trim(strRootKey) = 'HKEY_LOCAL_MACHINE' Then Result := HKEY_LOCAL_MACHINE  
184 - else if Trim(strRootKey) = 'HKEY_CLASSES_ROOT' Then Result := HKEY_CLASSES_ROOT  
185 - else if Trim(strRootKey) = 'HKEY_CURRENT_USER' Then Result := HKEY_CURRENT_USER  
186 - else if Trim(strRootKey) = 'HKEY_USERS' Then Result := HKEY_USERS  
187 - else if Trim(strRootKey) = 'HKEY_CURRENT_CONFIG' Then Result := HKEY_CURRENT_CONFIG  
188 - else if Trim(strRootKey) = 'HKEY_DYN_DATA' Then Result := HKEY_DYN_DATA;  
189 -end;  
190 -  
191 -Function RemoveCaracteresEspeciais(Texto : String) : String;  
192 -var I : Integer;  
193 - strAux : String;  
194 -Begin  
195 - For I := 0 To Length(Texto) Do  
196 - if ord(Texto[I]) in [32..126] Then  
197 - strAux := strAux + Texto[I]  
198 - else strAux := strAux + ' '; // Coloca um espaço onde houver caracteres especiais  
199 - Result := strAux;  
200 -end;  
201 -  
202 -function GetValorChaveRegEdit(Chave: String): Variant;  
203 -var RegEditGet: TRegistry;  
204 - RegDataType: TRegDataType;  
205 - strRootKey, strKey, strValue, s: String;  
206 - ListaAuxGet : TStrings;  
207 - DataSize, Len, I : Integer;  
208 -begin  
209 - try  
210 - Result := '';  
211 - ListaAuxGet := g_oCacic.explode(Chave, '\');  
212 -  
213 - strRootKey := ListaAuxGet[0];  
214 - For I := 1 To ListaAuxGet.Count - 2 Do strKey := strKey + ListaAuxGet[I] + '\';  
215 - strValue := ListaAuxGet[ListaAuxGet.Count - 1];  
216 - if (strValue = '(Padrão)') then strValue := ''; //Para os casos de se querer buscar o valor default (Padrão)  
217 - RegEditGet := TRegistry.Create;  
218 -  
219 - RegEditGet.Access := KEY_READ;  
220 - RegEditGet.Rootkey := GetRootKey(strRootKey);  
221 - if RegEditGet.OpenKeyReadOnly(strKey) then //teste  
222 - Begin  
223 - RegDataType := RegEditGet.GetDataType(strValue);  
224 - if (RegDataType = rdString) or (RegDataType = rdExpandString) then Result := RegEditGet.ReadString(strValue)  
225 - else if RegDataType = rdInteger then Result := RegEditGet.ReadInteger(strValue)  
226 - else if (RegDataType = rdBinary) or (RegDataType = rdUnknown)  
227 - then  
228 - begin  
229 - DataSize := RegEditGet.GetDataSize(strValue);  
230 - if DataSize = -1 then exit;  
231 - SetLength(s, DataSize);  
232 - Len := RegEditGet.ReadBinaryData(strValue, PChar(s)^, DataSize);  
233 - if Len <> DataSize then exit;  
234 - Result := RemoveCaracteresEspeciais(s);  
235 - end  
236 - end;  
237 - finally  
238 - RegEditGet.CloseKey;  
239 - RegEditGet.Free;  
240 - ListaAuxGet.Free;  
241 -  
242 - end;  
243 -end;  
244 -  
245 -procedure Grava_Debugs(strMsg : String);  
246 -var  
247 - DebugsFile : TextFile;  
248 - strDataArqLocal, strDataAtual, v_file_debugs : string;  
249 -begin  
250 - try  
251 - v_file_debugs := g_oCacic.getCacicPath + '\Temp\Debugs\debug_'+StringReplace(ExtractFileName(StrUpper(PChar(ParamStr(0)))),'.EXE','',[rfReplaceAll])+'.txt';  
252 - FileSetAttr (v_file_debugs,0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
253 - AssignFile(DebugsFile,v_file_debugs); {Associa o arquivo a uma variável do tipo TextFile}  
254 -  
255 - {$IOChecks off}  
256 - Reset(DebugsFile); {Abre o arquivo texto}  
257 - {$IOChecks on}  
258 -  
259 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
260 - begin  
261 - Rewrite(DebugsFile);  
262 - Append(DebugsFile);  
263 - Writeln(DebugsFile,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Debug <=======================');  
264 - end;  
265 - DateTimeToString(strDataArqLocal, 'yyyymmdd', FileDateToDateTime(Fileage(v_file_debugs)));  
266 - DateTimeToString(strDataAtual , 'yyyymmdd', Date);  
267 -  
268 - if (strDataAtual <> strDataArqLocal) then // Se o arquivo não é da data atual...  
269 - begin  
270 - Rewrite(DebugsFile); //Cria/Recria o arquivo  
271 - Append(DebugsFile);  
272 - Writeln(DebugsFile,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Debug <=======================');  
273 - end;  
274 -  
275 - Append(DebugsFile);  
276 - Writeln(DebugsFile,FormatDateTime('dd/mm hh:nn:ss : ', Now) + strMsg); {Grava a string Texto no arquivo texto}  
277 - CloseFile(DebugsFile); {Fecha o arquivo texto}  
278 - except  
279 - log_diario('Erro na gravação do Debug!');  
280 - end;  
281 -end;  
282 -  
283 -  
284 -procedure Executa_Col_undi;  
285 -var strTripaDados, strAux, id_tipo_unid_disco, ValorChaveRegistro : String;  
286 - I: Integer;  
287 - v_DISK : TMiTeC_Disk;  
288 - v_Report : TstringList;  
289 -Begin  
290 - SetValorDatMemoria('Col_Undi.Inicio', FormatDateTime('hh:nn:ss', Now), v_tstrCipherOpened1);  
291 - log_diario('Coletando informações de Unidades de Disco.');  
292 - Try  
293 - //strXML := '<?xml version="1.0" encoding="ISO-8859-1"?><unidades>';  
294 - strTripaDados := '';  
295 - v_DISK := TMiTeC_Disk.Create(nil);  
296 -  
297 - with v_DISK do  
298 - begin  
299 - RefreshData;  
300 - for i:=1 to length(AvailableDisks) do  
301 - begin  
302 - strAux := UpperCase(Copy(AvailableDisks,i,1) + ':\');  
303 - Drive := copy(strAux,1,2);  
304 - id_tipo_unid_disco := GetMediaTypeStr(MediaType);  
305 -  
306 - // Coleta de informações sobre unidades de HD.  
307 - if (UpperCase(id_tipo_unid_disco) = 'FIXED') then  
308 - Begin  
309 - id_tipo_unid_disco := '2';  
310 - if (strTripaDados <> '') then  
311 - strTripaDados := strTripaDados + '<REG>'; // Delimitador de REGISTRO  
312 -  
313 - //strXML := strXML + '<unidade>' +  
314 - // '<te_letra>' + Drive + '</te_letra>';  
315 - strTripaDados := strTripaDados + Drive + '<FIELD>';  
316 -  
317 - strTripaDados := strTripaDados + id_tipo_unid_disco + '<FIELD>';  
318 -  
319 - if ((id_tipo_unid_disco = '2') or (id_tipo_unid_disco = '4')) then  
320 - strTripaDados := strTripaDados + FileSystem + '<FIELD>' +  
321 - SerialNumber + '<FIELD>' +  
322 - IntToStr(Capacity div 10485760) + '0' + '<FIELD>' + // Em MB - Coleta apenas de 10 em 10 MB  
323 - IntToStr(FreeSpace div 10485760) + '0' + '<FIELD>' // Em MB - Coleta apenas de 10 em 10 MB  
324 - else  
325 - strTripaDados := strTripaDados + '' + '<FIELD>' +  
326 - '' + '<FIELD>' +  
327 - '' + '<FIELD>' + // Em MB - Coleta apenas de 10 em 10 MB  
328 - '' + '<FIELD>'; // Em MB - Coleta apenas de 10 em 10 MB  
329 - if (id_tipo_unid_disco = '4') then  
330 - strTripaDados := strTripaDados + ExpandUNCFilename(Drive)  
331 - else  
332 - strTripaDados := strTripaDados + '';  
333 -  
334 - end;  
335 - end;  
336 -  
337 - // Caso exista a pasta ..temp/debugs, será criado o arquivo diário debug_<coletor>.txt  
338 - // Usar esse recurso apenas para debug de coletas mal-sucedidas através do componente MSI-Mitec.  
339 - end;  
340 - if (v_Debugs) then  
341 - Begin  
342 - v_Report := TStringList.Create;  
343 - //report(v_Report,false);  
344 - MSI_XML_Reports.Disk_XML_Report(v_DISK,true,v_Report);  
345 - End;  
346 -  
347 - v_DISK.Free;  
348 - //strXML := strXML + '</unidades>';  
349 -  
350 - // Obtenho do registro o valor que foi previamente armazenado  
351 - ValorChaveRegistro := Trim(GetValorDatMemoria('Coletas.UnidadesDisco',v_tstrCipherOpened));  
352 -  
353 - SetValorDatMemoria('Col_Undi.Fim' , FormatDateTime('hh:nn:ss', Now), v_tstrCipherOpened1);  
354 -  
355 - // Se essas informações forem diferentes significa que houve alguma alteração  
356 - // na configuração. Nesse caso, gravo as informações no BD Central e, se não houver  
357 - // problemas durante esse procedimento, atualizo as informações no registro.  
358 - If ((GetValorDatMemoria('Configs.IN_COLETA_FORCADA_UNDI',v_tstrCipherOpened)='S') or (strTripaDados <> ValorChaveRegistro)) and  
359 - (strTripaDados <> '') Then  
360 - Begin  
361 - SetValorDatMemoria('Col_Undi.UVC', strTripaDados, v_tstrCipherOpened1);  
362 - CipherClose(g_oCacic.getCacicPath + 'temp\col_undi.dat', v_tstrCipherOpened1);  
363 - end  
364 - else  
365 - Begin  
366 - SetValorDatMemoria('Col_Undi.nada', 'nada', v_tstrCipherOpened1);  
367 - CipherClose(g_oCacic.getCacicPath + 'temp\col_undi.dat', v_tstrCipherOpened1);  
368 - End;  
369 -  
370 - // Caso exista a pasta ..temp/debugs, será criado o arquivo diário debug_<coletor>.txt  
371 - // Usar esse recurso apenas para debug de coletas mal-sucedidas através do componente MSI-Mitec.  
372 - if (v_Debugs) then  
373 - Begin  
374 - for i:=0 to v_Report.count-1 do  
375 - Begin  
376 - Grava_Debugs(v_report[i]);  
377 - End;  
378 - v_report.Free;  
379 - End;  
380 - Except  
381 - SetValorDatMemoria('Col_Undi.nada', 'nada', v_tstrCipherOpened1);  
382 - SetValorDatMemoria('Col_Undi.Fim', '99999999', v_tstrCipherOpened1);  
383 - CipherClose(g_oCacic.getCacicPath + 'temp\col_undi.dat', v_tstrCipherOpened1);  
384 - log_diario('Problema na coleta de informações de discos.');  
385 - End;  
386 -end;  
387 -  
388 -var strAux : String;  
389 -begin  
390 - g_oCacic := TCACIC.Create();  
391 -  
392 - g_oCacic.setBoolCipher(true);  
393 -  
394 - if( not g_oCacic.isAppRunning( CACIC_APP_NAME ) ) then  
395 - if (ParamCount>0) then  
396 - Begin  
397 - strAux := '';  
398 - For intAux := 1 to ParamCount do  
399 - Begin  
400 - if LowerCase(Copy(ParamStr(intAux),1,11)) = '/cacicpath=' then  
401 - begin  
402 - strAux := Trim(Copy(ParamStr(intAux),12,Length((ParamStr(intAux)))));  
403 - end;  
404 - end;  
405 -  
406 - if (strAux <> '') then  
407 - Begin  
408 - g_oCacic.setCacicPath(strAux);  
409 -  
410 - v_tstrCipherOpened := TStrings.Create;  
411 - v_tstrCipherOpened := CipherOpen(g_oCacic.getCacicPath + g_oCacic.getDatFileName);  
412 -  
413 - v_tstrCipherOpened1 := TStrings.Create;  
414 - v_tstrCipherOpened1 := CipherOpen(g_oCacic.getCacicPath + 'temp\col_undi.dat');  
415 -  
416 - Try  
417 - v_Debugs := false;  
418 - if DirectoryExists(g_oCacic.getCacicPath + 'Temp\Debugs') then  
419 - Begin  
420 - if (FormatDateTime('ddmmyyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs')) = FormatDateTime('ddmmyyyy', date)) then  
421 - Begin  
422 - v_Debugs := true;  
423 - log_diario('Pasta "' + g_oCacic.getCacicPath + 'Temp\Debugs" com data '+FormatDateTime('dd-mm-yyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs'))+' encontrada. DEBUG ativado.');  
424 - End;  
425 - End;  
426 -  
427 - Executa_Col_undi;  
428 - Except  
429 - SetValorDatMemoria('Col_Undi.nada', 'nada', v_tstrCipherOpened1);  
430 - CipherClose(g_oCacic.getCacicPath + 'temp\col_undi.dat', v_tstrCipherOpened1);  
431 - End;  
432 - End;  
433 - End;  
434 - g_oCacic.Free();  
435 -  
436 -end.  
col_undi/col_undi.res
No preview for this file type
col_undi/col_undi_icon.ico
No preview for this file type
col_undi/coleta_unidades_disco.pas
@@ -1,88 +0,0 @@ @@ -1,88 +0,0 @@
1 -unit coleta_unidades_disco;  
2 -  
3 -interface  
4 -  
5 -Uses Registry, Classes, SysUtils, Windows, dialogs;  
6 -  
7 -procedure RealizarColetaUnidadesDisco;  
8 -  
9 -implementation  
10 -  
11 -Uses main, comunicacao, registro;  
12 -  
13 -  
14 -procedure RealizarColetaUnidadesDisco;  
15 -var ValorChaveRegistro, strXML, strAux, id_tipo_unid_disco: String;  
16 - I: Integer;  
17 - Request_RCUD: TStringList;  
18 -Begin  
19 -  
20 - if (CS_COLETA_UNID_DISC) Then  
21 - Begin  
22 - main.frmMain.Log_Historico('* Coletando informações de unidades de disco.');  
23 -  
24 - strXML := '<?xml version="1.0" encoding="ISO-8859-1"?>' +  
25 - '<unidades>' +  
26 - '<te_node_address>' + TE_NODE_ADDRESS + '</te_node_address>' +  
27 - '<te_nome_computador>' + TE_NOME_COMPUTADOR + '</te_nome_computador>' +  
28 - '<te_workgroup>' + te_workgroup + '</te_workgroup>' +  
29 - '<id_so>' + ID_SO + '</id_so>';  
30 -  
31 - main.frmMain.MSystemInfo.Disk.GetInfo;  
32 - with main.frmMain.MSystemInfo.Disk do  
33 - begin  
34 - for i:=1 to length(AvailableDisks) do  
35 - begin  
36 - strAux := UpperCase(Copy(AvailableDisks,i,1) + ':\');  
37 - Drive := copy(strAux,1,2);  
38 -  
39 - id_tipo_unid_disco := GetMediaTypeStr(MediaType);  
40 - { if (UpperCase(id_tipo_unid_disco) = 'REMOVABLE') then id_tipo_unid_disco := '1'  
41 - else if (UpperCase(id_tipo_unid_disco) = 'CDROM') then id_tipo_unid_disco := '3'  
42 - else if (UpperCase(id_tipo_unid_disco) = 'REMOTE') then id_tipo_unid_disco := '4'  
43 - else id_tipo_unid_disco := ''; }  
44 - // Decidi que só me interessa unidades de HD.  
45 - if (UpperCase(id_tipo_unid_disco) = 'FIXED') then  
46 - Begin  
47 - id_tipo_unid_disco := '2';  
48 - strXML := strXML + '<unidade>' +  
49 - '<te_letra>' + Drive + '</te_letra>';  
50 - if ((id_tipo_unid_disco = '2') or (id_tipo_unid_disco = '4')) then strXML := strXML +  
51 - '<cs_sist_arq>' + FileSystem + '</cs_sist_arq>' +  
52 - '<nu_serial>' + SerialNumber + '</nu_serial>' +  
53 - '<nu_capacidade>' + IntToStr(Capacity div 10485760) + '0</nu_capacidade>' + // Em MB - Coleta apenas de 10 em 10 MB  
54 - '<nu_espaco_livre>' + IntToStr(FreeSpace div 10485760 ) + '0</nu_espaco_livre>'; // Em MB - Coleta apenas de 10 em 10 MB  
55 - if (id_tipo_unid_disco = '4') then strXML := strXML +  
56 - '<te_unc>' + ExpandUNCFilename(Drive) + '</te_unc>';  
57 - strXML := strXML + '<id_tipo_unid_disco>' + id_tipo_unid_disco + '</id_tipo_unid_disco>' +  
58 - '</unidade>';  
59 - end;  
60 - end;  
61 - end;  
62 -  
63 - strXML := strXML + '</unidades>';  
64 -  
65 - // Obtenho do registro o valor que foi previamente armazenado  
66 - ValorChaveRegistro := Trim(Registro.GetValorChaveRegIni('Coleta','UnidadesDisco',p_path_cacic_ini));  
67 -  
68 - // Se essas informações forem diferentes significa que houve alguma alteração  
69 - // na configuração. Nesse caso, gravo as informações no BD Central e, se não houver  
70 - // problemas durante esse procedimento, atualizo as informações no registro.  
71 - If (IN_COLETA_FORCADA or (strXML <> ValorChaveRegistro)) Then  
72 - Begin  
73 - //Envio via rede para ao Agente Gerente, para gravação no BD.  
74 - Request_RCUD:=TStringList.Create;  
75 - Request_RCUD.Values['unidades'] := strXML;  
76 -  
77 - // Somente atualizo o registro caso não tenha havido nenhum erro durante o envio das informações para o BD  
78 - //Sobreponho a informação no registro para posterior comparação, na próxima execução.  
79 - if (comunicacao.ComunicaServidor('set_unid_discos.php', Request_RCUD, '>> Enviando informações de Unidades de Disco para o servidor.') <> '0') Then  
80 - Registro.SetValorChaveRegIni('Coleta','UnidadesDisco', strXML,p_path_cacic_ini);  
81 - Request_RCUD.Free;  
82 - end;  
83 - end;  
84 -end;  
85 -  
86 -  
87 -  
88 -end.  
col_undi/main_undi.ddp
No preview for this file type
col_undi/main_undi.dfm
@@ -1,22 +0,0 @@ @@ -1,22 +0,0 @@
1 -object frm_col_undi: Tfrm_col_undi  
2 - Left = 911  
3 - Top = 718  
4 - Width = 112  
5 - Height = 27  
6 - Caption = 'CACIC - Coletor Unidades de Disco'  
7 - Color = clBtnFace  
8 - Font.Charset = DEFAULT_CHARSET  
9 - Font.Color = clWindowText  
10 - Font.Height = -11  
11 - Font.Name = 'MS Sans Serif'  
12 - Font.Style = []  
13 - OldCreateOrder = False  
14 - OnCreate = FormCreate  
15 - PixelsPerInch = 96  
16 - TextHeight = 13  
17 - object MSystemInfo1: TMSystemInfo  
18 - ExceptionModes = [emDefault]  
19 - Left = 136  
20 - Top = 144  
21 - end  
22 -end  
col_undi/main_undi.pas
@@ -1,345 +0,0 @@ @@ -1,345 +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 -NOTA: O componente MiTeC System Information Component (MSIC) é baseado na classe TComponent e contém alguns subcomponentes baseados na classe TPersistent  
17 - Este componente é apenas freeware e não open-source, e foi baixado de http://www.mitec.cz/Downloads/MSIC.zip  
18 ----------------------------------------------------------------------------------------------------------------------------------------------------------------  
19 -*)  
20 -  
21 -unit main_undi;  
22 -  
23 -interface  
24 -  
25 -uses Windows, Forms, IniFiles, SysUtils, Classes, Registry, MSI_GUI;  
26 -var p_path_cacic, p_path_cacic_ini : string;  
27 -  
28 -type  
29 - Tfrm_col_undi = class(TForm)  
30 - MSystemInfo1: TMSystemInfo;  
31 - procedure Executa_Col_undi;  
32 - procedure Log_Historico(strMsg : String);  
33 - Function Crip(PNome: String): String;  
34 - Function DesCrip(PNome: String): String;  
35 - function SetValorChaveRegIni(p_Secao: String; p_Chave: String; p_Valor: String; p_Path : String): String;  
36 - function GetValorChaveRegIni(p_SectionName, p_KeyName, p_IniFileName : String) : String;  
37 - function GetValorChaveRegEdit(Chave: String): Variant;  
38 - function GetRootKey(strRootKey: String): HKEY;  
39 - Function Explode(Texto, Separador : String) : TStrings;  
40 - Function RemoveCaracteresEspeciais(Texto : String) : String;  
41 - procedure FormCreate(Sender: TObject);  
42 - private  
43 - { Private declarations }  
44 - public  
45 - { Public declarations }  
46 - end;  
47 -  
48 -var  
49 - frm_col_undi: Tfrm_col_undi;  
50 -  
51 -implementation  
52 -  
53 -{$R *.dfm}  
54 -  
55 -//Para gravar no Arquivo INI...  
56 -function Tfrm_col_undi.SetValorChaveRegIni(p_Secao: String; p_Chave: String; p_Valor: String; p_Path : String): String;  
57 -var Reg_Ini : TIniFile;  
58 -begin  
59 - FileSetAttr (p_Path,0);  
60 - Reg_Ini := TIniFile.Create(p_Path);  
61 -// Reg_Ini.WriteString(frm_col_undi.Crip(p_Secao), frm_col_undi.Crip(p_Chave), frm_col_undi.Crip(p_Valor));  
62 - Reg_Ini.WriteString(p_Secao, p_Chave, p_Valor);  
63 - Reg_Ini.Free;  
64 -end;  
65 -  
66 -//Para buscar do Arquivo INI...  
67 -// Marreta devido a limitações do KERNEL w9x no tratamento de arquivos texto e suas seções  
68 -function Tfrm_col_undi.GetValorChaveRegIni(p_SectionName, p_KeyName, p_IniFileName : String) : String;  
69 -var  
70 - FileText : TStringList;  
71 - i, j, v_Size_Section, v_Size_Key : integer;  
72 - v_SectionName, v_KeyName : string;  
73 - begin  
74 - Result := '';  
75 - v_SectionName := '[' + p_SectionName + ']';  
76 - v_Size_Section := strLen(PChar(v_SectionName));  
77 - v_KeyName := p_KeyName + '=';  
78 - v_Size_Key := strLen(PChar(v_KeyName));  
79 - FileText := TStringList.Create;  
80 - try  
81 - FileText.LoadFromFile(p_IniFileName);  
82 - For i := 0 To FileText.Count - 1 Do  
83 - Begin  
84 - if (LowerCase(Trim(PChar(Copy(FileText[i],1,v_Size_Section)))) = LowerCase(Trim(PChar(v_SectionName)))) then  
85 - Begin  
86 - For j := i to FileText.Count - 1 Do  
87 - Begin  
88 - if (LowerCase(Trim(PChar(Copy(FileText[j],1,v_Size_Key)))) = LowerCase(Trim(PChar(v_KeyName)))) then  
89 - Begin  
90 - Result := PChar(Copy(FileText[j],v_Size_Key + 1,strLen(PChar(FileText[j]))-v_Size_Key));  
91 - Break;  
92 - End;  
93 - End;  
94 - End;  
95 - if (Result <> '') then break;  
96 - End;  
97 - finally  
98 - FileText.Free;  
99 - end;  
100 - end;  
101 -  
102 -Function Tfrm_col_undi.Explode(Texto, Separador : String) : TStrings;  
103 -var  
104 - strItem : String;  
105 - ListaAuxUTILS : TStrings;  
106 - NumCaracteres, I : Integer;  
107 -Begin  
108 - ListaAuxUTILS := TStringList.Create;  
109 - strItem := '';  
110 - NumCaracteres := Length(Texto);  
111 - For I := 0 To NumCaracteres Do  
112 - If (Texto[I] = Separador) or (I = NumCaracteres) Then  
113 - Begin  
114 - If (I = NumCaracteres) then strItem := strItem + Texto[I];  
115 - ListaAuxUTILS.Add(Trim(strItem));  
116 - strItem := '';  
117 - end  
118 - Else strItem := strItem + Texto[I];  
119 - Explode := ListaAuxUTILS;  
120 -end;  
121 -  
122 -function Tfrm_col_undi.GetRootKey(strRootKey: String): HKEY;  
123 -begin  
124 - /// Encontrar uma maneira mais elegante de fazer esses testes.  
125 - if Trim(strRootKey) = 'HKEY_LOCAL_MACHINE' Then Result := HKEY_LOCAL_MACHINE  
126 - else if Trim(strRootKey) = 'HKEY_CLASSES_ROOT' Then Result := HKEY_CLASSES_ROOT  
127 - else if Trim(strRootKey) = 'HKEY_CURRENT_USER' Then Result := HKEY_CURRENT_USER  
128 - else if Trim(strRootKey) = 'HKEY_USERS' Then Result := HKEY_USERS  
129 - else if Trim(strRootKey) = 'HKEY_CURRENT_CONFIG' Then Result := HKEY_CURRENT_CONFIG  
130 - else if Trim(strRootKey) = 'HKEY_DYN_DATA' Then Result := HKEY_DYN_DATA;  
131 -end;  
132 -  
133 -Function Tfrm_col_undi.RemoveCaracteresEspeciais(Texto : String) : String;  
134 -var I : Integer;  
135 - strAux : String;  
136 -Begin  
137 - For I := 0 To Length(Texto) Do  
138 - if ord(Texto[I]) in [32..126] Then  
139 - strAux := strAux + Texto[I]  
140 - else strAux := strAux + ' '; // Coloca um espaço onde houver caracteres especiais  
141 - Result := strAux;  
142 -end;  
143 -  
144 -function Tfrm_col_undi.GetValorChaveRegEdit(Chave: String): Variant;  
145 -var RegEditGet: TRegistry;  
146 - RegDataType: TRegDataType;  
147 - strRootKey, strKey, strValue, s: String;  
148 - ListaAuxGet : TStrings;  
149 - DataSize, Len, I : Integer;  
150 -begin  
151 - try  
152 - Result := '';  
153 - ListaAuxGet := frm_col_undi.Explode(Chave, '\');  
154 -  
155 - strRootKey := ListaAuxGet[0];  
156 - For I := 1 To ListaAuxGet.Count - 2 Do strKey := strKey + ListaAuxGet[I] + '\';  
157 - strValue := ListaAuxGet[ListaAuxGet.Count - 1];  
158 - if (strValue = '(Padrão)') then strValue := ''; //Para os casos de se querer buscar o valor default (Padrão)  
159 - RegEditGet := TRegistry.Create;  
160 -  
161 - RegEditGet.Access := KEY_READ;  
162 - RegEditGet.Rootkey := GetRootKey(strRootKey);  
163 - if RegEditGet.OpenKeyReadOnly(strKey) then //teste  
164 - Begin  
165 - RegDataType := RegEditGet.GetDataType(strValue);  
166 - if (RegDataType = rdString) or (RegDataType = rdExpandString) then Result := RegEditGet.ReadString(strValue)  
167 - else if RegDataType = rdInteger then Result := RegEditGet.ReadInteger(strValue)  
168 - else if (RegDataType = rdBinary) or (RegDataType = rdUnknown)  
169 - then  
170 - begin  
171 - DataSize := RegEditGet.GetDataSize(strValue);  
172 - if DataSize = -1 then exit;  
173 - SetLength(s, DataSize);  
174 - Len := RegEditGet.ReadBinaryData(strValue, PChar(s)^, DataSize);  
175 - if Len <> DataSize then exit;  
176 - Result := frm_col_undi.RemoveCaracteresEspeciais(s);  
177 - end  
178 - end;  
179 - finally  
180 - RegEditGet.CloseKey;  
181 - RegEditGet.Free;  
182 - ListaAuxGet.Free;  
183 -  
184 - end;  
185 -end;  
186 -  
187 -  
188 -// Simples rotinas de Criptografação e Descriptografação  
189 -// Baixadas de http://www.costaweb.com.br/forum/delphi/474.shtml  
190 -Function Tfrm_col_undi.Crip(PNome: String): String;  
191 -Var  
192 - TamI, TamF: Integer;  
193 - SenA, SenM, SenD: String;  
194 -Begin  
195 - SenA := Trim(PNome);  
196 - TamF := Length(SenA);  
197 - if (TamF > 1) then  
198 - begin  
199 - SenM := '';  
200 - SenD := '';  
201 - For TamI := TamF Downto 1 do  
202 - Begin  
203 - SenM := SenM + Copy(SenA,TamI,1);  
204 - End;  
205 - SenD := Chr(TamF+95)+Copy(SenM,1,1)+Copy(SenA,1,1)+Copy(SenM,2,TamF-2)+Chr(75+TamF);  
206 - end  
207 - else SenD := SenA;  
208 - Result := SenD;  
209 -End;  
210 -  
211 -Function Tfrm_col_undi.DesCrip(PNome: String): String;  
212 -Var  
213 - TamI, TamF: Integer;  
214 - SenA, SenM, SenD: String;  
215 -Begin  
216 - SenA := Trim(PNome);  
217 - TamF := Length(SenA) - 2;  
218 - if (TamF > 1) then  
219 - begin  
220 - SenM := '';  
221 - SenD := '';  
222 - SenA := Copy(SenA,2,TamF);  
223 - SenM := Copy(SenA,1,1)+Copy(SenA,3,TamF)+Copy(SenA,2,1);  
224 - For TamI := TamF Downto 1 do  
225 - Begin  
226 - SenD := SenD + Copy(SenM,TamI,1);  
227 - End;  
228 - end  
229 - else SenD := SenA;  
230 - Result := SenD;  
231 -End;  
232 -  
233 -procedure Tfrm_col_undi.Log_Historico(strMsg : String);  
234 -var  
235 - HistoricoLog : TextFile;  
236 - strDataArqLocal, strDataAtual : string;  
237 -begin  
238 - try  
239 - FileSetAttr (p_path_cacic + 'cacic2.log',0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000  
240 - AssignFile(HistoricoLog,p_path_cacic + 'cacic2.log'); {Associa o arquivo a uma variável do tipo TextFile}  
241 - {$IOChecks off}  
242 - Reset(HistoricoLog); {Abre o arquivo texto}  
243 - {$IOChecks on}  
244 - if (IOResult <> 0) then // Arquivo não existe, será recriado.  
245 - begin  
246 - Rewrite (HistoricoLog);  
247 - Append(HistoricoLog);  
248 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Log do CACIC <=======================');  
249 - end;  
250 - DateTimeToString(strDataArqLocal, 'yyyymmdd', FileDateToDateTime(Fileage(p_path_cacic + 'cacic2.log')));  
251 - DateTimeToString(strDataAtual , 'yyyymmdd', Date);  
252 - if (strDataAtual <> strDataArqLocal) then // Se o arquivo INI não é da data atual...  
253 - begin  
254 - Rewrite (HistoricoLog); //Cria/Recria o arquivo  
255 - Append(HistoricoLog);  
256 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + '======================> Iniciando o Log do CACIC <=======================');  
257 - end;  
258 - Append(HistoricoLog);  
259 - Writeln(HistoricoLog,FormatDateTime('dd/mm hh:nn:ss : ', Now) + strMsg); {Grava a string Texto no arquivo texto}  
260 - CloseFile(HistoricoLog); {Fecha o arquivo texto}  
261 - except  
262 - Log_Historico('Erro na gravação do log!');  
263 - end;  
264 -end;  
265 -  
266 -  
267 -  
268 -procedure Tfrm_col_undi.Executa_Col_undi;  
269 -var strXML, strAux, id_tipo_unid_disco, ValorChaveRegistro : String;  
270 - I: Integer;  
271 -Begin  
272 - Log_Historico('* Coletando informações de Unidades de Disco.');  
273 - Try  
274 - strXML := '<?xml version="1.0" encoding="ISO-8859-1"?><unidades>';  
275 -  
276 - MSystemInfo1.Disk.GetInfo;  
277 - with MSystemInfo1.Disk do  
278 - begin  
279 - for i:=1 to length(AvailableDisks) do  
280 - begin  
281 - strAux := UpperCase(Copy(AvailableDisks,i,1) + ':\');  
282 - Drive := copy(strAux,1,2);  
283 -  
284 - id_tipo_unid_disco := GetMediaTypeStr(MediaType);  
285 -  
286 - // Coleta de informações sobre unidades de HD.  
287 - if (UpperCase(id_tipo_unid_disco) = 'FIXED') then  
288 - Begin  
289 - id_tipo_unid_disco := '2';  
290 - strXML := strXML + '<unidade>' +  
291 - '<te_letra>' + Drive + '</te_letra>';  
292 - if ((id_tipo_unid_disco = '2') or (id_tipo_unid_disco = '4')) then strXML := strXML +  
293 - '<cs_sist_arq>' + FileSystem + '</cs_sist_arq>' +  
294 - '<nu_serial>' + SerialNumber + '</nu_serial>' +  
295 - '<nu_capacidade>' + IntToStr(Capacity div 10485760) + '0</nu_capacidade>' + // Em MB - Coleta apenas de 10 em 10 MB  
296 - '<nu_espaco_livre>' + IntToStr(FreeSpace div 10485760 ) + '0</nu_espaco_livre>'; // Em MB - Coleta apenas de 10 em 10 MB  
297 - if (id_tipo_unid_disco = '4') then strXML := strXML +  
298 - '<te_unc>' + ExpandUNCFilename(Drive) + '</te_unc>';  
299 - strXML := strXML + '<id_tipo_unid_disco>' + id_tipo_unid_disco + '</id_tipo_unid_disco>' +  
300 - '</unidade>';  
301 - end;  
302 - end;  
303 - end;  
304 - strXML := strXML + '</unidades>';  
305 -  
306 - // Obtenho do registro o valor que foi previamente armazenado  
307 - ValorChaveRegistro := Trim(GetValorChaveRegIni('Coleta','UnidadesDisco',p_path_cacic_ini));  
308 -  
309 - // Se essas informações forem diferentes significa que houve alguma alteração  
310 - // na configuração. Nesse caso, gravo as informações no BD Central e, se não houver  
311 - // problemas durante esse procedimento, atualizo as informações no registro.  
312 - If (GetValorChaveRegIni('Configs','IN_COLETA_FORCADA_UNDI',p_path_cacic_ini)='S') or (strXML <> ValorChaveRegistro) Then  
313 - Begin  
314 - SetValorChaveRegIni('Col_Undi','UnidadesDisco', strXML, GetValorChaveRegIni('Configs','P_PATH_COLETAS_INI',p_path_cacic + 'cacic2.ini')+'col_undi.ini');  
315 - end  
316 - else SetValorChaveRegIni('Col_Undi','nada', 'nada', GetValorChaveRegIni('Configs','P_PATH_COLETAS_INI',p_path_cacic + 'cacic2.ini')+'col_undi.ini');  
317 -  
318 - application.Terminate;  
319 - Except  
320 - SetValorChaveRegIni('Col_Undi','nada', 'nada', GetValorChaveRegIni('Configs','P_PATH_COLETAS_INI',p_path_cacic + 'cacic2.ini')+'col_undi.ini');  
321 - application.Terminate;  
322 - End;  
323 -end;  
324 -  
325 -procedure Tfrm_col_undi.FormCreate(Sender: TObject);  
326 -var tstrTripa1 : TStrings;  
327 - intAux : integer;  
328 -begin  
329 - //Pegarei o nível anterior do diretório, que deve ser, por exemplo \Cacic, para leitura do cacic2.ini  
330 - tstrTripa1 := explode(ExtractFilePath(Application.Exename),'\');  
331 - p_path_cacic := '';  
332 - For intAux := 0 to tstrTripa1.Count -2 do  
333 - begin  
334 - p_path_cacic := p_path_cacic + tstrTripa1[intAux] + '\';  
335 - end;  
336 - p_path_cacic_ini := p_path_cacic + 'cacic2.ini';  
337 - Application.ShowMainForm := false;  
338 - Try  
339 - Executa_Col_undi;  
340 - Except  
341 - SetValorChaveRegIni('Col_Undi','nada', 'nada', GetValorChaveRegIni('Configs','P_PATH_COLETAS_INI',p_path_cacic + 'cacic2.ini')+'col_undi.ini');  
342 - application.Terminate;  
343 - End;  
344 -end;  
345 -end.