Commit 6663eb4f3b8fb039a214f6d596d88408b3171c81

Authored by anderson.peterle@previdencia.gov.br
1 parent 619432b8
Exists in master

Implementação de USBDetect, ajustes para suporte de coleta de softwares à plataf…

…orma MS-Windows Vista/Seven, pequenas correções e faxina de código.

git-svn-id: http://svn.softwarepublico.gov.br/svn/cacic/cacic/trunk/agente-windows@949 fecfc0c7-e812-0410-ae72-849f08638ee7
USBdetectClass.pas 0 → 100644
... ... @@ -0,0 +1,164 @@
  1 +unit USBdetectClass;
  2 +// Código Original obtido em http://www.delphi3000.com/articles/article_4841.asp?SK=
  3 +interface
  4 +uses Windows, Messages, SysUtils, Classes;
  5 +
  6 +type
  7 + { Event Types }
  8 + TOnUsbChangeEvent = procedure(AObject : TObject;
  9 + const ADevType,AVendorID,
  10 + AProductID : string) of object;
  11 +
  12 + { USB Class }
  13 + TUsbClass = class(TObject)
  14 + private
  15 + FHandle : HWND;
  16 + FOnUsbRemoval,
  17 + FOnUsbInsertion : TOnUsbChangeEvent;
  18 + procedure GetUsbInfo(const ADeviceString : string;
  19 + out ADevType,AVendorID,
  20 + AProductID : string);
  21 + procedure WinMethod(var AMessage : TMessage);
  22 + procedure RegisterUsbHandler;
  23 + procedure WMDeviceChange(var AMessage : TMessage);
  24 + procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
  25 + public
  26 + constructor Create;
  27 + destructor Destroy; override;
  28 + property OnUsbInsertion : TOnUsbChangeEvent read FOnUsbInsertion
  29 + write FOnUsbInsertion;
  30 + property OnUsbRemoval : TOnUsbChangeEvent read FOnUsbRemoval
  31 + write FOnUsbRemoval;
  32 + end;
  33 +
  34 +
  35 +
  36 +// -----------------------------------------------------------------------------
  37 +implementation
  38 +
  39 +type
  40 + // Win API Definitions
  41 + PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
  42 + DEV_BROADCAST_DEVICEINTERFACE = record
  43 + dbcc_size : DWORD;
  44 + dbcc_devicetype : DWORD;
  45 + dbcc_reserved : DWORD;
  46 + dbcc_classguid : TGUID;
  47 + dbcc_name : char;
  48 + end;
  49 +
  50 +const
  51 + // Miscellaneous
  52 + GUID_DEVINTF_USB_DEVICE : TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  53 + USB_INTERFACE = $00000005; // Device interface class
  54 + USB_INSERTION = $8000; // System detected a new device
  55 + USB_REMOVAL = $8004; // Device is gone
  56 +
  57 +constructor TUsbClass.Create;
  58 +begin
  59 + inherited Create;
  60 + FHandle := AllocateHWnd(WinMethod);
  61 + RegisterUsbHandler;
  62 +end;
  63 +
  64 +destructor TUsbClass.Destroy;
  65 +begin
  66 + DeallocateHWnd(FHandle);
  67 + inherited Destroy;
  68 +end;
  69 +
  70 +procedure TUsbClass.GetUsbInfo(const ADeviceString : string;
  71 + out ADevType,AVendorID,
  72 + AProductID : string);
  73 +var sWork,sKey1 : string;
  74 + tstrAUX1,tstrAUX2 : TStringList;
  75 +begin
  76 + ADevType := '';
  77 + AVendorID := '';
  78 + AProductID := '';
  79 +
  80 + if ADeviceString <> '' then
  81 + Begin
  82 + sWork := copy(ADeviceString,pos('#',ADeviceString) + 1,1026);
  83 + sKey1 := copy(sWork,1,pos('#',sWork) - 1);
  84 +
  85 + tstrAUX1 := TStringList.Create;
  86 + tstrAUX2 := TStringList.Create;
  87 +
  88 + Split('&',sKey1,tstrAUX1);
  89 +
  90 + Split('_',tstrAUX1[0],tstrAUX2);
  91 + AVendorID := tstrAUX2[1];
  92 +
  93 + Split('_',tstrAUX1[1],tstrAUX2);
  94 + AProductID := tstrAUX2[1];
  95 +
  96 + tstrAUX1.Free;
  97 + tstrAUX2.Free;
  98 + End;
  99 +end;
  100 +
  101 +procedure TUsbClass.Split(const Delimiter: Char;
  102 + Input: string;
  103 + const Strings: TStrings) ;
  104 +begin
  105 + Assert(Assigned(Strings)) ;
  106 + Strings.Clear;
  107 + Strings.Delimiter := Delimiter;
  108 + Strings.DelimitedText := Input;
  109 +end;
  110 +
  111 +procedure TUsbClass.WMDeviceChange(var AMessage : TMessage);
  112 +var iDevType : integer;
  113 + sDevString,sDevType,
  114 + sVendorID,sProductID : string;
  115 + pData : PDevBroadcastDeviceInterface;
  116 +begin
  117 + if (AMessage.wParam = USB_INSERTION) or
  118 + (AMessage.wParam = USB_REMOVAL) then
  119 + Begin
  120 + pData := PDevBroadcastDeviceInterface(AMessage.LParam);
  121 + iDevType := pData^.dbcc_devicetype;
  122 +
  123 + // Se for um dispositivo USB...
  124 + if iDevType = USB_INTERFACE then
  125 + Begin
  126 + sDevString := PChar(@pData^.dbcc_name);
  127 +
  128 + GetUsbInfo(sDevString,sDevType,sVendorID,sProductID);
  129 +
  130 + // O evento é disparado conforme a mensagem
  131 + if (AMessage.wParam = USB_INSERTION) and Assigned(FOnUsbInsertion) then
  132 + FOnUsbInsertion(self,sDevType,sVendorID,sProductID);
  133 + if (AMessage.wParam = USB_REMOVAL) and Assigned(FOnUsbRemoval) then
  134 + FOnUsbRemoval(self,sDevType,sVendorID,sProductID);
  135 + End;
  136 + End;
  137 +end;
  138 +
  139 +procedure TUsbClass.WinMethod(var AMessage : TMessage);
  140 +begin
  141 + if (AMessage.Msg = WM_DEVICECHANGE) then
  142 + WMDeviceChange(AMessage)
  143 + else
  144 + AMessage.Result := DefWindowProc(FHandle,AMessage.Msg,
  145 + AMessage.wParam,AMessage.lParam);
  146 +end;
  147 +
  148 +
  149 +procedure TUsbClass.RegisterUsbHandler;
  150 +var rDbi : DEV_BROADCAST_DEVICEINTERFACE;
  151 + iSize : integer;
  152 +begin
  153 + iSize := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
  154 + ZeroMemory(@rDbi,iSize);
  155 + rDbi.dbcc_size := iSize;
  156 + rDbi.dbcc_devicetype := USB_INTERFACE;
  157 + rDbi.dbcc_reserved := 0;
  158 + rDbi.dbcc_classguid := GUID_DEVINTF_USB_DEVICE;
  159 + rDbi.dbcc_name := #0;
  160 + RegisterDeviceNotification(FHandle,@rDbi,DEVICE_NOTIFY_WINDOW_HANDLE);
  161 +end;
  162 +
  163 +
  164 +end.
... ...
cacic2.dpr
... ... @@ -26,7 +26,8 @@ uses
26 26 frmLog in 'frmLog.pas' {FormLog},
27 27 LibXmlParser,
28 28 WinVNC in 'winvnc.pas',
29   - CACIC_Library in 'CACIC_Library.pas';
  29 + CACIC_Library in 'CACIC_Library.pas',
  30 + USBdetectClass in 'USBdetectClass.pas';
30 31  
31 32 {$R *.res}
32 33  
... ... @@ -62,5 +63,5 @@ begin
62 63 Application.Initialize;
63 64 Application.Title := 'cacic2';
64 65 Application.CreateForm(TFormularioGeral, FormularioGeral);
65   - Application.Run;
  66 + Application.Run;
66 67 end.
... ...
cacic2.res
No preview for this file type
cacicservice/CACICsvc.cfg
... ... @@ -31,5 +31,6 @@
31 31 -M
32 32 -$M16384,1048576
33 33 -K$00400000
34   --LE"c:\arquivos de programas\borland\delphi7\Projects\Bpl"
35   --LN"c:\arquivos de programas\borland\delphi7\Projects\Bpl"
  34 +-E"..\"
  35 +-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
  36 +-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
... ...
cacicservice/CACICsvc.dof
... ... @@ -90,7 +90,7 @@ MaxStackSize=1048576
90 90 ImageBase=4194304
91 91 ExeDescription=
92 92 [Directories]
93   -OutputDir=
  93 +OutputDir=..\
94 94 UnitOutputDir=
95 95 PackageDLLOutputDir=
96 96 PackageDCPOutputDir=
... ... @@ -113,9 +113,9 @@ RootDir=E:\NTService\
113 113 IncludeVerInfo=1
114 114 AutoIncBuild=0
115 115 MajorVer=2
116   -MinorVer=5
  116 +MinorVer=6
117 117 Release=0
118   -Build=774
  118 +Build=2
119 119 Debug=0
120 120 PreRelease=0
121 121 Special=0
... ... @@ -124,13 +124,19 @@ DLL=0
124 124 Locale=11274
125 125 CodePage=1252
126 126 [Version Info Keys]
127   -CompanyName=Dataprev - Emp. de TI da Prev Social - URES
128   -FileDescription=CACICservice - Módulo Serviço para Sustentação do Agente Principal
129   -FileVersion=2.5.0.774
  127 +CompanyName=Dataprev - Emp. de TI da Prev Social - UDSL/SSLC
  128 +FileDescription=Sistema CACIC - Módulo para Sustentação do Agente Principal
  129 +FileVersion=2.6.0.2
130 130 InternalName=
131 131 LegalCopyright=
132 132 LegalTrademarks=
133 133 OriginalFilename=
134 134 ProductName=
135   -ProductVersion=2.6
136   -Comments=Baseado na Licença GNU/GPL
  135 +ProductVersion=2.6.0.1
  136 +Comments=Licença: GNU/LGPL
  137 +[HistoryLists\hlUnitAliases]
  138 +Count=1
  139 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
  140 +[HistoryLists\hlOutputDirectorry]
  141 +Count=1
  142 +Item0=..\
... ...
cacicservice/CACICsvc.res
No preview for this file type
chkcacic/chkcacic.res
No preview for this file type
chksis/chksis.res
No preview for this file type
col_anvi/col_anvi.dpr
... ... @@ -420,31 +420,31 @@ begin
420 420 Begin
421 421 g_oCacic.setCacicPath(strAux);
422 422  
423   - v_Debugs := false;
424   - if DirectoryExists(g_oCacic.getCacicPath + 'Temp\Debugs') then
425   - Begin
426   - if (FormatDateTime('ddmmyyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs')) = FormatDateTime('ddmmyyyy', date)) then
427   - Begin
428   - v_Debugs := true;
429   - log_diario('Pasta "' + g_oCacic.getCacicPath + 'Temp\Debugs" com data '+FormatDateTime('dd-mm-yyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs'))+' encontrada. DEBUG ativado.');
  423 + v_Debugs := false;
  424 + if DirectoryExists(g_oCacic.getCacicPath + 'Temp\Debugs') then
  425 + Begin
  426 + if (FormatDateTime('ddmmyyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs')) = FormatDateTime('ddmmyyyy', date)) then
  427 + Begin
  428 + v_Debugs := true;
  429 + log_diario('Pasta "' + g_oCacic.getCacicPath + 'Temp\Debugs" com data '+FormatDateTime('dd-mm-yyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs'))+' encontrada. DEBUG ativado.');
  430 + End;
430 431 End;
431   - End;
432 432  
433   - v_tstrCipherOpened := TStrings.Create;
434   - v_tstrCipherOpened := CipherOpen(g_oCacic.getCacicPath + g_oCacic.getDatFileName);
  433 + v_tstrCipherOpened := TStrings.Create;
  434 + v_tstrCipherOpened := CipherOpen(g_oCacic.getCacicPath + g_oCacic.getDatFileName);
435 435  
436   - v_tstrCipherOpened1 := TStrings.Create;
437   - v_tstrCipherOpened1 := CipherOpen(g_oCacic.getCacicPath + 'temp\col_anvi.dat');
  436 + v_tstrCipherOpened1 := TStrings.Create;
  437 + v_tstrCipherOpened1 := CipherOpen(g_oCacic.getCacicPath + 'temp\col_anvi.dat');
438 438  
439   - Try
440   - Executa_Col_Anvi;
441   - Except
442   - Begin
443   - SetValorDatMemoria('Col_Anvi.nada', 'nada', v_tstrCipherOpened1);
444   - CipherClose(g_oCacic.getCacicPath + 'temp\col_anvi.dat', v_tstrCipherOpened1);
445   - End;
446   - End;
  439 + Try
  440 + Executa_Col_Anvi;
  441 + Except
  442 + Begin
  443 + SetValorDatMemoria('Col_Anvi.nada', 'nada', v_tstrCipherOpened1);
  444 + CipherClose(g_oCacic.getCacicPath + 'temp\col_anvi.dat', v_tstrCipherOpened1);
  445 + End;
  446 + End;
  447 + End;
447 448 End;
448   - End;
449 449 g_oCacic.Free();
450 450 end.
... ...
col_comp/col_comp.res
No preview for this file type
col_hard/col_hard.dpr
... ... @@ -48,8 +48,6 @@ var
48 48 intAux : integer;
49 49 g_oCacic : TCACIC;
50 50  
51   -const
52   - CACIC_APP_NAME = 'col_hard';
53 51  
54 52 // Dica baixada de http://www.marcosdellantonio.net/2007/06/14/operador-if-ternario-em-delphi-e-c/
55 53 // Fiz isso para não ter que acrescentar o componente Math ao USES!
... ... @@ -538,6 +536,16 @@ var v_te_cpu_fabricante,
538 536  
539 537 begin
540 538  
  539 + v_Debugs := false;
  540 + if DirectoryExists(g_oCacic.getCacicPath + 'Temp\Debugs') then
  541 + Begin
  542 + if (FormatDateTime('ddmmyyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs')) = FormatDateTime('ddmmyyyy', date)) then
  543 + Begin
  544 + v_Debugs := true;
  545 + //log_diario('Pasta "' + g_oCacic.getCacicPath + 'Temp\Debugs" com data '+FormatDateTime('dd-mm-yyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs'))+' encontrada. DEBUG ativado.');
  546 + End;
  547 + End;
  548 +
541 549 Try
542 550 SetValorDatMemoria('Col_Hard.Inicio', FormatDateTime('hh:nn:ss', Now), v_tstrCipherOpened1);
543 551 v_Report := TStringList.Create;
... ... @@ -973,51 +981,48 @@ begin
973 981 g_oCacic.Free();
974 982 end;
975 983  
976   -var strAux : String;
  984 +// ATENÇÃO: Caso haja falha na execução deste agente pela estação de trabalho,
  985 +// a provável causa será a falta da Runtime Library RTL70.BPL, que
  986 +// costuma ser "confundida" com vírus e apagada por alguns anti-vírus
  987 +// como o Avasti.
  988 +// SOLUÇÃO: Baixar a partir do endereço http://nwvault.ign.com/View.php?view=Other.Detail&id=119 o pacote
  989 +// D70_Installer.zip, descompactar e executar na estação de trabalho.
  990 +var strAux : String;
  991 +const CACIC_APP_NAME = 'col_hard';
977 992 begin
978 993 g_oCacic := TCACIC.Create();
979   -
980 994 g_oCacic.setBoolCipher(true);
981 995  
982 996 if( not g_oCacic.isAppRunning( CACIC_APP_NAME ) ) then
983   - if (ParamCount>0) then
984   - Begin
985   - strAux := '';
986   - For intAux := 1 to ParamCount do
987   - Begin
988   - if LowerCase(Copy(ParamStr(intAux),1,11)) = '/cacicpath=' then
989   - begin
990   - strAux := Trim(Copy(ParamStr(intAux),12,Length((ParamStr(intAux)))));
991   - log_DEBUG('Parâmetro /CacicPath recebido com valor="'+strAux+'"');
992   - end;
993   - end;
994   -
995   - if (strAux <> '') then
996   - Begin
997   - g_oCacic.setCacicPath(strAux);
  997 + if (ParamCount>0) then
  998 + Begin
  999 + strAux := '';
  1000 + For intAux := 1 to ParamCount do
  1001 + Begin
  1002 + if LowerCase(Copy(ParamStr(intAux),1,11)) = '/cacicpath=' then
  1003 + begin
  1004 + strAux := Trim(Copy(ParamStr(intAux),12,Length((ParamStr(intAux)))));
  1005 + //log_DEBUG('Parâmetro /CacicPath recebido com valor="'+strAux+'"');
  1006 + end;
  1007 + end;
998 1008  
999   - v_tstrCipherOpened := TStrings.Create;
1000   - v_tstrCipherOpened := CipherOpen(g_oCacic.getCacicPath + g_oCacic.getDatFileName);
  1009 + if (strAux <> '') then
  1010 + Begin
  1011 + g_oCacic.setCacicPath(strAux);
1001 1012  
1002   - v_tstrCipherOpened1 := TStrings.Create;
1003   - v_tstrCipherOpened1 := CipherOpen(g_oCacic.getCacicPath + 'temp\col_hard.dat');
  1013 + v_tstrCipherOpened := TStrings.Create;
  1014 + v_tstrCipherOpened := CipherOpen(g_oCacic.getCacicPath + g_oCacic.getDatFileName);
1004 1015  
1005   - Try
1006   - v_Debugs := false;
1007   - if DirectoryExists(g_oCacic.getCacicPath + 'Temp\Debugs') then
1008   - Begin
1009   - if (FormatDateTime('ddmmyyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs')) = FormatDateTime('ddmmyyyy', date)) then
1010   - Begin
1011   - v_Debugs := true;
1012   - log_diario('Pasta "' + g_oCacic.getCacicPath + 'Temp\Debugs" com data '+FormatDateTime('dd-mm-yyyy', GetFolderDate(g_oCacic.getCacicPath + 'Temp\Debugs'))+' encontrada. DEBUG ativado.');
1013   - End;
1014   - End;
1015   - Executa_Col_Hard;
1016   - Except
1017   - SetValorDatMemoria('Col_Hard.nada', 'nada', v_tstrCipherOpened1);
1018   - CipherClose(g_oCacic.getCacicPath + 'temp\col_hard.dat', v_tstrCipherOpened1);
1019   - End;
1020   - End;
1021   - End;
  1016 + v_tstrCipherOpened1 := TStrings.Create;
  1017 + v_tstrCipherOpened1 := CipherOpen(g_oCacic.getCacicPath + 'temp\col_hard.dat');
1022 1018  
  1019 + Try
  1020 + Executa_Col_Hard;
  1021 + Except
  1022 + SetValorDatMemoria('Col_Hard.nada', 'nada', v_tstrCipherOpened1);
  1023 + CipherClose(g_oCacic.getCacicPath + 'temp\col_hard.dat', v_tstrCipherOpened1);
  1024 + End;
  1025 + Halt(0);
  1026 + End;
  1027 + End;
1023 1028 end.
... ...
col_hard/col_hard.res
No preview for this file type
col_moni/col_moni.res
No preview for this file type
col_patr/col_patr.res
No preview for this file type
col_soft/col_soft.dpr
... ... @@ -480,12 +480,15 @@ end;
480 480  
481 481 procedure Executa_Col_Soft;
482 482 var te_versao_mozilla, te_versao_ie, te_versao_jre, te_versao_acrobat_reader,
483   - UVC,ValorChaveRegistro, te_inventario_softwares, te_variaveis_ambiente : String;
  483 + UVC,ValorChaveRegistro, te_inventario_softwares, te_variaveis_ambiente,
  484 + strDisplayName,
  485 + strKeyName : String;
484 486 InfoSoft, v_Report : TStringList;
485 487 i : integer;
486 488 v_SOFTWARE : TMiTeC_Software;
487 489 v_ENGINES : TMiTeC_Engines;
488 490 v_OS : TMiTeC_OperatingSystem;
  491 + registrySoftwares : TRegistry;
489 492 begin
490 493 Try
491 494 log_diario('Coletando informações de Softwares Básicos.');
... ... @@ -495,44 +498,112 @@ begin
495 498 te_versao_jre := GetVersaoJRE;
496 499 te_versao_acrobat_reader := GetVersaoAcrobatReader;
497 500 te_inventario_softwares := '';
  501 + InfoSoft := TStringList.Create;
498 502  
499   - Try
500   - InfoSoft := TStringList.Create;
501   - v_SOFTWARE := TMiTeC_Software.Create(nil);
502   - v_SOFTWARE.RefreshData;
503   - MSI_XML_Reports.Software_XML_Report(v_SOFTWARE,true,InfoSoft);
  503 + if not g_oCacic.isWindowsGEVista then
  504 + Begin
  505 + Try
  506 + v_SOFTWARE := TMiTeC_Software.Create(nil);
  507 + v_SOFTWARE.RefreshData;
  508 + MSI_XML_Reports.Software_XML_Report(v_SOFTWARE,true,InfoSoft);
  509 +
  510 + // Caso exista a pasta ..temp/debugs, será criado o arquivo diário debug_<coletor>.txt
  511 + // Usar esse recurso apenas para debug de coletas mal-sucedidas através do componente MSI-Mitec.
  512 + if v_Debugs then
  513 + Begin
  514 + v_Report := TStringList.Create;
504 515  
505   - // Caso exista a pasta ..temp/debugs, será criado o arquivo diário debug_<coletor>.txt
506   - // Usar esse recurso apenas para debug de coletas mal-sucedidas através do componente MSI-Mitec.
507   - if v_Debugs then
508   - Begin
509   - v_Report := TStringList.Create;
  516 + MSI_XML_Reports.Software_XML_Report(v_SOFTWARE,true,v_Report);
  517 + v_SOFTWARE.Free;
510 518  
511   - MSI_XML_Reports.Software_XML_Report(v_SOFTWARE,true,v_Report);
512   - v_SOFTWARE.Free;
  519 + v_OS := TMiTeC_OperatingSystem.Create(nil);
  520 + v_OS.RefreshData;
513 521  
514   - v_OS := TMiTeC_OperatingSystem.Create(nil);
515   - v_OS.RefreshData;
  522 + MSI_XML_Reports.OperatingSystem_XML_Report(v_OS,true,v_Report);
  523 + v_OS.Free;
  524 + End
516 525  
517   - MSI_XML_Reports.OperatingSystem_XML_Report(v_OS,true,v_Report);
518   - v_OS.Free;
519   - End
  526 + except
  527 + log_diario('Problema em Software Report!');
  528 + end;
520 529  
521   - except
522   - log_diario('Problema em Software Report!');
523   - end;
  530 + for i := 0 to v_SOFTWARE.Count - 1 do
  531 + begin
  532 + if (trim(Copy(InfoSoft[i],1,14))='<section name=') then
  533 + Begin
  534 + if (te_inventario_softwares <> '') then
  535 + te_inventario_softwares := te_inventario_softwares + '#';
  536 + te_inventario_softwares := te_inventario_softwares + Copy(InfoSoft[i],16,Pos('">',InfoSoft[i])-16);
  537 + End;
  538 + end;
  539 +
  540 + v_SOFTWARE.Free;
  541 + end
  542 + else
  543 + Begin
  544 + // Chave para 64Bits
  545 + strKeyName := 'Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
  546 +
  547 + registrySoftwares := TRegistry.Create;
  548 + with registrySoftwares do
  549 + begin
  550 + RootKey:=HKEY_LOCAL_MACHINE;
  551 + if OpenKey(strKeyName,False)=True then GetKeyNames(InfoSoft);
  552 + CloseKey;
  553 +
  554 + for i:=0 to InfoSoft.Count-1 do
  555 + begin
  556 + RootKey:=HKEY_LOCAL_MACHINE;
  557 + OpenKey(strKeyName + '\'+InfoSoft[i],False);
  558 + strDisplayName := ReadString('DisplayName');
  559 + if (strDisplayName <> '') then
  560 + Begin
  561 + if (Copy(strDisplayName,1,1)='{') then
  562 + begin
  563 + OpenKey(strKeyName + '\'+InfoSoft[i]+'\'+strDisplayName,False);
  564 + strDisplayName := ReadString('DisplayName');
  565 + end;
  566 +
  567 + if (te_inventario_softwares <> '') then
  568 + te_inventario_softwares := te_inventario_softwares + '#';
  569 + te_inventario_softwares := te_inventario_softwares + strDisplayName;
  570 + end;
  571 + CloseKey;
  572 + end;
  573 + end;
  574 +
  575 + // Caso a consulta acima tenha retornado vazio, tentarei a chave para 32Bits
  576 + strKeyName := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
524 577  
525   - for i := 0 to v_SOFTWARE.Count - 1 do
526   - begin
527   - if (trim(Copy(InfoSoft[i],1,14))='<section name=') then
  578 + with registrySoftwares do
  579 + begin
  580 + RootKey:=HKEY_LOCAL_MACHINE;
  581 + if OpenKey(strKeyName,False)=True then GetKeyNames(InfoSoft);
  582 + CloseKey;
  583 +
  584 + for i:=0 to InfoSoft.Count-1 do
  585 + begin
  586 + RootKey:=HKEY_LOCAL_MACHINE;
  587 + OpenKey(strKeyName + '\'+InfoSoft[i],False);
  588 + strDisplayName := ReadString('DisplayName');
  589 + if (strDisplayName <> '') then
528 590 Begin
  591 + if (Copy(strDisplayName,1,1)='{') then
  592 + begin
  593 + OpenKey(strKeyName + '\'+InfoSoft[i]+'\'+strDisplayName,False);
  594 + strDisplayName := ReadString('DisplayName');
  595 + end;
  596 +
529 597 if (te_inventario_softwares <> '') then
530   - te_inventario_softwares := te_inventario_softwares + '#';
531   - te_inventario_softwares := te_inventario_softwares + Copy(InfoSoft[i],16,Pos('">',InfoSoft[i])-16);
532   - End;
533   - end;
  598 + te_inventario_softwares := te_inventario_softwares + '#';
  599 + te_inventario_softwares := te_inventario_softwares + strDisplayName;
  600 + end;
  601 + CloseKey;
  602 + end;
  603 + end;
534 604  
535   - v_SOFTWARE.Free;
  605 + //
  606 + end;
536 607  
537 608 try
538 609 te_inventario_softwares := AnsiToAscii(te_inventario_softwares);
... ...
col_soft/col_soft.res
No preview for this file type
col_undi/col_undi.res
No preview for this file type
frmsenha.dfm
1 1 object formSenha: TformSenha
2   - Left = 152
3   - Top = 110
  2 + Left = 361
  3 + Top = 279
4 4 BorderIcons = [biSystemMenu]
5 5 BorderStyle = bsDialog
6 6 Caption = 'Senha'
... ...
ger_cols/ger_cols.dpr
... ... @@ -56,6 +56,7 @@ var
56 56 v_Endereco_Servidor,
57 57 v_Aux,
58 58 strAux,
  59 + strUSBinfo,
59 60 endereco_servidor_cacic,
60 61 v_ModulosOpcoes,
61 62 v_ResultCompress,
... ... @@ -328,6 +329,7 @@ var v_strCipherOpenImploded,
328 329 v_DatFileDebug : TextFile;
329 330 v_cs_cipher : boolean;
330 331 begin
  332 + log_DEBUG('CipherClose: datFileName="' + g_oCacic.getDatFileName + '"');
331 333 try
332 334 FileSetAttr (p_DatFileName,0); // Retira os atributos do arquivo para evitar o erro FILE ACCESS DENIED em máquinas 2000
333 335 AssignFile(v_DatFile,p_DatFileName); {Associa o arquivo a uma variável do tipo TextFile}
... ... @@ -347,6 +349,7 @@ begin
347 349 {$IOChecks on}
348 350 Append(v_DatFileDebug);
349 351 End;
  352 + log_DEBUG('CipherClose: separatorKey="' + g_oCacic.getSeparatorKey + '"');
350 353  
351 354 v_strCipherOpenImploded := g_oCacic.implode(p_tstrCipherOpened,g_oCacic.getSeparatorKey);
352 355  
... ... @@ -2277,10 +2280,10 @@ Begin
2277 2280 SetValorDatMemoria('Configs.te_palavra_chave',strAux, v_tstrCipherOpened);
2278 2281  
2279 2282 // Verifico se srCACIC está em execução e em caso positivo entrego a chave atualizada
2280   - Matar(g_oCacic.getCacicPath+'Temp\','aguarde_SRCACIC.txt');
2281   - sleep(2000);
2282   - if (FileExists(g_oCacic.getCacicPath + 'Temp\aguarde_SRCACIC.txt')) then
2283   - Begin
  2283 + //Matar(g_oCacic.getCacicPath+'Temp\','aguarde_SRCACIC.txt');
  2284 + //sleep(2000);
  2285 + //if (FileExists(g_oCacic.getCacicPath + 'Temp\aguarde_SRCACIC.txt')) then
  2286 + // Begin
2284 2287 // Alguns cuidados necessários ao tráfego e recepção de valores pelo Gerente WEB
2285 2288 // Some cares about send and receive at Gerente WEB
2286 2289 v_Aux := StringReplace(strAux ,' ' ,'<ESPACE>' ,[rfReplaceAll]);
... ... @@ -2296,7 +2299,7 @@ Begin
2296 2299 Append(v_txtCookie);
2297 2300 Writeln(v_txtCookie,v_Aux);
2298 2301 CloseFile(v_txtCookie);
2299   - End;
  2302 + // End;
2300 2303  
2301 2304  
2302 2305 Request_SVG.Values['te_palavra_chave'] := g_oCacic.enCrypt(strAux);
... ... @@ -2495,7 +2498,8 @@ Begin
2495 2498 end;
2496 2499  
2497 2500 procedure Executa_Ger_Cols;
2498   -var strDtHrColetaForcada,
  2501 +var strRetorno,
  2502 + strDtHrColetaForcada,
2499 2503 strDtHrUltimaColeta : String;
2500 2504 Begin
2501 2505 Try
... ... @@ -2505,6 +2509,7 @@ Begin
2505 2509 // /coletas => Chamada para ativação das coletas
2506 2510 // /recuperaSR => Chamada para tentativa de recuperação do módulo srCACIC
2507 2511 // /patrimonio => Chamada para ativação do Formulário de Patrimônio
  2512 + // USBinfo => Informação sobre dispositivo USB inserido/removido
2508 2513 // UpdatePrincipal => Atualização do Agente Principal
2509 2514 // Chamada com parâmetros pelo chkcacic.exe ou linha de comando
2510 2515 // Chamada efetuada pelo Cacic2.exe quando da existência de temp\cacic2.exe para AutoUpdate
... ... @@ -2552,6 +2557,34 @@ Begin
2552 2557 Sair;
2553 2558 End;
2554 2559  
  2560 + strUSBinfo := '';
  2561 +
  2562 + // Chamada com informação de dispositivo USB inserido/removido
  2563 + For intAux := 1 to ParamCount do
  2564 + If LowerCase(Copy(ParamStr(intAux),1,9)) = '/usbinfo=' then
  2565 + strUSBinfo := Trim(Copy(ParamStr(intAux),10,Length((ParamStr(intAux)))));
  2566 +
  2567 + // Envio da informação sobre o dispositivo USB ao Gerente WEB
  2568 + if (strUSBinfo <> '') then
  2569 + begin
  2570 + log_DEBUG('Parâmetro USBinfo recebido: "'+strUSBinfo+'"');
  2571 + v_acao_gercols := 'Informando ao Gerente WEB sobre dispositivo USB inserido/removido.';
  2572 +
  2573 + ChecaCipher;
  2574 + ChecaCompress;
  2575 +
  2576 + Request_Ger_Cols := TStringList.Create;
  2577 + log_DEBUG('Preparando para criptografar "'+strUSBinfo+'"');
  2578 + Request_Ger_Cols.Values['te_usb_info'] := StringReplace(g_oCacic.enCrypt(strUSBinfo),'+','<MAIS>',[rfReplaceAll]);
  2579 + log_DEBUG('Preparando para empacotar "'+Request_Ger_Cols.Values['te_usb_info']+'"');
  2580 + strRetorno := ComunicaServidor('set_usbinfo.php', Request_Ger_Cols, '>> Enviando informações sobre ' + IfThen(Copy(strUSBinfo,1,1)='I','Inserção','Remoção')+ ' de dispositivo USB ao Gerente WEB!');
  2581 + if (g_oCacic.deCrypt(XML_RetornaValor('nm_device', strRetorno)) <> '') then
  2582 + log_diario('Dispositivo USB ' + IfThen(Copy(strUSBinfo,1,1)='I','Inserido','Removido')+': "' + g_oCacic.deCrypt(XML_RetornaValor('nm_device', strRetorno)+'"')+'"');
  2583 + Request_Ger_Cols.Free;
  2584 +
  2585 + Finalizar(true);
  2586 + end;
  2587 +
2555 2588 For intAux := 1 to ParamCount do
2556 2589 Begin
2557 2590 if LowerCase(Copy(ParamStr(intAux),1,15)) = '/ip_serv_cacic=' then
... ... @@ -2656,7 +2689,9 @@ Begin
2656 2689 Finalizar(false);
2657 2690 Sair;
2658 2691 End;
2659   - End;
  2692 + End
  2693 + else
  2694 + log_Diario('Indicador CS_AUTO_UPDATE="N". O recomendado é que esteja em "S" no Gerente WEB!');
2660 2695  
2661 2696 if ((GetValorDatMemoria('Configs.CS_COLETA_HARDWARE' , v_tstrCipherOpened) = 'S') or
2662 2697 (GetValorDatMemoria('Configs.CS_COLETA_SOFTWARE' , v_tstrCipherOpened) = 'S') or
... ... @@ -3272,15 +3307,28 @@ Begin
3272 3307 // g_oCacic.Free;
3273 3308 End;
3274 3309  
  3310 +procedure CriaCookie;
  3311 +Begin
  3312 + // A existência e bloqueio do arquivo abaixo evitará que Cacic2.exe chame o Ger_Cols quando este estiver em funcionamento
  3313 + AssignFile(v_Aguarde,g_oCacic.getCacicPath + 'temp\aguarde_GER.txt'); {Associa o arquivo a uma variável do tipo TextFile}
  3314 + {$IOChecks off}
  3315 + Reset(v_Aguarde); {Abre o arquivo texto}
  3316 + {$IOChecks on}
  3317 + if (IOResult <> 0) then // Arquivo não existe, será recriado.
  3318 + Rewrite (v_Aguarde);
  3319 +
  3320 + Append(v_Aguarde);
  3321 + Writeln(v_Aguarde,'Apenas um pseudo-cookie para o Cacic2 esperar o término de Ger_Cols');
  3322 + Append(v_Aguarde);
  3323 +End;
  3324 +
3275 3325 begin
3276 3326 g_oCacic := TCACIC.Create();
3277   -
3278 3327 if( not g_oCacic.isAppRunning( CACIC_APP_NAME ) ) then
3279 3328 begin
3280 3329 if ParamCount > 0 then
3281 3330 Begin
3282 3331 strAux := '';
3283   -
3284 3332 For intAux := 1 to ParamCount do
3285 3333 Begin
3286 3334 if (LowerCase(Copy(ParamStr(intAux),1,11)) = '/cacicpath=') then
... ... @@ -3322,18 +3370,8 @@ begin
3322 3370 log_DEBUG('Te_So obtido: "' + g_oCacic.getWindowsStrId() +'"');
3323 3371  
3324 3372 v_scripter := 'wscript.exe';
3325   - // A existência e bloqueio do arquivo abaixo evitará que Cacic2.exe chame o Ger_Cols quando este estiver em funcionamento
3326   - AssignFile(v_Aguarde,g_oCacic.getCacicPath + 'temp\aguarde_GER.txt'); {Associa o arquivo a uma variável do tipo TextFile}
3327   - {$IOChecks off}
3328   - Reset(v_Aguarde); {Abre o arquivo texto}
3329   - {$IOChecks on}
3330   - if (IOResult <> 0) then // Arquivo não existe, será recriado.
3331   - Rewrite (v_Aguarde);
3332   -
3333   - Append(v_Aguarde);
3334   - Writeln(v_Aguarde,'Apenas um pseudo-cookie para o Cacic2 esperar o término de Ger_Cols');
3335   - Append(v_Aguarde);
3336 3373  
  3374 + CriaCookie;
3337 3375 ChecaCipher;
3338 3376 ChecaCompress;
3339 3377  
... ...
ger_cols/ger_cols.res
No preview for this file type
ini_cols/ini_cols.dpr
... ... @@ -324,6 +324,7 @@ begin
324 324 log_DEBUG('Chamando "' + v_tstrModuloOpcao[0]+'.exe " /p_Option='+v_tstrModuloOpcao[2]);
325 325  
326 326 g_oCacic.createSampleProcess( g_oCacic.getCacicPath + '\modulos\' + strAux, CACIC_PROCESS_WAIT );
  327 + Sleep(500);
327 328 End;
328 329 except
329 330 end;
... ...
ini_cols/ini_cols.res
No preview for this file type
main.dfm
1 1 object FormularioGeral: TFormularioGeral
2   - Left = 301
3   - Top = 108
  2 + Left = 300
  3 + Top = 107
4 4 HorzScrollBar.Visible = False
5 5 VertScrollBar.Visible = False
6 6 BiDiMode = bdLeftToRight
... ... @@ -155,7 +155,7 @@ object FormularioGeral: TFormularioGeral
155 155 Height = 16
156 156 BevelInner = bvLowered
157 157 BevelOuter = bvLowered
158   - Caption = 'v. 2.4.0.xxx'
  158 + Caption = 'v. 2.6.0.xxx'
159 159 Color = clBackground
160 160 Font.Charset = DEFAULT_CHARSET
161 161 Font.Color = clWhite
... ...
main.pas
... ... @@ -39,7 +39,8 @@ uses
39 39 Buttons,
40 40 CACIC_Library,
41 41 ImgList,
42   - Graphics;
  42 + Graphics,
  43 + USBdetectClass;
43 44  
44 45 //IdTCPServer;
45 46 //IdFTPServer;
... ... @@ -211,9 +212,12 @@ type
211 212 procedure Popup_Menu_ContextoPopup(Sender: TObject);
212 213 procedure Timer_InicializaTrayTimer(Sender: TObject);
213 214 private
  215 + FUsb : TUsbClass;
214 216 ShutdownEmExecucao : Boolean;
215 217 IsMenuOpen : Boolean;
216 218 NotifyStruc : TNotifyIconData; {Estrutura do tray icon}
  219 + procedure UsbIN(ASender : TObject; const ADevType,AVendorID,ADeviceID : string);
  220 + procedure UsbOUT(ASender : TObject; const ADevType,AVendorID,ADeviceID : string);
217 221 procedure InicializaTray;
218 222 procedure Finaliza;
219 223 procedure VerificaDebugs;
... ... @@ -221,7 +225,7 @@ type
221 225 Function RetornaValorVetorUON1(id1 : string) : String;
222 226 Function RetornaValorVetorUON1a(id1a : string) : String;
223 227 Function RetornaValorVetorUON2(id2, idLocal: string) : String;
224   - procedure Invoca_GerCols(p_acao:string);
  228 + procedure Invoca_GerCols(p_acao:string; boolShowInfo : Boolean = true);
225 229 function GetVersionInfo(p_File: string):string;
226 230 function VerFmt(const MS, LS: DWORD): string;
227 231 procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
... ... @@ -327,6 +331,29 @@ begin
327 331 end;
328 332 inherited;
329 333 end;
  334 +
  335 +// Início de Procedimentos para monitoramento de dispositivos USB - Anderson Peterle - 02/2010
  336 +procedure TFormularioGeral.UsbIN(ASender : TObject; const ADevType,AVendorID,ADeviceID : string);
  337 +begin
  338 + // Envio de valores ao Gerente WEB
  339 + // Formato: USBinfo=I_ddmmyyyyhhnnss_ADeviceID
  340 + // Os valores serão armazenados localmente (cacic2.dat) se for impossível o envio.
  341 + Log_Debug('<< USB INSERIDO .:. Vendor ID => ' + AVendorID + ' .:. Device ID = ' + ADeviceID);
  342 + Invoca_GerCols('USBinfo=I_'+FormatDateTime('yyyymmddhhnnss', now) + '_' + AVendorID + '_' + ADeviceID,false);
  343 +end;
  344 +
  345 +
  346 +procedure TFormularioGeral.UsbOUT(ASender : TObject; const ADevType,AVendorID,ADeviceID : string);
  347 +begin
  348 + // Envio de valores ao Gerente WEB
  349 + // Formato: USBinfo=O_ddmmyyyyhhnnss_ADeviceID
  350 + // Os valores serão armazenados localmente (cacic2.dat) se for impossível o envio.
  351 + Log_Debug('>> USB REMOVIDO .:. Vendor ID => ' + AVendorID + ' .:. Device ID = ' + ADeviceID);
  352 + Invoca_GerCols('USBinfo=O_'+FormatDateTime('yyyymmddhhnnss', now) + '_' + AVendorID + '_' + ADeviceID,false);
  353 +end;
  354 +
  355 +// Fim de Procedimentos para monitoramento de dispositivos USB - Anderson Peterle - 02/2010
  356 +
330 357 procedure TFormularioGeral.MontaVetoresPatrimonio(p_strConfigs : String);
331 358 var Parser : TXmlParser;
332 359 i : integer;
... ... @@ -1231,6 +1258,11 @@ var strAux,
1231 1258 v_SystemDrive : TStrings;
1232 1259 begin
1233 1260  
  1261 + // Criação do objeto para monitoramento de dispositivos USB
  1262 + FUsb := TUsbClass.Create;
  1263 + FUsb.OnUsbInsertion := UsbIN;
  1264 + FUsb.OnUsbRemoval := UsbOUT;
  1265 +
1234 1266 // Essas variáveis ajudarão a controlar o redesenho do ícone no systray,
1235 1267 // evitando o "roubo" do foco.
1236 1268 g_intTaskBarAtual := 0;
... ... @@ -1516,6 +1548,7 @@ Begin
1516 1548 log_diario('PROBLEMAS NA FINALIZAÇÃO');
1517 1549 End;
1518 1550 g_oCacic.Free;
  1551 + FreeAndNil(FUsb);
1519 1552 FreeMemory(0);
1520 1553 Application.Terminate;
1521 1554 End;
... ... @@ -1527,7 +1560,7 @@ begin
1527 1560 If (getValorDatMemoria('Configs.SJI',v_tstrCipherOpened) = 'S') Then Finaliza;
1528 1561 end;
1529 1562  
1530   -procedure TFormularioGeral.Invoca_GerCols(p_acao:string);
  1563 +procedure TFormularioGeral.Invoca_GerCols(p_acao:string; boolShowInfo : Boolean = true);
1531 1564 begin
1532 1565 Matar(g_oCacic.getCacicPath + 'temp\','*.txt');
1533 1566 Matar(g_oCacic.getCacicPath + 'temp\','*.ini');
... ... @@ -1535,12 +1568,17 @@ begin
1535 1568 // Caso exista o Gerente de Coletas será verificada a versão e excluída caso antiga(Uma forma de ação pró-ativa)
1536 1569 if ChecaGERCOLS then
1537 1570 Begin
  1571 + Timer_InicializaTray.Enabled := False;
1538 1572 ChecaCONFIGS;
1539 1573 CipherClose;
1540   - log_diario('Invocando Gerente de Coletas com ação: "'+p_acao+'"');
  1574 + if boolShowInfo then
  1575 + log_diario('Invocando Gerente de Coletas com ação: "'+p_acao+'"')
  1576 + else
  1577 + log_DEBUG('Invocando Gerente de Coletas com ação: "'+p_acao+'"');
1541 1578 Timer_Nu_Exec_Apos.Enabled := False;
1542   - Log_DEBUG('Criando Processo Ger_Cols...');
  1579 + Log_DEBUG('Criando Processo Ger_Cols => "'+g_oCacic.getCacicPath + 'modulos\GER_COLS.EXE /'+p_acao+' /CacicPath='+g_oCacic.getCacicPath+'"');
1543 1580 g_oCacic.createSampleProcess(g_oCacic.getCacicPath + 'modulos\GER_COLS.EXE /'+p_acao+' /CacicPath='+g_oCacic.getCacicPath,false,SW_HIDE);
  1581 + Timer_InicializaTray.Enabled := True;
1544 1582 End
1545 1583 else
1546 1584 log_diario('Não foi possível invocar o Gerente de Coletas!');
... ... @@ -2001,6 +2039,7 @@ procedure TFormularioGeral.WMQueryEndSession(var Msg: TWMQueryEndSession);
2001 2039 begin
2002 2040 // Quando há um shutdown do windows em execução, libera o close.
2003 2041 OnCloseQuery := Nil;
  2042 + FreeAndNil(FUsb);
2004 2043 Application.Terminate;
2005 2044 inherited // Continue ShutDown request
2006 2045 end;
... ... @@ -2451,6 +2490,8 @@ begin
2451 2490  
2452 2491 // Alguns cuidados necessários ao tráfego e recepção de valores pelo Gerente WEB
2453 2492 // Some cares about send and receive at Gerente WEB
  2493 + // A partir da versão 2.6.0.2 deixo de enviar a palavra chave para que o srCACICsrv busque-a diretamente de cacic2.dat
  2494 + {
2454 2495 v_strPalavraChave := FormularioGeral.getValorDatMemoria('Configs.te_palavra_chave', v_tstrCipherOpened);
2455 2496 v_strPalavraChave := StringReplace(v_strPalavraChave,' ' ,'<ESPACE>' ,[rfReplaceAll]);
2456 2497 v_strPalavraChave := StringReplace(v_strPalavraChave,'"' ,'<AD>' ,[rfReplaceAll]);
... ... @@ -2458,6 +2499,7 @@ begin
2458 2499 v_strPalavraChave := StringReplace(v_strPalavraChave,'\' ,'<BarrInv>' ,[rfReplaceAll]);
2459 2500 v_strPalavraChave := g_oCacic.enCrypt(v_strPalavraChave);
2460 2501 v_strPalavraChave := StringReplace(v_strPalavraChave,'+','<MAIS>',[rfReplaceAll]);
  2502 + }
2461 2503  
2462 2504 v_strTeSO := trim(StringReplace(FormularioGeral.getValorDatMemoria('Configs.TE_SO', v_tstrCipherOpened),' ','<ESPACE>',[rfReplaceAll]));
2463 2505 v_strTeSO := g_oCacic.enCrypt(v_strTeSO);
... ... @@ -2500,8 +2542,8 @@ begin
2500 2542 '[' + g_oCacic.enCrypt(FormularioGeral.getValorDatMemoria('Configs.Endereco_WS' , v_tstrCipherOpened)) + ']' +
2501 2543 '[' + v_strTeSO + ']' +
2502 2544 '[' + v_strTeNodeAddress + ']' +
2503   - '[' + v_strPalavraChave + ']' +
2504   - '[' + g_oCacic.getCacicPath + 'Temp\' + ']' +
  2545 +// '[' + v_strPalavraChave + ']' +
  2546 + '[' + g_oCacic.getCacicPath + ']' +
2505 2547 '[' + v_strNuPortaSR + ']' +
2506 2548 '[' + v_strNuTimeOutSR + ']');
2507 2549  
... ... @@ -2515,8 +2557,8 @@ begin
2515 2557 '[' + g_oCacic.enCrypt(FormularioGeral.getValorDatMemoria('Configs.Endereco_WS' , v_tstrCipherOpened)) + ']' +
2516 2558 '[' + v_strTeSO + ']' +
2517 2559 '[' + v_strTeNodeAddress + ']' +
2518   - '[' + v_strPalavraChave + ']' +
2519   - '[' + g_oCacic.getCacicPath + 'Temp\' + ']' +
  2560 +// '[' + v_strPalavraChave + ']' +
  2561 + '[' + g_oCacic.getCacicPath + ']' +
2520 2562 '[' + v_strNuPortaSR + ']' +
2521 2563 '[' + v_strNuTimeOutSR + ']',false,SW_NORMAL);
2522 2564 BoolServerON := true;
... ...
mapa/mapacacic.res
No preview for this file type
testacrypt/main_testacrypt.pas
... ... @@ -99,9 +99,11 @@ implementation
99 99 procedure TForm1.CriptografaPalavra;
100 100 Begin
101 101 if (trim(form1.Edit_FraseOriginal.Text)<>'') then
102   - Form1.Edit_FraseCriptografadaEnviadaEstacao.Text := g_oCacic.enCrypt(trim(form1.Edit_FraseOriginal.Text))
103   - else if (trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text)<>'') then
104   - Form1.Edit_FraseOriginal.Text := g_oCacic.deCrypt(trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text));
  102 + Begin
  103 + Form1.Edit_FraseCriptografadaEnviadaEstacao.Text := g_oCacic.enCrypt(trim(form1.Edit_FraseOriginal.Text))
  104 + //else if (trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text)<>'') then
  105 + // Form1.Edit_FraseOriginal.Text := g_oCacic.deCrypt(trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text));
  106 + end;
105 107 End;
106 108  
107 109 procedure TForm1.Button_EfetuaTesteClick(Sender: TObject);
... ... @@ -114,111 +116,113 @@ var v_retorno,
114 116 IdHTTP1: TIdHTTP;
115 117 intAux : integer;
116 118 begin
117   -
118   - boolProcessaPausa := true;
119   -// InicializaCampos;
120   - CriptografaPalavra;
121   -
122   - intAux := POS('255.255.255.255',Edit_ScriptPath.Text);
123   - if (intAux > 0) then
124   - Begin
125   - StatusBar_Mensagens.Panels[0].Text := 'ATENÇÃO: Caso não seja um teste local, informe um endereço válido.';
126   - StatusBar_Mensagens.Color := clYellow;
127   - Edit_ScriptPath.SetFocus;
128   - End
129   - else
  119 + if (Trim(Edit_FraseCriptografadaEnviadaEstacao.Text) <> '') then
130 120 Begin
  121 + boolProcessaPausa := true;
  122 + // InicializaCampos;
  123 + CriptografaPalavra;
131 124  
132   - Request_Config := TStringList.Create;
133   - Request_Config.Values['cs_operacao'] := 'TestaCrypt';
134   - Request_Config.Values['cs_cipher'] := '1';
135   - Request_Config.Values['te_CipheredText'] := trim(Form1.Edit_FraseCriptografadaEnviadaEstacao.Text);
136   - Response_Config := TStringStream.Create('');
137   -
138   - Try
139   - idHTTP1 := TIdHTTP.Create(nil);
140   - idHTTP1.AllowCookies := true;
141   - idHTTP1.ASCIIFilter := false;
142   - idHTTP1.AuthRetries := 1;
143   - idHTTP1.BoundPort := 0;
144   - idHTTP1.HandleRedirects := false;
145   - idHTTP1.ProxyParams.BasicAuthentication := false;
146   - idHTTP1.ProxyParams.ProxyPort := 0;
147   - idHTTP1.ReadTimeout := 0;
148   - idHTTP1.RecvBufferSize := 32768;
149   - idHTTP1.RedirectMaximum := 15;
150   - idHTTP1.Request.Accept := 'text/html, */*';
151   - idHTTP1.Request.BasicAuthentication := true;
152   - idHTTP1.Request.ContentLength := -1;
153   - idHTTP1.Request.ContentRangeStart := 0;
154   - idHTTP1.Request.ContentRangeEnd := 0;
155   - idHTTP1.Request.ContentType := 'text/html';
156   - idHTTP1.SendBufferSize := 32768;
157   - idHTTP1.Tag := 0;
158   -
159   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Fazendo comunicação com "'+form1.Edit_ScriptPath.Text+'"';
160   - Sleep(1000);
161   - Form1.StatusBar_Mensagens.Panels[0].Text := '';
162   -
163   - IdHTTP1.Post(trim(Form1.Edit_ScriptPath.Text), Request_Config, Response_Config);
164   -
165   - //ShowMessage('Retorno: '+Response_Config.DataString);
166   - idHTTP1.Free;
167   - v_retorno := Response_Config.DataString;
168   - v_Status := XML_RetornaValor('STATUS',v_retorno);
169   - Except
  125 + intAux := POS('255.255.255.255',Edit_ScriptPath.Text);
  126 + if (intAux > 0) then
170 127 Begin
171   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Problemas na comunicação...';
172   - Sleep(1000);
173   - Form1.StatusBar_Mensagens.Panels[0].Text := '';
174   - End;
175   - End;
176   - Request_Config.Free;
177   - Response_Config.Free;
178   -
179   - if (v_Status <> '') then
  128 + StatusBar_Mensagens.Panels[0].Text := 'ATENÇÃO: Caso não seja um teste local, informe um endereço válido.';
  129 + StatusBar_Mensagens.Color := clYellow;
  130 + Edit_ScriptPath.SetFocus;
  131 + End
  132 + else
180 133 Begin
181   - v_strAux := XML_RetornaValor('UnCipheredText',v_retorno);
182   - form1.Edit_IVServer.Text := XML_RetornaValor('IVServer',v_retorno);
183   - form1.Edit_CipherKeyServer.Text := XML_RetornaValor('CipherKeyServer',v_retorno);
184   - form1.Edit_FraseCriptografadaRecebidaServidor.Text := XML_RetornaValor('CipheredTextRecepted',v_retorno);
185   - form1.Edit_OperacaoRecebidaServidor.Text := XML_RetornaValor('CS_OPERACAO',v_retorno);
186   - if (v_strAux <> '') then
  134 +
  135 + Request_Config := TStringList.Create;
  136 + Request_Config.Values['cs_operacao'] := 'TestaCrypt';
  137 + Request_Config.Values['cs_cipher'] := '1';
  138 + Request_Config.Values['te_CipheredText'] := trim(Form1.Edit_FraseCriptografadaEnviadaEstacao.Text);
  139 + Response_Config := TStringStream.Create('');
  140 +
  141 + Try
  142 + idHTTP1 := TIdHTTP.Create(nil);
  143 + idHTTP1.AllowCookies := true;
  144 + idHTTP1.ASCIIFilter := false;
  145 + idHTTP1.AuthRetries := 1;
  146 + idHTTP1.BoundPort := 0;
  147 + idHTTP1.HandleRedirects := false;
  148 + idHTTP1.ProxyParams.BasicAuthentication := false;
  149 + idHTTP1.ProxyParams.ProxyPort := 0;
  150 + idHTTP1.ReadTimeout := 0;
  151 + idHTTP1.RecvBufferSize := 32768;
  152 + idHTTP1.RedirectMaximum := 15;
  153 + idHTTP1.Request.Accept := 'text/html, */*';
  154 + idHTTP1.Request.BasicAuthentication := true;
  155 + idHTTP1.Request.ContentLength := -1;
  156 + idHTTP1.Request.ContentRangeStart := 0;
  157 + idHTTP1.Request.ContentRangeEnd := 0;
  158 + idHTTP1.Request.ContentType := 'text/html';
  159 + idHTTP1.SendBufferSize := 32768;
  160 + idHTTP1.Tag := 0;
  161 +
  162 + Form1.StatusBar_Mensagens.Panels[0].Text := 'Fazendo comunicação com "'+form1.Edit_ScriptPath.Text+'"';
  163 + Sleep(1000);
  164 + Form1.StatusBar_Mensagens.Panels[0].Text := '';
  165 +
  166 + IdHTTP1.Post(trim(Form1.Edit_ScriptPath.Text), Request_Config, Response_Config);
  167 +
  168 + //ShowMessage('Retorno: '+Response_Config.DataString);
  169 + idHTTP1.Free;
  170 + v_retorno := Response_Config.DataString;
  171 + v_Status := XML_RetornaValor('STATUS',v_retorno);
  172 + Except
187 173 Begin
188   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := v_strAux;
189   - if (trim(form1.Edit_FraseDecriptografadaDevolvidaServidor.Text) <> trim(form1.Edit_FraseOriginal.Text)) then
  174 + Form1.StatusBar_Mensagens.Panels[0].Text := 'Problemas na comunicação...';
  175 + Sleep(1000);
  176 + Form1.StatusBar_Mensagens.Panels[0].Text := '';
  177 + End;
  178 + End;
  179 + Request_Config.Free;
  180 + Response_Config.Free;
  181 +
  182 + if (v_Status <> '') then
  183 + Begin
  184 + v_strAux := XML_RetornaValor('UnCipheredText',v_retorno);
  185 + form1.Edit_IVServer.Text := XML_RetornaValor('IVServer',v_retorno);
  186 + form1.Edit_CipherKeyServer.Text := XML_RetornaValor('CipherKeyServer',v_retorno);
  187 + form1.Edit_FraseCriptografadaRecebidaServidor.Text := XML_RetornaValor('CipheredTextRecepted',v_retorno);
  188 + form1.Edit_OperacaoRecebidaServidor.Text := XML_RetornaValor('CS_OPERACAO',v_retorno);
  189 + if (v_strAux <> '') then
190 190 Begin
191   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clRed;
192   - if (Edit_CipherKeyStation.Text <> Edit_CipherKeyServer.Text) then
  191 + form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := v_strAux;
  192 + if (trim(form1.Edit_FraseDecriptografadaDevolvidaServidor.Text) <> trim(form1.Edit_FraseOriginal.Text)) then
193 193 Begin
194   - Edit_CipherKeyStation.Color := clYellow;
195   - Edit_CipherKeyServer.Color := clYellow;
196   - End;
197   - if (Edit_IVStation.Text <> Edit_IVServer.Text) then
198   - Begin
199   - Edit_IVStation.Color := clYellow;
200   - Edit_IVServer.Color := clYellow;
201   - End;
202   -
  194 + form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clRed;
  195 + if (Edit_CipherKeyStation.Text <> Edit_CipherKeyServer.Text) then
  196 + Begin
  197 + Edit_CipherKeyStation.Color := clYellow;
  198 + Edit_CipherKeyServer.Color := clYellow;
  199 + End;
  200 + if (Edit_IVStation.Text <> Edit_IVServer.Text) then
  201 + Begin
  202 + Edit_IVStation.Color := clYellow;
  203 + Edit_IVServer.Color := clYellow;
  204 + End;
  205 +
  206 + End
  207 + else
  208 + form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clBlue;
203 209 End
204 210 else
205   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clBlue;
  211 + Begin
  212 + form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := 'NÃO FOI POSSÍVEL DECRIPTOGRAFAR!!!';
  213 + form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Style := [fsBold];
  214 + form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clRed;
  215 + End;
  216 + Form1.StatusBar_Mensagens.Panels[0].Text := 'Teste Concluído!';
206 217 End
207 218 else
208 219 Begin
209   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := 'NÃO FOI POSSÍVEL DECRIPTOGRAFAR!!!';
210   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Style := [fsBold];
211   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clRed;
  220 + Form1.StatusBar_Mensagens.Panels[0].Text := 'Problemas na comunicação...';
  221 + Sleep(1000);
  222 + Form1.StatusBar_Mensagens.Panels[0].Text := '';
212 223 End;
213   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Teste Concluído!';
214   - End
215   - else
216   - Begin
217   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Problemas na comunicação...';
218   - Sleep(1000);
219   - Form1.StatusBar_Mensagens.Panels[0].Text := '';
220 224 End;
221   - End;
  225 + end;
222 226 end;
223 227 // Pad a string with zeros so that it is a multiple of size
224 228 function TForm1.PadWithZeros(const str : string; size : integer) : string;
... ...