-
Notifications
You must be signed in to change notification settings - Fork 2
/
CACIC_Library.pas
executable file
·2097 lines (1868 loc) · 86.2 KB
/
CACIC_Library.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{*------------------------------------------------------------------------------
Package of both methods/properties to be used by CACIC Clients
@version CACIC_Library 2009-01-07 23:00 harpiain
@package CACIC_Agente
@subpackage CACIC_Library
@author Adriano dos Santos Vieira <harpiain at gmail.com>
@copyright Copyright (C) Adriano dos Santos Vieira. All rights reserved.
@license GNU/GPL, see LICENSE.php
CACIC_Library is free software and parts of it may contain or be derived from
the GNU General Public License or other free or open source software license.
See COPYRIGHT.php for copyright notices and details.
CACIC_Library - Coding style
for Constants
- characters always in uppercase
- use underscore for long name
e.g.
const CACIC_VERSION = '2.4.0';
for Variables
- characters always in lowercase
- start with "g" character for global
- start with "v" character for local
- start with "p" character for methods parameters
- start with "P" character for pointers
- use underscore for better read
e.g.
var g_global : string;
var v_local : string;
for Objects
- start with "o" character
e.g.
oCacicObject : TCACIC_Common;
for Methods
- start with lowercase word
- next words start with capital letter
e.g.
function getLocalFolderName() : string;
procedure setLocalFolderName( pPath: string );
-------------------------------------------------------------------------------}
unit CACIC_Library;
interface
uses Windows,
Classes,
SysUtils,
StrUtils,
MD5,
DCPcrypt2,
DCPrijndael,
DCPbase64,
ActiveX,
PJVersionInfo,
Registry,
IniFiles,
Tlhelp32,
ComObj,
ShellAPI,
WinSvc,
Variants;
type
{ ------------------------------------------------------------------------------
Tipo de dados para obter informacoes extendidas dos Sistema Operacional
ver MSDN: http://msdn.microsoft.com/en-us/library/ms724833(VS.85).aspx
-------------------------------------------------------------------------------}
TOSVersionInfoEx = packed record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of AnsiChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: Byte;
wReserved: Byte;
end;
{*------------------------------------------------------------------------------
Classe para obter informações do sistema windows
-------------------------------------------------------------------------------}
TCACIC_Windows = class
private
protected
g_strAcao :string;
g_local_folder_name: string;
/// Mantem a identificação do sistema operacional
g_osVersionInfo: TOSVersionInfo;
/// Mantem a identificação extendida do sistema operacional
g_osVersionInfoEx: TOSVersionInfoEx;
/// TRUE se houver informação extendida do SO, FALSE caso contrário
g_osVersionInfoExtended: boolean;
public
function explode(p_String, p_Separador : String) : TStrings; virtual; abstract;
function getBitPlatform() : string;
function getBoolToString(pBoolQuestion : boolean) : string; virtual; abstract;
function getHomeDrive() : string;
function getLocalFolderName() : string;
function getVersionFromHCR(pStrToProcess : String) : string;
function getVersionInfo(pStrFileName: string) : string;
function getWindowsStrId() : string;
function getWinDir() : string;
function implode(const pTStrArray: TStrings; const pStrSeparator: string) : string; virtual; abstract;
function isWindowsAdmin() : boolean;
function isWindowsGEVista() : boolean;
function isWindowsGEXP() : boolean;
function isWindowsNT() : boolean;
function isWindowsNTPlataform() : boolean;
function isWindowsVista() : boolean;
function isWindowsXP() : boolean;
function isWindows2000() : boolean;
function isWindows9xME() : boolean;
function verFmt(const MS, LS: DWORD) : string;
procedure writeDebugLog(pStrDebugMessage:string); virtual; abstract;
procedure writeExceptionLog(pStrExceptionMessage, pStrExceptionClassName : String; pStrAddedMessage : String = ''); virtual; abstract;
end;
{*------------------------------------------------------------------------------
Classe geral da biblioteca
-------------------------------------------------------------------------------}
TCACIC = class(TCACIC_Windows)
constructor Create();
destructor Destroy; override;
private
protected
g_web_manager_address,
g_web_services_folder_name,
g_main_program_name,
g_main_program_hash,
g_details_to_debugging : string;
g_boolCipher : boolean;
public
Windows : TCACIC_Windows; /// objeto de informacoes de windows
function checkIfFileDateIsToday(pStrFileName : String) : Boolean;
function countOccurences(const strSubText, strText: string) : Integer;
function createOneProcess(pStrCmd: string; pBoolWait: boolean; pWordShowWindow : word = SW_HIDE; waitMilliseconds : cardinal = INFINITE) : Boolean;
function capitalize (CONST s: STRING) : String;
function checkModule(pStrModuleFileName, pStrModuleHashCode : String) : String;
function deCrypt(pStrCipheredText : String; pBoolShowInLog : boolean = true; pBoolForceDecrypt : boolean = false) : String;
function deleteFileOrFolder(pStrFileOrFolderName : string) : Boolean;
function enCrypt(pStrPlainText : String; pBoolShowInLog : boolean = true; pBoolForceEncrypt : boolean = false) : String;
function explode(p_String, p_Separador : String) : TStrings; override;
function fixFolderAtHomeDrive(pStrFolderName : String) : String;
function fixWebAddress(pStrWebAddress : String) : String;
function getBlockSize() : Integer;
function getBoolCipher() : Boolean;
function getBoolToString(pBoolQuestion : boolean) : String; override;
function getCipherKey() : String;
function getDetailsToDebugging() : String;
function getFileSize(pStrFileNameToExamine: string; boolShowInKBytes: Boolean) : String;
function getInfFileName() : String;
function getFileHash(pStrFileName : String) : String;
function getFolderDate(var p_FolderName: string) : TDateTime;
function getIV() : String;
function getKeySize() : Integer;
function getMainProgramName() : String;
function getMainProgramHash() : String;
function getParam(pStrParamName : string) : String;
function getRootKey(strRootKey: String) : HKEY;
function getSeparatorKey() : String;
function getTagsFromValues(pStrSource : String; pStrTags : String = '[]') : TStrings;
function getValueFromFile(pStrSectionName, pStrKeyName, pStrFileName : String; pBoolShowInDebug : boolean = true) : String;
function getValueFromTags(pStrTagLabel, pStrSource : String; pStrTags : String = '[]') : String;
function getValueRegistryKey(p_KeyName : String) : Variant;
function getWebManagerAddress() : String;
function getWebServicesFolderName() : String;
function implode(const pTStrArray: TStrings; const pStrSeparator: string) : String; override;
function isAppRunning(pStrAppName: PAnsiChar ) : Boolean;
function isInDebugMode(pStrDetailName : String = '') : Boolean;
function listParams : String;
function padWithZeros(const str : string; size : integer) : String;
function removeSpecialsCharacters(p_Text : String) : String;
function removeZerosFimString(Texto : String) : String;
function replaceInvalidHTTPChars(p_String : String) : String;
function replacePseudoTagsWithCorrectChars(pStrString : String) : String;
function setValueRegistryKey(p_KeyName: String; p_Data: Variant) : Variant;
function trimEspacosExcedentes(p_str: string) : String;
procedure addApplicationToFirewall(p_EntryName:string;p_ApplicationPathAndExe:string; p_Enabled : boolean);
procedure criaTXT(p_Dir, p_File : String; pStrTextToWrite : String = '');
procedure killProcess(p_HWindowHandle: HWND);
procedure killTask(p_ExeFileName: string);
procedure replaceEnvironmentVariables(var pStrText : String; pStrTag : String = '%');
procedure setBoolCipher(p_boolCipher : boolean);
procedure setDetailsToDebugging(pStrDetailsToDebugging: String);
procedure setLocalFolderName(pStrLocalFolderName: string = 'Cacic');
procedure setMainProgramName(p_main_program_name: string);
procedure setMainProgramHash(p_main_program_hash: string);
procedure setValueToFile(pStrSectionName, pStrKeyName, pStrValue, pStrFileName : String);
procedure setValueToTags(pStrTagLabel, pStrTagValue : String; var pStrSource : String; pStrTags : String = '[]');
procedure setWebManagerAddress(pStrWebManagerAddress: string);
procedure setWebServicesFolderName(pStrWebServicesFolderName: string);
procedure writeDailyLog(pStrLogMessage : String; pStrFileNameSuffix : String = '');
procedure writeDebugLog(pStrDebugMessage : String); override;
procedure writeExceptionLog(pStrExceptionMessage, pStrExceptionClassName : String; pStrAddedMessage : String = ''); override;
function serviceGetType(sMachine, sService: PChar): DWORD;
function serviceStart(sMachine,sService : string ) : boolean;
function ServiceGetStatus(sMachine, sService: PChar): DWORD;
end;
// Declaração de constantes para a biblioteca
const CACIC_PROCESS_WAIT = true; // aguardar fim do processo
CACIC_PROCESS_NOWAIT = false; // não aguardar o fim do processo
// Some constants that are dependant on the cipher being used
// Assuming MCRYPT_RIJNDAEL_128 (i.e., 128bit blocksize, 256bit keysize)
const CACIC_KEYSIZE = 32; // 32 bytes = 256 bits
CACIC_BLOCKSIZE = 16; // 16 bytes = 128 bits
// Chave AES. Recomenda-se que cada empresa altere a sua chave.
// Esta chave é passada como parâmetro para o Gerente de Coletas
const CACIC_CIPHERKEY = 'CacicBrasil';
CACIC_IV = 'abcdefghijklmnop';
CACIC_SEPARATORKEY = '=CacicIsFree='; // Usada apenas para os arquivos de controle (.INF)
{
Controle de prioridade de processo
http://msdn.microsoft.com/en-us/library/ms683211(VS.85).aspx
}
const BELOW_NORMAL_PRIORITY_CLASS = $00004000;
{$EXTERNALSYM BELOW_NORMAL_PRIORITY_CLASS}
var P_OSVersionInfo: POSVersionInfo;
implementation
{*------------------------------------------------------------------------------
Construtor para a classe
Objetiva inicializar valores a serem usados pelos objetos da
classe.
-------------------------------------------------------------------------------}
constructor TCACIC.Create();
begin
FillChar(Self.g_osVersionInfoEx, SizeOf(Self.g_osVersionInfoEx), 0);
{$TYPEDADDRESS OFF}
P_OSVersionInfo := @Self.g_osVersionInfoEx;
{$TYPEDADDRESS ON}
Self.g_osVersionInfoEx.dwOSVersionInfoSize:= SizeOf(TOSVersionInfoEx);
Self.g_osVersionInfoExtended := GetVersionEx(P_OSVersionInfo^);
if (not Self.g_osVersionInfoExtended) then begin
Self.g_osVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(Self.g_osVersionInfo);
end;
Self.Windows := TCACIC_Windows.Create();
end;
{*------------------------------------------------------------------------------
Destrutor para a classe
Objetiva finalizar valores usados pelos objetos da classe.
-------------------------------------------------------------------------------}
destructor TCACIC.Destroy();
begin
Try
P_OSVersionInfo:=nil;
FreeMemory(P_OSVersionInfo);
Except
End;
inherited;
end;
function TCACIC.getRootKey(strRootKey: String): HKEY;
begin
/// Encontrar uma maneira mais elegante de fazer esses testes.
if Trim(strRootKey) = 'HKEY_LOCAL_MACHINE' Then Result := HKEY_LOCAL_MACHINE
else if Trim(strRootKey) = 'HKEY_CLASSES_ROOT' Then Result := HKEY_CLASSES_ROOT
else if Trim(strRootKey) = 'HKEY_CURRENT_USER' Then Result := HKEY_CURRENT_USER
else if Trim(strRootKey) = 'HKEY_USERS' Then Result := HKEY_USERS
else if Trim(strRootKey) = 'HKEY_CURRENT_CONFIG' Then Result := HKEY_CURRENT_CONFIG
else if Trim(strRootKey) = 'HKEY_DYN_DATA' Then Result := HKEY_DYN_DATA;
end;
function TCACIC.deleteFileOrFolder(pStrFileOrFolderName: String) : boolean;
var OS: TSHFileOpStruct;
begin
Result := true;
if Length(pStrFileOrFolderName) > 0 then
begin
FillChar(OS, sizeof(OS),0);
OS.pFrom := PChar(pStrFileOrFolderName + #0);
OS.wFunc := FO_DELETE;
OS.fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
Result := (SHFileOperation(OS)=0);
end
end;
{ Returns a count of the number of occurences of SubText in Text }
function TCACIC.CountOccurences(const strSubText, strText: string): Integer;
begin
if (strSubText = '') OR (strText = '') OR (Pos(strSubText, strText) = 0) then
Result := 0
else
Result := (Length(strText) - Length(StringReplace(strText, strSubText, '', [rfReplaceAll]))) div Length(strSubText);
end; { CountOccurences }
{*------------------------------------------------------------------------------------
Transformar as variáveis de ambiente existentes no Texto em seus respectivos valores
-------------------------------------------------------------------------------------}
procedure TCACIC.replaceEnvironmentVariables(var pStrText : String; pStrTag : String = '%');
var intLoop : integer;
strVariableName : String;
tstrVariablesNames : TStrings;
begin
// Somente trato as variáveis de ambiente se as tags estiverem em número par!
if (countOccurences(pStrTag,pStrText) mod 2 = 0) then
Begin
tstrVariablesNames := explode(pStrText, pStrTag);
intloop := 1;
while (intLoop < tstrVariablesNames.Count) do
Begin
if strVariableName <> '' then
strVariableName := strVariableName + ',';
strVariableName := strVariableName + tstrVariablesNames[intLoop];
inc(intLoop,2);
End;
tstrVariablesNames := explode(strVariableName,',');
for intLoop := 0 to tstrVariablesNames.Count - 1 do
pStrText := StringReplace(pStrText,pStrTag + tstrVariablesNames[intLoop] + pStrTag, GetEnvironmentVariable(tstrVariablesNames[intLoop]),[rfReplaceAll]);
End;
writeDebugLog('replaceEnvironmentVariables: Final: "' + pStrText + '"');
end;
{*------------------------------------------------------------------------------------
Retornar o endereço Web devidamente formatado
-------------------------------------------------------------------------------------}
function TCACIC.fixWebAddress(pStrWebAddress : String): String;
Begin
Result := '';
if (pStrWebAddress <> '') then
Begin
Result := StringReplace(pStrWebAddress,'//' ,'',[rfReplaceAll]); // Substituo possíveis "//" por nada
Result := StringReplace(Result ,'http:','',[rfReplaceAll]); // Substituo possível "http:" por nada
Result := Result + '/'; // Acrescento "/"
Result := StringReplace(Result ,'//' ,'',[rfReplaceAll]); // Substituo possíveis "//" por nada
Result := Result + '/'; // Acrescento "/'
Result := 'http://' + StringReplace(Result, '//', '/', [rfReplaceAll]); // Precedo com "http://"
End;
End;
{*------------------------------------------------------------------------------------
Retornar para fixar um nome de pasta no HomeDrive
-------------------------------------------------------------------------------------}
function TCACIC.fixFolderAtHomeDrive(pStrFolderName : String) : String;
var tstrFolderName1,
tstrFolderName2 : TStrings;
intAUX : integer;
Begin
Result := pStrFolderName;
// Crio um array separado por ":" (Para o caso de ter sido informada a letra da unidade)
//tstrLocalFolder1 := TStrings.Create;
tstrFolderName1 := explode(StringReplace(pStrFolderName,'/','\',[rfReplaceAll]),':');
if (tstrFolderName1.Count > 1) then
Begin
tstrFolderName2 := TStrings.Create;
// Ignoro a letra informada...
// Certifico-me de que as barras são invertidas... (erros acontecem)
// Crio um array quebrado por "\"
Result := tstrFolderName1[1];
tstrFolderName2 := explode(Result,'\');
// Inicializo retorno com a unidade raiz do Sistema Operacional
// Concateno ao retorno as partes que formarão o caminho completo do CACIC
Result := getHomeDrive;
for intAux := 0 to (tstrFolderName2.Count-1) do
if (tstrFolderName2[intAux] <> '') then
Result := Result + tstrFolderName2[intAux];
tstrFolderName2.Free;
End
else
Result := getHomeDrive + pStrFolderName + '\';
tstrFolderName1.Free;
End;
{*------------------------------------------------------------------------------------
Retornar Boolean TRUE caso as informações de executável e hash-code estejam corretas
-------------------------------------------------------------------------------------}
function TCACIC.checkModule(pStrModuleFileName, pStrModuleHashCode : String) : String;
Begin
if (getFileHash(pStrModuleFileName) = pStrModuleHashCode) then
Result := 'Ok!'
else if FileExists(pStrModuleFileName) then
Result := 'Módulo Corrompido!'
else
Result := 'Módulo Não Baixado!';
End;
function TCACIC.getFileSize(pStrFileNameToExamine: string; boolShowInKBytes: Boolean): string;
var
SearchRec: TSearchRec;
strPath: string;
intRetval,
intFileSize,
intKbytes : Integer;
begin
Try
intKbytes := StrToInt(IfThen(boolShowInKBytes,'1024','1'));
strPath := ExpandFileName(pStrFileNameToExamine);
try
intRetval := FindFirst(ExpandFileName(pStrFileNameToExamine), faAnyFile, SearchRec);
if intRetval = 0 then
intFileSize := SearchRec.Size
else
intFileSize := -1;
finally
SysUtils.FindClose(SearchRec);
end;
Result := IntToStr(intFileSize);
if intFileSize > -1 then
Result := IntToStr((StrToInt(Result) div intKbytes)) ;
Except
End;
end;
function TCACIC.getParam(pStrParamName : string) : String;
var strAuxParamName : String;
intAuxLoop : integer;
Begin
Result := '';
strAuxParamName := '/' + Trim(pStrParamName) + '=';
intAuxLoop := 1;
while (intAuxLoop <= ParamCount) do
Begin
if (LowerCase(Copy(ParamStr(intAuxLoop),1,StrLen(PAnsiChar(strAuxParamName)))) = LowerCase(strAuxParamName)) then
Result := Copy(ParamStr(intAuxLoop),StrLen(PAnsiChar(strAuxParamName))+1,StrLen(PChar(ParamStr(intAuxLoop))));
inc(intAuxLoop);
End;
End;
function TCACIC.listParams : String;
var intAuxLoop : integer;
Begin
Result := Concat('Nenhum Parâmetro Recebido na Chamada a "' + ParamStr(0) + '"' , chr(13) ,DupeString('=',100));
if (ParamCount > 1) then
Begin
Result := Concat('Lista de Parâmetros Recebidos' , chr(13) , DupeString('-',50) , chr(13));
for intAuxLoop := 1 to ParamCount - 1 do
Result := Concat(Result,ParamStr(intAuxLoop),chr(13));
Result := Concat(Result,DupeString('=',100),chr(13));
End;
End;
function TCACIC.removeSpecialsCharacters(p_Text : String) : String;
var I : Integer;
strAuxRSC : String;
Begin
For I := 0 To Length(p_Text) Do
if ord(p_Text[I]) in [32..126] Then
strAuxRSC := strAuxRSC + p_Text[I]
else
strAuxRSC := strAuxRSC + ' '; // Coloca um espaço onde houver caracteres especiais
Result := strAuxRSC;
end;
function TCACIC.setValueRegistryKey(p_KeyName: String; p_Data: Variant): Variant;
var RegEditSet: TRegistry;
RegDataType: TRegDataType;
strRootKey, strKey, strValue : String;
ListaAuxSet : TStrings;
I : Integer;
begin
ListaAuxSet := explode(p_KeyName, '\');
strRootKey := ListaAuxSet[0];
For I := 1 To ListaAuxSet.Count - 2 do
strKey := strKey + ListaAuxSet[I] + '\';
strValue := ListaAuxSet[ListaAuxSet.Count - 1];
RegEditSet := TRegistry.Create;
try
RegEditSet.Access := KEY_WRITE;
RegEditSet.Rootkey := GetRootKey(strRootKey);
if RegEditSet.OpenKey(strKey, True) then
Begin
RegDataType := RegEditSet.GetDataType(strValue);
if RegDataType = rdString then
begin
RegEditSet.WriteString(strValue, p_Data);
end
else if RegDataType = rdExpandString then
begin
RegEditSet.WriteExpandString(strValue, p_Data);
end
else if RegDataType = rdInteger then
begin
RegEditSet.WriteInteger(strValue, p_Data);
end
else
begin
RegEditSet.WriteString(strValue, p_Data);
end;
end;
finally
RegEditSet.CloseKey;
end;
ListaAuxSet.Free;
RegEditSet.Free;
end;
function TCACIC.getValueRegistryKey(p_KeyName: String): Variant;
var RegEditGet: TRegistry;
RegDataType: TRegDataType;
strRootKey, strKey, strValue, s: String;
ListaAuxGet : TStrings;
DataSize, Len, I : Integer;
begin
try
Result := '';
ListaAuxGet := explode(p_KeyName, '\');
strRootKey := ListaAuxGet[0];
For I := 1 To ListaAuxGet.Count - 2 Do strKey := strKey + ListaAuxGet[I] + '\';
strValue := ListaAuxGet[ListaAuxGet.Count - 1];
if (strValue = '(Padrão)') then
strValue := ''; //Para os casos de se querer buscar o valor default (Padrão)
RegEditGet := TRegistry.Create;
RegEditGet.Access := KEY_READ;
RegEditGet.Rootkey := GetRootKey(strRootKey);
if RegEditGet.OpenKeyReadOnly(strKey) then //teste
Begin
RegDataType := RegEditGet.GetDataType(strValue);
if (RegDataType = rdString) or (RegDataType = rdExpandString) then
Result := RegEditGet.ReadString(strValue)
else if RegDataType = rdInteger then
Result := RegEditGet.ReadInteger(strValue)
else if (RegDataType = rdBinary) or (RegDataType = rdUnknown) then
Begin
DataSize := RegEditGet.GetDataSize(strValue);
if DataSize = -1 then
exit;
SetLength(s, DataSize);
Len := RegEditGet.ReadBinaryData(strValue, PChar(s)^, DataSize);
if Len <> DataSize then
exit;
Result := removeSpecialsCharacters(s);
End
end;
finally
RegEditGet.CloseKey;
RegEditGet.Free;
ListaAuxGet.Free;
end;
end;
function TCACIC.getFolderDate(var p_FolderName: string): TDateTime;
var
Rec: TSearchRec;
Found: Integer;
Date: TDateTime;
begin
if (p_FolderName[Length(p_FolderName)] = '\') then
p_FolderName := Copy(p_FolderName,1,Length(p_FolderName)-1);
Result := 0;
Found := FindFirst(p_FolderName, faDirectory, Rec);
try
if Found = 0 then
begin
Date := FileDateToDateTime(Rec.Time);
Result := Date;
end;
finally
sysutils.FindClose(Rec);
end;
end;
Function TCACIC.removeZerosFimString(Texto : String) : String;
var I : Integer;
strAuxRZFS : string;
Begin
strAuxRZFS := '';
if (Length(trim(Texto))>0) then
For I := Length(Texto) downto 0 do
if (ord(Texto[I])<>0) Then
strAuxRZFS := Texto[I] + strAuxRZFS;
Result := trim(strAuxRZFS);
end;
procedure TCACIC.criaTXT(p_Dir, p_File : String; pStrTextToWrite : String = '');
var v_TXT : TextFile;
begin
AssignFile(v_TXT,p_Dir + '\' + p_File + '.txt'); {Associa o arquivo a uma variável do tipo TextFile}
Rewrite (v_TXT);
if (pStrTextToWrite <> '') then
Begin
Append(v_TXT);
Writeln(v_TXT,pStrTextToWrite);
End;
Closefile(v_TXT);
end;
{
function RetornaValorShareNT(pStrKey, pStrText : String) : String;
var intPosKey,
intLoop : integer;
Begin
Result := '';
intPosKey := pos(' ' + pStrKey + '=',pStrText);
if (intPosKey > 0) then
Begin
intLoop := length(pStrText);
while (intLoop > intPosKey) do
Begin
if (copy(pStrText,intLoop,1) <> '=') then
Result := copy(pStrText,intLoop,1) + Result
else
Begin
if (copy(pStrText,intLoop - length(pStrKey),length(pStrKey)) = pStrKey) then
exit
else
Begin
Result := '';
while (copy(pStrText,intLoop,1) <> ' ') do
dec(intLoop);
End;
End;
dec(intLoop);
End;
End;
End;
}
// Função para recuperar valor delimitado por tags "[" e "]"
function TCACIC.getValueFromTags(pStrTagLabel, pStrSource : String; pStrTags : String = '[]'): String;
var strTagInicio,
strTagFim,
strSource : String;
begin
Result := '';
strSource := LowerCase(pStrSource);
strTagInicio := copy(pStrTags,1,1) + LowerCase(pStrTagLabel) + copy(pStrTags,2,1);
strTagFim := copy(pStrTags,1,1) + '/' + LowerCase(pStrTagLabel) + copy(pStrTags,2,1);
if (pos(strTagInicio,strSource) > 0) and (pos(strTagFim,strSource) > 0) then
Result := copy(pStrSource,pos(strTagInicio,strSource)+length(strTagInicio),pos(strTagFim,strSource) - pos(strTagInicio,strSource) - length(strTagInicio));
writeDebugLog('getValueFromTags: "'+pStrTagLabel+'" => "' + Result + '"');
End;
// Função para obter nomes de tags existentes em pStrSource
function TCACIC.getTagsFromValues(pStrSource : String; pStrTags : String = '[]') : TStrings;
var intLoopTags : integer;
strTagsNames : String;
tstrTags : TStrings;
Begin
tstrTags := explode(pStrSource,copy(pStrTags,2,1));
strTagsNames := '';
for intLoopTags := 0 to tstrTags.Count -1 do
Begin
if (copy(tstrTags[intLoopTags],1,1) = copy(pStrTags,1,1)) and (copy(tstrTags[intLoopTags],2,1) <> '/') then
Begin
if (strTagsNames <> '') then
strTagsNames := strTagsNames + ',';
strTagsNames := strTagsNames + copy(tstrTags[intLoopTags],2,length(tstrTags[intLoopTags]));
End;
End;
Result := explode(strTagsNames,',');
End;
// Procedure para atribuir valor delimitados por tags "[" e "]"
procedure TCACIC.setValueToTags(pStrTagLabel, pStrTagValue : String; var pStrSource : String; pStrTags : String = '[]');
var strAuxSVTT : String;
begin
strAuxSVTT := getValueFromTags(pStrTagLabel,pStrSource,pStrTags);
pStrSource := StringReplace(pStrSource, copy(pStrTags,1,1) + pStrTagLabel + copy(pStrTags,2,1) + strAuxSVTT + copy(pStrTags,1,1) + '/' + pStrTagLabel + copy(pStrTags,2,1), '' , [rfReplaceAll]);
pStrSource := pStrSource + copy(pStrTags,1,1) + pStrTagLabel + copy(pStrTags,2,1) + pStrTagValue + copy(pStrTags,1,1) + '/' + pStrTagLabel + copy(pStrTags,2,1);
End;
function TCACIC.getValueFromFile(pStrSectionName, pStrKeyName, pStrFileName : String; pBoolShowInDebug : boolean = true): String;
//Para buscar do Arquivo INF...
// Marreta devido a limitações do KERNEL w9x no tratamento de arquivos texto e suas seções
var textFileText : TStringList;
intFileLine,
intSectionSize,
intKeySize : integer;
strSectionName,
strKeyName : string;
begin
if pBoolShowInDebug then // Para evitar EStackOverflow devido a requisição recursiva!
Begin
writeDebugLog('getValueFromFile: pStrSectionName: "' + pStrSectionName + '"');
writeDebugLog('getValueFromFile: pStrKeyName: "' + pStrKeyName + '"');
writeDebugLog('getValueFromFile: pStrFileName: "' + pStrFileName + '"');
End;
Result := '';
strSectionName := '[' + pStrSectionName + ']';
intSectionSize := strLen(PChar(strSectionName));
strKeyName := pStrKeyName + '=';
intKeySize := strLen(PChar(strKeyName));
textFileText := TStringList.Create;
intFileLine := 0;
if (FileExists(pStrFileName)) then
Begin
try
textFileText.LoadFromFile(pStrFileName);
While (intFileLine < textFileText.Count) Do
Begin
if (LowerCase(Trim(PChar(Copy(textFileText[intFileLine],1,intSectionSize)))) = LowerCase(Trim(PChar(strSectionName)))) then
Begin
inc(intFileLine);
While (intFileLine < textFileText.Count) and (Trim(PChar(Copy(textFileText[intFileLine],1,1)))<>'[') Do
Begin
if (LowerCase(Trim(PChar(Copy(textFileText[intFileLine],1,intKeySize)))) = LowerCase(Trim(PChar(strKeyName)))) then
Begin
Result := PChar(Copy(textFileText[intFileLine],intKeySize + 1,strLen(PChar(textFileText[intFileLine]))-intKeySize));
intFileLine := textFileText.Count;
End;
inc(intFileLine);
End;
End;
inc(intFileLine);
End;
finally
textFileText.Free;
end;
end
else
textFileText.Free;
if pBoolShowInDebug then
Begin
writeDebugLog('getValueFromFile: Result: "' + Result + '"');
writeDebugLog('getValueFromFile: ' + DupeString(':',100));
End;
end;
// Para gravar no Arquivo INF...
procedure TCACIC.setValueToFile(pStrSectionName, pStrKeyName, pStrValue, pStrFileName : String);
var InfFile : TIniFile;
begin
self.writeDebugLog('setValueToFile: pStrSectionName: "' + pStrSectionName + '"');
self.writeDebugLog('setValueToFile: pStrKeyName: "' + pStrKeyName + '"');
self.writeDebugLog('setValueToFile: pStrValue: "' + pStrValue + '"');
self.writeDebugLog('setValueToFile: pStrFileName: "' + pStrFileName + '"');
self.writeDebugLog('setValueToFile: ' + DupeString(':',100));
if (FileGetAttr(pStrFileName) and faReadOnly) > 0 then
FileSetAttr(pStrFileName, FileGetAttr(pStrFileName) xor faReadOnly);
InfFile := TIniFile.Create(pStrFileName);
InfFile.DeleteKey(pStrSectionName, pStrKeyName);
InfFile.WriteString(pStrSectionName, pStrKeyName, pStrValue);
InfFile.Free;
end;
{*------------------------------------------------------------------------------
Insere exceção na FireWall nativa do MS-Windows
@param p_EntryName String Nome da exceção
@param p_ApplicationPathAndExe String Caminho e nome da aplicação
@param p_Enabled Boolean Estado da exceção
-------------------------------------------------------------------------------}
procedure TCACIC.addApplicationToFirewall(p_EntryName:string;p_ApplicationPathAndExe:string; p_Enabled : boolean);
var fwMgr,app:OleVariant;
profile:OleVariant;
Const NET_FW_PROFILE_DOMAIN = 0;
NET_FW_PROFILE_STANDARD = 1;
NET_FW_IP_VERSION_ANY = 2;
NET_FW_IP_PROTOCOL_UDP = 17;
NET_FW_IP_PROTOCOL_TCP = 6;
NET_FW_SCOPE_ALL = 0;
NET_FW_SCOPE_LOCAL_SUBNET = 1;
begin
Try
if FileExists(p_EntryName) then
Begin
CoInitialize(nil);
fwMgr := CreateOLEObject('HNetCfg.FwMgr');
profile := fwMgr.LocalPolicy.CurrentProfile;
app := CreateOLEObject('HNetCfg.FwAuthorizedApplication');
app.ProcessImageFileName := p_ApplicationPathAndExe;
app.Name := p_EntryName;
app.Scope := NET_FW_SCOPE_ALL;
app.IpVersion := NET_FW_IP_VERSION_ANY;
app.Enabled := p_Enabled;
profile.AuthorizedApplications.Add(app);
CoUninitialize;
End;
Except
on E : Exception do
writeExceptionLog(E.Message,E.ClassName,'addApplicationToFirewall: EntryName="'+p_EntryName+'" ApplicationPathAndExe="'+p_ApplicationPathAndExe+'"');
End;
end;
{*------------------------------------------------------------------------------
Retorna string de valores separados pelo caracter indicado
@param pTstrArray TStrings contendo os valores
@param pStrSeparator String separadora de valores
-------------------------------------------------------------------------------}
Function TCACIC.implode(const pTStrArray: TStrings; const pStrSeparator: string): String;
var i: Integer;
begin
Result := pTStrArray[0];
for i := 0 to pTStrArray.Count - 1 do
Result := Result + pStrSeparator + pTStrArray[i];
end;
{*------------------------------------------------------------------------------
Retorna array de elementos com base em separador
@param p_String String contendo campos e valores separados por caracter ou string
@param p_Separador String separadora de campos e valores
-------------------------------------------------------------------------------}
Function TCACIC.explode(p_String, p_Separador : String) : TStrings;
var strItem : String;
ListaAuxUTILS : TStrings;
NumCaracteres,
TamanhoSeparador,
I : Integer;
Begin
ListaAuxUTILS := TStringList.Create;
strItem := '';
NumCaracteres := Length(p_String);
TamanhoSeparador := Length(p_Separador);
I := 1;
While I <= NumCaracteres Do
Begin
If (Copy(p_String,I,TamanhoSeparador) = p_Separador) or (I = NumCaracteres) Then
Begin
if (I = NumCaracteres) then strItem := strItem + p_String[I];
ListaAuxUTILS.Add(trim(strItem));
strItem := '';
I := I + (TamanhoSeparador-1);
end
Else
strItem := strItem + p_String[I];
I := I + 1;
End;
Explode := ListaAuxUTILS;
end;
{*------------------------------------------------------------------------------
Elimina espacos excedentes na string
@param p_str String a excluir espacos
-------------------------------------------------------------------------------}
function TCACIC.trimEspacosExcedentes(p_str: String): String;
begin
if(ansipos(' ', p_str ) <> 0 ) then
repeat
p_str := StringReplace( p_str, ' ', ' ', [rfReplaceAll] );
until ( ansipos( ' ', p_str ) = 0 );
Result := p_str;
end;
{*------------------------------------------------------------------------------
Atribui valor booleano à variável indicadora do status da criptografia
@param p_boolCipher Valor booleano para atribuição à variável para status da
criptografia.
-------------------------------------------------------------------------------}
procedure TCACIC.setBoolCipher(p_boolCipher : boolean);
Begin
Self.g_boolCipher := p_boolCipher;
End;
{*------------------------------------------------------------------------------
Obtém o status da criptografia (TRUE -> Ligada / FALSE -> Desligada)
@return boolean contendo o status para a criptografia
-------------------------------------------------------------------------------}
function TCACIC.getBoolCipher() : boolean;
Begin
Result := Self.g_boolCipher;
End;
{*------------------------------------------------------------------------------
Atribui nomes de métodos para DEBUG
@param pStrWhatToDebug Valor string para atribuição à variável de nomes de
functions e procedures para DEBUG.
-------------------------------------------------------------------------------}
procedure TCACIC.setDetailsToDebugging(pStrDetailsToDebugging: String);
Begin
Self.g_details_to_debugging := pStrDetailsToDebugging;
End;
{*------------------------------------------------------------------------------
Obtém os nomes das functions e procedures indicadas para DEBUG
@return String contendo os nomes das functions e procedures para DEBUG
-------------------------------------------------------------------------------}
function TCACIC.getDetailsToDebugging() : String;
Begin
Result := Self.g_details_to_debugging;
End;
{*------------------------------------------------------------------------------
Atribui o nome da pasta do Gerente WEB
@param p_web_manager_address Nome da Pasta do Gerente WEB
-------------------------------------------------------------------------------}
procedure TCACIC.setWebManagerAddress(pStrWebManagerAddress: string);
begin
Self.g_web_manager_address := self.fixWebAddress(pStrWebManagerAddress);
end;
{*------------------------------------------------------------------------------
Atribui o nome da pasta dos scripts de comunicação do Gerente WEB
@param p_web_services_folder_name Nome da Pasta dos scripts de comunicação do Gerente WEB
-------------------------------------------------------------------------------}
procedure TCACIC.setWebServicesFolderName(pStrWebServicesFolderName: string);
begin
Self.g_web_services_folder_name := pStrWebServicesFolderName;
end;
{*------------------------------------------------------------------------------
Obtém o nome da pasta do Gerente WEB
@return String Nome da Pasta do Gerente WEB
-------------------------------------------------------------------------------}
function TCACIC.getWebManagerAddress() : string;
begin
Result := Self.g_web_manager_address;
end;
{*------------------------------------------------------------------------------
Obtém o nome da pasta dos scripts de comunicação do Gerente WEB
@return String Nome da Pasta dos scripts de comunicação do Gerente WEB
-------------------------------------------------------------------------------}
function TCACIC.getWebServicesFolderName() : string;
begin
Result := IfThen(Self.g_web_services_folder_name <> '', Self.g_web_services_folder_name , 'ws/');
end;
{*------------------------------------------------------------------------------
Atribui o caminho físico de instalação do agente cacic
@param p_local_folder_name Caminho físico de instalação do agente cacic
-------------------------------------------------------------------------------}
procedure TCACIC.setLocalFolderName(pStrLocalFolderName: string = 'Cacic');
begin
Self.g_local_folder_name := self.fixFolderAtHomeDrive(pStrLocalFolderName);
// DEBUG - Escrevendo lista de parâmetros recebidos
writeDebugLog('setLocalFolderName: "' + Self.g_local_folder_name + '"');
writeDebugLog('setLocalFolderName: ' + listParams);
end;
{*------------------------------------------------------------------------------
Atribui o nome do programa principal do CACIC
@param p_main_program_name Nome do programa principal do CACIC
-------------------------------------------------------------------------------}
procedure TCACIC.setMainProgramName(p_main_program_name: string);
begin
Self.g_main_program_name := p_main_program_name;
end;
{*------------------------------------------------------------------------------
Atribui o código hash do programa principal do CACIC
@param p_main_program_hash Código hash do programa principal do CACIC
-------------------------------------------------------------------------------}
procedure TCACIC.setMainProgramHash(p_main_program_hash: string);
begin
Self.g_main_program_hash := p_main_program_hash;
end;
{*------------------------------------------------------------------------------
Obtém o nome do programa principal do CACIC
@return String Nome do programa principal do CACIC
-------------------------------------------------------------------------------}
function TCACIC.getMainProgramName() : String;
begin
Result := Self.g_main_program_name;
end;
{*------------------------------------------------------------------------------
Obtém o hash-code do programa principal do CACIC
@return String Hash-Code do programa principal do CACIC